tricu

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

23b3eaae8088f6a0eff661e75106a407b3c04e380dc88e91f465d25337b94d76.tri (5532B)

      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 sourceAstFunction_ self node = (let kind = sourceAstKind node in
     42   lazyBool (_ : true)
     43     (_ : lazyBool (_ : self (sourceAstPayload node))
     44       (_ : lazyBool
     45         (_ : lazyList (_ : false) (equation rest : not? (emptyList? (fst equation)))
     46           (sourceAstPayload node))
     47         (_ : false) (equal? kind sourceAstEquationsKind))
     48       (equal? kind sourceAstGroupKind))
     49     (equal? kind sourceAstLambdaKind))
     50 sourceAstFunction? node = y sourceAstFunction_ node
     51 
     52 -- Each equation is (located argument patterns, located body).
     53 sourceAstEquations equations start end =
     54   sourceAstNode sourceAstEquationsKind equations start end
     55 
     56 sourceAstDoOperator node = fst (sourceAstPayload node)
     57 sourceAstDoStatements node = snd (sourceAstPayload node)
     58 sourceAstDoStatementBinder statement = fst statement
     59 sourceAstDoStatementValue statement = snd statement
     60 
     61 sourceAstPipeDirection node = fst (sourceAstPayload node)
     62 sourceAstPipeLeft node = fst (snd (sourceAstPayload node))
     63 sourceAstPipeRight node = snd (snd (sourceAstPayload node))
     64 
     65 sourceAstLetName node = sourceTokenPayload (fst (sourceAstPayload node))
     66 sourceAstLetValue node = fst (snd (sourceAstPayload node))
     67 sourceAstLetBody node = snd (snd (sourceAstPayload node))
     68 
     69 sourceAstLeaf token =
     70   sourceAstNode sourceAstLeafKind t
     71     (sourceTokenStart token) (sourceTokenEnd token)
     72 
     73 sourceAstName token =
     74   sourceAstNode sourceAstNameKind (sourceTokenPayload token)
     75     (sourceTokenStart token) (sourceTokenEnd token)
     76 
     77 sourceAstNumber token =
     78   sourceAstNode sourceAstNumberKind (sourceTokenPayload token)
     79     (sourceTokenStart token) (sourceTokenEnd token)
     80 
     81 sourceAstString token =
     82   sourceAstNode sourceAstStringKind (sourceTokenPayload token)
     83     (sourceTokenStart token) (sourceTokenEnd token)
     84 
     85 sourceAstList openToken elements closeToken =
     86   sourceAstNode sourceAstListKind elements
     87     (sourceTokenStart openToken) (sourceTokenEnd closeToken)
     88 
     89 sourceAstApply left right =
     90   sourceAstNode sourceAstApplyKind (pair left right)
     91     (sourceAstStart left) (sourceAstEnd right)
     92 
     93 -- Keep pipe direction and source order until core elaboration.
     94 sourceAstPipe operator left right =
     95   sourceAstNode sourceAstPipeKind
     96     (pair (sourceTokenKind operator) (pair left right))
     97     (sourceAstStart left) (sourceAstEnd right)
     98 
     99 sourceAstLambda nameToken body =
    100   sourceAstNode sourceAstLambdaKind (pair (sourceTokenPayload nameToken) body)
    101     (sourceTokenStart nameToken) (sourceAstEnd body)
    102 
    103 sourceAstGroup openToken body closeToken =
    104   sourceAstNode sourceAstGroupKind body
    105     (sourceTokenStart openToken) (sourceTokenEnd closeToken)
    106 
    107 -- A local binding is nonrecursive: the binder is in scope only for the body.
    108 -- Both `let x = value in body` and `body where x = value` use this node.
    109 sourceAstLocal nameToken value body start end =
    110   sourceAstNode sourceAstLetKind (pair nameToken (pair value body)) start end
    111 
    112 -- A do statement is pair (Maybe locatedNameToken) locatedExpression.
    113 -- Keep the whole block explicit until the elaboration boundary.
    114 sourceAstDo keyword operator statements last =
    115   sourceAstNode sourceAstDoKind (pair operator statements)
    116     (sourceTokenStart keyword) (sourceAstEnd last)
    117 
    118 -- The bootstrap uses an ignored "_" binder for non-final expression
    119 -- statements; retain that convention so lexical shadowing is identical.
    120 sourceAstDoIgnored statement =
    121   sourceToken sourceTokenName "_"
    122     (sourceAstStart (sourceAstDoStatementValue statement))
    123     (sourceAstEnd (sourceAstDoStatementValue statement))
    124 
    125 sourceAstDoBinderToken statement =
    126   lazyMaybe
    127     (_ : sourceAstDoIgnored statement)
    128     (name : name)
    129     (sourceAstDoStatementBinder statement)
    130 
    131 sourceAstDoLower_ self statements operator =
    132   lazyList
    133     (_ : operator)
    134     (statement rest :
    135       lazyList
    136         (_ : sourceAstDoStatementValue statement)
    137         (next tail :
    138           sourceAstApply
    139             (sourceAstApply operator (sourceAstDoStatementValue statement))
    140             (sourceAstLambda (sourceAstDoBinderToken statement)
    141               (self rest operator)))
    142         rest)
    143     statements
    144 
    145 sourceAstDoLower = (node :
    146   y sourceAstDoLower_ (sourceAstDoStatements node)
    147     (sourceAstDoOperator node))
    148