diff options
Diffstat (limited to '')
38 files changed, 1672 insertions, 382 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index de071c35a..c18603b4b 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -3270,7 +3270,11 @@ (#Some idx) (list& ("lux text clip" 0 idx input) (text\split_all_with splitter - ("lux text clip" ("lux i64 +" 1 idx) ("lux text size" input) input))))) + (let [after_offset ("lux i64 +" 1 idx) + after_length ("lux i64 -" + after_offset + ("lux text size" input))] + ("lux text clip" after_offset after_length input)))))) (def: (nth idx xs) (All [a] @@ -3760,7 +3764,7 @@ (def: (split! at x) (-> Nat Text [Text Text]) [("lux text clip" 0 at x) - ("lux text clip" at ("lux text size" x) x)]) + ("lux text clip" at ("lux i64 -" at ("lux text size" x)) x)]) (def: (split_with token sample) (-> Text Text (Maybe [Text Text])) @@ -3770,14 +3774,17 @@ [_ post] (split! ("lux text size" token) post')]] (wrap [pre post]))) -(def: (replace_all pattern value template) +(def: (replace_all pattern replacement template) (-> Text Text Text Text) - (case (..split_with pattern template) - (#.Some [pre post]) - ($_ "lux text concat" pre value (replace_all pattern value post)) + ((: (-> Text Text Text) + (function (recur left right) + (case (..split_with pattern right) + (#.Some [pre post]) + (recur ($_ "lux text concat" left pre replacement) post) - #.None - template)) + #.None + ("lux text concat" left right)))) + "" template)) (def: contextual_reference "#") (def: self_reference ".") @@ -3837,7 +3844,7 @@ list\reverse (interpose ..module_separator) (text\join_with "")) - clean ("lux text clip" relatives ("lux text size" module) module) + clean ("lux text clip" relatives ("lux i64 -" relatives ("lux text size" module)) module) output (case ("lux text size" clean) 0 prefix _ ($_ text\compose prefix ..module_separator clean))] diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux index 5f3719ba8..3b57678fc 100644 --- a/stdlib/source/lux/control/concurrency/atom.lux +++ b/stdlib/source/lux/control/concurrency/atom.lux @@ -24,13 +24,16 @@ (as_is))) (with_expansions [<new> (for {@.js "js array new" - @.python "python array new"} + @.python "python array new" + @.lua "lua array new"} (as_is)) <write> (for {@.js "js array write" - @.python "python array write"} + @.python "python array write" + @.lua "lua array write"} (as_is)) <read> (for {@.js "js array read" - @.python "python array read"} + @.python "python array read" + @.lua "lua array read"} (as_is))] (abstract: #export (Atom a) (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference a)] diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux index ccf4f54b4..1fa94f565 100644 --- a/stdlib/source/lux/data/binary.lux +++ b/stdlib/source/lux/data/binary.lux @@ -81,19 +81,28 @@ @.python (type: #export Binary - (primitive "bytearray"))})) + (primitive "bytearray"))} + + ## Default + (type: #export Binary + (array.Array (I64 Any))))) (template: (!size binary) (for {@.old (host.array_length binary) @.jvm (host.array_length binary) @.js - (f.nat (Uint8Array::length binary)) + (|> binary + Uint8Array::length + f.nat) @.python (|> binary (:coerce (array.Array (I64 Any))) - "python array length")})) + "python array length")} + + ## Default + (array.size binary))) (template: (!read idx binary) (for {@.old (..i64 (host.array_read idx binary)) @@ -110,24 +119,30 @@ @.python (|> binary (:coerce (array.Array .I64)) - ("python array read" idx))})) + ("python array read" idx))} + + ## Default + (|> binary + (array.read idx) + (maybe.default (: (I64 Any) 0)) + (:coerce I64)))) + +(template: (!!write <byte_type> <post> <write> idx value binary) + (|> binary + (: ..Binary) + (:coerce (array.Array <byte_type>)) + (<write> idx (|> value .nat (n.% (hex "100")) <post>)) + (:coerce ..Binary))) (template: (!write idx value binary) (for {@.old (host.array_write idx (..byte value) binary) @.jvm (host.array_write idx (..byte value) binary) - @.js - (|> binary - (: ..Binary) - (:coerce (array.Array .Frac)) - ("js array write" idx (n.frac (n.% (hex "100") (.nat value)))) - (:coerce ..Binary)) + @.js (!!write .Frac n.frac "js array write" idx value binary) + @.python (!!write (I64 Any) (:coerce (I64 Any)) "python array write" idx value binary)} - @.python - (|> binary - (:coerce (array.Array (I64 Any))) - ("python array write" idx (:coerce (I64 Any) (n.% (hex "100") (.nat value)))) - (:coerce ..Binary))})) + ## Default + (array.write! idx (|> value .nat (n.% (hex "100"))) binary))) (def: #export size (-> Binary Nat) @@ -143,7 +158,10 @@ @.python (|>> ("python apply" (:coerce host.Function ("python constant" "bytearray"))) - (:coerce Binary))})) + (:coerce Binary))} + + ## Default + array.new)) (def: #export (fold f init binary) (All [a] (-> (-> I64 a a) a Binary a)) diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux index e407f4877..0bc661941 100644 --- a/stdlib/source/lux/data/collection/array.lux +++ b/stdlib/source/lux/data/collection/array.lux @@ -45,11 +45,9 @@ (: <array_type>) :assume) - @.js - ("js array new" size) - - @.python - ("python array new" size)})) + @.js ("js array new" size) + @.python ("python array new" size) + @.lua ("lua array new" size)})) (def: #export (size array) (All [a] (-> (Array a) Nat)) @@ -65,11 +63,15 @@ (: <index_type>) (:coerce Nat)) - @.js - ("js array length" array) + @.js ("js array length" array) + @.python ("python array length" array) + @.lua ("lua array length" array)})) - @.python - ("python array length" array)})) + (template: (!read <read> <null?>) + (let [output (<read> index array)] + (if (<null?> output) + #.None + (#.Some output)))) (def: #export (read index array) (All [a] @@ -89,17 +91,9 @@ #.None (#.Some (:assume value)))) - @.js - (let [output ("js array read" index array)] - (if ("js object undefined?" output) - #.None - (#.Some output))) - - @.python - (let [output ("python array read" index array)] - (if ("python object none?" output) - #.None - (#.Some output)))}) + @.js (!read "js array read" "js object undefined?") + @.python (!read "python array read" "python object none?") + @.lua (!read "lua array read" "lua object nil?")}) #.None)) (def: #export (write! index value array) @@ -114,11 +108,9 @@ ("jvm array write object" (!int index) (:coerce <elem_type> value)) :assume) - @.js - ("js array write" index value array) - - @.python - ("python array write" index value array)})) + @.js ("js array write" index value array) + @.python ("python array write" index value array) + @.lua ("lua array write" index value array)})) (def: #export (delete! index array) (All [a] @@ -130,11 +122,9 @@ @.jvm (write! index (:assume (: <elem_type> ("jvm object null"))) array) - @.js - ("js array delete" index array) - - @.python - ("python array delete" index array)}) + @.js ("js array delete" index array) + @.python ("python array delete" index array) + @.lua ("lua array delete" index array)}) array)) ) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 0b07b3ae1..18d51a25f 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -2,7 +2,7 @@ [lux #* ["@" target] [abstract - hash + [hash (#+ Hash)] [monoid (#+ Monoid)] [equivalence (#+ Equivalence)] [order (#+ Order)] @@ -125,14 +125,14 @@ (-> Nat Nat Text (Maybe Text)) (if (and (n.<= to from) (n.<= ("lux text size" input) to)) - (#.Some ("lux text clip" from to input)) + (#.Some ("lux text clip" from (n.- from to) input)) #.None)) (def: #export (clip' from input) (-> Nat Text (Maybe Text)) (let [size ("lux text size" input)] (if (n.<= size from) - (#.Some ("lux text clip" from size input)) + (#.Some ("lux text clip" from (n.- from size) input)) #.None))) (def: #export (split at x) diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux index e4ebba1c9..5d29532a5 100644 --- a/stdlib/source/lux/data/text/buffer.lux +++ b/stdlib/source/lux/data/text/buffer.lux @@ -9,6 +9,7 @@ [text ["%" format (#+ format)]] [collection + ["." array] ["." row (#+ Row) ("#\." fold)]]] [math [number @@ -33,12 +34,18 @@ (new [int]) (toString [] java/lang/String)]))] (`` (for {@.old (as_is <jvm>) - @.jvm (as_is <jvm>)} + @.jvm (as_is <jvm>) + @.lua (as_is (import: table + ##v https://www.lua.org/manual/5.3/manual.html#pdf-table.concat + (#static concat [(Array Text) Text] Text) + ## https://www.lua.org/manual/5.3/manual.html#pdf-table.insert + (#static insert [(Array Text) Text] Nothing)))} (as_is)))) (`` (abstract: #export Buffer (for {@.old [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] - @.jvm [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)]} + @.jvm [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] + @.lua [Nat (-> (array.Array Text) (array.Array Text))]} ## default (Row Text)) @@ -48,7 +55,8 @@ Buffer (:abstraction (with_expansions [<jvm> [0 function.identity]] (for {@.old <jvm> - @.jvm <jvm>} + @.jvm <jvm> + @.lua function.identity} ## default row.empty)))) @@ -63,7 +71,15 @@ (:abstraction [(n.+ (//.size chunk) capacity) (|>> transform (append! chunk))]))] (for {@.old <jvm> - @.jvm <jvm>} + @.jvm <jvm> + @.lua (let [[capacity transform] (:representation buffer) + append! (: (-> Text (array.Array Text) (array.Array Text)) + (function (_ chunk array) + (exec + (table::insert [array chunk]) + array)))] + (:abstraction [(n.+ (//.size chunk) capacity) + (|>> transform (append! chunk))]))} ## default (|> buffer :representation (row.add chunk) :abstraction)))) @@ -71,7 +87,8 @@ (-> Buffer Nat) (with_expansions [<jvm> (|>> :representation product.left)] (for {@.old <jvm> - @.jvm <jvm>} + @.jvm <jvm> + @.lua <jvm>} ## default (|>> :representation (row\fold (function (_ chunk total) @@ -85,7 +102,9 @@ transform java/lang/StringBuilder::toString))] (for {@.old <jvm> - @.jvm <jvm>} + @.jvm <jvm> + @.lua (let [[capacity transform] (:representation buffer)] + (table::concat [(transform (array.new 0)) ""]))} ## default (row\fold (function (_ chunk total) (format total chunk)) diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index 2050cbc8c..55afc77ed 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -7,7 +7,7 @@ [control ["." try (#+ Try)]] [data - [binary (#+ Binary)]] + ["." binary (#+ Binary)]] [type abstract]]) @@ -195,7 +195,7 @@ (decode [Uint8Array] host.String)))} (as_is))) -(def: (to_utf8 value) +(def: (utf8\encode value) (-> Text Binary) (for {@.old (java/lang/String::getBytes (..name ..utf_8) @@ -224,9 +224,12 @@ ) @.python - (:coerce Binary ("python apply" (:assume ("python constant" "bytearray")) value "utf-8"))})) + (:coerce Binary ("python apply" (:assume ("python constant" "bytearray")) value "utf-8"))} -(def: (from_utf8 value) + ## Default + ("lua utf8 encode" value))) + +(def: (utf8\decode value) (-> Binary (Try Text)) (with_expansions [<jvm> (#try.Success (java/lang/String::new value (..name ..utf_8)))] (for {@.old <jvm> @@ -249,10 +252,13 @@ #try.Success)) @.python - (host.try (:coerce Text ("python object do" "decode" (:assume value) "utf-8")))}))) + (host.try (:coerce Text ("python object do" "decode" (:assume value) "utf-8")))} + + ## Default + (#try.Success ("lua utf8 decode" value))))) (structure: #export utf8 (Codec Binary Text) - (def: encode ..to_utf8) - (def: decode ..from_utf8)) + (def: encode ..utf8\encode) + (def: decode ..utf8\decode)) diff --git a/stdlib/source/lux/data/text/unicode/set.lux b/stdlib/source/lux/data/text/unicode/set.lux index bf0b55cd7..d773ba8e4 100644 --- a/stdlib/source/lux/data/text/unicode/set.lux +++ b/stdlib/source/lux/data/text/unicode/set.lux @@ -43,7 +43,7 @@ (-> [Block (List Block)] Set) (list\fold ..compose (..singleton head) (list\map ..singleton tail))) - (def: #export character + (def: character/0 Set (..set [//block.basic_latin (list //block.latin_1_supplement @@ -74,9 +74,12 @@ //block.lao //block.tibetan //block.myanmar - //block.georgian - //block.hangul_jamo - //block.ethiopic + //block.georgian)])) + + (def: character/1 + Set + (..set [//block.hangul_jamo + (list //block.ethiopic //block.cherokee //block.unified_canadian_aboriginal_syllabics //block.ogham @@ -105,10 +108,12 @@ //block.control_pictures //block.optical_character_recognition //block.enclosed_alphanumerics - //block.box_drawing + //block.box_drawing)])) - //block.block_elements - //block.geometric_shapes + (def: character/2 + Set + (..set [//block.block_elements + (list //block.geometric_shapes //block.miscellaneous_symbols //block.dingbats //block.miscellaneous_mathematical_symbols_a @@ -139,6 +144,14 @@ //block.hangul_syllables )])) + (def: #export character + Set + ($_ ..compose + ..character/0 + ..character/1 + ..character/2 + )) + (def: #export non_character Set (..set [//block.high_surrogates diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index cd354ec84..8006c83dd 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -6,13 +6,13 @@ [abstract [monad (#+ do)]] [control + [pipe (#+ case> new>)] ["." function] ["." try (#+ Try)] ["." exception (#+ exception:)] ["<>" parser ["<.>" type (#+ Parser)] - ["<.>" code]] - pipe] + ["<.>" code]]] [data ["." text ["%" format (#+ format)]] @@ -72,7 +72,14 @@ (primitive "python_type")) (import: (type [.Any] PyType)) - (import: (str [.Any] host.String)))})) + (import: (str [.Any] host.String))) + + @.lua + (as_is (import: (type [.Any] host.String)) + (import: (tostring [.Any] host.String)) + + (import: math + (#static type [.Any] #? host.String)))})) (def: Inspector (-> Any Text)) @@ -190,6 +197,39 @@ _ (..str value)) + + @.lua + (case (..type value) + (^template [<type_of> <then>] + [<type_of> + (`` (|> value (~~ (template.splice <then>))))]) + (["boolean" [(:coerce .Bit) %.bit]] + ["string" [(:coerce .Text) %.text]] + ["nil" [(new> "nil" [])]]) + + "number" + (case (math::type [value]) + (#.Some "integer") (|> value (:coerce .Int) %.int) + (#.Some "float") (|> value (:coerce .Frac) %.frac) + + _ + (..tostring value)) + + "table" + (let [variant_tag ("lua object get" "_lux_tag" value) + variant_flag ("lua object get" "_lux_flag" value) + variant_value ("lua object get" "_lux_value" value)] + (if (not (or ("lua object nil?" variant_tag) + ("lua object nil?" variant_flag) + ("lua object nil?" variant_value))) + (|> (format (|> variant_tag (:coerce .Int) %.int) + " " (%.bit (not ("lua object nil?" variant_flag))) + " " (inspect variant_value)) + (text.enclose ["(" ")"])) + (inspect_tuple inspect value))) + + _ + (..tostring value)) }))) (exception: #export (cannot_represent_value {type Type}) @@ -336,8 +376,7 @@ (~ (code.identifier definition)))))))) (def: #export (log! message) - {#.doc (doc "Logs message to standard output." - "Useful for debugging.")} + {#.doc "Logs message to standard output."} (-> Text Any) ("lux io log" message)) diff --git a/stdlib/source/lux/host.lua.lux b/stdlib/source/lux/host.lua.lux new file mode 100644 index 000000000..ed81d97b1 --- /dev/null +++ b/stdlib/source/lux/host.lua.lux @@ -0,0 +1,298 @@ +(.module: + [lux #* + ["." meta] + ["@" target] + [abstract + [monad (#+ do)]] + [control + ["." io] + ["<>" parser + ["<c>" code (#+ Parser)]]] + [data + ["." product] + ["." maybe] + ["." text + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor fold)]]] + [type + abstract] + [macro (#+ with_gensyms) + [syntax (#+ syntax:)] + ["." code] + ["." template]]]) + +(abstract: #export (Object brand) Any) + +(template [<name>] + [(with_expansions [<brand> (template.identifier [<name> "'"])] + (abstract: #export <brand> Any) + (type: #export <name> + (..Object <brand>)))] + + [Nil] + [Function] + [Table] + ) + +(template [<name> <type>] + [(type: #export <name> + <type>)] + + [Boolean Bit] + [Integer Int] + [Float Frac] + [String Text] + ) + +(type: Nilable + [Bit Code]) + +(def: nilable + (Parser Nilable) + (let [token (' #?)] + (<| (<>.and (<>.parses? (<c>.this! token))) + (<>.after (<>.not (<c>.this! token))) + <c>.any))) + +(type: Field + [Bit Text Nilable]) + +(def: static! + (Parser Any) + (<c>.this! (' #static))) + +(def: field + (Parser Field) + (<c>.form ($_ <>.and + (<>.parses? ..static!) + <c>.local_identifier + ..nilable))) + +(type: Common_Method + {#name Text + #alias (Maybe Text) + #inputs (List Nilable) + #io? Bit + #try? Bit + #output Nilable}) + +(type: Static_Method Common_Method) +(type: Virtual_Method Common_Method) + +(type: Method + (#Static Static_Method) + (#Virtual Virtual_Method)) + +(def: common_method + (Parser Common_Method) + ($_ <>.and + <c>.local_identifier + (<>.maybe (<>.after (<c>.this! (' #as)) <c>.local_identifier)) + (<c>.tuple (<>.some ..nilable)) + (<>.parses? (<c>.this! (' #io))) + (<>.parses? (<c>.this! (' #try))) + ..nilable)) + +(def: static_method + (<>.after ..static! ..common_method)) + +(def: method + (Parser Method) + (<c>.form (<>.or ..static_method + ..common_method))) + +(type: Member + (#Field Field) + (#Method Method)) + +(def: member + (Parser Member) + ($_ <>.or + ..field + ..method + )) + +(def: input_variables + (-> (List Nilable) (List [Bit Code])) + (|>> list.enumeration + (list\map (function (_ [idx [nilable? type]]) + [nilable? (|> idx %.nat code.local_identifier)])))) + +(def: (nilable_type [nilable? type]) + (-> Nilable Code) + (if nilable? + (` (.Maybe (~ type))) + type)) + +(def: (with_nil g!temp [nilable? input]) + (-> Code [Bit Code] Code) + (if nilable? + (` (case (~ input) + (#.Some (~ g!temp)) + (~ g!temp) + + #.Nil + ("lua object nil"))) + input)) + +(def: (without_nil g!temp [nilable? outputT] output) + (-> Code Nilable Code Code) + (if nilable? + (` (let [(~ g!temp) (~ output)] + (if ("lua object nil?" (~ g!temp)) + #.None + (#.Some (~ g!temp))))) + (` (let [(~ g!temp) (~ output)] + (if (not ("lua object nil?" (~ g!temp))) + (~ g!temp) + (.error! "Nil is an invalid value!")))))) + +(type: Import + (#Class [Text (List Member)]) + (#Function Static_Method)) + +(def: import + ($_ <>.or + ($_ <>.and + <c>.local_identifier + (<>.some member)) + (<c>.form ..common_method) + )) + +(syntax: #export (try expression) + {#.doc (doc (case (try (risky_computation input)) + (#.Right success) + (do_something success) + + (#.Left error) + (recover_from_failure error)))} + (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) + +(def: (with_io with? without) + (-> Bit Code Code) + (if with? + (` (io.io (~ without))) + without)) + +(def: (io_type io? rawT) + (-> Bit Code Code) + (if io? + (` (io.IO (~ rawT))) + rawT)) + +(def: (with_try with? without_try) + (-> Bit Code Code) + (if with? + (` (..try (~ without_try))) + without_try)) + +(def: (try_type try? rawT) + (-> Bit Code Code) + (if try? + (` (.Either .Text (~ rawT))) + rawT)) + +(def: (make_function g!method g!temp source inputsT io? try? outputT) + (-> Code Code Code (List Nilable) Bit Bit Nilable Code) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ g!method) + [(~+ (list\map product.right g!inputs))]) + (-> [(~+ (list\map nilable_type inputsT))] + (~ (|> (nilable_type outputT) + (try_type try?) + (io_type io?)))) + (:assume + (~ (<| (with_io io?) + (with_try try?) + (without_nil g!temp outputT) + (` ("lua apply" + (:coerce ..Function (~ source)) + (~+ (list\map (with_nil g!temp) g!inputs))))))))))) + +(syntax: #export (import: {import ..import}) + (with_gensyms [g!temp] + (case import + (#Class [class members]) + (with_gensyms [g!object] + (let [qualify (: (-> Text Code) + (|>> (format class "::") code.local_identifier)) + g!type (code.local_identifier class) + real_class (text.replace_all "/" "." class) + imported (case (text.split_all_with "/" class) + (#.Cons head tail) + (list\fold (function (_ sub super) + (` ("lua object get" (~ (code.text sub)) + (:coerce (..Object .Any) (~ super))))) + (` ("lua import" (~ (code.text head)))) + tail) + + #.Nil + (` ("lua import" (~ (code.text class)))))] + (wrap (list& (` (type: (~ g!type) + (..Object (primitive (~ (code.text real_class)))))) + (list\map (function (_ member) + (case member + (#Field [static? field fieldT]) + (if static? + (` ((~! syntax:) ((~ (qualify field))) + (\ (~! meta.monad) (~' wrap) + (list (` (.:coerce (~ (nilable_type fieldT)) + ("lua object get" (~ (code.text field)) + (:coerce (..Object .Any) (~ imported))))))))) + (` (def: ((~ (qualify field)) + (~ g!object)) + (-> (~ g!type) + (~ (nilable_type fieldT))) + (:assume + (~ (without_nil g!temp fieldT (` ("lua object get" (~ (code.text field)) + (:coerce (..Object .Any) (~ g!object)))))))))) + + (#Method method) + (case method + (#Static [method alias inputsT io? try? outputT]) + (..make_function (qualify (maybe.default method alias)) + g!temp + (` ("lua object get" (~ (code.text method)) + (:coerce (..Object .Any) (~ imported)))) + inputsT + io? + try? + outputT) + + (#Virtual [method alias inputsT io? try? outputT]) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ (qualify (maybe.default method alias))) + [(~+ (list\map product.right g!inputs))] + (~ g!object)) + (-> [(~+ (list\map nilable_type inputsT))] + (~ g!type) + (~ (|> (nilable_type outputT) + (try_type try?) + (io_type io?)))) + (:assume + (~ (<| (with_io io?) + (with_try try?) + (without_nil g!temp outputT) + (` ("lua object do" + (~ (code.text method)) + (~ g!object) + (~+ (list\map (with_nil g!temp) g!inputs))))))))))))) + members))))) + + (#Function [name alias inputsT io? try? outputT]) + (wrap (list (..make_function (code.local_identifier (maybe.default name alias)) + g!temp + (` ("lua constant" (~ (code.text name)))) + inputsT + io? + try? + outputT))) + ))) + +(template: #export (closure <inputs> <output>) + (.:coerce ..Function + (`` ("lua function" + (~~ (template.count <inputs>)) + (.function (_ [<inputs>]) + <output>))))) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 44650ed57..1c4247ad2 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -143,6 +143,38 @@ (def: #export root/3 (-> Frac Frac) + (..pow ("lux f64 /" +3.0 +1.0)))) + + @.lua + (as_is (template [<name> <method>] + [(def: #export <name> + (-> Frac Frac) + (|>> ("lua apply" ("lua constant" <method>)) + (:coerce Frac)))] + + [cos "math.cos"] + [sin "math.sin"] + [tan "math.tan"] + + [acos "math.acos"] + [asin "math.asin"] + [atan "math.atan"] + + [exp "math.exp"] + [log "math.log"] + + [ceil "math.ceil"] + [floor "math.floor"] + + [root/2 "math.sqrt"] + ) + + (def: #export (pow param subject) + (-> Frac Frac Frac) + ("lua power" param subject)) + + (def: #export root/3 + (-> Frac Frac) (..pow ("lux f64 /" +3.0 +1.0))))}) (def: #export (round input) diff --git a/stdlib/source/lux/math/number/frac.lux b/stdlib/source/lux/math/number/frac.lux index ccc6bd544..5ca3dff83 100644 --- a/stdlib/source/lux/math/number/frac.lux +++ b/stdlib/source/lux/math/number/frac.lux @@ -365,8 +365,10 @@ (^template [<factor> <patterns>] [<patterns> (do try.monad - [exponent (|> representation - ("lux text clip" (//nat.+ 2 split_index) ("lux text size" representation)) + [#let [after_offset (//nat.+ 2 split_index) + after_length (//nat.- after_offset ("lux text size" representation))] + exponent (|> representation + ("lux text clip" after_offset after_length) (\ codec decode))] (wrap [("lux text clip" 0 split_index representation) (//int.* <factor> (.int exponent))]))]) @@ -405,15 +407,17 @@ [whole decimal] (case ("lux text index" 0 "." mantissa) (#.Some split_index) (do ! - [decimal (|> mantissa - ("lux text clip" (inc split_index) ("lux text size" mantissa)) + [#let [after_offset (inc split_index) + after_length (//nat.- after_offset ("lux text size" mantissa))] + decimal (|> mantissa + ("lux text clip" after_offset after_length) (\ <nat> decode))] (wrap [("lux text clip" 0 split_index mantissa) decimal])) #.None (#try.Failure ("lux text concat" <error> representation))) - #let [whole ("lux text clip" 1 ("lux text size" whole) whole)] + #let [whole ("lux text clip" 1 (dec ("lux text size" whole)) whole)] mantissa (\ <nat> decode (case decimal 0 whole _ ("lux text concat" whole (\ <nat> encode decimal)))) diff --git a/stdlib/source/lux/math/number/int.lux b/stdlib/source/lux/math/number/int.lux index e43c5eb89..b121fc216 100644 --- a/stdlib/source/lux/math/number/int.lux +++ b/stdlib/source/lux/math/number/int.lux @@ -226,13 +226,13 @@ (case ("lux text clip" 0 1 repr) (^ (static ..+sign)) (|> repr - ("lux text clip" 1 input_size) + ("lux text clip" 1 (dec input_size)) (\ <codec> decode) (\ try.functor map .int)) (^ (static ..-sign)) (|> repr - ("lux text clip" 1 input_size) + ("lux text clip" 1 (dec input_size)) (\ <codec> decode) (\ try.functor map (|>> dec .int ..negate dec))) diff --git a/stdlib/source/lux/math/number/rev.lux b/stdlib/source/lux/math/number/rev.lux index 2e7975f1d..78d80767b 100644 --- a/stdlib/source/lux/math/number/rev.lux +++ b/stdlib/source/lux/math/number/rev.lux @@ -228,7 +228,7 @@ (def: (de_prefix input) (-> Text Text) - ("lux text clip" 1 ("lux text size" input) input)) + ("lux text clip" 1 (dec ("lux text size" input)) input)) (template [<struct> <codec> <char_bit_size> <error>] [(with_expansions [<error_output> (as_is (#try.Failure ("lux text concat" <error> repr)))] @@ -242,12 +242,13 @@ 0 0 _ 1)) raw_size ("lux text size" raw_output) - zero_padding (loop [zeroes_left (//nat.- raw_size max_num_chars) - output ""] - (if (//nat.= 0 zeroes_left) - output - (recur (dec zeroes_left) - ("lux text concat" "0" output))))] + zero_padding (: Text + (loop [zeroes_left (: Nat (//nat.- raw_size max_num_chars)) + output (: Text "")] + (if (//nat.= 0 zeroes_left) + output + (recur (dec zeroes_left) + ("lux text concat" "0" output)))))] (|> raw_output ("lux text concat" zero_padding) ("lux text concat" ".")))) @@ -366,7 +367,7 @@ (loop [idx 0 output (digits::new [])] (if (//nat.< length idx) - (case ("lux text index" 0 ("lux text clip" idx (inc idx) input) "0123456789") + (case ("lux text index" 0 ("lux text clip" idx 1 input) "0123456789") #.None #.None diff --git a/stdlib/source/lux/program.lux b/stdlib/source/lux/program.lux index 36f513e84..0723a7b4e 100644 --- a/stdlib/source/lux/program.lux +++ b/stdlib/source/lux/program.lux @@ -57,8 +57,7 @@ @.jvm (list) @.js (list) @.python (list)} - (list g!_ - (` ((~! thread.run!) [])))))] + (list g!_ (` (~! thread.run!)))))] ((~' wrap) (~ g!output))))] (wrap (list (` ("lux def program" (~ (case args diff --git a/stdlib/source/lux/target/lua.lux b/stdlib/source/lux/target/lua.lux index c1bceb634..ef646cddc 100644 --- a/stdlib/source/lux/target/lua.lux +++ b/stdlib/source/lux/target/lua.lux @@ -1,19 +1,25 @@ (.module: - [lux (#- Location Code int if cond function or and not let) + [lux (#- Location Code int if cond function or and not let ^) [abstract [equivalence (#+ Equivalence)] - [hash (#+ Hash)]] + [hash (#+ Hash)] + ["." enum]] [control - [pipe (#+ case> cond> new>)]] + [pipe (#+ case> cond> new>)] + [parser + ["<.>" code]]] [data ["." text ["%" format (#+ format)]] [collection ["." list ("#\." functor fold)]]] [macro - ["." template]] + [syntax (#+ syntax:)] + ["." template] + ["." code]] [math [number + ["n" nat] ["i" int] ["f" frac]]] [type @@ -69,6 +75,7 @@ [Literal [Computation' Expression' Code]] [Var [Location' Computation' Expression' Code]] [Access [Location' Computation' Expression' Code]] + [Label [Code]] ) (def: #export nil @@ -99,7 +106,7 @@ [(new> "(0.0/0.0)" [])] ## else - [%.frac]) + [%.frac (text.replace_all "+" "")]) :abstraction)) (def: sanitize @@ -123,6 +130,12 @@ (-> Text Literal) (|>> ..sanitize (text.enclose' text.double_quote) :abstraction)) + (def: #export multi + (-> (List Expression) Literal) + (|>> (list\map ..code) + (text.join_with ..input_separator) + :abstraction)) + (def: #export array (-> (List Expression) Literal) (|>> (list\map ..code) @@ -161,8 +174,8 @@ (format (:representation func)) :abstraction)) - (def: #export (do method table args) - (-> Text Expression (List Expression) Computation) + (def: #export (do method args table) + (-> Text (List Expression) Expression Computation) (|> args (list\map ..code) (text.join_with ..input_separator) @@ -187,6 +200,7 @@ ["+" +] ["-" -] ["*" *] + ["^" ^] ["/" /] ["//" //] ["%" %] @@ -206,9 +220,14 @@ (-> Expression Expression) (:abstraction (format "(not " (:representation subject) ")"))) - (def: #export var - (-> Text Var) - (|>> :abstraction)) + (template [<name> <type>] + [(def: #export <name> + (-> Text <type>) + (|>> :abstraction))] + + [var Var] + [label Label] + ) (def: #export statement (-> Expression Statement) @@ -236,9 +255,7 @@ (def: #export (let vars value) (-> (List Var) Expression Statement) - ($_ ..then - (local vars) - (set vars value))) + (:abstraction (format "local " (..locations vars) " = " (:representation value) ..statement_suffix))) (def: #export (local/1 var value) (-> Var Expression Statement) @@ -319,6 +336,14 @@ (|> "break" (text.suffix ..statement_suffix) :abstraction)) + + (def: #export (set_label label) + (-> Label Statement) + (:abstraction (format "::" (:representation label) "::"))) + + (def: #export (go_to label) + (-> Label Statement) + (:abstraction (format "goto " (:representation label)))) ) (def: #export (cond clauses else!) @@ -327,3 +352,40 @@ (..if test then! next!)) else! (list.reverse clauses))) + +(syntax: (arity_inputs {arity <code>.nat}) + (wrap (case arity + 0 (.list) + _ (|> (dec arity) + (enum.range n.enum 0) + (list\map (|>> %.nat code.local_identifier)))))) + +(syntax: (arity_types {arity <code>.nat}) + (wrap (list.repeat arity (` ..Expression)))) + +(template [<arity> <function>+] + [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) + <inputs> (arity_inputs <arity>) + <types> (arity_types <arity>) + <definitions> (template.splice <function>+)] + (def: #export (<apply> function <inputs>) + (-> Expression <types> Computation) + (..apply/* (.list <inputs>) function)) + + (template [<function>] + [(`` (def: #export (~~ (template.identifier [<function> "/" <arity>])) + (<apply> (..var <function>))))] + + <definitions>))] + + [1 + [["error"] + ["print"] + ["require"]]] + + [2 + []] + + [3 + []] + ) diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux index e38694d08..f8c7157a3 100644 --- a/stdlib/source/lux/target/python.lux +++ b/stdlib/source/lux/target/python.lux @@ -14,9 +14,9 @@ [collection ["." list ("#\." functor fold)]]] [macro + [syntax (#+ syntax:)] ["." template] - ["." code] - [syntax (#+ syntax:)]] + ["." code]] [math [number ["n" nat] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux index b15f22be5..860badea3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux @@ -207,10 +207,11 @@ Bundle (<| (bundle.prefix "js") (|> bundle.empty + (dictionary.merge bundle::array) + (dictionary.merge bundle::object) + (bundle.install "constant" js::constant) (bundle.install "apply" js::apply) (bundle.install "type-of" js::type_of) (bundle.install "function" js::function) - (dictionary.merge bundle::array) - (dictionary.merge bundle::object) ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux index b431dc39b..596000060 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux @@ -27,8 +27,225 @@ [/// ["." phase]]]]]]) +(def: Nil + (for {@.lua + host.Nil} + Any)) + +(def: Object + (for {@.lua (type (host.Object Any))} + Any)) + +(def: Function + (for {@.lua host.Function} + Any)) + +(def: array::new + Handler + (custom + [<c>.any + (function (_ extension phase archive lengthC) + (do phase.monad + [lengthA (analysis/type.with_type Nat + (phase archive lengthC)) + [var_id varT] (analysis/type.with_env check.var) + _ (analysis/type.infer (type (Array varT)))] + (wrap (#analysis.Extension extension (list lengthA)))))])) + +(def: array::length + Handler + (custom + [<c>.any + (function (_ extension phase archive arrayC) + (do phase.monad + [[var_id varT] (analysis/type.with_env check.var) + arrayA (analysis/type.with_type (type (Array varT)) + (phase archive arrayC)) + _ (analysis/type.infer Nat)] + (wrap (#analysis.Extension extension (list arrayA)))))])) + +(def: array::read + Handler + (custom + [(<>.and <c>.any <c>.any) + (function (_ extension phase archive [indexC arrayC]) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + [var_id varT] (analysis/type.with_env check.var) + arrayA (analysis/type.with_type (type (Array varT)) + (phase archive arrayC)) + _ (analysis/type.infer varT)] + (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + +(def: array::write + Handler + (custom + [($_ <>.and <c>.any <c>.any <c>.any) + (function (_ extension phase archive [indexC valueC arrayC]) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + [var_id varT] (analysis/type.with_env check.var) + valueA (analysis/type.with_type varT + (phase archive valueC)) + arrayA (analysis/type.with_type (type (Array varT)) + (phase archive arrayC)) + _ (analysis/type.infer (type (Array varT)))] + (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))])) + +(def: array::delete + Handler + (custom + [($_ <>.and <c>.any <c>.any) + (function (_ extension phase archive [indexC arrayC]) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + [var_id varT] (analysis/type.with_env check.var) + arrayA (analysis/type.with_type (type (Array varT)) + (phase archive arrayC)) + _ (analysis/type.infer (type (Array varT)))] + (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + +(def: bundle::array + Bundle + (<| (bundle.prefix "array") + (|> bundle.empty + (bundle.install "new" array::new) + (bundle.install "length" array::length) + (bundle.install "read" array::read) + (bundle.install "write" array::write) + (bundle.install "delete" array::delete) + ))) + +(def: object::get + Handler + (custom + [($_ <>.and <c>.text <c>.any) + (function (_ extension phase archive [fieldC objectC]) + (do phase.monad + [objectA (analysis/type.with_type ..Object + (phase archive objectC)) + _ (analysis/type.infer .Any)] + (wrap (#analysis.Extension extension (list (analysis.text fieldC) + objectA)))))])) + +(def: object::do + Handler + (custom + [($_ <>.and <c>.text <c>.any (<>.some <c>.any)) + (function (_ extension phase archive [methodC objectC inputsC]) + (do {! phase.monad} + [objectA (analysis/type.with_type ..Object + (phase archive objectC)) + inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) + _ (analysis/type.infer .Any)] + (wrap (#analysis.Extension extension (list& (analysis.text methodC) + objectA + inputsA)))))])) + +(def: bundle::object + Bundle + (<| (bundle.prefix "object") + (|> bundle.empty + (bundle.install "get" object::get) + (bundle.install "do" object::do) + (bundle.install "nil" (/.nullary ..Nil)) + (bundle.install "nil?" (/.unary Any Bit)) + ))) + +(template [<name> <fromT> <toT>] + [(def: <name> + Handler + (custom + [<c>.any + (function (_ extension phase archive inputC) + (do {! phase.monad} + [inputA (analysis/type.with_type (type <fromT>) + (phase archive inputC)) + _ (analysis/type.infer (type <toT>))] + (wrap (#analysis.Extension extension (list inputA)))))]))] + + [utf8::encode Text (array.Array (I64 Any))] + [utf8::decode (array.Array (I64 Any)) Text] + ) + +(def: bundle::utf8 + Bundle + (<| (bundle.prefix "utf8") + (|> bundle.empty + (bundle.install "encode" utf8::encode) + (bundle.install "decode" utf8::decode) + ))) + +(def: lua::constant + Handler + (custom + [<c>.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.infer Any)] + (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + +(def: lua::apply + Handler + (custom + [($_ <>.and <c>.any (<>.some <c>.any)) + (function (_ extension phase archive [abstractionC inputsC]) + (do {! phase.monad} + [abstractionA (analysis/type.with_type ..Function + (phase archive abstractionC)) + inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) + _ (analysis/type.infer Any)] + (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))])) + +(def: lua::power + Handler + (custom + [($_ <>.and <c>.any <c>.any) + (function (_ extension phase archive [powerC baseC]) + (do {! phase.monad} + [powerA (analysis/type.with_type Frac + (phase archive powerC)) + baseA (analysis/type.with_type Frac + (phase archive baseC)) + _ (analysis/type.infer Frac)] + (wrap (#analysis.Extension extension (list powerA baseA)))))])) + +(def: lua::import + Handler + (custom + [<c>.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.infer ..Object)] + (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + +(def: python::function + Handler + (custom + [($_ <>.and <c>.nat <c>.any) + (function (_ extension phase archive [arity abstractionC]) + (do phase.monad + [#let [inputT (type.tuple (list.repeat arity Any))] + abstractionA (analysis/type.with_type (-> inputT Any) + (phase archive abstractionC)) + _ (analysis/type.infer ..Function)] + (wrap (#analysis.Extension extension (list (analysis.nat arity) + abstractionA)))))])) + (def: #export bundle Bundle (<| (bundle.prefix "lua") (|> bundle.empty + (dictionary.merge bundle::array) + (dictionary.merge bundle::object) + (dictionary.merge bundle::utf8) + + (bundle.install "constant" lua::constant) + (bundle.install "apply" lua::apply) + (bundle.install "power" lua::power) + (bundle.install "import" lua::import) + (bundle.install "function" python::function) ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux index c81705f24..45fb3e5d2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux @@ -114,9 +114,7 @@ (custom [<s>.text (function (_ extension phase archive name) - (do ////////phase.monad - [] - (wrap (_.var name))))])) + (\ ////////phase.monad wrap (_.var name)))])) (def: js::apply (custom @@ -151,10 +149,11 @@ Bundle (<| (/.prefix "js") (|> /.empty + (dictionary.merge ..array) + (dictionary.merge ..object) + (/.install "constant" js::constant) (/.install "apply" js::apply) (/.install "type-of" (unary _.type_of)) (/.install "function" js::function) - (dictionary.merge ..array) - (dictionary.merge ..object) ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux index b64cf2427..ab0d0d555 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux @@ -5,6 +5,7 @@ ["." dictionary]]]] ["." / #_ ["#." common] + ["#." host] [//// [generation [lua @@ -12,4 +13,5 @@ (def: #export bundle Bundle - /common.bundle) + (dictionary.merge /common.bundle + /host.bundle)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux index 7d7ce2fbf..e619e76f8 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux @@ -3,24 +3,49 @@ [abstract ["." monad (#+ do)]] [control - ["." function]] + ["." function] + ["." try] + ["<>" parser + ["<s>" synthesis (#+ Parser)]]] [data ["." product] + ["." text + ["%" format (#+ format)]] [collection - ["." dictionary]]] + ["." dictionary] + ["." list ("#\." functor fold)]]] [math [number ["f" frac]]] [target - ["_" lua (#+ Expression Literal)]]] - [//// + ["_" lua (#+ Expression)]]] + ["." //// #_ ["/" bundle] - [// + ["/#" // #_ + ["." extension] [generation [extension (#+ Nullary Unary Binary Trinary nullary unary binary trinary)] ["//" lua #_ - ["#." runtime (#+ Operation Phase Handler Bundle)]]]]]) + ["#." runtime (#+ Operation Phase Handler Bundle Generator)]]] + [// + [synthesis (#+ %synthesis)] + ["." generation] + [/// + ["#" phase]]]]]) + +(def: #export (custom [parser handler]) + (All [s] + (-> [(Parser s) + (-> Text (Generator s))] + Handler)) + (function (_ extension_name phase archive input) + (case (<s>.run parser input) + (#try.Success input') + (handler extension_name phase archive input') + + (#try.Failure error) + (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) (template: (!unary function) (|>> list _.apply/* (|> (_.var function)))) @@ -70,9 +95,9 @@ (/.install "encode" (unary (!unary "tostring"))) (/.install "decode" (unary ..f64//decode))))) -(def: (text//char [subjectO paramO]) +(def: (text//char [paramO subjectO]) (Binary Expression) - (//runtime.text//char subjectO paramO)) + (//runtime.text//char (_.+ (_.int +1) paramO) subjectO)) (def: (text//clip [paramO extraO subjectO]) (Trinary Expression) @@ -80,7 +105,7 @@ (def: (text//index [startO partO textO]) (Trinary Expression) - (//runtime.text//index textO partO startO)) + (//runtime.text//index textO partO (_.+ (_.int +1) startO))) (def: text_procs Bundle @@ -89,10 +114,10 @@ (/.install "=" (binary (product.uncurry _.=))) (/.install "<" (binary (product.uncurry _.<))) (/.install "concat" (binary (product.uncurry (function.flip _.concat)))) - (/.install "index" (trinary text//index)) + (/.install "index" (trinary ..text//index)) (/.install "size" (unary (|>> list _.apply/* (|> (_.var "string.len"))))) - (/.install "char" (binary (product.uncurry //runtime.text//char))) - (/.install "clip" (trinary text//clip)) + (/.install "char" (binary ..text//char)) + (/.install "clip" (trinary ..text//clip)) ))) (def: (io//log! messageO) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux new file mode 100644 index 000000000..03600ab57 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux @@ -0,0 +1,197 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." function] + ["<>" parser + ["<s>" synthesis (#+ Parser)]]] + [data + [collection + ["." dictionary] + ["." list]] + [text + ["%" format (#+ format)]]] + [target + ["_" lua (#+ Var Expression)]]] + ["." // #_ + ["#." common (#+ custom)] + ["//#" /// #_ + ["/" bundle] + ["/#" // #_ + ["." extension] + [generation + [extension (#+ Nullary Unary Binary Trinary + nullary unary binary trinary)] + ["//" lua #_ + ["#." runtime (#+ Operation Phase Handler Bundle + with_vars)]]] + ["/#" // #_ + ["." generation] + ["//#" /// #_ + ["#." phase]]]]]]) + +(def: array::new + (Unary Expression) + (|>> ["n"] list _.table)) + +(def: array::length + (Unary Expression) + (_.the "n")) + +(def: (array::read [indexG arrayG]) + (Binary Expression) + (_.nth (_.+ (_.int +1) indexG) arrayG)) + +(def: (array::write [indexG valueG arrayG]) + (Trinary Expression) + (//runtime.array//write indexG valueG arrayG)) + +(def: (array::delete [indexG arrayG]) + (Binary Expression) + (//runtime.array//write indexG _.nil arrayG)) + +(def: array + Bundle + (<| (/.prefix "array") + (|> /.empty + (/.install "new" (unary array::new)) + (/.install "length" (unary array::length)) + (/.install "read" (binary array::read)) + (/.install "write" (trinary array::write)) + (/.install "delete" (binary array::delete)) + ))) + +(def: object::get + Handler + (custom + [($_ <>.and <s>.text <s>.any) + (function (_ extension phase archive [fieldS objectS]) + (do ////////phase.monad + [objectG (phase archive objectS)] + (wrap (_.the fieldS objectG))))])) + +(def: object::do + Handler + (custom + [($_ <>.and <s>.text <s>.any (<>.some <s>.any)) + (function (_ extension phase archive [methodS objectS inputsS]) + (do {! ////////phase.monad} + [objectG (phase archive objectS) + inputsG (monad.map ! (phase archive) inputsS)] + (wrap (_.do methodS inputsG objectG))))])) + +(template [<!> <?> <unit>] + [(def: <!> (Nullary Expression) (function.constant <unit>)) + (def: <?> (Unary Expression) (_.= <unit>))] + + [object::nil object::nil? _.nil] + ) + +(def: object + Bundle + (<| (/.prefix "object") + (|> /.empty + (/.install "get" object::get) + (/.install "do" object::do) + (/.install "nil" (nullary object::nil)) + (/.install "nil?" (unary object::nil?)) + ))) + +(def: $input + (_.var "input")) + +(def: utf8::encode + (custom + [<s>.any + (function (_ extension phase archive inputS) + (do {! ////////phase.monad} + [inputG (phase archive inputS)] + (wrap (_.apply/1 (<| (_.closure (list $input)) + (_.return (|> (_.var "string.byte") + (_.apply/* (list $input (_.int +1) (_.length $input))) + (_.apply/1 (_.var "table.pack"))))) + inputG))))])) + +(def: utf8::decode + (custom + [<s>.any + (function (_ extension phase archive inputS) + (do {! ////////phase.monad} + [inputG (phase archive inputS)] + (wrap (|> inputG + (_.apply/1 (_.var "table.unpack")) + (_.apply/1 (_.var "string.char"))))))])) + +(def: utf8 + Bundle + (<| (/.prefix "utf8") + (|> /.empty + (/.install "encode" utf8::encode) + (/.install "decode" utf8::decode) + ))) + +(def: lua::constant + (custom + [<s>.text + (function (_ extension phase archive name) + (\ ////////phase.monad wrap (_.var name)))])) + +(def: lua::apply + (custom + [($_ <>.and <s>.any (<>.some <s>.any)) + (function (_ extension phase archive [abstractionS inputsS]) + (do {! ////////phase.monad} + [abstractionG (phase archive abstractionS) + inputsG (monad.map ! (phase archive) inputsS)] + (wrap (_.apply/* inputsG abstractionG))))])) + +(def: lua::power + (custom + [($_ <>.and <s>.any <s>.any) + (function (_ extension phase archive [powerS baseS]) + (do {! ////////phase.monad} + [powerG (phase archive powerS) + baseG (phase archive baseS)] + (wrap (_.^ powerG baseG))))])) + +(def: lua::import + (custom + [<s>.text + (function (_ extension phase archive module) + (\ ////////phase.monad wrap + (_.require/1 (_.string module))))])) + +(def: lua::function + (custom + [($_ <>.and <s>.i64 <s>.any) + (function (_ extension phase archive [arity abstractionS]) + (do {! ////////phase.monad} + [abstractionG (phase archive abstractionS) + #let [variable (: (-> Text (Operation Var)) + (|>> generation.gensym + (\ ! map _.var)))] + g!inputs (monad.map ! (function (_ _) + (variable "input")) + (list.repeat (.nat arity) []))] + (wrap (<| (_.closure g!inputs) + _.statement + (case (.nat arity) + 0 (_.apply/1 abstractionG //runtime.unit) + 1 (_.apply/* g!inputs abstractionG) + _ (_.apply/1 abstractionG (_.array g!inputs)))))))])) + +(def: #export bundle + Bundle + (<| (/.prefix "lua") + (|> /.empty + (dictionary.merge ..array) + (dictionary.merge ..object) + (dictionary.merge ..utf8) + + (/.install "constant" lua::constant) + (/.install "apply" lua::apply) + (/.install "power" lua::power) + (/.install "import" lua::import) + (/.install "function" lua::function) + ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux index 03913b84b..ab89ff708 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux @@ -26,8 +26,6 @@ [reference (#+) [variable (#+)]]]]]]]) -(exception: #export cannot-recur-as-an-expression) - (def: (statement expression archive synthesis) Phase! (case synthesis @@ -64,6 +62,8 @@ (//////phase\map _.return (/function.function statement expression archive abstraction)) )) +(exception: #export cannot-recur-as-an-expression) + (def: (expression archive synthesis) Phase (case synthesis @@ -109,8 +109,7 @@ (/function.apply expression archive application) (#synthesis.Extension extension) - (///extension.apply archive expression extension) - )) + (///extension.apply archive expression extension))) (def: #export generate Phase diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux index 1bcd569c7..50e3ba008 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux @@ -34,11 +34,11 @@ (-> Register Var) (|>> (///reference.local //reference.system) :assume)) -(def: #export (let generate archive [valueS register bodyS]) +(def: #export (let expression archive [valueS register bodyS]) (Generator [Synthesis Register Synthesis]) (do ///////phase.monad - [valueO (generate archive valueS) - bodyO (generate archive bodyS)] + [valueO (expression archive valueS) + bodyO (expression archive bodyS)] ## TODO: Find some way to do 'let' without paying the price of the closure. (wrap (_.apply/* (_.closure (list (..register register)) (_.return bodyO)) @@ -49,15 +49,16 @@ (do ///////phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] - (wrap (_.then (_.define (..register register) valueO) - bodyO)))) + (wrap ($_ _.then + (_.define (..register register) valueO) + bodyO)))) -(def: #export (if generate archive [testS thenS elseS]) +(def: #export (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) (do ///////phase.monad - [testO (generate archive testS) - thenO (generate archive thenS) - elseO (generate archive elseS)] + [testO (expression archive testS) + thenO (expression archive thenS) + elseO (expression archive elseS)] (wrap (_.? testO thenO elseO)))) (def: #export (if! statement expression archive [testS thenS elseS]) @@ -70,10 +71,10 @@ thenO elseO)))) -(def: #export (get generate archive [pathP valueS]) +(def: #export (get expression archive [pathP valueS]) (Generator [(List Member) Synthesis]) (do ///////phase.monad - [valueO (generate archive valueS)] + [valueO (expression archive valueS)] (wrap (list\fold (function (_ side source) (.let [method (.case side (^template [<side> <accessor>] @@ -223,6 +224,9 @@ #.None (.case pathP + (#/////synthesis.Then bodyS) + (statement expression archive bodyS) + #/////synthesis.Pop (///////phase\wrap pop_cursor!) @@ -269,9 +273,6 @@ ([#/////synthesis.F64_Fork //primitive.f64] [#/////synthesis.Text_Fork //primitive.text]) - (#/////synthesis.Then bodyS) - (statement expression archive bodyS) - (^template [<complex> <choice>] [(^ (<complex> idx)) (///////phase\wrap (<choice> false idx))]) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux index 89fd86bb6..4d403e22e 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux @@ -26,28 +26,30 @@ [reference [variable (#+ Register Variable)]]]]]]) -(def: #export (apply generate archive [functionS argsS+]) +(def: #export (apply expression archive [functionS argsS+]) (Generator (Application Synthesis)) (do {! ///////phase.monad} - [functionO (generate archive functionS) - argsO+ (monad.map ! (generate archive) argsS+)] + [functionO (expression archive functionS) + argsO+ (monad.map ! (expression archive) argsS+)] (wrap (_.apply/* functionO argsO+)))) -(def: (with_closure @self inits function_body) +(def: capture + (-> Register Var) + (|>> (///reference.foreign //reference.system) :assume)) + +(def: (with_closure @self inits body!) (-> Var (List Expression) Statement [Statement Expression]) (case inits #.Nil - [(_.function! @self (list) function_body) + [(_.function! @self (list) body!) @self] _ - (let [capture (: (-> Register Var) - (|>> (///reference.foreign //reference.system) :assume))] - [(_.function! @self - (|> (list.enumeration inits) - (list\map (|>> product.left capture))) - (_.return (_.function @self (list) function_body))) - (_.apply/* @self inits)]))) + [(_.function! @self + (|> (list.enumeration inits) + (list\map (|>> product.left ..capture))) + (_.return (_.function @self (list) body!))) + (_.apply/* @self inits)])) (def: @curried (_.var "curried")) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux index bbeaca725..135cfeb74 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux @@ -69,20 +69,11 @@ ## true loop _ (do {! ///////phase.monad} - [@scope (\ ! map ..@scope /////generation.next) - initsO+ (monad.map ! (expression archive) initsS+) - body! (/////generation.with_anchor [start @scope] - (statement expression archive bodyS)) - #let [closure (_.closure - (|> initsS+ - list.enumeration - (list\map (|>> product.left (n.+ start) //case.register))) - (_.with_label (_.label @scope) - (_.do_while (_.boolean true) - body!)))]] - (wrap (_.apply/* closure initsO+))))) + [loop! (scope! statement expression archive [start initsS+ bodyS])] + (wrap (_.apply/* (_.closure (list) loop!) (list)))))) -(def: @temp (_.var "lux_recur_values")) +(def: @temp + (_.var "lux_recur_values")) (def: #export (recur! statement expression archive argsS+) (Generator! (List Synthesis)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index f62b04c4e..53213d3f1 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -682,9 +682,10 @@ ..none (..some (i64//from_number idx))))))) -(runtime: (text//clip start end text) - (_.return (|> text (_.do "substring" (list (_.the ..i64_low_field start) - (_.the ..i64_low_field end)))))) +(runtime: (text//clip offset length text) + (_.return (|> text (_.do "substring" (list (_.the ..i64_low_field offset) + (_.+ (_.the ..i64_low_field offset) + (_.the ..i64_low_field length))))))) (runtime: (text//char idx text) (with_vars [result] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux index 2e3369915..7f16a8d5f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux @@ -1,7 +1,11 @@ (.module: [lux #* [abstract - [monad (#+ do)]]] + [monad (#+ do)]] + [control + ["." exception (#+ exception:)]] + [target + ["_" lua]]] ["." / #_ [runtime (#+ Phase Phase!)] ["#." primitive] @@ -22,7 +26,45 @@ [reference (#+) [variable (#+)]]]]]]]) -(def: #export (generate archive synthesis) +(def: (statement expression archive synthesis) + Phase! + (case synthesis + (^template [<tag>] + [(^ (<tag> value)) + (//////phase\map _.return (expression archive synthesis))]) + ([synthesis.bit] + [synthesis.i64] + [synthesis.f64] + [synthesis.text] + [synthesis.variant] + [synthesis.tuple] + [#synthesis.Reference] + [synthesis.branch/get] + [synthesis.function/apply] + [#synthesis.Extension]) + + (^ (synthesis.branch/case case)) + (/case.case! statement expression archive case) + + (^ (synthesis.branch/let let)) + (/case.let! statement expression archive let) + + (^ (synthesis.branch/if if)) + (/case.if! statement expression archive if) + + (^ (synthesis.loop/scope scope)) + (/loop.scope! statement expression archive scope) + + (^ (synthesis.loop/recur updates)) + (/loop.recur! statement expression archive updates) + + (^ (synthesis.function/abstraction abstraction)) + (//////phase\map _.return (/function.function statement expression archive abstraction)) + )) + +(exception: #export cannot-recur-as-an-expression) + +(def: (expression archive synthesis) Phase (case synthesis (^template [<tag> <generator>] @@ -34,37 +76,41 @@ [synthesis.text /primitive.text]) (^ (synthesis.variant variantS)) - (/structure.variant generate archive variantS) + (/structure.variant expression archive variantS) (^ (synthesis.tuple members)) - (/structure.tuple generate archive members) + (/structure.tuple expression archive members) (#synthesis.Reference value) (//reference.reference /reference.system archive value) (^ (synthesis.branch/case case)) - (/case.case generate archive case) + (/case.case ..statement expression archive case) (^ (synthesis.branch/let let)) - (/case.let generate archive let) + (/case.let expression archive let) (^ (synthesis.branch/if if)) - (/case.if generate archive if) + (/case.if expression archive if) (^ (synthesis.branch/get get)) - (/case.get generate archive get) + (/case.get expression archive get) (^ (synthesis.loop/scope scope)) - (/loop.scope generate archive scope) + (/loop.scope ..statement expression archive scope) (^ (synthesis.loop/recur updates)) - (/loop.recur generate archive updates) + (//////phase.throw ..cannot-recur-as-an-expression []) (^ (synthesis.function/abstraction abstraction)) - (/function.function generate archive abstraction) + (/function.function ..statement expression archive abstraction) (^ (synthesis.function/apply application)) - (/function.apply generate archive application) + (/function.apply expression archive application) (#synthesis.Extension extension) - (///extension.apply archive generate extension))) + (///extension.apply archive expression extension))) + +(def: #export generate + Phase + ..expression) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux index 3c56c2dfa..818575720 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux @@ -37,21 +37,30 @@ (-> Register Var) (|>> (///reference.foreign //reference.system) :assume)) -(def: #export (let generate archive [valueS register bodyS]) +(def: #export (let expression archive [valueS register bodyS]) (Generator [Synthesis Register Synthesis]) (do ///////phase.monad - [valueO (generate archive valueS) - bodyO (generate archive bodyS)] + [valueO (expression archive valueS) + bodyO (expression archive bodyS)] ## TODO: Find some way to do 'let' without paying the price of the closure. (wrap (|> bodyO _.return (_.closure (list (..register register))) (_.apply/* (list valueO)))))) -(def: #export (get generate archive [pathP valueS]) +(def: #export (let! statement expression archive [valueS register bodyS]) + (Generator! [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS) + bodyO (statement expression archive bodyS)] + (wrap ($_ _.then + (_.local/1 (..register register) valueO) + bodyO)))) + +(def: #export (get expression archive [pathP valueS]) (Generator [(List Member) Synthesis]) (do ///////phase.monad - [valueO (generate archive valueS)] + [valueO (expression archive valueS)] (wrap (list\fold (function (_ side source) (.let [method (.case side (^template [<side> <accessor>] @@ -63,18 +72,28 @@ valueO (list.reverse pathP))))) -(def: #export (if generate archive [testS thenS elseS]) +(def: #export (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) (do ///////phase.monad - [testO (generate archive testS) - thenO (generate archive thenS) - elseO (generate archive elseS)] + [testO (expression archive testS) + thenO (expression archive thenS) + elseO (expression archive elseS)] (wrap (|> (_.if testO (_.return thenO) (_.return elseO)) (_.closure (list)) (_.apply/* (list)))))) +(def: #export (if! statement expression archive [testS thenS elseS]) + (Generator! [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testO (expression archive testS) + thenO (statement expression archive thenS) + elseO (statement expression archive elseS)] + (wrap (_.if testO + thenO + elseO)))) + (def: @savepoint (_.var "lux_pm_savepoint")) (def: @cursor (_.var "lux_pm_cursor")) (def: @temp (_.var "lux_pm_temp")) @@ -134,12 +153,12 @@ ..restore! post!))) -(def: (pattern_matching' generate archive) - (-> Phase Archive Path (Operation Statement)) +(def: (pattern_matching' statement expression archive) + (-> Phase! Phase Archive Path (Operation Statement)) (function (recur pathP) (.case pathP (#/////synthesis.Then bodyS) - (///////phase\map _.return (generate archive bodyS)) + (statement expression archive bodyS) #/////synthesis.Pop (///////phase\wrap ..pop!) @@ -213,10 +232,10 @@ ([/////synthesis.path/seq _.then] [/////synthesis.path/alt ..alternation])))) -(def: (pattern_matching generate archive pathP) - (-> Phase Archive Path (Operation Statement)) +(def: (pattern_matching statement expression archive pathP) + (-> Phase! Phase Archive Path (Operation Statement)) (do ///////phase.monad - [pattern_matching! (pattern_matching' generate archive pathP)] + [pattern_matching! (pattern_matching' statement expression archive pathP)] (wrap ($_ _.then (_.while (_.bool true) pattern_matching!) @@ -235,21 +254,21 @@ (#///////variable.Foreign register) (..capture register)))))) -(def: #export (case generate archive [valueS pathP]) - (Generator [Synthesis Path]) +(def: #export (case! statement expression archive [valueS pathP]) + (Generator! [Synthesis Path]) (do ///////phase.monad - [initG (generate archive valueS) - [[case_module case_artifact] pattern_matching!] (/////generation.with_new_context archive - (pattern_matching generate archive pathP)) - #let [@case (_.var (///reference.artifact [case_module case_artifact])) - @dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS) - pathP)) - directive (_.function @case @dependencies+ - ($_ _.then - (_.local (list @temp)) - (_.local/1 @cursor (_.array (list initG))) - (_.local/1 @savepoint (_.array (list))) - pattern_matching!))] - _ (/////generation.execute! directive) - _ (/////generation.save! (%.nat case_artifact) directive)] - (wrap (_.apply/* @dependencies+ @case)))) + [stack_init (expression archive valueS) + pattern_matching! (pattern_matching statement expression archive pathP)] + (wrap ($_ _.then + (_.local (list @temp)) + (_.local/1 @cursor (_.array (list stack_init))) + (_.local/1 @savepoint (_.array (list))) + pattern_matching!)))) + +(def: #export (case statement expression archive [valueS pathP]) + (-> Phase! (Generator [Synthesis Path])) + (|> [valueS pathP] + (..case! statement expression archive) + (\ ///////phase.monad map + (|>> (_.closure (list)) + (_.apply/* (list)))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index c7fe7f51c..3aa3a9ca7 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -11,7 +11,7 @@ [collection ["." list ("#\." functor fold)]]] [target - ["_" lua (#+ Var Expression Statement)]]] + ["_" lua (#+ Var Expression Label Statement)]]] ["." // #_ ["#." runtime (#+ Operation Phase Phase! Generator)] ["#." reference] @@ -28,58 +28,55 @@ [reference [variable (#+ Register Variable)]]]]]]) -(def: #export (apply generate archive [functionS argsS+]) +(def: #export (apply expression archive [functionS argsS+]) (Generator (Application Synthesis)) (do {! ///////phase.monad} - [functionO (generate archive functionS) - argsO+ (monad.map ! (generate archive) argsS+)] + [functionO (expression archive functionS) + argsO+ (monad.map ! (expression archive) argsS+)] (wrap (_.apply/* argsO+ functionO)))) -(def: #export capture +(def: capture (-> Register Var) (|>> (///reference.foreign //reference.system) :assume)) -(def: (with_closure function_name inits @function @args @body) - (-> Text (List Expression) Var (List Var) Statement (Operation Expression)) +(def: (with_closure inits @self @args body!) + (-> (List Expression) Var (List Var) Statement [Statement Expression]) (case inits #.Nil - (do ///////phase.monad - [#let [function_definition (_.function @function @args @body)] - _ (/////generation.execute! function_definition) - _ (/////generation.save! function_name function_definition)] - (wrap (_.var function_name))) + [(_.function @self @args body!) + @self] _ - (do {! ///////phase.monad} - [#let [@closure (_.var (format function_name "_closure")) - directive (_.function @closure - (|> (list.enumeration inits) - (list\map (|>> product.left ..capture))) - ($_ _.then - (_.local_function @function @args @body) - (_.return (_.var function_name))))] - _ (/////generation.execute! directive) - _ (/////generation.save! (_.code @closure) directive)] - (wrap (_.apply/* inits @closure))))) + (let [@inits (|> (list.enumeration inits) + (list\map (|>> product.left ..capture)))] + [(_.function @self @inits + ($_ _.then + (_.local_function @self @args body!) + (_.return @self))) + (_.apply/* inits @self)]))) (def: input (|>> inc //case.register)) -(def: #export (function generate archive [environment arity bodyS]) - (Generator (Abstraction Synthesis)) +(def: (@scope function_name) + (-> Context Label) + (_.label (format (///reference.artifact function_name) "_scope"))) + +(def: #export (function statement expression archive [environment arity bodyS]) + (-> Phase! (Generator (Abstraction Synthesis))) (do {! ///////phase.monad} - [[function_name bodyO] (/////generation.with_new_context archive + [[function_name body!] (/////generation.with_new_context archive (do ! - [function_name (\ ! map ///reference.artifact - (/////generation.context archive))] - (/////generation.with_anchor (_.var function_name) - (generate archive bodyS)))) - closureO+ (monad.map ! (generate archive) environment) - #let [function_name (///reference.artifact function_name) - @curried (_.var "curried") + [@scope (\ ! map ..@scope + (/////generation.context archive))] + (/////generation.with_anchor [1 @scope] + (statement expression archive bodyS)))) + closureO+ (monad.map ! (expression archive) environment) + #let [@curried (_.var "curried") arityO (|> arity .int _.int) @num_args (_.var "num_args") - @self (_.var function_name) + @scope (..@scope function_name) + @self (_.var (///reference.artifact function_name)) initialize_self! (_.local/1 (//case.register 0) @self) initialize! (list\fold (.function (_ post pre!) ($_ _.then @@ -89,26 +86,28 @@ (list.indices arity)) pack (|>> (list) _.array) unpack (|>> (list) _.apply/* (|> (_.var "table.unpack"))) - @var_args (_.var "...")]] - (with_closure function_name closureO+ - @self (list @var_args) - ($_ _.then - (_.local/1 @curried (pack @var_args)) - (_.local/1 @num_args (_.length @curried)) - (_.cond (list [(|> @num_args (_.= (_.int +0))) - (_.return @self)] - [(|> @num_args (_.= arityO)) - ($_ _.then - initialize! - (_.return bodyO))] - [(|> @num_args (_.> arityO)) - (let [arity_inputs (//runtime.array//sub (_.int +0) arityO @curried) - extra_inputs (//runtime.array//sub arityO @num_args @curried)] - (_.return (|> @self - (_.apply/* (list (unpack arity_inputs))) - (_.apply/* (list (unpack extra_inputs))))))]) - ## (|> @num_args (_.< arityO)) - (_.return (_.closure (list @var_args) - (_.return (|> @self (_.apply/* (list (unpack (//runtime.array//concat @curried (pack @var_args)))))))))) - )) - )) + @var_args (_.var "...")] + #let [[definition instantiation] (with_closure closureO+ @self (list @var_args) + ($_ _.then + (_.local/1 @curried (pack @var_args)) + (_.local/1 @num_args (_.length @curried)) + (_.cond (list [(|> @num_args (_.= (_.int +0))) + (_.return @self)] + [(|> @num_args (_.= arityO)) + ($_ _.then + initialize! + (_.set_label @scope) + body!)] + [(|> @num_args (_.> arityO)) + (let [arity_inputs (//runtime.array//sub (_.int +0) arityO @curried) + extra_inputs (//runtime.array//sub arityO @num_args @curried)] + (_.return (|> @self + (_.apply/* (list (unpack arity_inputs))) + (_.apply/* (list (unpack extra_inputs))))))]) + ## (|> @num_args (_.< arityO)) + (_.return (_.closure (list @var_args) + (_.return (|> @self (_.apply/* (list (unpack (//runtime.array//concat @curried (pack @var_args)))))))))) + ))] + _ (/////generation.execute! definition) + _ (/////generation.save! (%.nat (product.right function_name)) definition)] + (wrap instantiation))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux index b1b8a47cb..7fc7ebbfd 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux @@ -13,7 +13,7 @@ [number ["n" nat]]] [target - ["_" lua (#+ Var Expression Statement)]]] + ["_" lua (#+ Var Expression Label Statement)]]] ["." // #_ [runtime (#+ Operation Phase Phase! Generator Generator!)] ["#." case] @@ -27,29 +27,53 @@ [reference [variable (#+ Register)]]]]]]) -(def: loop_name - (-> Nat Var) - (|>> %.nat (format "loop") _.var)) +(def: @scope + (-> Nat Label) + (|>> %.nat (format "scope") _.label)) -(def: #export (scope generate archive [start initsS+ bodyS]) - (Generator (Scope Synthesis)) +(def: (setup initial? offset bindings body) + (-> Bit Register (List Expression) Statement Statement) + (let [variables (|> bindings + list.enumeration + (list\map (|>> product.left (n.+ offset) //case.register)))] + ($_ _.then + (if initial? + (_.let variables (_.multi bindings)) + (_.set variables (_.multi bindings))) + body))) + +(def: #export (scope! statement expression archive [start initsS+ bodyS]) + (Generator! (Scope Synthesis)) + (case initsS+ + ## function/false/non-independent loop + #.Nil + (statement expression archive bodyS) + + ## true loop + _ + (do {! ///////phase.monad} + [@scope (\ ! map ..@scope /////generation.next) + initsO+ (monad.map ! (expression archive) initsS+) + body! (/////generation.with_anchor [start @scope] + (statement expression archive bodyS))] + (wrap (..setup true start initsO+ + ($_ _.then + (_.set_label @scope) + body!)))))) + +(def: #export (scope statement expression archive [start initsS+ bodyS]) + (-> Phase! (Generator (Scope Synthesis))) (case initsS+ ## function/false/non-independent loop #.Nil - (generate archive bodyS) + (expression archive bodyS) ## true loop _ (do {! ///////phase.monad} - [@loop (\ ! map ..loop_name /////generation.next) - initsO+ (monad.map ! (generate archive) initsS+) - [loop_name bodyO] (/////generation.with_new_context archive - (do ! - [@loop (\ ! map (|>> ///reference.artifact _.var) - (/////generation.context archive))] - (/////generation.with_anchor @loop - (generate archive bodyS)))) - #let [@loop (_.var (///reference.artifact loop_name)) + [[[artifact_module artifact_id] scope!] (/////generation.with_new_context archive + (scope! statement expression archive [start initsS+ bodyS])) + #let [@loop (_.var (///reference.artifact [artifact_module artifact_id])) locals (|> initsS+ list.enumeration (list\map (|>> product.left (n.+ start) //case.register))) @@ -61,25 +85,25 @@ set.to_list) #.Nil [(_.function @loop locals - (_.return bodyO)) + scope!) @loop] foreigns - (let [@context (_.var (format (///reference.artifact loop_name) "_context"))] + (let [@context (_.var (format (_.code @loop) "_context"))] [(_.function @context foreigns ($_ _.then (<| (_.local_function @loop locals) - (_.return bodyO)) + scope!) (_.return @loop) )) (_.apply/* foreigns @context)])))] _ (/////generation.execute! directive) - _ (/////generation.save! (_.code @loop) directive)] - (wrap (_.apply/* initsO+ instantiation))))) + _ (/////generation.save! (%.nat artifact_id) directive)] + (wrap instantiation)))) -(def: #export (recur generate archive argsS+) - (Generator (List Synthesis)) +(def: #export (recur! statement expression archive argsS+) + (Generator! (List Synthesis)) (do {! ///////phase.monad} - [@scope /////generation.anchor - argsO+ (monad.map ! (generate archive) argsS+)] - (wrap (_.apply/* argsO+ @scope)))) + [[offset @scope] /////generation.anchor + argsO+ (monad.map ! (expression archive) argsS+)] + (wrap (..setup false offset argsO+ (_.go_to @scope))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index d7b0f1cd3..46911bcc4 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -22,7 +22,7 @@ [number (#+ hex) ["." i64]]] [target - ["_" lua (#+ Expression Location Var Computation Literal Statement)]]] + ["_" lua (#+ Expression Location Var Computation Literal Label Statement)]]] ["." /// #_ ["#." reference] ["//#" /// #_ @@ -38,7 +38,7 @@ (template [<name> <base>] [(type: #export <name> - (<base> Var Expression Statement))] + (<base> [Register Label] Expression Statement))] [Operation /////generation.Operation] [Phase /////generation.Phase] @@ -295,22 +295,23 @@ (runtime: (text//index subject param start) (with_vars [idx] ($_ _.then - (_.let (list idx) (_.apply/* (list subject param start (_.bool #1)) - (_.var "string.find"))) + (_.local/1 idx (_.apply/* (list subject param start (_.bool #1)) + (_.var "string.find"))) (_.if (_.= _.nil idx) (_.return ..none) - (_.return (..some idx)))))) + (_.return (..some (_.- (_.int +1) idx))))))) -(runtime: (text//clip text from to) - (_.return (_.apply/* (list text from to) (_.var "string.sub")))) +(runtime: (text//clip text offset length) + (_.return (_.apply/* (list text (_.+ (_.int +1) offset) (_.+ offset length)) + (_.var "string.sub")))) (runtime: (text//char idx text) (with_vars [char] ($_ _.then - (_.let (list char) (_.apply/* (list text idx) (_.var "string.byte"))) + (_.local/1 char (_.apply/* (list text idx) + (_.var "string.byte"))) (_.if (_.= _.nil char) - (_.statement (_.apply/* (list (_.string "[Lux Error] Cannot get char from text.")) - (_.var "error"))) + (_.statement (_.error/1 (_.string "[Lux Error] Cannot get char from text."))) (_.return char))))) (def: runtime//text @@ -321,24 +322,7 @@ @text//char )) -(runtime: (array//new size) - (with_vars [output idx] - ($_ _.then - (_.let (list output) (_.array (list))) - (_.for_step idx (_.int +1) size (_.int +1) - (_.statement (_.apply/* (list output ..unit) (_.var "table.insert")))) - (_.return output)))) - -(runtime: (array//get array idx) - (with_vars [temp] - ($_ _.then - (_.let (list temp) (..nth idx array)) - (_.if (_.or (_.= _.nil temp) - (_.= ..unit temp)) - (_.return ..none) - (_.return (..some temp)))))) - -(runtime: (array//put array idx value) +(runtime: (array//write idx value array) ($_ _.then (_.set (list (..nth idx array)) value) (_.return array))) @@ -346,31 +330,17 @@ (def: runtime//array Statement ($_ _.then - @array//new - @array//get - @array//put - )) - -(runtime: (box//write value box) - ($_ _.then - (_.set (list (_.nth (_.int +1) box)) value) - (_.return ..unit))) - -(def: runtime//box - Statement - ($_ _.then - @box//write + @array//write )) (def: runtime Statement ($_ _.then - runtime//adt - runtime//lux - runtime//i64 - runtime//text - runtime//array - runtime//box + ..runtime//adt + ..runtime//lux + ..runtime//i64 + ..runtime//text + ..runtime//array )) (def: #export artifact ..prefix) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 132ec3c98..a2e18808a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -378,8 +378,8 @@ (_.and (|> value (_.>= (_.int +0))) (|> value (_.< top)))) -(runtime: (text//clip @from @to @text) - (_.return (|> @text (_.slice @from @to)))) +(runtime: (text//clip @offset @length @text) + (_.return (|> @text (_.slice @offset (_.+ @offset @length))))) (runtime: (text//char idx text) (_.if (|> idx (within? (_.len/1 text))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux index 8362c7054..488738c00 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux @@ -79,7 +79,7 @@ ) (template: (!clip from to text) - ("lux text clip" from to text)) + ("lux text clip" from (n.- from to) text)) (template [<name> <extension>] [(template: (<name> reference subject) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index b24f6fda4..63298038f 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -216,12 +216,16 @@ [not_a_directory] ) -(with_expansions [<for_jvm> (as_is (exception: #export (cannot_move {target Path} {source Path}) - (exception.report - ["Source" source] - ["Target" target])) - - (exception: #export (cannot_modify {instant Instant} {file Path}) +(with_expansions [<extra> (as_is (exception: #export (cannot_move {target Path} {source Path}) + (exception.report + ["Source" source] + ["Target" target])))] + (for {@.old (as_is <extra>) + @.jvm (as_is <extra>) + @.lua (as_is <extra>)} + (as_is))) + +(with_expansions [<for_jvm> (as_is (exception: #export (cannot_modify {instant Instant} {file Path}) (exception.report ["Instant" (%.instant instant)] ["Path" file])) @@ -723,7 +727,7 @@ _ (PyFile::close [] file)] (wrap [])))))] - [over_write "wb"] + [over_write "w+b"] [append "ab"] )) @@ -874,6 +878,270 @@ (os/path::sep)) )) ) + + @.lua + (as_is (host.import: LuaFile + (read [host.String] #io host.String) + (write [host.String] #io #? LuaFile) + (flush [] #io host.Boolean) + (close [] #io host.Boolean)) + + (host.import: io + (#static open [host.String host.String] #io #? LuaFile)) + + (host.import: package + (#static config host.String)) + + (host.import: os + (#static rename [host.String host.String] #io #? host.Boolean) + (#static remove [host.String] #io #? host.Boolean) + (#static execute [host.String] #io #? host.Boolean)) + + (def: default_separator + Text + (|> (package::config) + (text.split_all_with text.new_line) + list.head + (maybe.default "/"))) + + (template [<name>] + [(exception: #export (<name> {file Path}) + (exception.report + ["Path" file]))] + + [cannot_open_file] + [cannot_close_file] + [cannot_write_to_file] + [file_already_exists] + ) + + (exception: #export (invalid_operation {signature Name} {operation Text}) + (exception.report + ["Platform" @.lua] + ["Signature" (%.name signature)] + ["Operation" (%.text operation)])) + + (`` (structure: (file path) + (-> Path (File IO)) + + (~~ (template [<name> <mode>] + [(def: <name> + (..can_modify + (function (<name> data) + (do {! io.monad} + [?file (io::open [path <mode>])] + (case ?file + (#.Some file) + (do ! + [?wrote (LuaFile::write [("lua utf8 decode" data)] file)] + (case ?wrote + (#.Some _) + (do ! + [flushed? (LuaFile::flush [] file) + closed? (LuaFile::close [] file)] + (wrap (cond (not flushed?) + (exception.throw ..cannot_write_to_file [path]) + + (not closed?) + (exception.throw ..cannot_close_file [path]) + + ## else + (#try.Success [])))) + + #.None + (wrap (exception.throw ..cannot_write_to_file [path])))) + + #.None + (wrap (exception.throw ..cannot_open_file [path])))))))] + + [over_write "w+b"] + [append "ab"] + )) + + (def: content + (..can_query + (function (_ _) + (do {! io.monad} + [?file (io::open [path "rb"])] + (case ?file + (#.Some file) + (do ! + [data (LuaFile::read ["a"] file) + closed? (LuaFile::close [] file)] + (wrap (if closed? + (#try.Success ("lua utf8 encode" data)) + (exception.throw ..cannot_close_file [path])))) + + #.None + (wrap (exception.throw ..cannot_read_all_data [path]))))))) + + (def: name + (..can_see + (function (_ _) + (|> path + (text.split_all_with ..default_separator) + list.reverse + list.head + (maybe.default path))))) + + (def: path + (..can_see + (function (_ _) + path))) + + (~~ (template [<capability> <name>] + [(def: <name> + (<capability> + (function (_ _) + (let [[_ short] (name_of <name>)] + (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))))] + + [..can_query size] + [..can_query last_modified] + [..can_query can_execute?] + + [..can_modify modify] + )) + + (def: move + (..can_open + (function (move destination) + (do io.monad + [?verdict (os::rename [path destination])] + (wrap (if (case ?verdict + (#.Some verdict) + verdict + + #.None + false) + (#try.Success (file destination)) + (exception.throw ..cannot_move [destination path]))))))) + + (def: delete + (..can_delete + (function (delete _) + (do io.monad + [?verdict (os::remove [path])] + (wrap (if (case ?verdict + (#.Some verdict) + verdict + + #.None + false) + (#try.Success []) + (exception.throw ..cannot_delete_file path))))))) + )) + + (`` (structure: (directory path) + (-> Path (Directory IO)) + + (def: scope + (..can_see + (function (_ _) + path))) + + (~~ (template [<name>] + [(def: <name> + (..can_query + (function (_ _) + (let [[_ short] (name_of <name>)] + (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))))] + + [files] + [directories] + )) + + (def: discard + (..can_delete + (function (discard _) + (do io.monad + [?verdict (os::remove [path])] + (wrap (if (case ?verdict + (#.Some verdict) + verdict + + #.None + false) + (#try.Success []) + (exception.throw ..cannot_discard_directory path))))))) + )) + + (def: (default_file path) + (-> Path (IO (Try (File IO)))) + (do {! io.monad} + [?file (io::open [path "r"])] + (case ?file + (#try.Success file) + (do ! + [closed? (LuaFile::close [] file)] + (wrap (if closed? + (#try.Success (..file path)) + (exception.throw ..cannot_close_file [path])))) + + (#try.Failure _) + (wrap (exception.throw ..cannot_find_file [path]))))) + + (def: (default_create_file path) + (-> Path (IO (Try (File IO)))) + (do {! io.monad} + [?file (..default_file path)] + (case ?file + (#try.Failure _) + (do {! io.monad} + [?file (io::open [path "w+b"])] + (case ?file + (#.Some file) + (do ! + [closed? (LuaFile::close [] file)] + (wrap (if closed? + (#try.Success (..file path)) + (exception.throw ..cannot_close_file [path])))) + + #.None + (wrap (exception.throw ..cannot_create_file [path])))) + + (#try.Success file) + (wrap (exception.throw ..file_already_exists [path]))))) + + (`` (structure: #export default + (System IO) + + (def: file (..can_open ..default_file)) + (def: create_file (..can_open ..default_create_file)) + + (def: directory + (let [dummy "lux_lua_dummy_file"] + (..can_open + (function (directory path) + (do {! io.monad} + [?file (..default_create_file (format path ..default_separator dummy))] + (case ?file + (#try.Success file) + (do (try.with !) + [_ (!.use (\ file delete) [])] + (wrap (..directory path))) + + (#try.Failure error) + (wrap (if (exception.match? ..file_already_exists error) + (#try.Success (..directory path)) + (exception.throw ..cannot_find_directory [path]))))))))) + + (def: create_directory + (..can_open + (function (create_directory path) + (do io.monad + [?verdict (os::execute [(format "mkdir " path)])] + (wrap (case ?verdict + (#.Some verdict) + (#try.Success (..directory path)) + + #.None + (exception.throw ..cannot_create_directory [path]))))))) + + (def: separator + ..default_separator) + )) + ) })) (template [<get> <signature> <create> <find> <exception>] diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux index ca301e2ce..1d6b099ad 100644 --- a/stdlib/source/lux/world/program.lux +++ b/stdlib/source/lux/world/program.lux @@ -7,6 +7,7 @@ [control ["." function] ["." io (#+ IO)] + ["." try] [concurrency ["." atom] ["." promise (#+ Promise)]] @@ -178,7 +179,36 @@ (#static get [host.String] #io host.String)) (import: sys - (#static exit [host.Integer] #io Nothing)))} + (#static exit [host.Integer] #io Nothing))) + @.lua (as_is (host.import: LuaFile + (read [host.String] #io #? host.String) + (close [] #io host.Boolean)) + + (host.import: io + (#static popen [host.String] #io #try #? LuaFile)) + + (import: os + (#static getenv [host.String] #io #? host.String) + (#static exit [host.Integer] #io Nothing)) + + (def: (run_command default command) + (-> Text Text (IO Text)) + (do {! io.monad} + [outcome (io::popen [command])] + (case outcome + (#try.Success outcome) + (case outcome + (#.Some file) + (do ! + [?output (LuaFile::read ["*l"] file) + _ (LuaFile::close [] file)] + (wrap (maybe.default default ?output))) + + #.None + (wrap default)) + + (#try.Failure _) + (wrap default)))))} (as_is))) (structure: #export default @@ -224,12 +254,13 @@ (:coerce NodeJs_OS) (NodeJs_OS::homedir [])) <default>) - @.python (os/path::expanduser ["~"])} + @.python (os/path::expanduser ["~"]) + @.lua (..run_command "~" "echo ~")} ## TODO: Replace dummy implementation. <default>))) (def: (directory _) - (with_expansions [<default> (io.io ".") + (with_expansions [<default> "." <jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))] (for {@.old <jvm> @.jvm <jvm> @@ -239,11 +270,17 @@ (NodeJs_Process::cwd [] process) #.None - <default>) - <default>) - @.python (os::getcwd [])} + (io.io <default>)) + (io.io <default>)) + @.python (os::getcwd []) + @.lua (do io.monad + [#let [default <default>] + on_windows (..run_command default "cd")] + (if (is? default on_windows) + (..run_command default "pwd") + (wrap on_windows)))} ## TODO: Replace dummy implementation. - <default>))) + (io.io <default>)))) (def: (exit code) (with_expansions [<jvm> (do io.monad @@ -259,4 +296,5 @@ ## else (..default_exit! code)) - @.python (sys::exit code)})))) + @.python (sys::exit code) + @.lua (os::exit [code])})))) diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux index a963cd7f6..baa32674a 100644 --- a/stdlib/source/spec/compositor/generation/common.lux +++ b/stdlib/source/spec/compositor/generation/common.lux @@ -251,11 +251,11 @@ _ false)))) (let [test-clip (: (-> (I64 Any) (I64 Any) Text Bit) - (function (_ from to expected) + (function (_ offset length expected) (|> (#synthesis.Extension "lux text clip" (list concatenatedS - (synthesis.i64 from) - (synthesis.i64 to))) + (synthesis.i64 offset) + (synthesis.i64 length))) (run (..sanitize "lux text clip")) (case> (^multi (#try.Success valueV) [(:coerce (Maybe Text) valueV) (#.Some valueV)]) @@ -265,7 +265,7 @@ false))))] (_.test "Can clip text to extract sub-text." (and (test-clip 0 sample-size sample-lower) - (test-clip sample-size (n.* 2 sample-size) sample-upper)))) + (test-clip sample-size sample-size sample-upper)))) (_.test "Can extract individual characters from text." (|> (#synthesis.Extension "lux text char" (list sample-lowerS |