tricu

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

module.tri (4585B)

      1 !import prelude *
      2 !import io *
      3 !import source_object as O
      4 !import source_module as M
      5 !import source_resolve as R
      6 !import consumers_base_source as B
      7 !export *
      8 -- Experimental hash-pinned SCP source linker. Each source and its import
      9 -- descriptor is independently verified as an immutable CAS object. Worker
     10 -- compilation remains separate: callers choose initial state and CPS entry.
     11 
     12 cmSourceDomain = "arboricx.scp-source.v1"
     13 cmImportDomain = "arboricx.scp-imports.v1"
     14 cmHeader = "arboricx.scp-imports.v1\n"
     15 -- import<TAB>local alias<TAB>source SHA-256<TAB>authored export<NEWLINE>
     16 cmRow alias hash name =
     17   (append "import\t" (append alias (append "\t"
     18     (append hash (append "\t" (append name "\n"))))))
     19 cmEncode_ self rows =
     20   (lazyList (_ : t)
     21     (row rest : append (cmRow (fst row) (fst (snd row)) (snd (snd row)))
     22       (self rest)) rows)
     23 cmEncode rows = append cmHeader (y cmEncode_ rows)
     24 cmParseRow line seen =
     25   (lazyList (_ : err "invalid SCP import row" t)
     26     (tag r0 : lazyList (_ : err "invalid SCP import row" t)
     27       (alias r1 : lazyList (_ : err "invalid SCP import row" t)
     28         (hash r2 : lazyList (_ : err "invalid SCP import row" t)
     29           (name extra : lazyBool
     30             (_ : lazyMaybe (_ : ok (pair alias (pair hash name)) t)
     31               (_ : err "duplicate SCP import alias" t)
     32               (R.sourceFindExternal seen alias))
     33             (_ : err "invalid SCP import name, digest or fields" t)
     34             (and? (equal? tag "import")
     35               (and? (emptyList? extra)
     36                 (and? (M.sourceModuleAliasValid alias)
     37                   (and? (O.sourceObjectHashValid hash)
     38                     (M.sourceModuleExportNameValid name))))))
     39           r2)
     40         r1)
     41       r0)
     42     (splitOnByte 9 line))
     43 cmParseRows_ self rows seen =
     44   (lazyList (_ : err "SCP imports require a source" t)
     45     (line rest : lazyList
     46       (_ : lazyBool (_ : ok (reverse seen) t)
     47         (_ : err "blank SCP import row" t) (emptyList? rest))
     48       (_ _ : lazyResult (problem unused : err problem t)
     49         (entry unused : self rest (pair entry seen))
     50         (cmParseRow line seen)) line) rows)
     51 cmDecode bytes =
     52   (lazyList (_ : err "empty SCP imports" t)
     53     (header rows : lazyBool
     54       (_ : lazyResult (problem unused : err problem t)
     55         (entries unused : lazyBool (_ : ok entries t)
     56           (_ : err "noncanonical SCP imports" t)
     57           (equal? bytes (cmEncode entries)))
     58         (y cmParseRows_ rows t))
     59       (_ : err "unsupported SCP import version" t)
     60       (equal? header "arboricx.scp-imports.v1"))
     61     (splitOnByte 10 bytes))
     62 cmPutSource root source = O.sourceObjectStore root cmSourceDomain source
     63 cmPutImports root rows =
     64   (lazyResult
     65     (problem unused : pure (err problem t))
     66     (checked unused : O.sourceObjectStore root cmImportDomain (cmEncode checked))
     67     (cmDecode (cmEncode rows)))
     68 -- Both loaders verify the same source objects. The located variant retains
     69 -- parser positions alongside IR without changing the cmLoad return shape.
     70 cmLoadRowsWith_ self rows root reversed parse unpack onFailure =
     71   (lazyList (_ : pure (ok (reverse reversed) t))
     72     (row rest : matchPair (alias more : matchPair (hash name :
     73       onResult_ (O.sourceObjectGet root cmSourceDomain hash)
     74         (problem : pure (err (onFailure alias problem) t))
     75         (source : lazyResult
     76           (diagnostic unused : pure (err (onFailure alias diagnostic) t))
     77           (parsed unused : matchPair (export payload : lazyBool
     78             (_ : self rest root (pair (pair alias payload) reversed)
     79               parse unpack onFailure)
     80             (_ : pure (err (onFailure alias "SCP import export name mismatch") t))
     81             (equal? export name)) (unpack parsed))
     82           (parse source))) more) row) rows)
     83 cmLoadWith root digest parse unpack onFailure =
     84   (onResult_ (O.sourceObjectGet root cmImportDomain digest)
     85     (problem : pure (err problem t))
     86     (bytes : lazyResult
     87       (problem unused : pure (err problem t))
     88       (rows unused : y cmLoadRowsWith_ rows root t parse unpack onFailure)
     89       (cmDecode bytes)))
     90 cmLoad root digest = (cmLoadWith root digest B.compileBaseSource
     91   (named : named) (alias problem : problem))
     92 cmLoadLocated root digest = (cmLoadWith root digest B.compileBaseSourceLocated
     93   (located : pair (fst (fst located))
     94     (pair (snd (fst located)) (snd located)))
     95   (alias problem : pair alias problem))
     96 -- Export original authored IR under explicit aliases using the existing
     97 -- canonical tree objects and module-manifest policy.
     98 cmPublishIR root definitions names = M.sourceModulePublishNames root definitions names