53cd0d7fc25595095151a9c9f17bd211ecadc7a367ba39334124e19b5e4f9f3c.tri (18886B)
1 !import prelude * 2 !import parser * 3 !import source_lexer * 4 !import source_ast * 5 !import source_equations * 6 !export * 7 8 -- Small, single-expression gate grammar. Its recursive expression parser is 9 -- one fixed point behind a wrapper; atom/application/lambda helpers receive 10 -- the recursive parser as an argument rather than forming top-level cycles. 11 sourceGateExpected kind found location = 12 parserDiagnostic 2 kind found location t 13 14 sourceGateExpect kind input = 15 lazyList 16 (_ : parserReplyFail (sourceGateExpected kind t t) input false false) 17 (token rest : 18 lazyBool 19 (_ : parserReplyOk token rest true false) 20 (_ : parserReplyFail 21 (sourceGateExpected kind (sourceTokenKind token) 22 (sourceTokenStart token)) input false false) 23 (equal? (sourceTokenKind token) kind)) 24 input 25 26 sourceGateEof input = 27 lazyList 28 (_ : parserReplyOk t input false false) 29 (token rest : parserReplyFail 30 (sourceGateExpected t (sourceTokenKind token) 31 (sourceTokenStart token)) input false false) 32 input 33 34 -- A lambda head is one or more name tokens followed by a same-line colon. 35 -- Stop scanning on the first non-name; do not mistake an ordinary `f x` 36 -- application for a multi-binder head when no colon follows. 37 sourceGateLambdaHead_ self input seen = 38 lazyList 39 (_ : false) 40 (token rest : 41 lazyBool 42 (_ : self rest true) 43 (_ : and? seen (equal? (sourceTokenKind token) sourceTokenColon)) 44 (equal? (sourceTokenKind token) sourceTokenName)) 45 input 46 47 sourceGateLambdaHead? = (input : y sourceGateLambdaHead_ input false) 48 49 sourceGateParseLambda expression input = 50 parserBind (parserSome (sourceGateExpect sourceTokenName)) (names : 51 parserThen (sourceGateExpect sourceTokenColon) 52 (parserThen sourceGateSkipNestedNewlines 53 (parserMap (body : foldr 54 (value name : sourceAstLambda name value) body names) 55 expression))) input 56 57 sourceGateParseGroup expression input = 58 parserBind (sourceGateExpect sourceTokenOpen) (open : 59 parserThen sourceGateSkipNestedNewlines 60 (parserBind expression (body : 61 parserThen sourceGateSkipNestedNewlines 62 (parserMap (close : sourceAstGroup open body close) 63 (sourceGateExpect sourceTokenClose))))) input 64 65 -- Shared binding head: retain patterns until contiguous equations have 66 -- coalesced. Only unique all-name singleton heads take the lambda fast path. 67 sourceGateParseBindingWith valueParser input = sourceEquationBinding valueParser input 68 69 sourceGateParseBinding expression = sourceGateParseBindingWith expression 70 71 -- Shared layout transition after `=`, `in`, or another binding boundary. 72 -- Inline values use the enclosing expression context. After newlines, the 73 -- next located token selects the new indentation context without rewriting 74 -- source text or exposing recursion driven by a known indentation counter. 75 sourceGateParseLayoutFirst expression indentedExpression label input = 76 lazyList 77 (_ : parserReplyFail (parserDiagnostic 40 label t t t) 78 input false false) 79 (token rest : 80 lazyBool 81 (_ : expression input) 82 (_ : indentedExpression 83 (sourcePositionColumn (sourceTokenStart token)) input) 84 (equal? (sourcePositionColumn (sourceTokenStart token)) 1)) 85 input 86 87 sourceGateParseLayoutValue expression indentedExpression label input = 88 lazyList 89 (_ : expression input) 90 (token rest : 91 lazyBool 92 (_ : parserThen sourceGateSkipNestedNewlines 93 (sourceGateParseLayoutFirst expression indentedExpression label) 94 input) 95 (_ : expression input) 96 (equal? (sourceTokenKind token) sourceTokenNewline)) 97 input 98 99 -- Local groups share the program head grammar, but are deliberately not 100 -- dependency-sorted: nested nonrecursive lets expose only earlier groups. 101 sourceGateLocalValue indentedExpression column input = 102 sourceGateParseLayoutValue (indentedExpression column) indentedExpression 103 "local binding value" input 104 sourceGateLocalNext? input column = (lazyList (_ : false) 105 (token rest : lazyBool 106 (_ : sourceGateLocalAfterNewlines? rest column) 107 (_ : false) (equal? (sourceTokenKind token) sourceTokenNewline)) input) 108 sourceGateLocalAfterNewlines_ self input column = (lazyList (_ : false) 109 (token rest : lazyBool (_ : self rest column) 110 (_ : and? (equal? (sourcePositionColumn (sourceTokenStart token)) column) 111 (sourceEquationBindingHead? input)) 112 (equal? (sourceTokenKind token) sourceTokenNewline)) input) 113 sourceGateLocalAfterNewlines? input column = y sourceGateLocalAfterNewlines_ input column 114 sourceGateLocalNext indentedExpression column input = (lazyBool 115 (_ : parserThen sourceGateSkipNestedNewlines 116 (sourceEquationBinding (sourceGateLocalValue indentedExpression column)) input) 117 (_ : parserReplyFail (sourceGateExpected "local equation" t t) input false false) 118 (sourceGateLocalNext? input column)) 119 sourceGateLocalGroupsReply bindings input = (lazyResult 120 (diagnostic remainder : parserReplyFail diagnostic input false false) 121 (groups unused : lazyResult 122 (diagnostic remainder : parserReplyFail diagnostic input false false) 123 (_ unused : parserReplyOk groups input false false) 124 (sourceEquationUnique groups)) (sourceEquationGroups bindings)) 125 sourceGateLocalBindings indentedExpression input = (lazyList 126 (_ : sourceGateAtomError input) 127 (token rest : parserBind 128 (sourceEquationBinding (sourceGateLocalValue indentedExpression 129 (sourcePositionColumn (sourceTokenStart token)))) 130 (first : parserBind (parserMany (sourceGateLocalNext indentedExpression 131 (sourcePositionColumn (sourceTokenStart token)))) 132 (remaining : sourceGateLocalGroupsReply (pair first remaining))) input) input) 133 sourceGateLocalBuild bindings body start end = (foldr 134 (rest binding : sourceAstLocal (fst binding) (snd binding) rest start end) 135 body bindings) 136 sourceGateLocalIndented indentedExpression parentColumn input = (lazyList 137 (_ : parserReplyFail (parserDiagnostic 40 "indented local block" t t t) input false false) 138 (token rest : lazyBool 139 (_ : sourceGateLocalBindings indentedExpression input) 140 (_ : parserReplyFail (parserDiagnostic 40 "indented local block" 141 (sourceTokenKind token) (sourceTokenStart token) t) input false false) 142 (and? (not? (lte_? (sourcePositionColumn (sourceTokenStart token)) parentColumn)) 143 (not? (lte_? (sourcePositionColumn (sourceTokenStart token)) 1)))) input) 144 sourceGateLocalStart indentedExpression parentColumn input = (lazyList 145 (_ : sourceGateLocalBindings indentedExpression input) 146 (token rest : lazyBool 147 (_ : parserThen sourceGateSkipNestedNewlines 148 (sourceGateLocalIndented indentedExpression parentColumn) input) 149 (_ : sourceGateLocalBindings indentedExpression input) 150 (equal? (sourceTokenKind token) sourceTokenNewline)) input) 151 sourceGateParseLet expression indentedExpression parentColumn input = (parserBind 152 (sourceGateExpect sourceTokenLet) (keyword : 153 parserBind (sourceGateLocalStart indentedExpression parentColumn) (bindings : 154 parserThen sourceGateSkipNestedNewlines 155 (parserThen (sourceGateExpect sourceTokenIn) 156 (parserMap (body : sourceGateLocalBuild bindings body 157 (sourceTokenStart keyword) (sourceAstEnd body)) 158 (sourceGateParseLayoutValue expression indentedExpression 159 "local binding body"))))) input) 160 sourceGateParseWhere expression indentedExpression body parentColumn input = (parserThen 161 (sourceGateExpect sourceTokenWhere) 162 (parserMap (bindings : sourceGateLocalBuild bindings body 163 (sourceAstStart body) 164 (sourceAstEnd (snd (foldl (_ binding : binding) (fst bindings) bindings)))) 165 (sourceGateLocalStart indentedExpression parentColumn)) input) 166 167 -- Newlines are meaningful between top-level expressions but are trivia 168 -- within a bracketed list. Each element is one atom: applications inside a 169 -- list need parentheses, as in the bootstrap grammar. 170 sourceGateSkipNestedNewlines = 171 parserMap (_ : t) (parserMany (sourceGateExpect sourceTokenNewline)) 172 173 sourceGateParseList atom input = 174 parserBind (sourceGateExpect sourceTokenLeftBracket) (open : 175 parserThen sourceGateSkipNestedNewlines 176 (parserBind 177 (parserMany 178 (parserBefore atom sourceGateSkipNestedNewlines)) 179 (elements : parserMap 180 (close : sourceAstList open elements close) 181 (sourceGateExpect sourceTokenRightBracket)))) input 182 183 sourceGateAtomError input = 184 lazyList 185 (_ : parserReplyFail (sourceGateExpected 7 t t) input false false) 186 (token rest : parserReplyFail 187 (sourceGateExpected 7 (sourceTokenKind token) 188 (sourceTokenStart token)) input false false) 189 input 190 191 -- A do block begins after an explicit operator atom and a newline. Its 192 -- statements start at one located column; deeper lines belong to the current 193 -- expression, while a new line at that column starts the next statement. 194 sourceGateDoBindHead? input = 195 lazyList 196 (_ : false) 197 (token rest : 198 lazyBool 199 (_ : lazyList 200 (_ : false) 201 (next tail : equal? (sourceTokenKind next) sourceTokenBindArrow) 202 rest) 203 (_ : false) 204 (equal? (sourceTokenKind token) sourceTokenName)) 205 input 206 207 sourceGateDoSameColumn_ self input column = 208 lazyList 209 (_ : false) 210 (token rest : 211 lazyBool 212 (_ : self rest column) 213 (_ : and? 214 (equal? (sourcePositionColumn (sourceTokenStart token)) column) 215 (sourceGateAtomStarts? (sourceTokenKind token))) 216 (equal? (sourceTokenKind token) sourceTokenNewline)) 217 input 218 219 sourceGateDoSameColumn? = (input column : 220 y sourceGateDoSameColumn_ input column) 221 222 sourceGateParseDoStatement expression indentedExpression column input = 223 lazyBool 224 (_ : parserBind (sourceGateExpect sourceTokenName) (name : 225 parserThen (sourceGateExpect sourceTokenBindArrow) 226 (parserMap (action : pair (just name) action) 227 (sourceGateParseLayoutValue 228 (tokens : expression tokens (sourceGateLayoutIndented column)) 229 indentedExpression "do binding action"))) input) 230 (_ : parserMap (action : pair nothing action) 231 (tokens : expression tokens (sourceGateLayoutIndented column)) 232 input) 233 (sourceGateDoBindHead? input) 234 235 sourceGateParseDoNext expression indentedExpression column input = 236 lazyBool 237 (_ : parserThen sourceGateSkipNestedNewlines 238 (sourceGateParseDoStatement expression indentedExpression column) 239 input) 240 (_ : parserReplyFail 241 (sourceGateExpected "do statement" t t) input false false) 242 (sourceGateDoSameColumn? input column) 243 244 sourceGateParseDoFirst expression indentedExpression keyword operator input = 245 lazyList 246 (_ : parserReplyFail 247 (parserDiagnostic 40 "indented do block" t t t) input false false) 248 (token rest : 249 lazyBool 250 (_ : parserBind 251 (sourceGateParseDoStatement expression indentedExpression 252 (sourcePositionColumn (sourceTokenStart token))) 253 (first : parserBind 254 (parserMany (sourceGateParseDoNext expression indentedExpression 255 (sourcePositionColumn (sourceTokenStart token)))) 256 (remaining : (nextInput : 257 lazyMaybe 258 (_ : parserReplyOk 259 (sourceAstDo keyword operator (pair first remaining) 260 (sourceAstDoStatementValue 261 (foldl (_ statement : statement) first remaining))) 262 nextInput false false) 263 (name : parserReplyFail 264 (parserDiagnostic 40 "do final expression" t 265 (sourceTokenStart name) t) 266 nextInput false false) 267 (sourceAstDoStatementBinder 268 (foldl (_ statement : statement) first remaining))))) 269 input) 270 (_ : parserReplyFail 271 (parserDiagnostic 40 "indented do block" 272 (sourceTokenKind token) (sourceTokenStart token) t) 273 input false false) 274 (not? (lte_? (sourcePositionColumn (sourceTokenStart token)) 1))) 275 input 276 277 sourceGateParseDo expression indentedExpression atom input = 278 parserBind (sourceGateExpect sourceTokenDo) (keyword : 279 parserThen sourceGateSkipNestedNewlines 280 (parserBind atom (operator : 281 parserThen (sourceGateExpect sourceTokenNewline) 282 (parserThen sourceGateSkipNestedNewlines 283 (sourceGateParseDoFirst expression indentedExpression 284 keyword operator))))) input 285 286 -- Alternatives use the reusable parser protocol. A malformed opened group 287 -- has consumed input, so parserOr propagates its failure rather than silently 288 -- retrying the atom error or another token kind. 289 sourceGateParseAtom_ self expression mode = 290 parserOr 291 (sourceGateParseDo expression 292 (column tokens : expression tokens (sourceGateLayoutIndented column)) 293 (self expression sourceGateLayoutTop)) 294 (parserOr 295 (sourceGateParseLet (tokens : expression tokens mode) 296 (column tokens : expression tokens (sourceGateLayoutIndented column)) (snd mode)) 297 (parserOr 298 (parserMap sourceAstLeaf (sourceGateExpect sourceTokenT)) 299 (parserOr 300 (parserMap sourceAstName (sourceGateExpect sourceTokenName)) 301 (parserOr 302 (parserMap sourceAstNumber (sourceGateExpect sourceTokenNumber)) 303 (parserOr 304 (parserMap sourceAstString (sourceGateExpect sourceTokenString)) 305 (parserOr 306 (sourceGateParseGroup 307 (tokens : expression tokens sourceGateLayoutNested)) 308 (parserOr 309 (sourceGateParseList 310 (self expression sourceGateLayoutNested)) 311 sourceGateAtomError))))))) 312 313 sourceGateParseAtom = (expression mode input : 314 y sourceGateParseAtom_ expression mode input) 315 316 -- Only a successful atom consumes another operand. A close paren, colon or 317 -- newline is left intact for the enclosing parser; an opened but malformed 318 -- group propagates its consumed failure instead of silently ending the app. 319 -- A newline is a continuation only inside a delimiter and only when a 320 -- following token can start an atom. Looking ahead prevents a newline before 321 -- ')' or 'where' from becoming a committed atom failure. 322 sourceGateAtomStarts? kind = 323 or? (equal? kind sourceTokenT) 324 (or? (equal? kind sourceTokenName) 325 (or? (equal? kind sourceTokenNumber) 326 (or? (equal? kind sourceTokenString) 327 (or? (equal? kind sourceTokenOpen) 328 (or? (equal? kind sourceTokenLeftBracket) 329 (or? (equal? kind sourceTokenLet) 330 (equal? kind sourceTokenDo))))))) 331 332 -- mode = pair insideDelimiter baseColumn. A top-level baseColumn of zero 333 -- disables continuation; a nonzero column allows strictly deeper lines. 334 sourceGateLayoutTop = pair false 0 335 sourceGateLayoutNested = pair true 0 336 sourceGateLayoutIndented column = pair false column 337 338 sourceGateNewlineStarts_ self tokens predicate mode = 339 lazyList 340 (_ : false) 341 (token rest : 342 lazyBool 343 (_ : self rest predicate mode) 344 (_ : and? (predicate (sourceTokenKind token)) 345 (or? (fst mode) 346 (and? (not? (isZero_? (snd mode))) 347 (not? (lte_? (sourcePositionColumn (sourceTokenStart token)) 348 (snd mode)))))) 349 (equal? (sourceTokenKind token) sourceTokenNewline)) 350 tokens 351 352 sourceGateNewlineStarts? = (tokens predicate mode : 353 y sourceGateNewlineStarts_ tokens predicate mode) 354 355 -- Do not consume a newline until a matching token at an allowed indentation 356 -- is visible. This retains layout boundaries in parser remainders. 357 sourceGateAfterLayoutNewlines mode starts parser input = 358 lazyList 359 (_ : parser input) 360 (token rest : 361 lazyBool 362 (_ : lazyBool 363 (_ : parserThen sourceGateSkipNestedNewlines parser input) 364 (_ : parser input) 365 (sourceGateNewlineStarts? rest starts mode)) 366 (_ : parser input) 367 (equal? (sourceTokenKind token) sourceTokenNewline)) 368 input 369 370 sourceGateAppNext mode expression input = 371 sourceGateAfterLayoutNewlines mode sourceGateAtomStarts? 372 (sourceGateParseAtom expression mode) input 373 374 sourceGateAppTail_ tailSelf input mode expression acc consumed = 375 parserMatchReply 376 (diagnostic rest stepConsumed committed : 377 lazyBool 378 (_ : parserReplyFail diagnostic rest 379 (or? consumed stepConsumed) committed) 380 (_ : parserReplyOk acc input consumed false) 381 (or? stepConsumed committed)) 382 (atom rest stepConsumed committed : 383 tailSelf rest mode expression (sourceAstApply acc atom) true) 384 (sourceGateAppNext mode expression input) 385 386 sourceGateParseApplication mode expression input = 387 parserBind (sourceGateParseAtom expression mode) (first : 388 (rest : y sourceGateAppTail_ rest mode expression first false)) input 389 390 sourceGatePipeStarts? kind = 391 or? (equal? kind sourceTokenPipeBackward) 392 (equal? kind sourceTokenPipeForward) 393 394 sourceGateParsePipeOperator = 395 parserOr (sourceGateExpect sourceTokenPipeBackward) 396 (sourceGateExpect sourceTokenPipeForward) 397 398 sourceGateParsePipeSegment mode expression input = 399 parserBind 400 (sourceGateAfterLayoutNewlines sourceGateLayoutNested 401 sourceGatePipeStarts? sourceGateParsePipeOperator) 402 (operator : parserThen sourceGateSkipNestedNewlines 403 (parserMap (right : pair operator right) 404 (sourceGateParseApplication mode expression))) input 405 406 -- Application binds tighter than a left-associative pipe chain. Retain an 407 -- explicit located AST pipe; core resolution chooses the direction later. 408 sourceGateParsePipes mode expression input = 409 parserBind (sourceGateParseApplication mode expression) (first : 410 parserMap (segments : foldl 411 (left segment : sourceAstPipe (fst segment) left (snd segment)) 412 first segments) 413 (parserMany (sourceGateParsePipeSegment mode expression))) input 414 415 sourceGateExpr_ self input mode = 416 lazyBool 417 (_ : sourceGateParseLambda (tokens : self tokens mode) input) 418 (_ : parserBind 419 (sourceGateParsePipes mode self) 420 (body : 421 parserMap (suffix : lazyMaybe (_ : body) (local : local) suffix) 422 (parserOptional (sourceGateAfterLayoutNewlines sourceGateLayoutNested 423 (kind : equal? kind sourceTokenWhere) 424 (sourceGateParseWhere 425 (tokens : self tokens mode) 426 (column tokens : self tokens (sourceGateLayoutIndented column)) 427 body (snd mode))))) input) 428 (sourceGateLambdaHead? input) 429 430 sourceGateExpr = (input : y sourceGateExpr_ input sourceGateLayoutTop) 431 sourceGateExprIndented = (column input : 432 y sourceGateExpr_ input (sourceGateLayoutIndented column)) 433 434 parseGateTokens input = 435 parserBefore sourceGateExpr sourceGateEof input 436 437 parseGateSource = parserWithLexer lexGateSource parseGateTokens 438