From 2c99b4515447315d76a8dc203a2dbcafc09506ea Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 17 Jul 2021 01:48:49 -0400 Subject: Now properly loading cached modules. --- stdlib/source/library/lux.lux | 13 ++-- .../library/lux/control/concurrency/actor.lux | 5 +- stdlib/source/library/lux/data/bit.lux | 8 +++ stdlib/source/library/lux/data/collection/tree.lux | 10 +-- .../lux/phase/generation/python/runtime.lux | 4 ++ .../lux/tool/compiler/language/lux/syntax.lux | 20 +++--- .../library/lux/tool/compiler/meta/archive.lux | 26 ++++--- .../library/lux/tool/compiler/meta/io/archive.lux | 79 ++++++++++++---------- stdlib/source/library/lux/world/file.lux | 46 ++++++------- 9 files changed, 121 insertions(+), 90 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 6d1f82632..4d3141587 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -5903,14 +5903,13 @@ _ (fail (..wrong_syntax_error (name_of ..^code))))) -(template [ ] - [(def: #export #0) - (def: #export #1)] +(def: #export false + Bit + #0) - [false true] - [no yes] - [off on] - ) +(def: #export true + Bit + #1) (macro: #export (:let tokens) (case tokens diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index a12e65471..78ed99765 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -12,6 +12,7 @@ ["<>" parser ["<.>" code (#+ Parser)]]] [data + ["." bit] ["." product] [text ["%" format (#+ format)]] @@ -113,10 +114,10 @@ promise.poll (\ io.functor map (|>> (case> #.None - yes + bit.yes _ - no)))))) + bit.no)))))) (def: #export (obituary actor) (All [s] (-> (Actor s) (IO (Maybe (Obituary s))))) diff --git a/stdlib/source/library/lux/data/bit.lux b/stdlib/source/library/lux/data/bit.lux index 5a62ecce5..05d419b8f 100644 --- a/stdlib/source/library/lux/data/bit.lux +++ b/stdlib/source/library/lux/data/bit.lux @@ -9,6 +9,14 @@ [control ["." function]]]]) +(template [ ] + [(def: #export Bit #0) + (def: #export Bit #1)] + + [no yes] + [off on] + ) + (implementation: #export equivalence (Equivalence Bit) diff --git a/stdlib/source/library/lux/data/collection/tree.lux b/stdlib/source/library/lux/data/collection/tree.lux index 6ed986476..045b176c6 100644 --- a/stdlib/source/library/lux/data/collection/tree.lux +++ b/stdlib/source/library/lux/data/collection/tree.lux @@ -8,7 +8,7 @@ [monad (#+ do)]] [control ["<>" parser - ["" code (#+ Parser)]]] + ["<.>" code (#+ Parser)]]] [data [collection ["." list ("#\." monad fold)]]] @@ -41,13 +41,13 @@ (def: tree^ (Parser Tree_Code) (|> (|>> <>.some - .record - (<>.and .any)) + .record + (<>.and .any)) <>.rec <>.some - .record + .record (<>.default (list)) - (<>.and .any))) + (<>.and .any))) (syntax: #export (tree {root tree^}) {#.doc (doc "Tree literals." diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 1b7c4310c..7a19539df 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -188,6 +188,10 @@ (runtime: (io::log! message) ($_ _.then (_.print message) + (|> (_.__import__/1 (_.unicode "sys")) + (_.the "stdout") + (_.do "flush" (list)) + _.statement) (_.return ..unit))) (runtime: (io::throw! message) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux index e41cd0f79..de266d0ad 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux @@ -483,17 +483,24 @@ (with_expansions [ (as_is where (!inc offset/0) source_code) (as_is [(!forward 1 where) (!inc offset/0) source_code]) (as_is [(!forward 1 where) (!inc/2 offset/0) source_code]) - (as_is (parse current_module aliases source_code//size)) - (as_is (recur (!horizontal where offset/0 source_code)))] + (as_is (parse current_module aliases source_code//size))] (template: (!close closer) (#.Left [ closer])) + + (def: (bit_syntax value [where offset/0 source_code]) + (-> Bit (Parser Code)) + (#.Right [[(update@ #.column (|>> !inc/2) where) + (!inc/2 offset/0) + source_code] + [where (#.Bit value)]])) (def: #export (parse current_module aliases source_code//size) (-> Text Aliases Nat (Parser Code)) ## The "exec []" is only there to avoid function fusion. ## This is to preserve the loop as much as possible and keep it tight. - (exec [] + (exec + [] (function (recur [where offset/0 source_code]) (<| (!with_char+ source_code//size source_code offset/0 char/0 (!end_of_file where offset/0 source_code current_module)) @@ -511,7 +518,7 @@ (`` ("lux syntax char case!" char/0 [[(~~ (static text.space)) (~~ (static text.carriage_return))] - + (recur (!horizontal where offset/0 source_code)) ## New line [(~~ (static text.new_line))] @@ -543,10 +550,7 @@ (~~ (template [ ] [[] - (#.Right [[(update@ #.column (|>> !inc/2) where) - (!inc offset/1) - source_code] - [where (#.Bit )]])] + (..bit_syntax [where offset/0 source_code])] ["0" #0] ["1" #1]))] diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index d04f1227f..735e315c5 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -9,9 +9,10 @@ ["." exception (#+ exception:)] ["." function] ["<>" parser - ["" binary (#+ Parser)]]] + ["<.>" binary (#+ Parser)]]] [data [binary (#+ Binary)] + ["." bit] ["." product] ["." name] ["." text @@ -149,10 +150,10 @@ (-> Archive Module Bit) (case (..find module archive) (#try.Success _) - yes + bit.yes (#try.Failure _) - no)) + bit.no)) (def: #export archived (-> Archive (List Module)) @@ -169,10 +170,10 @@ (let [(^slots [#..resolver]) (:representation archive)] (case (dictionary.get module resolver) (#.Some [id _]) - yes + bit.yes #.None - no))) + bit.no))) (def: #export reserved (-> Archive (List Module)) @@ -206,15 +207,18 @@ (dictionary.entries +resolver)))) :abstraction))) - (type: Reservation [Module ID]) - (type: Frozen [Version ID (List Reservation)]) + (type: Reservation + [Module ID]) + + (type: Frozen + [Version ID (List Reservation)]) (def: reader (Parser ..Frozen) ($_ <>.and - .nat - .nat - (.list (<>.and .text .nat)))) + .nat + .nat + (.list (<>.and .text .nat)))) (def: writer (Writer ..Frozen) @@ -266,7 +270,7 @@ (def: #export (import expected binary) (-> Version Binary (Try Archive)) (do try.monad - [[actual next reservations] (.run ..reader binary) + [[actual next reservations] (.run ..reader binary) _ (exception.assert ..version_mismatch [expected actual] (n\= expected actual)) _ (exception.assert ..corrupt_data [] diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index b5ed4b84b..0b7a54a34 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -213,20 +213,22 @@ (def: (loaded_document extension host module_id expected actual document) (All [expression directive] (-> Text (generation.Host expression directive) archive.ID (Row Artifact) (Dictionary Text Binary) (Document .Module) - (Try [(Document .Module) Bundles]))) + (Try [(Document .Module) Bundles Output]))) (do {! try.monad} - [[definitions bundles] (: (Try [Definitions Bundles]) + [[definitions bundles] (: (Try [Definitions Bundles Output]) (loop [input (row.to_list expected) definitions (: Definitions (dictionary.new text.hash)) - bundles ..empty_bundles] + bundles ..empty_bundles + output (: Output row.empty)] (let [[analysers synthesizers generators directives] bundles] (case input (#.Cons [[artifact_id artifact_category] input']) (case (do ! [data (try.from_maybe (dictionary.get (format (%.nat artifact_id) extension) actual)) #let [context [module_id artifact_id] - directive (\ host ingest context data)]] + directive (\ host ingest context data) + output (row.add [artifact_id data] output)]] (case artifact_category #artifact.Anonymous (do ! @@ -235,7 +237,8 @@ [analysers synthesizers generators - directives]])) + directives] + output])) (#artifact.Definition name) (if (text\= $/program.name name) @@ -243,14 +246,16 @@ [analysers synthesizers generators - directives]]) + directives] + output]) (do ! [value (\ host re_load context directive)] (wrap [(dictionary.put name value definitions) [analysers synthesizers generators - directives]]))) + directives] + output]))) (#artifact.Analyser extension) (do ! @@ -259,7 +264,8 @@ [(dictionary.put extension (:as analysis.Handler value) analysers) synthesizers generators - directives]])) + directives] + output])) (#artifact.Synthesizer extension) (do ! @@ -268,7 +274,8 @@ [analysers (dictionary.put extension (:as synthesis.Handler value) synthesizers) generators - directives]])) + directives] + output])) (#artifact.Generator extension) (do ! @@ -277,7 +284,8 @@ [analysers synthesizers (dictionary.put extension (:as generation.Handler value) generators) - directives]])) + directives] + output])) (#artifact.Directive extension) (do ! @@ -286,15 +294,16 @@ [analysers synthesizers generators - (dictionary.put extension (:as directive.Handler value) directives)]])))) - (#try.Success [definitions' bundles']) - (recur input' definitions' bundles') + (dictionary.put extension (:as directive.Handler value) directives)] + output])))) + (#try.Success [definitions' bundles' output']) + (recur input' definitions' bundles' output') failure failure) - #.None - (#try.Success [definitions bundles]))))) + #.Nil + (#try.Success [definitions bundles output]))))) content (document.read $.key document) definitions (monad.map ! (function (_ [def_name def_global]) (case def_global @@ -302,23 +311,26 @@ (wrap [def_name (#.Alias alias)]) (#.Definition [exported? type annotations _]) - (do ! - [value (try.from_maybe (dictionary.get def_name definitions))] - (wrap [def_name (#.Definition [exported? type annotations value])])))) + (|> definitions + (dictionary.get def_name) + try.from_maybe + (\ ! map (|>> [exported? type annotations] + #.Definition + [def_name]))))) (get@ #.definitions content))] (wrap [(document.write $.key (set@ #.definitions definitions content)) bundles]))) -(def: (load_definitions fs static module_id host_environment [descriptor document output]) +(def: (load_definitions fs static module_id host_environment descriptor document) (All [expression directive] (-> (file.System Promise) Static archive.ID (generation.Host expression directive) - [Descriptor (Document .Module) Output] + Descriptor (Document .Module) (Promise (Try [[Descriptor (Document .Module) Output] Bundles])))) (do (try.with promise.monad) [actual (cached_artifacts fs static module_id) #let [expected (|> descriptor (get@ #descriptor.registry) artifact.artifacts)] - [document bundles] (promise\wrap (loaded_document (get@ #static.artifact_extension static) host_environment module_id expected actual document))] + [document bundles output] (promise\wrap (loaded_document (get@ #static.artifact_extension static) host_environment module_id expected actual document))] (wrap [[descriptor document output] bundles]))) (def: (purge! fs static [module_name module_id]) @@ -344,7 +356,7 @@ (Dictionary Module archive.ID)) (def: initial_purge - (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module) Output]]]]) + (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]]) Purge) (|>> (list.all (function (_ [valid_cache? [module_name [module_id _]]]) (if valid_cache? @@ -353,10 +365,10 @@ (dictionary.from_list text.hash))) (def: (full_purge caches load_order) - (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module) Output]]]]) + (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]]) dependency.Order Purge) - (list\fold (function (_ [module_name [module_id [descriptor document output]]] purge) + (list\fold (function (_ [module_name [module_id [descriptor document]]] purge) (let [purged? (: (Predicate Module) (dictionary.key? purge))] (if (purged? module_name) @@ -387,16 +399,16 @@ [descriptor document] (promise\wrap (.run ..parser data))] (if (text\= archive.runtime_module module_name) (wrap [true - [module_name [module_id [descriptor document (: Output row.empty)]]]]) + [module_name [module_id [descriptor document]]]]) (do ! [input (//context.read fs ..pseudo_module import contexts (get@ #static.host_module_extension static) module_name)] (wrap [(..valid_cache? descriptor input) - [module_name [module_id [descriptor document (: Output row.empty)]]]]))))))) + [module_name [module_id [descriptor document]]]]))))))) load_order (|> pre_loaded_caches (list\map product.right) (monad.fold try.monad - (function (_ [module [module_id descriptor,document,output]] archive) - (archive.add module descriptor,document,output archive)) + (function (_ [module [module_id [descriptor document]]] archive) + (archive.add module [descriptor document (: Output row.empty)] archive)) archive) (\ try.monad map (dependency.load_order $.key)) (\ try.monad join) @@ -406,18 +418,17 @@ dictionary.entries (monad.map ! (..purge! fs static))) loaded_caches (|> load_order - (list.filter (function (_ [module_name [module_id [descriptor document output]]]) - (not (dictionary.key? purge module_name)))) - (monad.map ! (function (_ [module_name [module_id descriptor,document,output]]) + (list.filter (|>> product.left (dictionary.key? purge) not)) + (monad.map ! (function (_ [module_name [module_id [descriptor document _]]]) (do ! - [[descriptor,document,output bundles] (..load_definitions fs static module_id host_environment descriptor,document,output)] + [[descriptor,document,output bundles] (..load_definitions fs static module_id host_environment descriptor document)] (wrap [[module_name descriptor,document,output] bundles])))))] (promise\wrap (do {! try.monad} [archive (monad.fold ! - (function (_ [[module descriptor,document] _bundle] archive) - (archive.add module descriptor,document archive)) + (function (_ [[module descriptor,document,output] _bundle] archive) + (archive.add module descriptor,document,output archive)) archive loaded_caches) analysis_state (..analysis_state (get@ #static.host static) archive)] diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index 7f95b3282..3a7b4463d 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -153,15 +153,6 @@ [cannot_read_all_data] ) -(with_expansions [ (as_is (exception: #export (cannot_move {target Path} {source Path}) - (exception.report - ["Source" source] - ["Target" target])))] - (for {@.old (as_is ) - @.jvm (as_is ) - @.lua (as_is )} - (as_is))) - (with_expansions [ (as_is (exception: #export (cannot_modify_file {instant Instant} {file Path}) (exception.report ["Instant" (%.instant instant)] @@ -336,7 +327,7 @@ (accessSync [ffi.String ffi.Number] #io #try Any) (renameSync [ffi.String ffi.String] #io #try Any) (utimesSync [ffi.String ffi.Number ffi.Number] #io #try Any) - (unlink [ffi.String] #io #try Any) + (unlinkSync [ffi.String] #io #try Any) (readdirSync [ffi.String] #io #try (Array ffi.String)) (mkdirSync [ffi.String] #io #try Any) (rmdirSync [ffi.String] #io #try Any)]) @@ -375,13 +366,16 @@ [node_path "path" ..JsPath] ) + (def: js_separator + (if ffi.on_node_js? + (JsPath::sep (..node_path [])) + "/")) + (`` (implementation: #export default (System IO) (def: separator - (if ffi.on_node_js? - (JsPath::sep (..node_path [])) - "/")) + ..js_separator) (~~ (template [ ] [(def: ( path) @@ -418,6 +412,7 @@ subs (Fs::readdirSync [path] node_fs)] (|> subs array.to_list + (list\map (|>> (format path ..js_separator))) (monad.map ! (function (_ sub) (do ! [stats (Fs::statSync [sub] node_fs)] @@ -465,7 +460,7 @@ stats (Fs::statSync [path] node_fs) verdict (Stats::isFile [] stats)] (if verdict - (Fs::unlink [path] node_fs) + (Fs::unlinkSync [path] node_fs) (Fs::rmdirSync [path] node_fs)))) (def: (modify time_stamp path) @@ -520,11 +515,14 @@ (#static getsize [ffi.String] #io #try ffi.Integer) (#static getmtime [ffi.String] #io #try ffi.Float)]) + (def: python_separator + (os/path::sep)) + (`` (implementation: #export default (System IO) (def: separator - (os/path::sep)) + ..python_separator) (~~ (template [ ] [(def: @@ -539,15 +537,17 @@ os::mkdir) (~~ (template [ ] - [(def: + [(def: ( path) (let [! (try.with io.monad)] - (|>> os::listdir - (\ ! map (|>> array.to_list - (monad.map ! (function (_ sub) - (\ ! map (|>> [sub]) ( [sub])))) - (\ ! map (|>> (list.filter product.right) - (list\map product.left))))) - (\ ! join))))] + (|> path + os::listdir + (\ ! map (|>> array.to_list + (list\map (|>> (format path ..python_separator))) + (monad.map ! (function (_ sub) + (\ ! map (|>> [sub]) ( [sub])))) + (\ ! map (|>> (list.filter product.right) + (list\map product.left))))) + (\ ! join))))] [directory_files os/path::isfile] [sub_directories os/path::isdir] -- cgit v1.2.3