tricu

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

6a6428c3776f75d7c80876a9a9a8cb2e8d8b388d7383f6563deea1f75049cce8.tri (4065B)

      1 !import prelude *
      2 !import io *
      3 !import source_object *
      4 !import source_module *
      5 !import source_lock *
      6 !import source_build *
      7 !import source_unit *
      8 !import source_resolve *
      9 !export *
     10 
     11 -- Opt-in bootstrap acceleration. The runner supplies its compiler identity;
     12 -- rewritten source fixes exact imported manifests. Indices are hints, not CAS.
     13 sourceExportCacheOne root scope name tree =
     14   onOk_ (sourceObjectDigest "arboricx.source-export-name.v1" name) (nameHash :
     15     (path : thenIO (putStrLn (append "export-start=" name))
     16       (onOk_ (fileExists path) (exists : lazyBool
     17         (_ : onOk_ (readFile path) (hash :
     18           onOk_ (sourceObjectGetTree root hash) (_ :
     19             thenIO (putStrLn (append "export-reused=" name))
     20               (pure (ok hash t)))))
     21         (_ : onOk_ (sourceObjectPutTree root tree) (hash :
     22           onOk_ (atomicWriteBytes path hash) (_ :
     23             thenIO (putStrLn (append "export-complete="
     24               (append name (append "\t" hash)))) (pure (ok hash t)))))
     25         exists))) (append scope (append "/" nameHash)))
     26 
     27 sourceExportCacheAll entries root scope selected =
     28   lazyList
     29     (_ : pure (ok selected t))
     30     (entry rest : lazyMaybe
     31       (_ : onOk_ (sourceExportCacheOne root scope (fst entry) (snd entry))
     32         (hash : sourceExportCacheAll rest root scope (pair (pair (fst entry) hash) selected)))
     33       (_ : pure (err "duplicate export" t))
     34       (sourceFindExternal selected (fst entry)))
     35     entries
     36 
     37 sourceExportCacheSelect pending root scope definitions selected =
     38   lazyList
     39     (_ : sourceModulePutManifest root (reverse selected))
     40     (words rest : lazyResult
     41       (problem unused : pure (err problem t))
     42       (request unused : lazyBool
     43         (_ : onOk_ (sourceModuleGetRefManifest root (snd request)) (entries :
     44           onOk_ (sourceModuleAddEntries root entries selected)
     45             (next : sourceExportCacheSelect rest root scope definitions next)))
     46         (_ : lazyBool
     47           (_ : onOk_ (sourceExportCacheAll definitions root scope selected)
     48             (next : sourceExportCacheSelect rest root scope definitions next))
     49           (_ : lazyMaybe
     50             (_ : pure (err "undeclared local export" t))
     51             (tree : lazyMaybe
     52               (_ : onOk_ (sourceExportCacheOne root scope (fst request) tree)
     53                 (hash : sourceExportCacheSelect rest root scope definitions
     54                   (pair (pair (fst request) hash) selected)))
     55               (_ : pure (err "duplicate export" t))
     56               (sourceFindExternal selected (fst request)))
     57             (sourceFindExternal definitions (fst request)))
     58           (equal? (fst request) "*"))
     59         (equal? (fst request) "from"))
     60       (sourceModuleExportShape words))
     61     pending
     62 
     63 sourceExportCacheBuild root source compiler =
     64   onOk_ (sourceObjectDigest "arboricx.source-export-build.v1"
     65     (append compiler (pair 0 source))) (key :
     66     (scope : onOk_ (createDirectory root) (_ :
     67       onOk_ (createDirectory (append root "/cache")) (_ :
     68       onOk_ (createDirectory (append root "/cache/source-export")) (_ :
     69         onOk_ (createDirectory scope) (_ : lazyResult
     70           (problem unused : pure (err problem t))
     71           (staged unused : onOk_ (sourceModuleExtendUses root (fst staged))
     72             (environment : lazyResult
     73               (problem unused : pure (err problem t))
     74               (definitions unused : sourceExportCacheSelect
     75                 (fst (snd staged)) root scope definitions t)
     76               (compileModuleDefinitions environment (snd (snd staged)))))
     77           (sourceModuleStage source))))))
     78       (append root (append "/cache/source-export/" key)))
     79 
     80 sourceExportCacheCompile root clean groups compiler =
     81   lazyResult
     82     (problem unused : pure (err problem t))
     83     (rewritten unused : sourceExportCacheBuild root rewritten compiler)
     84     (sourceLockRewriteSource clean groups)
     85 sourceExportCacheProfile compiler =
     86   pair (workspace name : sourceBuildReadTri workspace name)
     87     (pair (root clean groups : sourceExportCacheCompile root clean groups compiler)
     88       "source-module.reference.v1")