tricu

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

ec97f34c89ead701af75053ea340ead1bb0fda13d83b474ca760c3aa359970fa.tri (8621B)

      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 !import source_index *
      9 !export *
     10 
     11 sourceFindDefinition definitions name = (let rec
     12   find definitions = (lazyList (_ : nothing)
     13     (definition rest : lazyBool (_ : just definition)
     14       (_ : find rest) (equal? (sourceDefinitionName definition) name)) definitions)
     15   in find definitions)
     16 
     17 -- Free-name collection returns located name AST nodes, so a missing-name
     18 -- diagnostic retains the original source position rather than a string key.
     19 sourceFreeList elements visit bound = concatMap (element : visit element bound) elements
     20 
     21 -- Pins see the surrounding scope, never the equation's captures. Keep pins
     22 -- before the body and retain repeated located occurrences in traversal order.
     23 sourceFreeEquations equations visit bound = (concatMap
     24   (equation : append
     25     (sourceFreeList (sourceEquationCollect (fst equation) sourceEquationPins) visit bound)
     26     (visit (snd equation)
     27       (append (reverse (sourceEquationCollect (fst equation) sourceEquationCaptures)) bound)))
     28   equations)
     29 
     30 sourceFreeOrdinary visit node bound = (case sourceAstKind node of
     31   ^sourceAstNameKind = lazyMaybe (_ : [node]) (_ : t)
     32     (sourceFindBinder bound (sourceAstPayload node))
     33   ^sourceAstApplyKind = append (visit (fst (sourceAstPayload node)) bound)
     34     (visit (snd (sourceAstPayload node)) bound)
     35   ^sourceAstLambdaKind = visit (snd (sourceAstPayload node))
     36     (pair (fst (sourceAstPayload node)) bound)
     37   ^sourceAstGroupKind = visit (sourceAstPayload node) bound
     38   ^sourceAstListKind = sourceFreeList (sourceAstPayload node) visit bound
     39   ^sourceAstLetKind = append (visit (sourceAstLetValue node) bound)
     40     (visit (sourceAstLetBody node) (pair (sourceAstLetName node) bound))
     41   ^sourceAstPipeKind = append (visit (sourceAstPipeLeft node) bound)
     42     (visit (sourceAstPipeRight node) bound)
     43   ^sourceAstDoKind = visit (sourceAstDoLower node) bound
     44   ^sourceAstEquationsKind = sourceFreeEquations (sourceAstPayload node) visit bound
     45   _ = t)
     46 
     47 sourceFreeNames node = sourceFreeVisit node t
     48 
     49 sourceCheckDuplicates definitions = (let rec
     50   walk definitions seen = (lazyList
     51       (_ : ok t t)
     52       (definition rest :
     53         lazyMaybe
     54           (_ : walk rest (pair definition seen))
     55           (prior : err
     56             (parserDiagnostic 30 (sourceDefinitionName definition)
     57               (sourceDefinitionName prior)
     58               (sourceDefinitionPosition definition) t)
     59             definition)
     60           (sourceFindDefinition seen (sourceDefinitionName definition)))
     61       definitions)
     62   in walk definitions t)
     63 
     64 sourceCheckNames names definitions environment = (let rec
     65   walk names = (lazyList
     66       (_ : ok t t)
     67       (node rest :
     68         lazyMaybe
     69           (_ : lazyMaybe
     70             (_ : err
     71               (parserDiagnostic 20 (sourceAstPayload node) t
     72                 (sourceAstStart node) t)
     73               node)
     74             (value : walk rest)
     75             (sourceFindExternal environment (sourceAstPayload node)))
     76           (definition : walk rest)
     77           (sourceFindDefinition definitions (sourceAstPayload node)))
     78       names)
     79   in walk names)
     80 
     81 sourceCheckDefinitionNames definitions environment = (let rec
     82   walk pending = (lazyList
     83       (_ : ok t t)
     84       (definition rest :
     85         lazyResult
     86           (diagnostic node : err diagnostic node)
     87           (ignored unused : walk rest)
     88           (lazyResult (diagnostic remainder : err diagnostic remainder)
     89             (_ unused : sourceCheckNames (sourceFreeNames (sourceDefinitionBody definition))
     90               definitions environment)
     91             (sourceEquationValidate (sourceDefinitionBody definition))))
     92       pending)
     93   in walk definitions)
     94 
     95 sourceCheckFinalNames final definitions environment =
     96   lazyMaybe
     97     (_ : ok t t)
     98     (expression : lazyResult (diagnostic remainder : err diagnostic remainder)
     99       (_ unused : sourceCheckNames (sourceFreeNames expression) definitions environment)
    100       (sourceEquationValidate expression))
    101     final
    102 
    103 sourceDependencyNames names definitions = (let rec
    104   walk names = (lazyList
    105       (_ : t)
    106       (node rest :
    107         lazyMaybe
    108           (_ : walk rest)
    109           (definition : pair (sourceAstPayload node) (walk rest))
    110           (sourceFindDefinition definitions (sourceAstPayload node)))
    111       names)
    112   in walk names)
    113 
    114 sourceDefinitionGraph definitions = (map
    115   (definition : pair (sourceDefinitionName definition)
    116     (sourceDependencyNames (sourceFreeNames (sourceDefinitionBody definition)) definitions))
    117   definitions)
    118 
    119 -- Validate each located free name and retain its local edge in the same pass.
    120 -- Do not deduplicate/reorder edges: their order determines cycle witnesses.
    121 -- A local definition wins over an external with the same spelling.
    122 sourceAnalyzeNamesUsing findDefinition findExternal names = (let rec
    123   walk names = (lazyList
    124     (_ : ok t t)
    125     (node rest : lazyMaybe
    126       (_ : lazyMaybe
    127         (_ : err (parserDiagnostic 20 (sourceAstPayload node) t
    128           (sourceAstStart node) t) node)
    129         (_ : walk rest)
    130         (findExternal (sourceAstPayload node)))
    131       (_ : lazyResult
    132         (diagnostic missing : err diagnostic missing)
    133         (dependencies unused : ok (pair (sourceAstPayload node) dependencies) t)
    134         (walk rest))
    135       (findDefinition (sourceAstPayload node))) names)
    136   in walk names)
    137 
    138 -- Equation validation still precedes names in each definition. Only after all
    139 -- definitions succeed may final-expression validation and graph sorting run.
    140 -- The reversed accumulator is constructor-only; reverse once on completion.
    141 sourceAnalyzeDefinitionsUsing findDefinition findExternal definitions = (let rec
    142   walk pending reversed = (lazyList
    143     (_ : ok (reverse reversed) t)
    144     (definition rest : lazyResult
    145       (diagnostic remainder : err diagnostic remainder)
    146       (_ unused : lazyResult
    147         (diagnostic missing : err diagnostic missing)
    148         (dependencies unused : walk rest
    149           (pair (pair (sourceDefinitionName definition) dependencies) reversed))
    150         (sourceAnalyzeNamesUsing findDefinition findExternal (sourceFreeNames (sourceDefinitionBody definition))))
    151       (sourceEquationValidate (sourceDefinitionBody definition))) pending)
    152   in walk definitions t)
    153 
    154 sourceOrderCycle definitions name =
    155   lazyMaybe
    156     (_ : parserDiagnostic 31 "acyclic" name t (pair name t))
    157     (definition : parserDiagnostic 31 "acyclic" name
    158       (sourceDefinitionPosition definition) (pair name t))
    159     (sourceFindDefinition definitions name)
    160 
    161 orderGateProgramUsing analyze environment program = (let definitions = sourceProgramDefinitions program in
    162   let proceed reply next = (lazyResult
    163     (diagnostic rest : err diagnostic rest) (value unused : next value) reply) in
    164   do proceed
    165     sourceCheckDuplicates definitions
    166     graph <- analyze definitions
    167     sourceCheckFinalNames (sourceProgramFinal program) definitions environment
    168     (lazyResult
    169       (cycle unused : err (sourceOrderCycle definitions cycle) t)
    170       (names unused : ok names t)
    171       (graphSort graph)))
    172 
    173 orderGateSource environment characters =
    174   parserMatchReply
    175     (diagnostic rest consumed committed : err diagnostic rest)
    176     (program rest consumed committed : orderGateProgram environment program)
    177     (parseGateProgram characters)
    178 
    179 
    180 sourceFreeVisit node bound = (case sourceAstKind node of
    181   ^sourceAstCaseKind = append
    182     (sourceFreeVisit (sourceAstCaseSubject node) bound)
    183     (sourceFreeVisit (sourceAstCaseMatcher node) bound)
    184   ^sourceAstRecKind = (let nested = pair (sourceAstLetName node) bound in
    185     append (sourceFreeVisit (sourceAstLetValue node) nested)
    186       (sourceFreeVisit (sourceAstLetBody node) nested))
    187   _ = sourceFreeOrdinary sourceFreeVisit node bound)
    188 
    189 sourceAnalyzeNames names definitions environment = sourceAnalyzeNamesUsing
    190   (sourceFindDefinition definitions) (sourceFindExternal environment) names
    191 sourceAnalyzeDefinitions definitions environment = sourceAnalyzeDefinitionsUsing
    192   (sourceFindDefinition definitions) (sourceFindExternal environment) definitions
    193 orderGateProgram environment program = orderGateProgramUsing
    194   (definitions : sourceAnalyzeDefinitions definitions environment) environment program
    195 
    196 -- Values (including definition bodies) are opaque to index construction.
    197 sourceDefinitionIndex definitions = sourceIndexBuild
    198   (map (definition : pair (sourceDefinitionName definition) definition) definitions)
    199 sourceAnalyzeIndexedDefinitions external definitions = sourceAnalyzeDefinitionsUsing
    200   (sourceIndexGet (sourceDefinitionIndex definitions)) (sourceIndexGet external) definitions