tricu

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

workspace-build.tri (3871B)

      1 !import prelude *
      2 !import io *
      3 !import source_build as G
      4 !import source_module as M
      5 !import source_resolve as R
      6 !import consumers_unit_build as U
      7 !export *
      8 -- Explicit portable workspace: logical name -> (relative path, frontend).
      9 -- Source declares only logical dependencies. Dispatch never probes extensions,
     10 -- ambient aliases, directories, or an alternative frontend after failure.
     11 
     12 wbPair? value = triage false (_ : false) (_ _ : true) value
     13 wbPathChars_ self path = (triage true (_ : false)
     14   (byte rest : lazyBool
     15     (_ : lazyBool (_ : self rest) (_ : false)
     16       (and? (not? (lt_? byte 32)) (lte_? byte 126)))
     17     (_ : false) (isNat? byte)) path)
     18 wbPath? path = (triage false (_ : false)
     19   (first rest : lazyBool
     20     (_ : false) (_ : y wbPathChars_ path) (equal? first 47)) path)
     21 wbDeclarations_ self declarations seen = (triage (ok t t)
     22   (_ : err "improper workspace declaration list" t)
     23   (row rest : lazyBool
     24     (_ : lazyBool
     25       (_ : lazyBool
     26         (_ : lazyMaybe
     27           (_ : self rest (pair row seen))
     28           (_ : err "duplicate workspace unit name" t)
     29           (R.sourceFindExternal seen (fst row)))
     30         (_ : err "invalid workspace name, path or frontend" t)
     31         (and? (M.sourceModuleAliasValid (fst row))
     32           (and? (wbPath? (fst (snd row)))
     33             (or? (equal? (snd (snd row)) "tri")
     34               (equal? (snd (snd row)) "scp")))))
     35       (_ : err "invalid workspace selection" t) (wbPair? (snd row)))
     36     (_ : err "invalid workspace declaration" t) (wbPair? row)) declarations)
     37 workspaceDeclarations declarations = y wbDeclarations_ declarations t
     38 wbProfileIdentity frontend = (lazyBool
     39   (_ : "source-module.reference.v1") (_ : "scp-unit.lexical-worker.v2")
     40   (equal? frontend "tri"))
     41 -- Selected unit = (relative path, (frontend, (profile identity, staged unit))).
     42 -- Source bytes remain unmodified fingerprint input; selection belongs to options.
     43 wbSelected selection staged = (pair (fst staged)
     44   (pair (fst (snd staged)) (pair (fst (snd (snd staged)))
     45     (pair (fst selection) (pair (snd selection)
     46       (pair (wbProfileIdentity (snd selection)) (snd (snd (snd staged)))))))))
     47 wbRead workspace name = (lazyMaybe
     48   (_ : pure (err (pair "undeclared workspace unit" name) t))
     49   (selection : let path = append (fst workspace) (append "/" (fst selection)) in
     50     lazyBool
     51       (_ : onOk_ (G.sourceBuildReadTriPath path)
     52         (staged : pure (ok (wbSelected selection staged) t)))
     53       (_ : onOk_ (U.scpUnitReadPath path)
     54         (staged : pure (ok (wbSelected selection staged) t)))
     55       (equal? (snd selection) "tri"))
     56   (R.sourceFindExternal (snd workspace) name))
     57 wbCompile root selected groups = (lazyBool
     58   (_ : G.sourceBuildCompileTri root (snd (snd (snd selected))) groups)
     59   (_ : U.scpUnitCompile root (snd (snd (snd selected))) groups)
     60   (equal? (fst (snd selected)) "tri"))
     61 wbOptions selected = (append "arboricx.workspace-unit-options.v1\nfrontend\t"
     62   (append (fst (snd selected)) (append "\nprofile\t"
     63     (append (fst (snd (snd selected))) (append "\npath\t"
     64       (append (M.sourceModuleEscape (fst selected)) "\n"))))))
     65 workspaceUnitProfile = (pair (workspace name : wbRead workspace name)
     66   (pair (root selected groups : wbCompile root selected groups)
     67     (selected : wbOptions selected)))
     68 -- The directory is an explicit read base, not an ambient workspace resolver.
     69 -- Relative paths may traverse parents; IO capability grants are the authority,
     70 -- not this mapping. ASCII paths only in this first profile. Directory relocation
     71 -- preserves identity when relative selections, source bytes and pins agree.
     72 workspaceBuildGraph directory declarations root compilerDigest name = (lazyResult
     73   (problem unused : pure (err problem t))
     74   (_ unused : G.sourceBuildGraphUnitProfile (pair directory declarations)
     75     root compilerDigest name workspaceUnitProfile)
     76   (workspaceDeclarations declarations))