source.tri (6951B)
1 !import prelude * 2 !import parser as P 3 !import lexer as L 4 !import source_lexer as SL 5 !import consumers_structural as SCP 6 !export * 7 -- Shared lexer, tokens, and capture lookup for the general SCP source parser. 8 -- Numeric tokens retain tricu's compact natural-number encoding. 9 10 cName = 1 11 cNumber = 2 12 cString = 3 13 cOpen = 4 14 cClose = 5 15 cLeft = 6 16 cRight = 7 17 cComma = 8 18 cBar = 9 19 cAt = 10 20 cArrow = 11 21 cPlus = 12 22 cDot = 13 23 cBang = 14 24 25 cToken kind payload start end = L.lexerToken kind payload start end 26 cKind = L.lexerTokenKind 27 cPayload = L.lexerTokenPayload 28 cStart = L.lexerTokenStart 29 cAdvance = L.lexerAdvance 30 31 cSpace? char = or? (equal? char 32) (or? (equal? char 9) 32 (or? (equal? char 10) (equal? char 13))) 33 cPunctuation? char = or? (equal? char 40) (or? (equal? char 41) 34 (or? (equal? char 91) (or? (equal? char 93) 35 (or? (equal? char 44) (or? (equal? char 124) 36 (or? (equal? char 64) (or? (equal? char 43) 37 (or? (equal? char 46) (equal? char 33))))))))) 38 cPunctuation char = 39 lazyBool (_ : cOpen) (_ : lazyBool (_ : cClose) 40 (_ : lazyBool (_ : cLeft) (_ : lazyBool (_ : cRight) 41 (_ : lazyBool (_ : cComma) (_ : lazyBool (_ : cBar) 42 (_ : lazyBool (_ : cAt) (_ : lazyBool (_ : cPlus) 43 (_ : lazyBool (_ : cDot) (_ : cBang) (equal? char 46)) (equal? char 43)) (equal? char 64)) 44 (equal? char 124)) (equal? char 44)) (equal? char 93)) 45 (equal? char 91)) (equal? char 41)) (equal? char 40) 46 47 cLexError character position input = 48 P.parserReplyFail (P.parserDiagnostic 4 t character position t) input true false 49 50 -- Dot belongs to qualified output references, never capture identifiers. 51 cScanName input position first = (L.lexerMapScan reverse 52 (L.lexerScanWhile input position (pair first t) 53 (character : and? (SL.sourceNameContinue? character) 54 (not? (equal? character 46))) 55 (reversed character : pair character reversed))) 56 cLexNameUsing scan self rest position reversed character = 57 L.lexerEmitScan 58 (scan rest (cAdvance position character) character) 59 position reversed (text : pair cName text) 60 (remaining end tokens : self remaining end tokens) 61 cLexNumber self rest position reversed character = 62 L.lexerEmitScan 63 (SL.sourceScanNumber rest (cAdvance position character) character) 64 position reversed (number : pair cNumber number) 65 (remaining end tokens : self remaining end tokens) 66 cLexString self rest position reversed character = 67 L.lexerEmitScan 68 (SL.sourceScanString rest (cAdvance position character) position) 69 position reversed (text : pair cString text) 70 (remaining end tokens : self remaining end tokens) 71 72 -- A pair of dashes starts a line comment outside quoted strings. Scan to 73 -- (but not through) the newline so source positions still describe the 74 -- original file, including the position of the next rule. 75 cLexDash self input rest position reversed = 76 lazyList 77 (_ : cLexError 45 position input) 78 (next tail : lazyBool 79 (_ : L.lexerResumeScan 80 (SL.sourceSkipLineComment tail 81 (cAdvance (cAdvance position 45) 45)) 82 (remaining end : self remaining end reversed)) 83 (_ : cLexError 45 position input) 84 (equal? next 45)) 85 rest 86 cLexArrow self input rest position reversed = 87 lazyList 88 (_ : cLexError 61 position input) 89 (next tail : lazyBool 90 (_ : self tail (cAdvance (cAdvance position 61) 62) 91 (pair (cToken cArrow t position 92 (cAdvance (cAdvance position 61) 62)) reversed)) 93 (_ : cLexError 61 position input) 94 (equal? next 62)) 95 rest 96 cLex_ self input position reversed scan = 97 lazyList 98 (_ : P.parserReplyOk (reverse reversed) input 99 (not? (isZero_? (L.lexerPositionOffset position))) false) 100 (character rest : 101 lazyBool 102 (_ : self rest (cAdvance position character) reversed scan) 103 (_ : lazyBool 104 (_ : cLexNameUsing scan (remaining end tokens : self remaining end tokens scan) rest position reversed character) 105 (_ : lazyBool 106 (_ : cLexNumber (remaining end tokens : self remaining end tokens scan) rest position reversed character) 107 (_ : lazyBool 108 (_ : cLexString (remaining end tokens : self remaining end tokens scan) rest position reversed character) 109 (_ : lazyBool 110 (_ : cLexArrow (remaining end tokens : self remaining end tokens scan) input rest position reversed) 111 (_ : lazyBool 112 (_ : cLexDash (remaining end tokens : self remaining end tokens scan) input rest position reversed) 113 (_ : lazyBool 114 (_ : self rest (cAdvance position character) 115 (pair (cToken (cPunctuation character) t position 116 (cAdvance position character)) reversed) scan) 117 (_ : cLexError character position input) 118 (cPunctuation? character)) 119 (equal? character 45)) 120 (equal? character 61)) 121 (equal? character 34)) 122 (SL.sourceAsciiDigit? character)) 123 (SL.sourceNameStart? character)) 124 (cSpace? character)) 125 input 126 -- Preserve the legacy single-consumer identifier lexer. Units reserve dot 127 -- for explicit qualified references; both lexers retain original positions. 128 lexConsumer = (source : y cLex_ source L.lexerStart t SL.sourceScanName) 129 lexScpUnit = (source : y cLex_ source L.lexerStart t cScanName) 130 131 -- Parsing returns lib/parser.tri replies, with source positions in failures. 132 cExpected kind found location = P.parserDiagnostic 2 kind found location t 133 cExpect kind input = 134 lazyList 135 (_ : P.parserReplyFail (cExpected kind t t) input false false) 136 (token rest : lazyBool 137 (_ : P.parserReplyOk (cPayload token) rest true false) 138 (_ : P.parserReplyFail 139 (cExpected kind (cKind token) (cStart token)) input false false) 140 (equal? (cKind token) kind)) 141 input 142 cWord text = P.parserBind (cExpect cName) (name : 143 lazyBool (_ : P.parserPure name) 144 (_ : P.parserFailure (cExpected text name t)) 145 (equal? name text)) 146 147 cNameUsed_ self entries name = 148 lazyList (_ : false) (entry rest : lazyBool 149 (_ : true) (_ : self rest name) (equal? (fst entry) name)) entries 150 cNameUsed entries name = y cNameUsed_ entries name 151 cBind name slot entries input = 152 lazyBool 153 (_ : P.parserReplyFail 154 (P.parserDiagnostic 21 "fresh capture" name t t) input false false) 155 (_ : P.parserReplyOk (pair (pair name slot) entries) input false false) 156 (cNameUsed entries name) 157 cSlot_ self entries name = 158 lazyList (_ : nothing) (entry rest : lazyBool 159 (_ : just (snd entry)) (_ : self rest name) 160 (equal? (fst entry) name)) entries 161 cSlot entries name = y cSlot_ entries name 162 cReference entries name input = 163 lazyMaybe 164 (_ : P.parserReplyFail 165 (P.parserDiagnostic 22 "bound capture" name t t) input false false) 166 (slot : P.parserReplyOk (SCP.outCapture slot) input false false) 167 (cSlot entries name)