tricu

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

2a740ce43838351b2bdd7a210d0b1789c0083148c635bd812b2027a255aae2ef.tri (9687B)

      1 !import prelude *
      2 !import parser *
      3 !import graph *
      4 !import source_program *
      5 !import source_resolve *
      6 !import source_ast *
      7 !import source_equations *
      8 !export *
      9 
     10 sourceFindDefinition_ self definitions name =
     11   lazyList
     12     (_ : nothing)
     13     (definition rest :
     14       lazyBool
     15         (_ : just definition)
     16         (_ : self rest name)
     17         (equal? (sourceDefinitionName definition) name))
     18     definitions
     19 
     20 sourceFindDefinition = (definitions name :
     21   y sourceFindDefinition_ definitions name)
     22 
     23 -- Free-name collection returns located name AST nodes, so a missing-name
     24 -- diagnostic retains the original source position rather than a string key.
     25 sourceFreeList_ self elements visit bound =
     26   lazyList
     27     (_ : t)
     28     (element rest : append (visit element bound) (self rest visit bound))
     29     elements
     30 
     31 sourceFreeList = (elements visit bound :
     32   y sourceFreeList_ elements visit bound)
     33 
     34 sourceFreeEquations_ self equations visit bound = (lazyList (_ : t)
     35   (equation rest : append
     36     (append (sourceFreeList
     37       (sourceEquationCollect (fst equation) sourceEquationPins) visit bound)
     38       (visit (snd equation)
     39         (append (reverse (sourceEquationCollect (fst equation) sourceEquationCaptures)) bound)))
     40     (self rest visit bound)) equations)
     41 sourceFreeEquations equations visit bound = y sourceFreeEquations_ equations visit bound
     42 
     43 sourceFreeOrdinary self node bound =
     44   lazyBool
     45     (_ : lazyMaybe
     46       (_ : pair node t)
     47       (index : t)
     48       (sourceFindBinder bound (sourceAstPayload node)))
     49     (_ : lazyBool
     50       (_ : append
     51         (self (fst (sourceAstPayload node)) bound)
     52         (self (snd (sourceAstPayload node)) bound))
     53       (_ : lazyBool
     54         (_ : self (snd (sourceAstPayload node))
     55           (pair (fst (sourceAstPayload node)) bound))
     56         (_ : lazyBool
     57           (_ : self (sourceAstPayload node) bound)
     58           (_ : lazyBool
     59             (_ : sourceFreeList (sourceAstPayload node) self bound)
     60             (_ : lazyBool
     61               (_ : append
     62                 (self (sourceAstLetValue node) bound)
     63                 (self (sourceAstLetBody node)
     64                   (pair (sourceAstLetName node) bound)))
     65               (_ : lazyBool
     66                 (_ : append
     67                   (self (sourceAstPipeLeft node) bound)
     68                   (self (sourceAstPipeRight node) bound))
     69                 (_ : lazyBool
     70                   (_ : self (sourceAstDoLower node) bound)
     71                   (_ : lazyBool
     72                     (_ : sourceFreeEquations (sourceAstPayload node) self bound)
     73                     (_ : t) (equal? (sourceAstKind node) sourceAstEquationsKind))
     74                   (equal? (sourceAstKind node) sourceAstDoKind))
     75                 (equal? (sourceAstKind node) sourceAstPipeKind))
     76               (equal? (sourceAstKind node) sourceAstLetKind))
     77             (equal? (sourceAstKind node) sourceAstListKind))
     78           (equal? (sourceAstKind node) sourceAstGroupKind))
     79         (equal? (sourceAstKind node) sourceAstLambdaKind))
     80       (equal? (sourceAstKind node) sourceAstApplyKind))
     81     (equal? (sourceAstKind node) sourceAstNameKind)
     82 
     83 sourceFreeNames = (node : y sourceFreeNames_ node t)
     84 
     85 sourceCheckDuplicates_ self definitions seen =
     86   lazyList
     87     (_ : ok t t)
     88     (definition rest :
     89       lazyMaybe
     90         (_ : self rest (pair definition seen))
     91         (prior : err
     92           (parserDiagnostic 30 (sourceDefinitionName definition)
     93             (sourceDefinitionName prior)
     94             (sourceDefinitionPosition definition) t)
     95           definition)
     96         (sourceFindDefinition seen (sourceDefinitionName definition)))
     97     definitions
     98 
     99 sourceCheckDuplicates = (definitions : y sourceCheckDuplicates_ definitions t)
    100 
    101 sourceCheckNames_ self names definitions environment =
    102   lazyList
    103     (_ : ok t t)
    104     (node rest :
    105       lazyMaybe
    106         (_ : lazyMaybe
    107           (_ : err
    108             (parserDiagnostic 20 (sourceAstPayload node) t
    109               (sourceAstStart node) t)
    110             node)
    111           (value : self rest definitions environment)
    112           (sourceFindExternal environment (sourceAstPayload node)))
    113         (definition : self rest definitions environment)
    114         (sourceFindDefinition definitions (sourceAstPayload node)))
    115     names
    116 
    117 sourceCheckNames = (names definitions environment :
    118   y sourceCheckNames_ names definitions environment)
    119 
    120 sourceCheckDefinitionNames_ self pending definitions environment =
    121   lazyList
    122     (_ : ok t t)
    123     (definition rest :
    124       lazyResult
    125         (diagnostic node : err diagnostic node)
    126         (ignored unused : self rest definitions environment)
    127         (lazyResult (diagnostic remainder : err diagnostic remainder)
    128           (_ unused : sourceCheckNames (sourceFreeNames (sourceDefinitionBody definition))
    129             definitions environment)
    130           (sourceEquationValidate (sourceDefinitionBody definition))))
    131     pending
    132 
    133 sourceCheckDefinitionNames = (definitions environment :
    134   y sourceCheckDefinitionNames_ definitions definitions environment)
    135 
    136 sourceCheckFinalNames final definitions environment =
    137   lazyMaybe
    138     (_ : ok t t)
    139     (expression : lazyResult (diagnostic remainder : err diagnostic remainder)
    140       (_ unused : sourceCheckNames (sourceFreeNames expression) definitions environment)
    141       (sourceEquationValidate expression))
    142     final
    143 
    144 sourceDependencyNames_ self names definitions =
    145   lazyList
    146     (_ : t)
    147     (node rest :
    148       lazyMaybe
    149         (_ : self rest definitions)
    150         (definition : pair (sourceAstPayload node) (self rest definitions))
    151         (sourceFindDefinition definitions (sourceAstPayload node)))
    152     names
    153 
    154 sourceDependencyNames = (names definitions :
    155   y sourceDependencyNames_ names definitions)
    156 
    157 sourceDefinitionGraph_ self pending definitions =
    158   lazyList
    159     (_ : t)
    160     (definition rest :
    161       pair
    162         (pair (sourceDefinitionName definition)
    163           (sourceDependencyNames
    164             (sourceFreeNames (sourceDefinitionBody definition)) definitions))
    165         (self rest definitions))
    166     pending
    167 
    168 sourceDefinitionGraph = (definitions :
    169   y sourceDefinitionGraph_ definitions definitions)
    170 
    171 -- Validate each located free name and retain its local edge in the same pass.
    172 -- Do not deduplicate/reorder edges: their order determines cycle witnesses.
    173 -- A local definition wins over an external with the same spelling.
    174 sourceAnalyzeNames_ self names definitions environment = (lazyList
    175   (_ : ok t t)
    176   (node rest : lazyMaybe
    177     (_ : lazyMaybe
    178       (_ : err (parserDiagnostic 20 (sourceAstPayload node) t
    179         (sourceAstStart node) t) node)
    180       (_ : self rest definitions environment)
    181       (sourceFindExternal environment (sourceAstPayload node)))
    182     (_ : lazyResult
    183       (diagnostic missing : err diagnostic missing)
    184       (dependencies unused : ok (pair (sourceAstPayload node) dependencies) t)
    185       (self rest definitions environment))
    186     (sourceFindDefinition definitions (sourceAstPayload node))) names)
    187 sourceAnalyzeNames names definitions environment =
    188   y sourceAnalyzeNames_ names definitions environment
    189 
    190 -- Equation validation still precedes names in each definition. Only after all
    191 -- definitions succeed may final-expression validation and graph sorting run.
    192 -- The reversed accumulator is constructor-only; reverse once on completion.
    193 sourceAnalyzeDefinitions_ self pending definitions environment reversed = (lazyList
    194   (_ : ok (reverse reversed) t)
    195   (definition rest : lazyResult
    196     (diagnostic remainder : err diagnostic remainder)
    197     (_ unused : lazyResult
    198       (diagnostic missing : err diagnostic missing)
    199       (dependencies unused : self rest definitions environment
    200         (pair (pair (sourceDefinitionName definition) dependencies) reversed))
    201       (sourceAnalyzeNames (sourceFreeNames (sourceDefinitionBody definition))
    202         definitions environment))
    203     (sourceEquationValidate (sourceDefinitionBody definition))) pending)
    204 sourceAnalyzeDefinitions definitions environment =
    205   y sourceAnalyzeDefinitions_ definitions definitions environment t
    206 
    207 sourceOrderCycle definitions name =
    208   lazyMaybe
    209     (_ : parserDiagnostic 31 "acyclic" name t (pair name t))
    210     (definition : parserDiagnostic 31 "acyclic" name
    211       (sourceDefinitionPosition definition) (pair name t))
    212     (sourceFindDefinition definitions name)
    213 
    214 orderGateProgram environment program =
    215   lazyResult
    216     (diagnostic rest : err diagnostic rest)
    217     (unused rest :
    218       lazyResult
    219         (diagnostic duplicate : err diagnostic duplicate)
    220         (graph unused :
    221           lazyResult
    222             (diagnostic missing : err diagnostic missing)
    223             (ignored unused :
    224               lazyResult
    225                 (cycle unused : err (sourceOrderCycle
    226                   (sourceProgramDefinitions program) cycle) t)
    227                 (names unused : ok names t)
    228                 (graphSort graph))
    229             (sourceCheckFinalNames (sourceProgramFinal program)
    230               (sourceProgramDefinitions program) environment))
    231         (sourceAnalyzeDefinitions
    232           (sourceProgramDefinitions program) environment))
    233     (sourceCheckDuplicates (sourceProgramDefinitions program))
    234 
    235 orderGateSource environment characters =
    236   parserMatchReply
    237     (diagnostic rest consumed committed : err diagnostic rest)
    238     (program rest consumed committed : orderGateProgram environment program)
    239     (parseGateProgram characters)
    240 
    241 
    242 sourceFreeNames_ self node bound = (let
    243   collect ^sourceAstCaseKind = append
    244     (self (sourceAstCaseSubject node) bound) (self (sourceAstCaseMatcher node) bound)
    245   collect ^sourceAstRecKind = (let nested = pair (sourceAstLetName node) bound in
    246     append (self (sourceAstLetValue node) nested) (self (sourceAstLetBody node) nested))
    247   collect _ = sourceFreeOrdinary self node bound
    248   in collect (sourceAstKind node))