tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

lexer.tri (9821B)

      1 !import prelude *
      2 !import parser *
      3 !import lexer *
      4 !import native_math as N
      5 !export *
      6 
      7 -- Located source profile: t, ASCII names, literals, lists, grouping,
      8 -- application, lambdas, local bindings, pipes, do blocks, and definitions.
      9 -- Indentation-sensitive bodies use token columns, not rewritten source.
     10 -- External names are supplied as resolved trees, not lexed as imports here.
     11 -- Positions are one-based line/column and zero-based character offset.
     12 sourcePosition = lexerPosition
     13 sourcePositionLine = lexerPositionLine
     14 sourcePositionColumn = lexerPositionColumn
     15 sourcePositionOffset = lexerPositionOffset
     16 sourceStart = lexerStart
     17 sourcePositionAdvance = lexerAdvance
     18 
     19 sourceToken = lexerToken
     20 sourceTokenKind = lexerTokenKind
     21 sourceTokenPayload = lexerTokenPayload
     22 sourceTokenStart = lexerTokenStart
     23 sourceTokenEnd = lexerTokenEnd
     24 
     25 sourceTokenT = 1
     26 sourceTokenName = 2
     27 sourceTokenOpen = 3
     28 sourceTokenClose = 4
     29 sourceTokenColon = 5
     30 sourceTokenNewline = 6
     31 sourceTokenNumber = 7
     32 sourceTokenString = 8
     33 sourceTokenLeftBracket = 9
     34 sourceTokenRightBracket = 10
     35 sourceTokenAssign = 11
     36 sourceTokenLet = 12
     37 sourceTokenIn = 13
     38 sourceTokenWhere = 14
     39 sourceTokenPipeBackward = 15
     40 sourceTokenPipeForward = 16
     41 sourceTokenDo = 17
     42 sourceTokenBindArrow = 18
     43 sourceTokenAt = 19
     44 sourceTokenComma = 20
     45 sourceTokenBar = 21
     46 sourceTokenLeftBrace = 22
     47 sourceTokenRightBrace = 23
     48 sourceTokenPin = 24
     49 sourceTokenCase = 25
     50 sourceTokenOf = 26
     51 sourceTokenRec = 27
     52 
     53 -- Character codes and decimal accumulators are canonical natural numbers.
     54 -- Use binary TC math here; general tree equality and position arithmetic remain
     55 -- the prelude operations. The math module is namespaced to avoid shadowing them.
     56 sourceAsciiLetter? character = N.letter character
     57 sourceAsciiDigit? character = N.digit character
     58 
     59 sourceNameStart? character =
     60   or? (sourceAsciiLetter? character) (equal? character 95)
     61 
     62 sourceNameContinue? character =
     63   or? (sourceNameStart? character)
     64     (or? (sourceAsciiDigit? character)
     65       (or? (equal? character 45)
     66         (or? (equal? character 63)
     67           (or? (equal? character 36)
     68             (or? (equal? character 37)
     69               (or? (equal? character 39) (equal? character 46)))))))
     70 
     71 sourceGateSpace? character = equal? character 32
     72 
     73 sourceScanName input position first =
     74   lexerMapScan reverse
     75     (lexerScanWhile input position (pair first t) sourceNameContinue?
     76       (reversed character : pair character reversed))
     77 
     78 -- The character already consumed is the first decimal digit. Leading zeroes
     79 -- are accepted. The generic scan also preserves the first non-digit.
     80 sourceScanNumber input position first =
     81   lexerScanWhile input position (N.subtract first 48) sourceAsciiDigit?
     82     (value character : N.decimal value (N.subtract character 48))
     83 
     84 -- Leave the newline in the input so it remains an explicit gate token.
     85 sourceSkipLineComment input position =
     86   lexerScanWhile input position t
     87     (character : not? (equal? character 10))
     88     (ignored character : t)
     89 
     90 sourceGateEscape character = case character of
     91   110 = just 10
     92   116 = just 9
     93   114 = just 13
     94   102 = just 12
     95   98 = just 8
     96   92 = just 92
     97   34 = just 34
     98   39 = just 39
     99   _ = nothing
    100 
    101 sourceScanString input position start =
    102   lexerScanQuoted input position 34 92 sourceGateEscape
    103     (parserDiagnostic 5 34 t start t)
    104     (character location : parserDiagnostic 6 34 character location t)
    105 
    106 -- Caller has classified punctuation; preserve the internal @ fallback.
    107 sourceGateToken character start end = (let kind = (case character of
    108     40 = sourceTokenOpen
    109     41 = sourceTokenClose
    110     58 = sourceTokenColon
    111     10 = sourceTokenNewline
    112     91 = sourceTokenLeftBracket
    113     93 = sourceTokenRightBracket
    114     61 = sourceTokenAssign
    115     44 = sourceTokenComma
    116     123 = sourceTokenLeftBrace
    117     125 = sourceTokenRightBrace
    118     94 = sourceTokenPin
    119     _ = sourceTokenAt)
    120   in sourceToken kind t start end)
    121 
    122 sourceGatePunctuation? character =
    123   or? (equal? character 40)
    124     (or? (equal? character 41)
    125       (or? (equal? character 58)
    126         (or? (equal? character 10)
    127           (or? (equal? character 91)
    128             (or? (equal? character 93)
    129               (or? (equal? character 61)
    130                 (or? (equal? character 64)
    131                   (or? (equal? character 44)
    132                     (or? (equal? character 123)
    133                       (or? (equal? character 125) (equal? character 94)))))))))))
    134 
    135 sourceLexGateDash resume input rest position reversed =
    136   lazyList
    137     (_ : parserReplyFail
    138       (parserDiagnostic 4 t 45 position t) input
    139       (not? (isZero_? (sourcePositionOffset position))) false)
    140     (next tail :
    141       lazyBool
    142         (_ : lexerResumeScan
    143           (sourceSkipLineComment tail
    144             (sourcePositionAdvance (sourcePositionAdvance position 45) 45))
    145           (remaining end : resume remaining end reversed))
    146         (_ : parserReplyFail
    147           (parserDiagnostic 4 t 45 position t) input
    148           (not? (isZero_? (sourcePositionOffset position))) false)
    149         (equal? next 45))
    150     rest
    151 
    152 sourceLexGateBlock resume input rest position reversed =
    153   lazyList
    154     (_ : resume rest (sourcePositionAdvance position 124)
    155       (pair (sourceToken sourceTokenBar t position
    156         (sourcePositionAdvance position 124)) reversed))
    157     (next tail :
    158       lazyBool
    159         (_ : lexerResumeScan
    160           (lexerSkipUntilPair tail
    161             (sourcePositionAdvance (sourcePositionAdvance position 124) 45)
    162             45 124 (parserDiagnostic 5 "-|" t position t))
    163           (remaining end : resume remaining end reversed))
    164         (_ : lazyBool
    165           (_ : resume tail (sourcePositionAdvance
    166             (sourcePositionAdvance position 124) 62)
    167             (pair (sourceToken sourceTokenPipeForward t position
    168               (sourcePositionAdvance
    169                 (sourcePositionAdvance position 124) 62)) reversed))
    170           (_ : resume rest (sourcePositionAdvance position 124)
    171             (pair (sourceToken sourceTokenBar t position
    172               (sourcePositionAdvance position 124)) reversed))
    173           (equal? next 62))
    174         (equal? next 45))
    175     rest
    176 
    177 sourceLexGatePipeBackward resume input rest position reversed =
    178   lazyList
    179     (_ : parserReplyFail
    180       (parserDiagnostic 4 t 60 position t) input
    181       (not? (isZero_? (sourcePositionOffset position))) false)
    182     (next tail :
    183       lazyBool
    184         (_ : resume tail (sourcePositionAdvance
    185           (sourcePositionAdvance position 60) 124)
    186           (pair (sourceToken sourceTokenPipeBackward t position
    187             (sourcePositionAdvance
    188               (sourcePositionAdvance position 60) 124)) reversed))
    189         (_ : lazyBool
    190           (_ : resume tail (sourcePositionAdvance
    191             (sourcePositionAdvance position 60) 45)
    192             (pair (sourceToken sourceTokenBindArrow t position
    193               (sourcePositionAdvance
    194                 (sourcePositionAdvance position 60) 45)) reversed))
    195           (_ : parserReplyFail
    196             (parserDiagnostic 4 t 60 position t) input
    197             (not? (isZero_? (sourcePositionOffset position))) false)
    198           (equal? next 45))
    199         (equal? next 124))
    200     rest
    201 
    202 sourceGateNameClassify name = (let kind = (case name of
    203     "t" = sourceTokenT
    204     "let" = sourceTokenLet
    205     "in" = sourceTokenIn
    206     "where" = sourceTokenWhere
    207     "do" = sourceTokenDo
    208     "case" = sourceTokenCase
    209     "of" = sourceTokenOf
    210     "rec" = sourceTokenRec
    211     _ = sourceTokenName)
    212   in pair kind name)
    213 
    214 sourceLexGateName resume rest position reversed character =
    215   lexerEmitScan
    216     (sourceScanName rest (sourcePositionAdvance position character) character)
    217     position reversed sourceGateNameClassify
    218     (remaining end tokens : resume remaining end tokens)
    219 
    220 sourceLexGateNumber resume rest position reversed character =
    221   lexerEmitScan
    222     (sourceScanNumber rest (sourcePositionAdvance position character) character)
    223     position reversed (value : pair sourceTokenNumber value)
    224     (remaining end tokens : resume remaining end tokens)
    225 
    226 sourceLexGateString resume rest position reversed character =
    227   lexerEmitScan
    228     (sourceScanString rest (sourcePositionAdvance position character) position)
    229     position reversed (value : pair sourceTokenString value)
    230     (remaining end tokens : resume remaining end tokens)
    231 
    232 sourceLexGatePunctuation resume rest position reversed character =
    233   resume rest (sourcePositionAdvance position character)
    234     (pair (sourceGateToken character position
    235             (sourcePositionAdvance position character)) reversed)
    236 
    237 sourceLexGate input position reversed =
    238   lazyList
    239     (_ : parserReplyOk (reverse reversed) input
    240            (not? (isZero_? (sourcePositionOffset position))) false)
    241     (character rest :
    242       lexerDispatch
    243         [ (pair sourceGateSpace?
    244             (c : sourceLexGate rest (sourcePositionAdvance position c) reversed))
    245           (pair (c : equal? c 45)
    246             (c : sourceLexGateDash sourceLexGate input rest position reversed))
    247           (pair (c : equal? c 124)
    248             (c : sourceLexGateBlock sourceLexGate input rest position reversed))
    249           (pair (c : equal? c 60)
    250             (c : sourceLexGatePipeBackward sourceLexGate input rest position reversed))
    251           (pair (c : equal? c 34)
    252             (c : sourceLexGateString sourceLexGate rest position reversed c))
    253           (pair sourceAsciiDigit?
    254             (c : sourceLexGateNumber sourceLexGate rest position reversed c))
    255           (pair sourceNameStart?
    256             (c : sourceLexGateName sourceLexGate rest position reversed c))
    257           (pair sourceGatePunctuation?
    258             (c : sourceLexGatePunctuation sourceLexGate rest position reversed c))
    259         ]
    260         (c : parserReplyFail
    261           (parserDiagnostic 4 t c position t) input
    262           (not? (isZero_? (sourcePositionOffset position))) false)
    263         character)
    264     input
    265 
    266 lexGateSource = (input : sourceLexGate input sourceStart t)