tricu

A lazy functional language based on Tree Calculus
Log | Files | Refs | README | LICENSE

5445a4f505c572889455435960a144663e224fa40a9c1cce1d9a96a8e3678fef.tri (4321B)

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