link.tri (3680B)
1 !import prelude * 2 !import io * 3 !import consumers_module as M 4 !import consumers_structural as S 5 !import consumers_lexical_worker as X 6 !import consumers_validate as V 7 !import consumers_base_source as B 8 !import source_module as Module 9 !import source_resolve as Resolve 10 !export * 11 -- Verified source-to-worker preparation. Source and authored IR identities 12 -- remain separate from executable identity; initial states are supplied by 13 -- the caller, never inferred by traversing arbitrary worker-bearing trees. 14 15 -- Selections are [(source alias, explicit initial state)]. The result is 16 -- (authored IR manifest, ([(alias, executable descriptor)], 17 -- [(alias, aligned rule/output positions)])). The positions come from the 18 -- verified source; the manifest still identifies only authored IR, not a 19 -- compiler configuration, executable, or independently attested source map. 20 clNames_ self selections = (lazyList (_ : t) 21 (selection rest : pair (fst selection) (self rest)) selections) 22 clNames selections = y clNames_ selections 23 clAuthored_ self linked = (lazyList (_ : t) 24 (entry rest : pair (pair (fst entry) (fst (snd entry))) (self rest)) linked) 25 clAuthored linked = y clAuthored_ linked 26 clLocations_ self linked = (lazyList (_ : t) 27 (entry rest : pair (pair (fst entry) (snd (snd entry))) (self rest)) linked) 28 clLocations linked = y clLocations_ linked 29 clValidate_ self linked = (lazyList (_ : ok t t) 30 (entry rest : lazyResult 31 (problem _ : err (pair (fst entry) 32 (pair problem (B.bsDiagnosticLocation problem (snd (snd entry))))) t) 33 (_ _ : self rest) 34 (V.vValidate (fst (snd entry)))) linked) 35 clValidate linked = y clValidate_ linked 36 clProblemLocation problem sidecars alias = (lazyMaybe (_ : t) 37 (locations : lazyBool 38 (_ : lazyBool 39 (_ : B.bsDiagnosticLocation problem locations) 40 (_ : t) 41 (or? (equal? (fst problem) "malformed") 42 (equal? (fst problem) "unsupported"))) 43 (_ : t) (V.vPair? problem)) 44 (Resolve.sourceFindExternal sidecars alias)) 45 -- Recompile a selected preserved IR with an explicit state, for applications 46 -- whose worker graph is assembled in dependency order after initial loading. 47 clCompileSelected root manifest alias initial = (onResult_ 48 (Module.sourceModuleLoadSelected root manifest alias) 49 (problem : pure (err (pair alias problem) t)) 50 (authored : lazyResult 51 (problem _ : pure (err (pair alias problem) t)) 52 (worker _ : pure (ok worker t)) 53 (X.lCompile (S.makeConsumer initial (snd authored))))) 54 clPrepareRows_ self selections root manifest sidecars reversed = (lazyList 55 (_ : pure (ok (reverse reversed) t)) 56 (selection rest : matchPair (alias initial : 57 onResult_ (clCompileSelected root manifest alias initial) 58 (problem : pure (err (pair alias 59 (pair (snd problem) 60 (clProblemLocation (snd problem) sidecars alias))) t)) 61 (worker : self rest root manifest sidecars 62 (pair (pair alias worker) reversed))) 63 selection) 64 selections) 65 clPrepareRows selections root manifest sidecars = 66 y clPrepareRows_ selections root manifest sidecars t 67 clPrepare root descriptor selections = (onResult_ (M.cmLoadLocated root descriptor) 68 (problem : pure (err problem t)) 69 (linked : lazyResult 70 (problem _ : pure (err problem t)) 71 (_ _ : onResult_ (M.cmPublishIR root (clAuthored linked) (clNames selections)) 72 (problem : pure (err problem t)) 73 (manifest : onResult_ (clPrepareRows selections root manifest 74 (clLocations linked)) 75 (problem : pure (err problem t)) 76 (workers : pure (ok (pair manifest 77 (pair workers (clLocations linked))) t)))) 78 (clValidate linked)))