tricu

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

b6d05cace61c04032ea39a858dedc7482988dbb3ed47581a9a3239094263d314.tri (5581B)

      1 !import prelude *
      2 !import source_lexer *
      3 !export *
      4 
      5 -- Gate-profile surface AST. Every node has a half-open source span.
      6 -- node = pair kind (pair payload (pair start end))
      7 sourceAstNode kind payload start end =
      8   pair kind (pair payload (pair start end))
      9 sourceAstKind node = fst node
     10 sourceAstPayload node = fst (snd node)
     11 sourceAstStart node = fst (snd (snd node))
     12 sourceAstEnd node = snd (snd (snd node))
     13 
     14 sourceAstLeafKind = 1
     15 sourceAstNameKind = 2
     16 sourceAstApplyKind = 3
     17 sourceAstLambdaKind = 4
     18 sourceAstGroupKind = 5
     19 sourceAstNumberKind = 6
     20 sourceAstStringKind = 7
     21 sourceAstListKind = 8
     22 sourceAstLetKind = 9
     23 sourceAstPipeKind = 10
     24 sourceAstDoKind = 11
     25 sourceAstEquationsKind = 12
     26 sourceAstPatternKind = 13
     27 sourceAstCaseKind = 14
     28 sourceAstRecKind = 15
     29 
     30 -- Case keeps source order and spans; its matcher is an ordinary unary equation
     31 -- group. No generated surface identifier can capture a user's lexical name.
     32 sourceAstCase subject equations start end = (sourceAstNode sourceAstCaseKind
     33   (pair subject (sourceAstEquations equations start end)) start end)
     34 sourceAstCaseSubject node = fst (sourceAstPayload node)
     35 sourceAstCaseMatcher node = snd (sourceAstPayload node)
     36 
     37 -- Explicit self-recursion shares the local payload, not ordinary let scoping.
     38 sourceAstRecursive nameToken value body start end =
     39   sourceAstNode sourceAstRecKind (pair nameToken (pair value body)) start end
     40 
     41 -- Only compiler-built ASTs are accepted here; equation arity comes from the
     42 -- first row. Grouping does not turn a recursive value into a function.
     43 sourceAstFunction? node = case sourceAstKind node of
     44   ^sourceAstLambdaKind = true
     45   ^sourceAstGroupKind = sourceAstFunction? (sourceAstPayload node)
     46   ^sourceAstEquationsKind = (lazyList (_ : false)
     47     (equation _ : not? (emptyList? (fst equation))) (sourceAstPayload node))
     48   _ = false
     49 
     50 -- Each equation is (located argument patterns, located body).
     51 sourceAstEquations equations start end =
     52   sourceAstNode sourceAstEquationsKind equations start end
     53 
     54 sourceAstDoOperator node = fst (sourceAstPayload node)
     55 sourceAstDoStatements node = snd (sourceAstPayload node)
     56 sourceAstDoStatementBinder statement = fst statement
     57 sourceAstDoStatementValue statement = snd statement
     58 
     59 sourceAstPipeDirection node = fst (sourceAstPayload node)
     60 sourceAstPipeLeft node = fst (snd (sourceAstPayload node))
     61 sourceAstPipeRight node = snd (snd (sourceAstPayload node))
     62 
     63 sourceAstLetName node = sourceTokenPayload (fst (sourceAstPayload node))
     64 sourceAstLetValue node = fst (snd (sourceAstPayload node))
     65 sourceAstLetBody node = snd (snd (sourceAstPayload node))
     66 
     67 sourceAstLeaf token =
     68   sourceAstNode sourceAstLeafKind t
     69     (sourceTokenStart token) (sourceTokenEnd token)
     70 
     71 sourceAstName token =
     72   sourceAstNode sourceAstNameKind (sourceTokenPayload token)
     73     (sourceTokenStart token) (sourceTokenEnd token)
     74 
     75 sourceAstNumber token =
     76   sourceAstNode sourceAstNumberKind (sourceTokenPayload token)
     77     (sourceTokenStart token) (sourceTokenEnd token)
     78 
     79 sourceAstString token =
     80   sourceAstNode sourceAstStringKind (sourceTokenPayload token)
     81     (sourceTokenStart token) (sourceTokenEnd token)
     82 
     83 sourceAstList openToken elements closeToken =
     84   sourceAstNode sourceAstListKind elements
     85     (sourceTokenStart openToken) (sourceTokenEnd closeToken)
     86 
     87 sourceAstApply left right =
     88   sourceAstNode sourceAstApplyKind (pair left right)
     89     (sourceAstStart left) (sourceAstEnd right)
     90 
     91 -- Keep pipe direction and source order until core elaboration.
     92 sourceAstPipe operator left right =
     93   sourceAstNode sourceAstPipeKind
     94     (pair (sourceTokenKind operator) (pair left right))
     95     (sourceAstStart left) (sourceAstEnd right)
     96 
     97 sourceAstLambda nameToken body =
     98   sourceAstNode sourceAstLambdaKind (pair (sourceTokenPayload nameToken) body)
     99     (sourceTokenStart nameToken) (sourceAstEnd body)
    100 
    101 sourceAstGroup openToken body closeToken =
    102   sourceAstNode sourceAstGroupKind body
    103     (sourceTokenStart openToken) (sourceTokenEnd closeToken)
    104 
    105 -- A local binding is nonrecursive: the binder is in scope only for the body.
    106 -- Both `let x = value in body` and `body where x = value` use this node.
    107 sourceAstLocal nameToken value body start end =
    108   sourceAstNode sourceAstLetKind (pair nameToken (pair value body)) start end
    109 
    110 -- A do statement is pair (Maybe locatedNameToken) locatedExpression.
    111 -- Keep the whole block explicit until the elaboration boundary.
    112 sourceAstDo keyword operator statements last =
    113   sourceAstNode sourceAstDoKind (pair operator statements)
    114     (sourceTokenStart keyword) (sourceAstEnd last)
    115 
    116 -- The bootstrap uses an ignored "_" binder for non-final expression
    117 -- statements; retain that convention so lexical shadowing is identical.
    118 sourceAstDoIgnored statement =
    119   sourceToken sourceTokenName "_"
    120     (sourceAstStart (sourceAstDoStatementValue statement))
    121     (sourceAstEnd (sourceAstDoStatementValue statement))
    122 
    123 sourceAstDoBinderToken statement =
    124   lazyMaybe
    125     (_ : sourceAstDoIgnored statement)
    126     (name : name)
    127     (sourceAstDoStatementBinder statement)
    128 
    129 -- Capture the operator once. The last expression is returned unchanged, not
    130 -- passed to the bind operator, and an empty internal block keeps the operator.
    131 sourceAstDoLower node = (let operator = sourceAstDoOperator node in
    132   let rec lower statements = (lazyList
    133     (_ : operator)
    134     (statement rest : lazyList
    135       (_ : sourceAstDoStatementValue statement)
    136       (_ _ : sourceAstApply
    137         (sourceAstApply operator (sourceAstDoStatementValue statement))
    138         (sourceAstLambda (sourceAstDoBinderToken statement) (lower rest)))
    139       rest)
    140     statements)
    141   in lower (sourceAstDoStatements node))