diff options
Diffstat (limited to '')
11 files changed, 210 insertions, 128 deletions
diff --git a/stdlib/source/library/lux/target/jvm/constant/pool.lux b/stdlib/source/library/lux/target/jvm/constant/pool.lux index fd68e5ccb..09dbf910f 100644 --- a/stdlib/source/library/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/library/lux/target/jvm/constant/pool.lux @@ -1,39 +1,36 @@ (.using - [library - [lux "*" - ["[0]" ffi] - [abstract - [equivalence {"+" Equivalence}] - [monad {"+" Monad do}]] - [control - ["[0]" state {"+" +State}] - ["[0]" try {"+" Try}]] - [data - ["[0]" product] - ["[0]" text] - ["[0]" format "_" - ["[1]" binary {"+" Writer} ("specification#[0]" monoid)]] - [collection - ["[0]" sequence {"+" Sequence} ("[1]#[0]" mix)]]] - [macro - ["[0]" template]] - [math - [number - ["[0]" i32] - ["n" nat] - ["[0]" int] - ["[0]" frac]]] - [type - abstract]]] - ["[0]" // {"+" UTF8 String Class Integer Float Long Double Constant Name_And_Type Reference} - [// - [encoding - ["[1][0]" name {"+" Internal External}] - ["[1][0]" unsigned]] - ["[1][0]" index {"+" Index}] - [type - [category {"+" Value Method}] - ["[1][0]" descriptor {"+" Descriptor}]]]]) + [library + [lux "*" + ["[0]" ffi] + [abstract + [equivalence {"+" Equivalence}] + [functor {"+" Functor}] + [monad {"+" Monad do}]] + [control + [pipe {"+" case>}] + ["[0]" state {"+" +State}] + ["[0]" try {"+" Try}]] + [data + ["[0]" product] + ["[0]" text] + ["[0]" format "_" + ["[1]" binary {"+" Writer} ("specification#[0]" monoid)]] + [collection + ["[0]" sequence {"+" Sequence} ("[1]#[0]" mix)]]] + [math + [number + ["[0]" int] + ["[0]" frac] + ["[0]" i32]]]]] + ["[0]" // {"+" UTF8 String Class Integer Float Long Double Constant Name_And_Type Reference} + [// + ["[1][0]" index {"+" Index}] + [encoding + ["[1][0]" name {"+" Internal External}] + ["[1][0]" unsigned]] + [type + [category {"+" Value Method}] + ["[1][0]" descriptor {"+" Descriptor}]]]]) (type: .public Pool [Index (Sequence [Index Constant])]) @@ -47,42 +44,90 @@ (type: .public (Resource a) (+State Try Pool a)) -(def: .public monad +(implementation: .public functor + (Functor Resource) + + (def: (each $ it) + (|>> it + (case> {try.#Success [state output]} + {try.#Success [state ($ output)]} + + ... {try.#Failure error} + failure + (:expected failure))))) + +(implementation: .public monad (Monad Resource) - (state.with try.monad)) - -(template: (!add <tag> <equivalence> <value>) - [(function (_ [current pool]) - (let [<value>' <value>] - (with_expansions [<try_again> (as_is (again (.++ idx)))] - (loop [idx 0] - (case (sequence.item idx pool) - {try.#Success entry} - (case entry - [index {<tag> reference}] - (if (# <equivalence> = reference <value>') - {try.#Success [[current pool] - index]} - <try_again>) - - _ + + (def: &functor ..functor) + + (def: (in it) + (function (_ state) + {try.#Success [state it]})) + + (def: (conjoint it) + (function (_ state) + (case (it state) + {try.#Success [state' it']} + (it' state') + + ... {try.#Failure error} + failure + (:expected failure))))) + +(template: (try|each <binding> <value> <body>) + [(case <value> + {try.#Success <binding>} + <body> + + ... {try.#Failure error} + failure + (:expected failure))]) + +(template: (try|in <it>) + [{try.#Success <it>}]) + +(template: (!add <state> <tag> <equivalence> <value>) + [(let [[current pool] <state> + <value>' <value>] + (with_expansions [<try_again> (as_is (again (.++ idx)))] + (loop [idx 0] + (case (sequence.item idx pool) + {try.#Success entry} + (case entry + [index {<tag> reference}] + (if (# <equivalence> = reference <value>') + {try.#Success [[current pool] + index]} <try_again>) - {try.#Failure _} - (let [new {<tag> <value>'}] - (do [! try.monad] - [@new (//unsigned.u2 (//.size new)) - next (: (Try Index) - (|> current - //index.value - (//unsigned.+/2 @new) - (# ! each //index.index)))] - (in [[next - (sequence.suffix [current new] pool)] - current]))))))))]) - -(template: (!index <index>) - [(|> <index> //index.value //unsigned.value)]) + _ + <try_again>) + + {try.#Failure _} + (<| (let [new {<tag> <value>'}]) + (try|each @new (//unsigned.u2 (//.size new))) + (try|each next (: (Try Index) + (|> current + //index.value + (//unsigned.+/2 @new) + (# try.monad each //index.index)))) + (try|in [[next + (sequence.suffix [current new] pool)] + current]))))))]) + +(template: (/|do <state> <body>) + [(function (_ <state>) + <body>)]) + +(template: (/|each <state> <binding> <value> <body>) + [(case (<value> <state>) + {try.#Success [<state> <binding>]} + <body> + + ... {try.#Failure error} + failure + (:expected failure))]) (type: (Adder of) (-> of (Resource (Index of)))) @@ -90,7 +135,8 @@ (template [<name> <type> <tag> <equivalence>] [(def: .public (<name> value) (Adder <type>) - (!add <tag> <equivalence> value))] + (<| (/|do %) + (!add % <tag> <equivalence> value)))] [integer Integer //.#Integer (//.value_equivalence i32.equivalence)] [float Float //.#Float (//.value_equivalence //.float_equivalence)] @@ -101,24 +147,25 @@ (def: .public (string value) (-> Text (Resource (Index String))) - (do ..monad - [@value (utf8 value) - .let [value (//.string @value)]] - (!add //.#String (//.value_equivalence //index.equivalence) value))) + (<| (/|do %) + (/|each % @value (utf8 value)) + (let [value (//.string @value)]) + (!add % //.#String (//.value_equivalence //index.equivalence) value))) (def: .public (class name) (-> Internal (Resource (Index Class))) - (do ..monad - [@name (utf8 (//name.read name)) - .let [value (//.class @name)]] - (!add //.#Class //.class_equivalence value))) + (<| (/|do %) + (/|each % @name (utf8 (//name.read name))) + (let [value (//.class @name)]) + (!add % //.#Class //.class_equivalence value))) (def: .public (descriptor value) (All (_ kind) (-> (Descriptor kind) (Resource (Index (Descriptor kind))))) - (let [value (//descriptor.descriptor value)] - (!add //.#UTF8 text.equivalence value))) + (<| (let [value (//descriptor.descriptor value)]) + (/|do %) + (!add % //.#UTF8 text.equivalence value))) (type: .public (Member of) (Record @@ -128,24 +175,27 @@ (def: .public (name_and_type [name descriptor]) (All (_ of) (-> (Member of) (Resource (Index (Name_And_Type of))))) - (do ..monad - [@name (utf8 name) - @descriptor (..descriptor descriptor)] - (!add //.#Name_And_Type //.name_and_type_equivalence [//.#name @name //.#descriptor @descriptor]))) + (<| (/|do %) + (/|each % @name (utf8 name)) + (/|each % @descriptor (..descriptor descriptor)) + (!add % //.#Name_And_Type //.name_and_type_equivalence [//.#name @name //.#descriptor @descriptor]))) (template [<name> <tag> <of>] [(def: .public (<name> class member) (-> External (Member <of>) (Resource (Index (Reference <of>)))) - (do ..monad - [@class (..class (//name.internal class)) - @name_and_type (name_and_type member)] - (!add <tag> //.reference_equivalence [//.#class @class //.#name_and_type @name_and_type])))] + (<| (/|do %) + (/|each % @class (..class (//name.internal class))) + (/|each % @name_and_type (name_and_type member)) + (!add % <tag> //.reference_equivalence [//.#class @class //.#name_and_type @name_and_type])))] [field //.#Field Value] [method //.#Method Method] [interface_method //.#Interface_Method Method] ) +(template: (!index <index>) + [(|> <index> //index.value //unsigned.value)]) + (def: .public writer (Writer Pool) (function (_ [next pool]) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 8f1c1fddf..45430e7e9 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -392,7 +392,7 @@ (type: .public Except (Record - [#classes (List SVar) + [#classes (List Text) #exception SVar #handler (Statement Any)])) @@ -403,7 +403,7 @@ (..nested (:representation body!)) (|> excepts (list#each (function (_ [classes exception catch!]) - (format \n+ "except (" (|> classes (list#each ..code) (text.interposed ..input_separator)) + (format \n+ "except (" (text.interposed ..input_separator classes) ") as " (:representation exception) ":" (..nested (:representation catch!))))) text.together)))) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index c63f5cb2c..787866710 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -54,7 +54,8 @@ [import {"+" Import}] ["[0]" context {"+" Context}] ["[0]" cache - ["[1]/[0]" module]] + ["[1]/[0]" module] + ["[1]/[0]" artifact]] [cli {"+" Compilation Library} ["[0]" compiler {"+" Compiler}]] ["[0]" archive {"+" Output Archive} @@ -109,7 +110,7 @@ (let [system (value@ #&file_system platform) write_artifact! (: (-> [artifact.ID (Maybe Text) Binary] (Action Any)) (function (_ [artifact_id custom content]) - (ioW.write system context module_id artifact_id content)))] + (cache/artifact.write! system context module_id artifact_id content)))] (do [! ..monad] [_ (cache/module.enable! system context module_id) _ (for [@.python (|> entry diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux index 65e2dcc6a..dff13d37f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux @@ -113,7 +113,7 @@ (function (_ extension phase archive module) (do ////////phase.monad [] - (in (_.apply/* (_.var "__import__") (list (_.string module))))))])) + (in (_.apply/* (list (_.string module)) (_.var "__import__")))))])) (def: python::apply (custom @@ -122,7 +122,7 @@ (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) inputsG (monad.each ! (phase archive) inputsS)] - (in (_.apply/* abstractionG inputsG))))])) + (in (_.apply/* inputsG abstractionG))))])) (def: python::function (custom @@ -137,9 +137,9 @@ (list.repeated (.nat arity) []))] (in (_.lambda g!inputs (case (.nat arity) - 0 (_.apply/1 abstractionG //runtime.unit) - 1 (_.apply/* abstractionG g!inputs) - _ (_.apply/1 abstractionG (_.list g!inputs)))))))])) + 0 (_.apply/* (list //runtime.unit) abstractionG) + 1 (_.apply/* g!inputs abstractionG) + _ (_.apply/* (list (_.list g!inputs)) abstractionG))))))])) (def: python::exec (custom diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux index b9f8d24e1..26e21c065 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -56,9 +56,9 @@ [valueO (expression archive valueS) bodyO (expression archive bodyS)] ... TODO: Find some way to do 'let' without paying the price of the closure. - (in (_.apply/* (_.lambda (list (..register register)) - bodyO) - (list valueO))))) + (in (_.apply/* (list valueO) + (_.lambda (list (..register register)) + bodyO))))) (def: .public (let! statement expression archive [valueS register bodyS]) (Generator! [Synthesis Register Synthesis]) @@ -356,4 +356,4 @@ pattern_matching!)] _ (/////generation.execute! directive) _ (/////generation.save! case_artifact {.#None} directive)] - (in (_.apply/* @case @dependencies+)))) + (in (_.apply/* @dependencies+ @case)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux index a164ccd5e..9692d6ee7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -39,7 +39,7 @@ (do [! ///////phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] - (in (_.apply/* functionO argsO+)))) + (in (_.apply/* argsO+ functionO)))) (def: .public capture (-> Register SVar) @@ -64,7 +64,7 @@ (_.return @function)))] _ (/////generation.execute! directive) _ (/////generation.save! function_id {.#None} directive)] - (in (_.apply/* @function inits))))) + (in (_.apply/* inits @function))))) (def: input (|>> ++ //case.register)) @@ -82,7 +82,7 @@ @num_args (_.var "num_args") @self (_.var (///reference.artifact [function_module function_artifact])) apply_poly (.function (_ args func) - (_.apply/* func (list (_.splat_poly args)))) + (_.apply/* (list (_.splat_poly args)) func)) initialize_self! (_.set (list (//case.register 0)) @self) initialize! (list#mix (.function (_ post pre!) ($_ _.then diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index aecb9b4dd..36762f8cc 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -105,10 +105,10 @@ actual_loop (_.return @loop) )) - (_.apply/* @loop foreigns)]))] + (_.apply/* foreigns @loop)]))] _ (/////generation.execute! directive) _ (/////generation.save! loop_artifact {.#None} directive)] - (in (_.apply/* instantiation initsO+))))) + (in (_.apply/* initsO+ instantiation))))) (def: .public (again! statement expression archive argsS+) (Generator! (List Synthesis)) 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 12a2cc5d4..4e293bb74 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 @@ -148,7 +148,7 @@ inputs)] (in (list (` (def: .public ((~ nameC) (~+ inputsC)) (-> (~+ inputs_typesC) (Computation Any)) - (_.apply/* (~ runtime_nameC) (list (~+ inputsC))))) + (_.apply/* (list (~+ inputsC)) (~ runtime_nameC)))) (` (def: (~ code_nameC) (Statement Any) (..feature (~ runtime_nameC) @@ -159,15 +159,15 @@ (runtime: (lux::try op) (with_vars [exception] - (_.try (_.return (..right (_.apply/* op (list ..unit)))) - (list [(list (_.var "Exception")) exception + (_.try (_.return (..right (_.apply/* (list ..unit) op))) + (list [(list "Exception") exception (_.return (..left (_.str/1 exception)))])))) (runtime: (lux::program_args program_args) (with_vars [inputs value] ($_ _.then (_.set (list inputs) ..none) - (<| (_.for_in value (_.apply/* (_.var "reversed") (list program_args))) + (<| (_.for_in value (_.apply/* (list program_args) (_.var "reversed"))) (_.set (list inputs) (..some (_.list (list value inputs))))) (_.return inputs)))) @@ -379,10 +379,9 @@ (runtime: (f64::decode input) (with_vars [ex] - (_.try - (_.return (..some (_.float/1 input))) - (list [(list (_.var "Exception")) ex - (_.return ..none)])))) + (_.try (_.return (..some (_.float/1 input))) + (list [(list "Exception") ex + (_.return ..none)])))) (def: runtime::f64 (Statement Any) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 6a7235ac0..522da7f04 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -393,6 +393,10 @@ [bodyS bodyS synthesis_storage path_storage] (case bodyS + (^or {/.#Simple _} + (^ (/.constant _))) + synthesis_storage + (^ (/.variant [lefts right? valueS])) (for_synthesis valueS synthesis_storage) @@ -418,6 +422,9 @@ (set.union (value@ #dependencies (for_path pathS synthesis_storage))) (for_synthesis inputS synthesis_storage)) + (^ (/.branch/exec [before after])) + (list#mix for_synthesis synthesis_storage (list before after)) + (^ (/.branch/let [inputS register exprS])) (revised@ #dependencies (set.union (|> synthesis_storage @@ -447,8 +454,5 @@ (list#mix for_synthesis synthesis_storage replacementsS+) {/.#Extension [extension argsS]} - (list#mix for_synthesis synthesis_storage argsS) - - _ - synthesis_storage)) + (list#mix for_synthesis synthesis_storage argsS))) ))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux new file mode 100644 index 000000000..d294bc51a --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux @@ -0,0 +1,39 @@ +(.using + [library + [lux "*" + [target {"+" Target}] + [control + [try {"+" Try}] + [concurrency + ["[0]" async {"+" Async}]]] + [data + [binary {"+" Binary}] + [text + ["%" format {"+" format}]]] + [world + ["[0]" file]]]] + ["[0]" // "_" + ["[1][0]" module] + [// + ["[0]" context {"+" Context}] + [archive + ["[0]" module] + ["[0]" artifact]]]]) + +(def: .public (path fs context @module @artifact) + (All (_ !) + (-> (file.System !) Context module.ID artifact.ID file.Path)) + (format (//module.path fs context @module) + (# fs separator) + (%.nat @artifact) + (value@ context.#artifact_extension context))) + +(def: .public (read! fs context @module @artifact) + (All (_ !) + (-> (file.System !) Context module.ID artifact.ID (! (Try Binary)))) + (# fs read (..path fs context @module @artifact))) + +(def: .public (write! fs context @module @artifact content) + (All (_ !) + (-> (file.System !) Context module.ID artifact.ID Binary (! (Try Any)))) + (# fs write content (..path fs context @module @artifact))) 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 46055f00d..5c6340f86 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -57,17 +57,6 @@ ["[0]" directive] ["[1]/[0]" program]]]]]]) -(def: .public (artifact fs context module_id artifact_id) - (All (_ !) (-> (file.System !) Context module.ID artifact.ID file.Path)) - (format (cache/module.path fs context module_id) - (# fs separator) - (%.nat artifact_id) - (value@ context.#artifact_extension context))) - -(def: .public (write fs context module_id artifact_id content) - (-> (file.System Async) Context module.ID artifact.ID Binary (Async (Try Any))) - (# fs write content (..artifact fs context module_id artifact_id))) - (def: (general_descriptor fs context) (-> (file.System Async) Context file.Path) (format (cache.path fs context) |