tricu

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

export-cache.tri (4120B)

      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_ (encodeSourceText source) (sourceBytes :
     65   onOk_ (sourceObjectDigest "arboricx.source-export-build.v1"
     66     (append compiler (pair 0 sourceBytes))) (key :
     67     (scope : onOk_ (createDirectory root) (_ :
     68       onOk_ (createDirectory (append root "/cache")) (_ :
     69       onOk_ (createDirectory (append root "/cache/source-export")) (_ :
     70         onOk_ (createDirectory scope) (_ : lazyResult
     71           (problem unused : pure (err problem t))
     72           (staged unused : onOk_ (sourceModuleExtendUses root (fst staged))
     73             (environment : lazyResult
     74               (problem unused : pure (err problem t))
     75               (definitions unused : sourceExportCacheSelect
     76                 (fst (snd staged)) root scope definitions t)
     77               (compileModuleDefinitions environment (snd (snd staged)))))
     78           (sourceModuleStage source))))))
     79       (append root (append "/cache/source-export/" key))))
     80 
     81 sourceExportCacheCompile root clean groups compiler =
     82   lazyResult
     83     (problem unused : pure (err problem t))
     84     (rewritten unused : sourceExportCacheBuild root rewritten compiler)
     85     (sourceLockRewriteSource clean groups)
     86 sourceExportCacheProfile compiler =
     87   pair (workspace name : sourceBuildReadTri workspace name)
     88     (pair (root clean groups : sourceExportCacheCompile root clean groups compiler)
     89       "source-module.reference.v1")