diff options
Diffstat (limited to '')
53 files changed, 1144 insertions, 830 deletions
diff --git a/stdlib/source/lux/control/concurrency/promise.lux b/stdlib/source/lux/control/concurrency/promise.lux index 6f8a35f96..b6076f300 100644 --- a/stdlib/source/lux/control/concurrency/promise.lux +++ b/stdlib/source/lux/control/concurrency/promise.lux @@ -64,17 +64,20 @@ (def: #export (await f promise) (All [a] (-> (-> a (IO Any)) (Promise a) (IO Any))) - (let [promise (:representation promise) - (^@ old [_value _observers]) (io.run (atom.read promise))] + (do {! io.monad} + [#let [promise (:representation promise)] + (^@ old [_value _observers]) (atom.read promise)] (case _value (#.Some value) (f value) #.None (let [new [_value (#.Cons f _observers)]] - (if (io.run (atom.compare_and_swap old new promise)) - (io.io []) - (await f (:abstraction promise))))))) + (do ! + [swapped? (atom.compare_and_swap old new promise)] + (if swapped? + (wrap []) + (await f (:abstraction promise)))))))) ) (def: #export resolved? diff --git a/stdlib/source/lux/control/concurrency/thread.lux b/stdlib/source/lux/control/concurrency/thread.lux index daeb38a63..8dcfbfd48 100644 --- a/stdlib/source/lux/control/concurrency/thread.lux +++ b/stdlib/source/lux/control/concurrency/thread.lux @@ -50,8 +50,9 @@ @.python (ffi.import: threading/Timer - (new [ffi.Float ffi.Function]) - (start [] #io #? Any))} + ["#::." + (new [ffi.Float ffi.Function]) + (start [] #io #? Any)])} ## Default (type: Thread diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux index c706ec4cb..9dfc6f96b 100644 --- a/stdlib/source/lux/data/binary.lux +++ b/stdlib/source/lux/data/binary.lux @@ -65,11 +65,13 @@ @.js (as_is (ffi.import: ArrayBuffer - (new [ffi.Number])) + ["#::." + (new [ffi.Number])]) (ffi.import: Uint8Array - (new [ArrayBuffer]) - (length ffi.Number)) + ["#::." + (new [ArrayBuffer]) + (length ffi.Number)]) (type: #export Binary Uint8Array)) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 45c986eca..480c6fd59 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -181,6 +181,7 @@ (:coerce (primitive "java.lang.String") template) ["Ljava/lang/CharSequence;" (:coerce (primitive "java.lang.CharSequence") pattern)] ["Ljava/lang/CharSequence;" (:coerce (primitive "java.lang.CharSequence") replacement)])) + ## TODO: Comment/turn-off when generating a JS compiler using a JVM-based compiler because Nashorn's implementation of "replaceAll" is incorrect. @.js (:coerce Text ("js object do" "replaceAll" template [pattern replacement])) @@ -196,6 +197,8 @@ ("php apply" (:assume ("php constant" "str_replace")) pattern replacement template)) ## TODO @.scheme + ## TODO @.common_lisp + ## TODO @.r } ## Inefficient default (loop [left "" diff --git a/stdlib/source/lux/data/text/encoding/utf8.lux b/stdlib/source/lux/data/text/encoding/utf8.lux index 01e4cd8a5..f0c15df01 100644 --- a/stdlib/source/lux/data/text/encoding/utf8.lux +++ b/stdlib/source/lux/data/text/encoding/utf8.lux @@ -22,27 +22,32 @@ ## On Node (ffi.import: Buffer - (#static from #as from|encode [ffi.String ffi.String] Buffer) - (#static from #as from|decode [Uint8Array] Buffer) - (toString [ffi.String] ffi.String)) + ["#::." + (#static from #as from|encode [ffi.String ffi.String] Buffer) + (#static from #as from|decode [Uint8Array] Buffer) + (toString [ffi.String] ffi.String)]) ## On the browser (ffi.import: TextEncoder - (new [ffi.String]) - (encode [ffi.String] Uint8Array)) + ["#::." + (new [ffi.String]) + (encode [ffi.String] Uint8Array)]) (ffi.import: TextDecoder - (new [ffi.String]) - (decode [Uint8Array] ffi.String))) + ["#::." + (new [ffi.String]) + (decode [Uint8Array] ffi.String)])) @.ruby (as_is (ffi.import: String #as RubyString - (encode [Text] RubyString) - (force_encoding [Text] Text) - (bytes [] Binary)) + ["#::." + (encode [Text] RubyString) + (force_encoding [Text] Text) + (bytes [] Binary)]) (ffi.import: Array #as RubyArray - (pack [Text] RubyString))) + ["#::." + (pack [Text] RubyString)])) @.php (as_is (ffi.import: Almost_Binary) diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index 2c6175601..2e353f44f 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -67,9 +67,11 @@ @.js (as_is (import: JSON - (#static stringify [.Any] ffi.String)) + ["#::." + (#static stringify [.Any] ffi.String)]) (import: Array - (#static isArray [.Any] ffi.Boolean))) + ["#::." + (#static isArray [.Any] ffi.Boolean)])) @.python (as_is (type: PyType @@ -83,13 +85,15 @@ (import: (tostring [.Any] ffi.String)) (import: math - (#static type [.Any] #? ffi.String))) + ["#::." + (#static type [.Any] #? ffi.String)])) @.ruby (as_is (import: Class) (import: Object - (type [] Class))) + ["#::." + (type [] Class)])) @.php (as_is (import: (gettype [.Any] ffi.String)) diff --git a/stdlib/source/lux/ffi.js.lux b/stdlib/source/lux/ffi.js.lux index 8bfe8cc94..0e0172a61 100644 --- a/stdlib/source/lux/ffi.js.lux +++ b/stdlib/source/lux/ffi.js.lux @@ -6,12 +6,12 @@ [control ["." io] ["<>" parser - ["<c>" code (#+ Parser)]]] + ["<.>" code (#+ Parser)]]] [data ["." product] ["." maybe] ["." text - ["%" format (#+ format)]] + ["%" format]] [collection ["." list ("#\." functor fold)]]] [type @@ -53,31 +53,31 @@ (def: nullable (Parser Nullable) (let [token (' #?)] - (<| (<>.and (<>.parses? (<c>.this! token))) - (<>.after (<>.not (<c>.this! token))) - <c>.any))) + (<| (<>.and (<>.parses? (<code>.this! token))) + (<>.after (<>.not (<code>.this! token))) + <code>.any))) (type: Constructor (List Nullable)) (def: constructor (Parser Constructor) - (<c>.form (<>.after (<c>.this! (' new)) - (<c>.tuple (<>.some ..nullable))))) + (<code>.form (<>.after (<code>.this! (' new)) + (<code>.tuple (<>.some ..nullable))))) (type: Field [Bit Text Nullable]) (def: static! (Parser Any) - (<c>.this! (' #static))) + (<code>.this! (' #static))) (def: field (Parser Field) - (<c>.form ($_ <>.and - (<>.parses? ..static!) - <c>.local_identifier - ..nullable))) + (<code>.form ($_ <>.and + (<>.parses? ..static!) + <code>.local_identifier + ..nullable))) (type: Common_Method {#name Text @@ -97,11 +97,11 @@ (def: common_method (Parser Common_Method) ($_ <>.and - <c>.local_identifier - (<>.maybe (<>.after (<c>.this! (' #as)) <c>.local_identifier)) - (<c>.tuple (<>.some ..nullable)) - (<>.parses? (<c>.this! (' #io))) - (<>.parses? (<c>.this! (' #try))) + <code>.local_identifier + (<>.maybe (<>.after (<code>.this! (' #as)) <code>.local_identifier)) + (<code>.tuple (<>.some ..nullable)) + (<>.parses? (<code>.this! (' #io))) + (<>.parses? (<code>.this! (' #try))) ..nullable)) (def: static_method @@ -109,8 +109,8 @@ (def: method (Parser Method) - (<c>.form (<>.or ..static_method - ..common_method))) + (<code>.form (<>.or ..static_method + ..common_method))) (type: Member (#Constructor Constructor) @@ -161,16 +161,16 @@ (.error! "Null is an invalid value.")))))) (type: Import - (#Class [Text (List Member)]) + (#Class [Text Text (List Member)]) (#Function Static_Method)) (def: import - ($_ <>.or - ($_ <>.and - <c>.local_identifier - (<>.some member)) - (<c>.form ..common_method) - )) + (Parser Import) + (<>.or (<>.and <code>.local_identifier + (<>.default ["" (list)] + (<code>.tuple (<>.and <code>.text + (<>.some member))))) + (<code>.form ..common_method))) (syntax: #export (try expression) {#.doc (doc (case (try (risky_computation input)) @@ -225,10 +225,14 @@ (syntax: #export (import: {import ..import}) (with_gensyms [g!temp] (case import - (#Class [class members]) + (#Class [class format members]) (with_gensyms [g!object] (let [qualify (: (-> Text Code) - (|>> (format class "::") code.local_identifier)) + (function (_ member_name) + (|> format + (text.replace_all "#" class) + (text.replace_all "." member_name) + code.local_identifier))) g!type (code.local_identifier class) real_class (text.replace_all "/" "." class)] (wrap (list& (` (type: (~ g!type) @@ -251,7 +255,7 @@ (` ((~! syntax:) ((~ (qualify field))) (\ (~! meta.monad) (~' wrap) (list (` (.:coerce (~ (nullable_type fieldT)) - ("js constant" (~ (code.text (format real_class "." field)))))))))) + ("js constant" (~ (code.text (%.format real_class "." field)))))))))) (` (def: ((~ (qualify field)) (~ g!object)) (-> (~ g!type) @@ -264,7 +268,7 @@ (#Static [method alias inputsT io? try? outputT]) (..make_function (qualify (maybe.default method alias)) g!temp - (format real_class "." method) + (%.format real_class "." method) inputsT io? try? @@ -304,7 +308,7 @@ ("js type-of" object)) (syntax: #export (constant type - {[head tail] (<c>.tuple (<>.and <c>.local_identifier (<>.some <c>.local_identifier)))}) + {[head tail] (<code>.tuple (<>.and <code>.local_identifier (<>.some <code>.local_identifier)))}) (with_gensyms [g!_] (let [constant (` ("js constant" (~ (code.text head))))] (case tail @@ -325,7 +329,7 @@ #.None (~ g!_) - (..constant (~ type) [(~ (code.local_identifier (format head "." next))) + (..constant (~ type) [(~ (code.local_identifier (%.format head "." next))) (~+ (list\map code.local_identifier tail))]))))))))))) (template: (!defined? <constant>) diff --git a/stdlib/source/lux/ffi.lua.lux b/stdlib/source/lux/ffi.lua.lux index 785ca82d6..519c32fdf 100644 --- a/stdlib/source/lux/ffi.lua.lux +++ b/stdlib/source/lux/ffi.lua.lux @@ -7,12 +7,12 @@ [control ["." io] ["<>" parser ("#\." monad) - ["<c>" code (#+ Parser)]]] + ["<code>" code (#+ Parser)]]] [data ["." product] ["." maybe] ["." text - ["%" format (#+ format)]] + ["%" format]] [collection ["." list ("#\." functor fold)]]] [type @@ -51,30 +51,30 @@ (def: nilable (Parser Nilable) (let [token (' #?)] - (<| (<>.and (<>.parses? (<c>.this! token))) - (<>.after (<>.not (<c>.this! token))) - <c>.any))) + (<| (<>.and (<>.parses? (<code>.this! token))) + (<>.after (<>.not (<code>.this! token))) + <code>.any))) (type: Field [Bit Text Nilable]) (def: static! (Parser Any) - (<c>.this! (' #static))) + (<code>.this! (' #static))) (def: field (Parser Field) - (<c>.form ($_ <>.and - (<>.parses? ..static!) - <c>.local_identifier - ..nilable))) + (<code>.form ($_ <>.and + (<>.parses? ..static!) + <code>.local_identifier + ..nilable))) (def: constant (Parser Field) - (<c>.form ($_ <>.and - (<>\wrap true) - <c>.local_identifier - ..nilable))) + (<code>.form ($_ <>.and + (<>\wrap true) + <code>.local_identifier + ..nilable))) (type: Common_Method {#name Text @@ -94,11 +94,11 @@ (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))) + <code>.local_identifier + (<>.maybe (<>.after (<code>.this! (' #as)) <code>.local_identifier)) + (<code>.tuple (<>.some ..nilable)) + (<>.parses? (<code>.this! (' #io))) + (<>.parses? (<code>.this! (' #try))) ..nilable)) (def: static_method @@ -106,8 +106,8 @@ (def: method (Parser Method) - (<c>.form (<>.or ..static_method - ..common_method))) + (<code>.form (<>.or ..static_method + ..common_method))) (type: Member (#Field Field) @@ -156,16 +156,17 @@ (.error! "Nil is an invalid value!")))))) (type: Import - (#Class [Text (List Member)]) + (#Class [Text Text (List Member)]) (#Function Static_Method) (#Constant Field)) (def: import ($_ <>.or - ($_ <>.and - <c>.local_identifier - (<>.some member)) - (<c>.form ..common_method) + (<>.and <code>.local_identifier + (<>.default ["" (list)] + (<code>.tuple (<>.and <code>.text + (<>.some member))))) + (<code>.form ..common_method) ..constant )) @@ -222,10 +223,14 @@ (syntax: #export (import: {import ..import}) (with_gensyms [g!temp] (case import - (#Class [class members]) + (#Class [class format members]) (with_gensyms [g!object] (let [qualify (: (-> Text Code) - (|>> (format class "::") code.local_identifier)) + (function (_ member_name) + (|> format + (text.replace_all "#" class) + (text.replace_all "." member_name) + code.local_identifier))) g!type (code.local_identifier class) real_class (text.replace_all "/" "." class) imported (case (text.split_all_with "/" class) diff --git a/stdlib/source/lux/ffi.old.lux b/stdlib/source/lux/ffi.old.lux index 3a69f2464..346fa4dc8 100644 --- a/stdlib/source/lux/ffi.old.lux +++ b/stdlib/source/lux/ffi.old.lux @@ -8,8 +8,8 @@ ["." function] ["." io] ["." try (#+ Try)] - ["p" parser - ["s" code (#+ Parser)]]] + ["<>" parser + ["<.>" code (#+ Parser)]]] [data ["." maybe] ["." product] @@ -385,24 +385,24 @@ (def: (make_get_const_parser class_name field_name) (-> Text Text (Parser Code)) - (do p.monad + (do <>.monad [#let [dotted_name (format "::" field_name)] - _ (s.this! (code.identifier ["" dotted_name]))] + _ (<code>.this! (code.identifier ["" dotted_name]))] (wrap (`' ((~ (code.text (format "jvm getstatic" ":" class_name ":" field_name)))))))) (def: (make_get_var_parser class_name field_name) (-> Text Text (Parser Code)) - (do p.monad + (do <>.monad [#let [dotted_name (format "::" field_name)] - _ (s.this! (code.identifier ["" dotted_name]))] + _ (<code>.this! (code.identifier ["" dotted_name]))] (wrap (`' ((~ (code.text (format "jvm getfield" ":" class_name ":" field_name))) _jvm_this))))) (def: (make_put_var_parser class_name field_name) (-> Text Text (Parser Code)) - (do p.monad + (do <>.monad [#let [dotted_name (format "::" field_name)] [_ _ value] (: (Parser [Any Any Code]) - (s.form ($_ p.and (s.this! (' :=)) (s.this! (code.identifier ["" dotted_name])) s.any)))] + (<code>.form ($_ <>.and (<code>.this! (' :=)) (<code>.this! (code.identifier ["" dotted_name])) <code>.any)))] (wrap (`' ((~ (code.text (format "jvm putfield" ":" class_name ":" field_name))) _jvm_this (~ value)))))) (def: (pre_walk_replace f input) @@ -425,7 +425,7 @@ (def: (parser->replacer p ast) (-> (Parser Code) (-> Code Code)) - (case (p.run p (list ast)) + (case (<>.run p (list ast)) (#.Right [#.Nil ast']) ast' @@ -440,26 +440,26 @@ (make_get_const_parser class_name field_name) (#VariableField _) - (p.either (make_get_var_parser class_name field_name) - (make_put_var_parser class_name field_name)))) + (<>.either (make_get_var_parser class_name field_name) + (make_put_var_parser class_name field_name)))) (def: (make_constructor_parser params class_name arg_decls) (-> (List Type_Parameter) Text (List ArgDecl) (Parser Code)) - (do p.monad + (do <>.monad [args (: (Parser (List Code)) - (s.form (p.after (s.this! (' ::new!)) - (s.tuple (p.exactly (list.size arg_decls) s.any))))) + (<code>.form (<>.after (<code>.this! (' ::new!)) + (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any))))) #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]] (wrap (` ((~ (code.text (format "jvm new" ":" class_name ":" (text.join_with "," arg_decls')))) (~+ args)))))) (def: (make_static_method_parser params class_name method_name arg_decls) (-> (List Type_Parameter) Text Text (List ArgDecl) (Parser Code)) - (do p.monad + (do <>.monad [#let [dotted_name (format "::" method_name "!")] args (: (Parser (List Code)) - (s.form (p.after (s.this! (code.identifier ["" dotted_name])) - (s.tuple (p.exactly (list.size arg_decls) s.any))))) + (<code>.form (<>.after (<code>.this! (code.identifier ["" dotted_name])) + (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any))))) #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]] (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class_name ":" method_name ":" (text.join_with "," arg_decls')))) (~+ args)))))) @@ -467,11 +467,11 @@ (template [<name> <jvm_op>] [(def: (<name> params class_name method_name arg_decls) (-> (List Type_Parameter) Text Text (List ArgDecl) (Parser Code)) - (do p.monad + (do <>.monad [#let [dotted_name (format "::" method_name "!")] args (: (Parser (List Code)) - (s.form (p.after (s.this! (code.identifier ["" dotted_name])) - (s.tuple (p.exactly (list.size arg_decls) s.any))))) + (<code>.form (<>.after (<code>.this! (code.identifier ["" dotted_name])) + (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any))))) #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]] (wrap (`' ((~ (code.text (format <jvm_op> ":" class_name ":" method_name ":" (text.join_with "," arg_decls')))) (~' _jvm_this) (~+ args))))))] @@ -502,331 +502,331 @@ ## Parsers (def: privacy_modifier^ (Parser PrivacyModifier) - (let [(^open ".") p.monad] - ($_ p.or - (s.this! (' #public)) - (s.this! (' #private)) - (s.this! (' #protected)) + (let [(^open ".") <>.monad] + ($_ <>.or + (<code>.this! (' #public)) + (<code>.this! (' #private)) + (<code>.this! (' #protected)) (wrap [])))) (def: inheritance_modifier^ (Parser InheritanceModifier) - (let [(^open ".") p.monad] - ($_ p.or - (s.this! (' #final)) - (s.this! (' #abstract)) + (let [(^open ".") <>.monad] + ($_ <>.or + (<code>.this! (' #final)) + (<code>.this! (' #abstract)) (wrap [])))) (def: bound_kind^ (Parser BoundKind) - (p.or (s.this! (' <)) - (s.this! (' >)))) + (<>.or (<code>.this! (' <)) + (<code>.this! (' >)))) (def: (assert_no_periods name) (-> Text (Parser Any)) - (p.assert "Names in class declarations cannot contain periods." - (not (text.contains? "." name)))) + (<>.assert "Names in class declarations cannot contain periods." + (not (text.contains? "." name)))) (def: (generic_type^ type_vars) (-> (List Type_Parameter) (Parser GenericType)) - (p.rec + (<>.rec (function (_ recur^) - ($_ p.either - (do p.monad - [_ (s.this! (' ?))] + ($_ <>.either + (do <>.monad + [_ (<code>.this! (' ?))] (wrap (#GenericWildcard #.None))) - (s.tuple (do p.monad - [_ (s.this! (' ?)) - bound_kind bound_kind^ - bound recur^] - (wrap (#GenericWildcard (#.Some [bound_kind bound]))))) - (do p.monad - [name s.local_identifier + (<code>.tuple (do <>.monad + [_ (<code>.this! (' ?)) + bound_kind bound_kind^ + bound recur^] + (wrap (#GenericWildcard (#.Some [bound_kind bound]))))) + (do <>.monad + [name <code>.local_identifier _ (assert_no_periods name)] (if (list.member? text.equivalence (list\map product.left type_vars) name) (wrap (#GenericTypeVar name)) (wrap (#GenericClass name (list))))) - (s.tuple (do p.monad - [component recur^] - (case component - (^template [<class> <name>] - [(#GenericClass <name> #.Nil) - (wrap (#GenericClass <class> (list)))]) - (["[Z" "boolean"] - ["[B" "byte"] - ["[S" "short"] - ["[I" "int"] - ["[J" "long"] - ["[F" "float"] - ["[D" "double"] - ["[C" "char"]) - - _ - (wrap (#GenericArray component))))) - (s.form (do p.monad - [name s.local_identifier - _ (assert_no_periods name) - params (p.some recur^) - _ (p.assert (format name " cannot be a type-parameter!") - (not (list.member? text.equivalence (list\map product.left type_vars) name)))] - (wrap (#GenericClass name params)))) + (<code>.tuple (do <>.monad + [component recur^] + (case component + (^template [<class> <name>] + [(#GenericClass <name> #.Nil) + (wrap (#GenericClass <class> (list)))]) + (["[Z" "boolean"] + ["[B" "byte"] + ["[S" "short"] + ["[I" "int"] + ["[J" "long"] + ["[F" "float"] + ["[D" "double"] + ["[C" "char"]) + + _ + (wrap (#GenericArray component))))) + (<code>.form (do <>.monad + [name <code>.local_identifier + _ (assert_no_periods name) + params (<>.some recur^) + _ (<>.assert (format name " cannot be a type-parameter!") + (not (list.member? text.equivalence (list\map product.left type_vars) name)))] + (wrap (#GenericClass name params)))) )))) (def: type_param^ (Parser Type_Parameter) - (p.either (do p.monad - [param_name s.local_identifier] - (wrap [param_name (list)])) - (s.tuple (do p.monad - [param_name s.local_identifier - _ (s.this! (' <)) - bounds (p.many (..generic_type^ (list)))] - (wrap [param_name bounds]))))) + (<>.either (do <>.monad + [param_name <code>.local_identifier] + (wrap [param_name (list)])) + (<code>.tuple (do <>.monad + [param_name <code>.local_identifier + _ (<code>.this! (' <)) + bounds (<>.many (..generic_type^ (list)))] + (wrap [param_name bounds]))))) (def: type_params^ (Parser (List Type_Parameter)) (|> ..type_param^ - p.some - s.tuple - (p.default (list)))) + <>.some + <code>.tuple + (<>.default (list)))) (def: class_decl^ (Parser Class_Declaration) - (p.either (do p.monad - [name s.local_identifier - _ (assert_no_periods name)] - (wrap [name (list)])) - (s.form (do p.monad - [name s.local_identifier - _ (assert_no_periods name) - params (p.some ..type_param^)] - (wrap [name params]))) - )) + (<>.either (do <>.monad + [name <code>.local_identifier + _ (assert_no_periods name)] + (wrap [name (list)])) + (<code>.form (do <>.monad + [name <code>.local_identifier + _ (assert_no_periods name) + params (<>.some ..type_param^)] + (wrap [name params]))) + )) (def: (super_class_decl^ type_vars) (-> (List Type_Parameter) (Parser Super_Class_Decl)) - (p.either (do p.monad - [name s.local_identifier - _ (assert_no_periods name)] - (wrap [name (list)])) - (s.form (do p.monad - [name s.local_identifier - _ (assert_no_periods name) - params (p.some (..generic_type^ type_vars))] - (wrap [name params]))))) + (<>.either (do <>.monad + [name <code>.local_identifier + _ (assert_no_periods name)] + (wrap [name (list)])) + (<code>.form (do <>.monad + [name <code>.local_identifier + _ (assert_no_periods name) + params (<>.some (..generic_type^ type_vars))] + (wrap [name params]))))) (def: annotation_params^ (Parser (List AnnotationParam)) - (s.record (p.some (p.and s.local_tag s.any)))) + (<code>.record (<>.some (<>.and <code>.local_tag <code>.any)))) (def: annotation^ (Parser Annotation) - (p.either (do p.monad - [ann_name s.local_identifier] - (wrap [ann_name (list)])) - (s.form (p.and s.local_identifier - annotation_params^)))) + (<>.either (do <>.monad + [ann_name <code>.local_identifier] + (wrap [ann_name (list)])) + (<code>.form (<>.and <code>.local_identifier + annotation_params^)))) (def: annotations^' (Parser (List Annotation)) - (do p.monad - [_ (s.this! (' #ann))] - (s.tuple (p.some ..annotation^)))) + (do <>.monad + [_ (<code>.this! (' #ann))] + (<code>.tuple (<>.some ..annotation^)))) (def: annotations^ (Parser (List Annotation)) - (do p.monad - [anns?? (p.maybe ..annotations^')] + (do <>.monad + [anns?? (<>.maybe ..annotations^')] (wrap (maybe.default (list) anns??)))) (def: (throws_decl'^ type_vars) (-> (List Type_Parameter) (Parser (List GenericType))) - (do p.monad - [_ (s.this! (' #throws))] - (s.tuple (p.some (..generic_type^ type_vars))))) + (do <>.monad + [_ (<code>.this! (' #throws))] + (<code>.tuple (<>.some (..generic_type^ type_vars))))) (def: (throws_decl^ type_vars) (-> (List Type_Parameter) (Parser (List GenericType))) - (do p.monad - [exs? (p.maybe (throws_decl'^ type_vars))] + (do <>.monad + [exs? (<>.maybe (throws_decl'^ type_vars))] (wrap (maybe.default (list) exs?)))) (def: (method_decl^ type_vars) (-> (List Type_Parameter) (Parser [Member_Declaration MethodDecl])) - (s.form (do p.monad - [tvars ..type_params^ - name s.local_identifier - anns ..annotations^ - inputs (s.tuple (p.some (..generic_type^ type_vars))) - output (..generic_type^ type_vars) - exs (..throws_decl^ type_vars)] - (wrap [[name #PublicPM anns] {#method_tvars tvars - #method_inputs inputs - #method_output output - #method_exs exs}])))) + (<code>.form (do <>.monad + [tvars ..type_params^ + name <code>.local_identifier + anns ..annotations^ + inputs (<code>.tuple (<>.some (..generic_type^ type_vars))) + output (..generic_type^ type_vars) + exs (..throws_decl^ type_vars)] + (wrap [[name #PublicPM anns] {#method_tvars tvars + #method_inputs inputs + #method_output output + #method_exs exs}])))) (def: state_modifier^ (Parser StateModifier) - ($_ p.or - (s.this! (' #volatile)) - (s.this! (' #final)) - (\ p.monad wrap []))) + ($_ <>.or + (<code>.this! (' #volatile)) + (<code>.this! (' #final)) + (\ <>.monad wrap []))) (def: (field_decl^ type_vars) (-> (List Type_Parameter) (Parser [Member_Declaration FieldDecl])) - (p.either (s.form (do p.monad - [_ (s.this! (' #const)) - name s.local_identifier - anns ..annotations^ - type (..generic_type^ type_vars) - body s.any] - (wrap [[name #PublicPM anns] (#ConstantField [type body])]))) - (s.form (do p.monad - [pm privacy_modifier^ - sm state_modifier^ - name s.local_identifier - anns ..annotations^ - type (..generic_type^ type_vars)] - (wrap [[name pm anns] (#VariableField [sm type])]))))) + (<>.either (<code>.form (do <>.monad + [_ (<code>.this! (' #const)) + name <code>.local_identifier + anns ..annotations^ + type (..generic_type^ type_vars) + body <code>.any] + (wrap [[name #PublicPM anns] (#ConstantField [type body])]))) + (<code>.form (do <>.monad + [pm privacy_modifier^ + sm state_modifier^ + name <code>.local_identifier + anns ..annotations^ + type (..generic_type^ type_vars)] + (wrap [[name pm anns] (#VariableField [sm type])]))))) (def: (arg_decl^ type_vars) (-> (List Type_Parameter) (Parser ArgDecl)) - (s.record (p.and s.local_identifier - (..generic_type^ type_vars)))) + (<code>.record (<>.and <code>.local_identifier + (..generic_type^ type_vars)))) (def: (arg_decls^ type_vars) (-> (List Type_Parameter) (Parser (List ArgDecl))) - (p.some (arg_decl^ type_vars))) + (<>.some (arg_decl^ type_vars))) (def: (constructor_arg^ type_vars) (-> (List Type_Parameter) (Parser ConstructorArg)) - (s.record (p.and (..generic_type^ type_vars) s.any))) + (<code>.record (<>.and (..generic_type^ type_vars) <code>.any))) (def: (constructor_args^ type_vars) (-> (List Type_Parameter) (Parser (List ConstructorArg))) - (s.tuple (p.some (constructor_arg^ type_vars)))) + (<code>.tuple (<>.some (constructor_arg^ type_vars)))) (def: (constructor_method^ class_vars) (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition])) - (s.form (do p.monad - [pm privacy_modifier^ - strict_fp? (p.parses? (s.this! (' #strict))) - method_vars ..type_params^ - #let [total_vars (list\compose class_vars method_vars)] - [_ arg_decls] (s.form (p.and (s.this! (' new)) - (..arg_decls^ total_vars))) - constructor_args (..constructor_args^ total_vars) - exs (..throws_decl^ total_vars) - annotations ..annotations^ - body s.any] - (wrap [{#member_name constructor_method_name - #member_privacy pm - #member_anns annotations} - (#ConstructorMethod strict_fp? method_vars arg_decls constructor_args body exs)])))) + (<code>.form (do <>.monad + [pm privacy_modifier^ + strict_fp? (<>.parses? (<code>.this! (' #strict))) + method_vars ..type_params^ + #let [total_vars (list\compose class_vars method_vars)] + [_ arg_decls] (<code>.form (<>.and (<code>.this! (' new)) + (..arg_decls^ total_vars))) + constructor_args (..constructor_args^ total_vars) + exs (..throws_decl^ total_vars) + annotations ..annotations^ + body <code>.any] + (wrap [{#member_name constructor_method_name + #member_privacy pm + #member_anns annotations} + (#ConstructorMethod strict_fp? method_vars arg_decls constructor_args body exs)])))) (def: (virtual_method_def^ class_vars) (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition])) - (s.form (do p.monad - [pm privacy_modifier^ - strict_fp? (p.parses? (s.this! (' #strict))) - final? (p.parses? (s.this! (' #final))) - method_vars ..type_params^ - #let [total_vars (list\compose class_vars method_vars)] - [name this_name arg_decls] (s.form ($_ p.and - s.local_identifier - s.local_identifier - (..arg_decls^ total_vars))) - return_type (..generic_type^ total_vars) - exs (..throws_decl^ total_vars) - annotations ..annotations^ - body s.any] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#VirtualMethod final? strict_fp? - method_vars - this_name arg_decls return_type - body exs)])))) + (<code>.form (do <>.monad + [pm privacy_modifier^ + strict_fp? (<>.parses? (<code>.this! (' #strict))) + final? (<>.parses? (<code>.this! (' #final))) + method_vars ..type_params^ + #let [total_vars (list\compose class_vars method_vars)] + [name this_name arg_decls] (<code>.form ($_ <>.and + <code>.local_identifier + <code>.local_identifier + (..arg_decls^ total_vars))) + return_type (..generic_type^ total_vars) + exs (..throws_decl^ total_vars) + annotations ..annotations^ + body <code>.any] + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#VirtualMethod final? strict_fp? + method_vars + this_name arg_decls return_type + body exs)])))) (def: overriden_method_def^ (Parser [Member_Declaration Method_Definition]) - (s.form (do p.monad - [strict_fp? (p.parses? (s.this! (' #strict))) - owner_class ..class_decl^ - method_vars ..type_params^ - #let [total_vars (list\compose (product.right owner_class) method_vars)] - [name this_name arg_decls] (s.form ($_ p.and - s.local_identifier - s.local_identifier - (..arg_decls^ total_vars))) - return_type (..generic_type^ total_vars) - exs (..throws_decl^ total_vars) - annotations ..annotations^ - body s.any] - (wrap [{#member_name name - #member_privacy #PublicPM - #member_anns annotations} - (#OverridenMethod strict_fp? - owner_class method_vars - this_name arg_decls return_type - body exs)])))) + (<code>.form (do <>.monad + [strict_fp? (<>.parses? (<code>.this! (' #strict))) + owner_class ..class_decl^ + method_vars ..type_params^ + #let [total_vars (list\compose (product.right owner_class) method_vars)] + [name this_name arg_decls] (<code>.form ($_ <>.and + <code>.local_identifier + <code>.local_identifier + (..arg_decls^ total_vars))) + return_type (..generic_type^ total_vars) + exs (..throws_decl^ total_vars) + annotations ..annotations^ + body <code>.any] + (wrap [{#member_name name + #member_privacy #PublicPM + #member_anns annotations} + (#OverridenMethod strict_fp? + owner_class method_vars + this_name arg_decls return_type + body exs)])))) (def: static_method_def^ (Parser [Member_Declaration Method_Definition]) - (s.form (do p.monad - [pm privacy_modifier^ - strict_fp? (p.parses? (s.this! (' #strict))) - _ (s.this! (' #static)) - method_vars ..type_params^ - #let [total_vars method_vars] - [name arg_decls] (s.form (p.and s.local_identifier - (..arg_decls^ total_vars))) - return_type (..generic_type^ total_vars) - exs (..throws_decl^ total_vars) - annotations ..annotations^ - body s.any] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#StaticMethod strict_fp? method_vars arg_decls return_type body exs)])))) + (<code>.form (do <>.monad + [pm privacy_modifier^ + strict_fp? (<>.parses? (<code>.this! (' #strict))) + _ (<code>.this! (' #static)) + method_vars ..type_params^ + #let [total_vars method_vars] + [name arg_decls] (<code>.form (<>.and <code>.local_identifier + (..arg_decls^ total_vars))) + return_type (..generic_type^ total_vars) + exs (..throws_decl^ total_vars) + annotations ..annotations^ + body <code>.any] + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#StaticMethod strict_fp? method_vars arg_decls return_type body exs)])))) (def: abstract_method_def^ (Parser [Member_Declaration Method_Definition]) - (s.form (do p.monad - [pm privacy_modifier^ - _ (s.this! (' #abstract)) - method_vars ..type_params^ - #let [total_vars method_vars] - [name arg_decls] (s.form (p.and s.local_identifier - (..arg_decls^ total_vars))) - return_type (..generic_type^ total_vars) - exs (..throws_decl^ total_vars) - annotations ..annotations^] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#AbstractMethod method_vars arg_decls return_type exs)])))) + (<code>.form (do <>.monad + [pm privacy_modifier^ + _ (<code>.this! (' #abstract)) + method_vars ..type_params^ + #let [total_vars method_vars] + [name arg_decls] (<code>.form (<>.and <code>.local_identifier + (..arg_decls^ total_vars))) + return_type (..generic_type^ total_vars) + exs (..throws_decl^ total_vars) + annotations ..annotations^] + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#AbstractMethod method_vars arg_decls return_type exs)])))) (def: native_method_def^ (Parser [Member_Declaration Method_Definition]) - (s.form (do p.monad - [pm privacy_modifier^ - _ (s.this! (' #native)) - method_vars ..type_params^ - #let [total_vars method_vars] - [name arg_decls] (s.form (p.and s.local_identifier - (..arg_decls^ total_vars))) - return_type (..generic_type^ total_vars) - exs (..throws_decl^ total_vars) - annotations ..annotations^] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#NativeMethod method_vars arg_decls return_type exs)])))) + (<code>.form (do <>.monad + [pm privacy_modifier^ + _ (<code>.this! (' #native)) + method_vars ..type_params^ + #let [total_vars method_vars] + [name arg_decls] (<code>.form (<>.and <code>.local_identifier + (..arg_decls^ total_vars))) + return_type (..generic_type^ total_vars) + exs (..throws_decl^ total_vars) + annotations ..annotations^] + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#NativeMethod method_vars arg_decls return_type exs)])))) (def: (method_def^ class_vars) (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition])) - ($_ p.either + ($_ <>.either (..constructor_method^ class_vars) (..virtual_method_def^ class_vars) ..overriden_method_def^ @@ -836,106 +836,106 @@ (def: partial_call^ (Parser Partial_Call) - (s.form (p.and s.identifier (p.some s.any)))) + (<code>.form (<>.and <code>.identifier (<>.some <code>.any)))) (def: class_kind^ (Parser Class_Kind) - (p.either (do p.monad - [_ (s.this! (' #class))] - (wrap #Class)) - (do p.monad - [_ (s.this! (' #interface))] - (wrap #Interface)) - )) + (<>.either (do <>.monad + [_ (<code>.this! (' #class))] + (wrap #Class)) + (do <>.monad + [_ (<code>.this! (' #interface))] + (wrap #Interface)) + )) (def: import_member_alias^ (Parser (Maybe Text)) - (p.maybe (do p.monad - [_ (s.this! (' #as))] - s.local_identifier))) + (<>.maybe (do <>.monad + [_ (<code>.this! (' #as))] + <code>.local_identifier))) (def: (import_member_args^ type_vars) (-> (List Type_Parameter) (Parser (List [Bit GenericType]))) - (s.tuple (p.some (p.and (p.parses? (s.this! (' #?))) (..generic_type^ type_vars))))) + (<code>.tuple (<>.some (<>.and (<>.parses? (<code>.this! (' #?))) (..generic_type^ type_vars))))) (def: import_member_return_flags^ (Parser [Bit Bit Bit]) - ($_ p.and (p.parses? (s.this! (' #io))) (p.parses? (s.this! (' #try))) (p.parses? (s.this! (' #?))))) + ($_ <>.and (<>.parses? (<code>.this! (' #io))) (<>.parses? (<code>.this! (' #try))) (<>.parses? (<code>.this! (' #?))))) (def: primitive_mode^ (Parser Primitive_Mode) - (p.or (s.this! (' #manual)) - (s.this! (' #auto)))) + (<>.or (<code>.this! (' #manual)) + (<code>.this! (' #auto)))) (def: (import_member_decl^ owner_vars) (-> (List Type_Parameter) (Parser Import_Member_Declaration)) - ($_ p.either - (s.form (do p.monad - [_ (s.this! (' #enum)) - enum_members (p.some s.local_identifier)] - (wrap (#EnumDecl enum_members)))) - (s.form (do p.monad - [tvars ..type_params^ - _ (s.this! (' new)) - ?alias import_member_alias^ - #let [total_vars (list\compose owner_vars tvars)] - ?prim_mode (p.maybe primitive_mode^) - args (..import_member_args^ total_vars) - [io? try? maybe?] import_member_return_flags^] - (wrap (#ConstructorDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) - #import_member_alias (maybe.default "new" ?alias) - #import_member_kind #VirtualIMK + ($_ <>.either + (<code>.form (do <>.monad + [_ (<code>.this! (' #enum)) + enum_members (<>.some <code>.local_identifier)] + (wrap (#EnumDecl enum_members)))) + (<code>.form (do <>.monad + [tvars ..type_params^ + _ (<code>.this! (' new)) + ?alias import_member_alias^ + #let [total_vars (list\compose owner_vars tvars)] + ?prim_mode (<>.maybe primitive_mode^) + args (..import_member_args^ total_vars) + [io? try? maybe?] import_member_return_flags^] + (wrap (#ConstructorDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) + #import_member_alias (maybe.default "new" ?alias) + #import_member_kind #VirtualIMK + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?} + {}])) + )) + (<code>.form (do <>.monad + [kind (: (Parser ImportMethodKind) + (<>.or (<code>.this! (' #static)) + (wrap []))) + tvars ..type_params^ + name <code>.local_identifier + ?alias import_member_alias^ + #let [total_vars (list\compose owner_vars tvars)] + ?prim_mode (<>.maybe primitive_mode^) + args (..import_member_args^ total_vars) + [io? try? maybe?] import_member_return_flags^ + return (..generic_type^ total_vars)] + (wrap (#MethodDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) + #import_member_alias (maybe.default name ?alias) + #import_member_kind kind #import_member_tvars tvars #import_member_args args #import_member_maybe? maybe? #import_member_try? try? #import_member_io? io?} - {}])) - )) - (s.form (do p.monad - [kind (: (Parser ImportMethodKind) - (p.or (s.this! (' #static)) - (wrap []))) - tvars ..type_params^ - name s.local_identifier - ?alias import_member_alias^ - #let [total_vars (list\compose owner_vars tvars)] - ?prim_mode (p.maybe primitive_mode^) - args (..import_member_args^ total_vars) - [io? try? maybe?] import_member_return_flags^ - return (..generic_type^ total_vars)] - (wrap (#MethodDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) - #import_member_alias (maybe.default name ?alias) - #import_member_kind kind - #import_member_tvars tvars - #import_member_args args - #import_member_maybe? maybe? - #import_member_try? try? - #import_member_io? io?} - {#import_method_name name - #import_method_return return - }])))) - (s.form (do p.monad - [static? (p.parses? (s.this! (' #static))) - name s.local_identifier - ?prim_mode (p.maybe primitive_mode^) - gtype (..generic_type^ owner_vars) - maybe? (p.parses? (s.this! (' #?))) - setter? (p.parses? (s.this! (' #!)))] - (wrap (#FieldAccessDecl {#import_field_mode (maybe.default #AutoPrM ?prim_mode) - #import_field_name name - #import_field_static? static? - #import_field_maybe? maybe? - #import_field_setter? setter? - #import_field_type gtype})))) + {#import_method_name name + #import_method_return return + }])))) + (<code>.form (do <>.monad + [static? (<>.parses? (<code>.this! (' #static))) + name <code>.local_identifier + ?prim_mode (<>.maybe primitive_mode^) + gtype (..generic_type^ owner_vars) + maybe? (<>.parses? (<code>.this! (' #?))) + setter? (<>.parses? (<code>.this! (' #!)))] + (wrap (#FieldAccessDecl {#import_field_mode (maybe.default #AutoPrM ?prim_mode) + #import_field_name name + #import_field_static? static? + #import_field_maybe? maybe? + #import_field_setter? setter? + #import_field_type gtype})))) )) (def: bundle (-> (List Type_Parameter) (Parser [Text (List Import_Member_Declaration)])) (|>> ..import_member_decl^ - p.some - (p.and s.text) - s.tuple)) + <>.some + (<>.and <code>.text) + <code>.tuple)) ## Generators (def: with_parens @@ -1091,16 +1091,16 @@ (~ body)))))))) (#OverridenMethod strict_fp? class_decl type_vars this_name arg_decls return_type body exs) - (let [super_replacer (parser->replacer (s.form (do p.monad - [_ (s.this! (' ::super!)) - args (s.tuple (p.exactly (list.size arg_decls) s.any)) - #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ (list))) - arg_decls))]] - (wrap (`' ((~ (code.text (format "jvm invokespecial" - ":" (get@ #super_class_name super_class) - ":" name - ":" (text.join_with "," arg_decls')))) - (~' _jvm_this) (~+ args)))))))] + (let [super_replacer (parser->replacer (<code>.form (do <>.monad + [_ (<code>.this! (' ::super!)) + args (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any)) + #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ (list))) + arg_decls))]] + (wrap (`' ((~ (code.text (format "jvm invokespecial" + ":" (get@ #super_class_name super_class) + ":" name + ":" (text.join_with "," arg_decls')))) + (~' _jvm_this) (~+ args)))))))] (with_parens (spaced (list "override" (class_decl$ class_decl) @@ -1169,13 +1169,13 @@ {class_decl ..class_decl^} {#let [full_class_name (product.left class_decl)]} {#let [class_vars (product.right class_decl)]} - {super (p.default object_super_class - (..super_class_decl^ class_vars))} - {interfaces (p.default (list) - (s.tuple (p.some (..super_class_decl^ class_vars))))} + {super (<>.default object_super_class + (..super_class_decl^ class_vars))} + {interfaces (<>.default (list) + (<code>.tuple (<>.some (..super_class_decl^ class_vars))))} {annotations ..annotations^} - {fields (p.some (..field_decl^ class_vars))} - {methods (p.some (..method_def^ class_vars))}) + {fields (<>.some (..field_decl^ class_vars))} + {methods (<>.some (..method_def^ class_vars))}) {#.doc (doc "Allows defining JVM classes in Lux code." "For example:" (class: #final (TestClass A) [Runnable] @@ -1211,8 +1211,8 @@ #let [fully_qualified_class_name (format (sanitize current_module) "." full_class_name) field_parsers (list\map (field->parser fully_qualified_class_name) fields) method_parsers (list\map (method->parser (product.right class_decl) fully_qualified_class_name) methods) - replacer (parser->replacer (list\fold p.either - (p.fail "") + replacer (parser->replacer (list\fold <>.either + (<>.fail "") (list\compose field_parsers method_parsers))) def_code (format "jvm class:" (spaced (list (class_decl$ class_decl) @@ -1227,10 +1227,10 @@ (syntax: #export (interface: {class_decl ..class_decl^} {#let [class_vars (product.right class_decl)]} - {supers (p.default (list) - (s.tuple (p.some (..super_class_decl^ class_vars))))} + {supers (<>.default (list) + (<code>.tuple (<>.some (..super_class_decl^ class_vars))))} {annotations ..annotations^} - {members (p.some (..method_decl^ class_vars))}) + {members (<>.some (..method_decl^ class_vars))}) {#.doc (doc "Allows defining JVM interfaces." (interface: TestInterface ([] foo [boolean String] void #throws [Exception])))} @@ -1243,13 +1243,13 @@ )) (syntax: #export (object - {class_vars (s.tuple (p.some ..type_param^))} - {super (p.default object_super_class - (..super_class_decl^ class_vars))} - {interfaces (p.default (list) - (s.tuple (p.some (..super_class_decl^ class_vars))))} + {class_vars (<code>.tuple (<>.some ..type_param^))} + {super (<>.default object_super_class + (..super_class_decl^ class_vars))} + {interfaces (<>.default (list) + (<code>.tuple (<>.some (..super_class_decl^ class_vars))))} {constructor_args (..constructor_args^ class_vars)} - {methods (p.some ..overriden_method_def^)}) + {methods (<>.some ..overriden_method_def^)}) {#.doc (doc "Allows defining anonymous classes." "The 1st tuple corresponds to class-level type-variables." "The 2nd tuple corresponds to parent interfaces." @@ -1319,7 +1319,7 @@ (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) (syntax: #export (check {class (..generic_type^ (list))} - {unchecked (p.maybe s.any)}) + {unchecked (<>.maybe <code>.any)}) {#.doc (doc "Checks whether an object is an instance of a particular class." "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes." (case (check java/lang/String "YOLO") @@ -1353,11 +1353,11 @@ (finish_the_computation ___))))} (wrap (list (` ("jvm object synchronized" (~ lock) (~ body)))))) -(syntax: #export (do_to obj {methods (p.some partial_call^)}) +(syntax: #export (do_to obj {methods (<>.some partial_call^)}) {#.doc (doc "Call a variety of methods on an object. Then, return the object." (do_to object - (ClassName::method1 arg0 arg1 arg2) - (ClassName::method2 arg3 arg4 arg5)))} + (ClassName::method1 arg0 arg1 arg2) + (ClassName::method2 arg3 arg4 arg5)))} (with_gensyms [g!obj] (wrap (list (` (let [(~ g!obj) (~ obj)] (exec (~+ (list\map (complete_call$ g!obj) methods)) @@ -1660,7 +1660,7 @@ (syntax: #export (import: {class_decl ..class_decl^} - {bundles (p.some (..bundle (product.right class_decl)))}) + {bundles (<>.some (..bundle (product.right class_decl)))}) {#.doc (doc "Allows importing JVM classes, and using them as types." "Their methods, fields and enum options can also be imported." (import: java/lang/Object diff --git a/stdlib/source/lux/ffi.php.lux b/stdlib/source/lux/ffi.php.lux index ac0daf9c5..e26464f7a 100644 --- a/stdlib/source/lux/ffi.php.lux +++ b/stdlib/source/lux/ffi.php.lux @@ -12,7 +12,7 @@ ["." product] ["." maybe] ["." text - ["%" format (#+ format)]] + ["%" format]] [collection ["." list ("#\." functor fold)]]] [type @@ -164,7 +164,7 @@ (.error! "Null is an invalid value!")))))) (type: Import - (#Class Text (Maybe Alias) (List Member)) + (#Class Text (Maybe Alias) Text (List Member)) (#Function Static_Method) (#Constant Field)) @@ -174,7 +174,9 @@ ($_ <>.and <code>.local_identifier (<>.maybe ..alias) - (<>.some member)) + (<>.default ["" (list)] + (<code>.tuple (<>.and <code>.text + (<>.some member))))) (<code>.form ..common_method) ..constant )) @@ -232,10 +234,14 @@ (syntax: #export (import: {import ..import}) (with_gensyms [g!temp] (case import - (#Class [class alias members]) + (#Class [class alias format members]) (with_gensyms [g!object] (let [qualify (: (-> Text Code) - (|>> (format (maybe.default class alias) "::") code.local_identifier)) + (function (_ member_name) + (|> format + (text.replace_all "#" (maybe.default class alias)) + (text.replace_all "." member_name) + code.local_identifier))) g!type (code.local_identifier (maybe.default class alias)) class_import (` ("php constant" (~ (code.text class))))] (wrap (list& (` (type: (~ g!type) @@ -247,7 +253,7 @@ (` ((~! syntax:) ((~ (qualify (maybe.default field alias)))) (\ (~! meta.monad) (~' wrap) (list (` (.:coerce (~ (nullable_type fieldT)) - ("php constant" (~ (code.text (format class "::" field)))))))))) + ("php constant" (~ (code.text (%.format class "::" field)))))))))) (` (def: ((~ (qualify field)) (~ g!object)) (-> (~ g!type) @@ -263,7 +269,7 @@ g!temp (` ("php object get" (~ (code.text method)) (:coerce (..Object .Any) - ("php constant" (~ (code.text (format class "::" method))))))) + ("php constant" (~ (code.text (%.format class "::" method))))))) inputsT io? try? diff --git a/stdlib/source/lux/ffi.py.lux b/stdlib/source/lux/ffi.py.lux index ed67b3705..865683dc6 100644 --- a/stdlib/source/lux/ffi.py.lux +++ b/stdlib/source/lux/ffi.py.lux @@ -7,12 +7,12 @@ [control ["." io] ["<>" parser - ["<c>" code (#+ Parser)]]] + ["<code>" code (#+ Parser)]]] [data ["." product] ["." maybe] ["." text - ["%" format (#+ format)]] + ["%" format]] [collection ["." list ("#\." functor fold)]]] [type @@ -51,31 +51,31 @@ (def: noneable (Parser Noneable) (let [token (' #?)] - (<| (<>.and (<>.parses? (<c>.this! token))) - (<>.after (<>.not (<c>.this! token))) - <c>.any))) + (<| (<>.and (<>.parses? (<code>.this! token))) + (<>.after (<>.not (<code>.this! token))) + <code>.any))) (type: Constructor (List Noneable)) (def: constructor (Parser Constructor) - (<c>.form (<>.after (<c>.this! (' new)) - (<c>.tuple (<>.some ..noneable))))) + (<code>.form (<>.after (<code>.this! (' new)) + (<code>.tuple (<>.some ..noneable))))) (type: Field [Bit Text Noneable]) (def: static! (Parser Any) - (<c>.this! (' #static))) + (<code>.this! (' #static))) (def: field (Parser Field) - (<c>.form ($_ <>.and - (<>.parses? ..static!) - <c>.local_identifier - ..noneable))) + (<code>.form ($_ <>.and + (<>.parses? ..static!) + <code>.local_identifier + ..noneable))) (type: Common_Method {#name Text @@ -95,11 +95,11 @@ (def: common_method (Parser Common_Method) ($_ <>.and - <c>.local_identifier - (<>.maybe (<>.after (<c>.this! (' #as)) <c>.local_identifier)) - (<c>.tuple (<>.some ..noneable)) - (<>.parses? (<c>.this! (' #io))) - (<>.parses? (<c>.this! (' #try))) + <code>.local_identifier + (<>.maybe (<>.after (<code>.this! (' #as)) <code>.local_identifier)) + (<code>.tuple (<>.some ..noneable)) + (<>.parses? (<code>.this! (' #io))) + (<>.parses? (<code>.this! (' #try))) ..noneable)) (def: static_method @@ -107,8 +107,8 @@ (def: method (Parser Method) - (<c>.form (<>.or ..static_method - ..common_method))) + (<code>.form (<>.or ..static_method + ..common_method))) (type: Member (#Constructor Constructor) @@ -159,16 +159,16 @@ (.error! "None is an invalid value!")))))) (type: Import - (#Class [Text (List Member)]) + (#Class [Text Text (List Member)]) (#Function Static_Method)) (def: import - ($_ <>.or - ($_ <>.and - <c>.local_identifier - (<>.some member)) - (<c>.form ..common_method) - )) + (Parser Import) + (<>.or (<>.and <code>.local_identifier + (<>.default ["" (list)] + (<code>.tuple (<>.and <code>.text + (<>.some member))))) + (<code>.form ..common_method))) (syntax: #export (try expression) {#.doc (doc (case (try (risky_computation input)) @@ -223,10 +223,14 @@ (syntax: #export (import: {import ..import}) (with_gensyms [g!temp] (case import - (#Class [class members]) + (#Class [class format members]) (with_gensyms [g!object] (let [qualify (: (-> Text Code) - (|>> (format class "::") code.local_identifier)) + (function (_ member_name) + (|> format + (text.replace_all "#" class) + (text.replace_all "." member_name) + code.local_identifier))) g!type (code.local_identifier class) real_class (text.replace_all "/" "." class) imported (case (text.split_all_with "/" class) diff --git a/stdlib/source/lux/ffi.rb.lux b/stdlib/source/lux/ffi.rb.lux index 63f14e8a3..5e980a41d 100644 --- a/stdlib/source/lux/ffi.rb.lux +++ b/stdlib/source/lux/ffi.rb.lux @@ -12,7 +12,7 @@ ["." product] ["." maybe] ["." text - ["%" format (#+ format)]] + ["%" format]] [collection ["." list ("#\." functor fold)]]] [type @@ -164,7 +164,7 @@ (.error! "Nil is an invalid value!")))))) (type: Import - (#Class Text (Maybe Alias) (List Member)) + (#Class Text (Maybe Alias) Text (List Member)) (#Function Static_Method) (#Constant Field)) @@ -176,7 +176,9 @@ ($_ <>.and <code>.local_identifier (<>.maybe ..alias) - (<>.some member)) + (<>.default ["" (list)] + (<code>.tuple (<>.and <code>.text + (<>.some member))))) (<code>.form ..common_method) ..constant ))) @@ -234,10 +236,14 @@ (syntax: #export (import: {[?module import] ..import}) (with_gensyms [g!temp] (case import - (#Class [class alias members]) + (#Class [class alias format members]) (with_gensyms [g!object] (let [qualify (: (-> Text Code) - (|>> (format (maybe.default class alias) "::") code.local_identifier)) + (function (_ member_name) + (|> format + (text.replace_all "#" (maybe.default class alias)) + (text.replace_all "." member_name) + code.local_identifier))) g!type (code.local_identifier (maybe.default class alias)) module_import (: (List Code) (case ?module @@ -258,7 +264,7 @@ (list (` (.:coerce (~ (nilable_type fieldT)) (.exec (~+ module_import) - ("ruby constant" (~ (code.text (format class "::" field))))))))))) + ("ruby constant" (~ (code.text (%.format class "::" field))))))))))) (` (def: ((~ (qualify field)) (~ g!object)) (-> (~ g!type) @@ -276,7 +282,7 @@ (:coerce (..Object .Any) (.exec (~+ module_import) - ("ruby constant" (~ (code.text (format class "::" method)))))))) + ("ruby constant" (~ (code.text (%.format class "::" method)))))))) inputsT io? try? diff --git a/stdlib/source/lux/math/number/complex.lux b/stdlib/source/lux/math/number/complex.lux index 32c14f74e..3da5071b0 100644 --- a/stdlib/source/lux/math/number/complex.lux +++ b/stdlib/source/lux/math/number/complex.lux @@ -227,9 +227,10 @@ (-> Frac Frac Frac) (f.* (f.signum sign) magnitude)) -(def: #export (root/2 (^@ input (^slots [#real #imaginary]))) +(def: #export (root/2 input) (-> Complex Complex) - (let [t (|> input ..abs (f.+ (f.abs real)) (f./ +2.0) (math.pow +0.5))] + (let [(^slots [#real #imaginary]) input + t (|> input ..abs (f.+ (f.abs real)) (f./ +2.0) (math.pow +0.5))] (if (f.>= +0.0 real) {#real t #imaginary (f./ (f.* +2.0 t) @@ -260,25 +261,25 @@ (def: #export (acos input) (-> Complex Complex) (|> input - (+ (|> input ..root/2-1z (* i))) - log - (* (negate i)))) + (..+ (|> input ..root/2-1z (..* ..i))) + ..log + (..* (..negate ..i)))) (def: #export (asin input) (-> Complex Complex) (|> input ..root/2-1z - (+ (* i input)) - log - (* (negate i)))) + (..+ (..* ..i input)) + ..log + (..* (..negate ..i)))) (def: #export (atan input) (-> Complex Complex) (|> input - (+ i) - (/ (- input i)) - log - (* (/ (complex +2.0) i)))) + (..+ ..i) + (../ (..- input ..i)) + ..log + (..* (../ (..complex +2.0) ..i)))) (def: #export (argument (^slots [#real #imaginary])) (-> Complex Frac) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 928e90506..4cf486c43 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -154,21 +154,43 @@ (exception: #export must_try_test_at_least_once) -(def: #export (times amount test) - (-> Nat Test Test) +## TODO: Figure out why tests sometimes freeze and fix it. Delete "times'" afterwards. +(def: (times' millis_time_out amount test) + (-> (Maybe Nat) Nat Test Test) (case amount 0 (..fail (exception.construct ..must_try_test_at_least_once [])) _ (do random.monad [seed random.nat] - (function (_ prng) + (function (recur prng) (let [[prng' instance] (random.run (random.pcg32 [..pcg32_magic_inc seed]) test)] - [prng' (do promise.monad - [[tally documentation] instance] - (if (failed? tally) - (wrap [tally (times_failure seed documentation)]) - (case amount - 1 instance - _ (|> test (times (dec amount)) (random.run prng') product.right))))]))))) + [prng' (do {! promise.monad} + [outcome (case millis_time_out + (#.Some millis_time_out) + (promise.time_out millis_time_out instance) + + #.None + (do ! + [output instance] + (wrap (#.Some output))))] + (case outcome + (#.Some [tally documentation]) + (if (failed? tally) + (wrap [tally (times_failure seed documentation)]) + (case amount + 1 instance + _ (|> test + (times' millis_time_out (dec amount)) + (random.run prng') + product.right))) + + #.None + (exec + ("lux io log" "Time-out reached! Retrying tests...") + (product.right (recur prng)))))]))))) + +(def: #export times + (-> Nat Test Test) + (..times' #.None)) (def: (description duration tally) (-> Duration Tally Text) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 4658c75d4..25df6407c 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -162,7 +162,7 @@ (:coerce Frac) "lux f64 i64")) @.python (let [time ("python import" "time")] - (|> ("python object do" "time" time []) + (|> ("python object do" "time" time) (:coerce Frac) (f.* +1,000.0) "lux f64 i64")) @@ -171,8 +171,8 @@ (:coerce Int) (i.* +1,000)) @.ruby (let [% ("ruby constant" "Time") - % ("ruby object do" % "now")] - (|> ("ruby object do" % "to_f") + % ("ruby object do" "now" %)] + (|> ("ruby object do" "to_f" %) (:coerce Frac) (f.* +1,000.0) "lux f64 i64")) 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 860badea3..d36dcd1ef 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 @@ -1,6 +1,6 @@ (.module: [lux #* - ["." host] + ["." ffi] [abstract ["." monad (#+ do)]] [control @@ -198,7 +198,7 @@ [#let [inputT (type.tuple (list.repeat arity Any))] abstractionA (analysis/type.with_type (-> inputT Any) (phase archive abstractionC)) - _ (analysis/type.infer (for {@.js host.Function} + _ (analysis/type.infer (for {@.js ffi.Function} Any))] (wrap (#analysis.Extension extension (list (analysis.nat arity) abstractionA)))))])) 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 99154e105..8f97d1ba9 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 @@ -1,11 +1,11 @@ (.module: [lux #* - ["." host] + ["." ffi] [abstract ["." monad (#+ do)]] [control ["<>" parser - ["<c>" code (#+ Parser)]]] + ["<.>" code (#+ Parser)]]] [data [collection ["." array (#+ Array)] @@ -28,21 +28,21 @@ ["." phase]]]]]]) (def: Nil - (for {@.lua host.Nil} + (for {@.lua ffi.Nil} Any)) (def: Object - (for {@.lua (type (host.Object Any))} + (for {@.lua (type (ffi.Object Any))} Any)) (def: Function - (for {@.lua host.Function} + (for {@.lua ffi.Function} Any)) (def: array::new Handler (custom - [<c>.any + [<code>.any (function (_ extension phase archive lengthC) (do phase.monad [lengthA (analysis/type.with_type Nat @@ -54,7 +54,7 @@ (def: array::length Handler (custom - [<c>.any + [<code>.any (function (_ extension phase archive arrayC) (do phase.monad [[var_id varT] (analysis/type.with_env check.var) @@ -66,7 +66,7 @@ (def: array::read Handler (custom - [(<>.and <c>.any <c>.any) + [(<>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) (do phase.monad [indexA (analysis/type.with_type Nat @@ -80,7 +80,7 @@ (def: array::write Handler (custom - [($_ <>.and <c>.any <c>.any <c>.any) + [($_ <>.and <code>.any <code>.any <code>.any) (function (_ extension phase archive [indexC valueC arrayC]) (do phase.monad [indexA (analysis/type.with_type Nat @@ -96,7 +96,7 @@ (def: array::delete Handler (custom - [($_ <>.and <c>.any <c>.any) + [($_ <>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) (do phase.monad [indexA (analysis/type.with_type Nat @@ -121,7 +121,7 @@ (def: object::get Handler (custom - [($_ <>.and <c>.text <c>.any) + [($_ <>.and <code>.text <code>.any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad [objectA (analysis/type.with_type ..Object @@ -133,7 +133,7 @@ (def: object::do Handler (custom - [($_ <>.and <c>.text <c>.any (<>.some <c>.any)) + [($_ <>.and <code>.text <code>.any (<>.some <code>.any)) (function (_ extension phase archive [methodC objectC inputsC]) (do {! phase.monad} [objectA (analysis/type.with_type ..Object @@ -158,7 +158,7 @@ [(def: <name> Handler (custom - [<c>.any + [<code>.any (function (_ extension phase archive inputC) (do {! phase.monad} [inputA (analysis/type.with_type (type <fromT>) @@ -181,7 +181,7 @@ (def: lua::constant Handler (custom - [<c>.text + [<code>.text (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer Any)] @@ -190,7 +190,7 @@ (def: lua::apply Handler (custom - [($_ <>.and <c>.any (<>.some <c>.any)) + [($_ <>.and <code>.any (<>.some <code>.any)) (function (_ extension phase archive [abstractionC inputsC]) (do {! phase.monad} [abstractionA (analysis/type.with_type ..Function @@ -202,7 +202,7 @@ (def: lua::power Handler (custom - [($_ <>.and <c>.any <c>.any) + [($_ <>.and <code>.any <code>.any) (function (_ extension phase archive [powerC baseC]) (do {! phase.monad} [powerA (analysis/type.with_type Frac @@ -215,7 +215,7 @@ (def: lua::import Handler (custom - [<c>.text + [<code>.text (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer ..Object)] @@ -224,7 +224,7 @@ (def: lua::function Handler (custom - [($_ <>.and <c>.nat <c>.any) + [($_ <>.and <code>.nat <code>.any) (function (_ extension phase archive [arity abstractionC]) (do phase.monad [#let [inputT (type.tuple (list.repeat arity Any))] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux index 78e1a4f5a..53e6c0b05 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux @@ -1,11 +1,11 @@ (.module: [lux #* - ["." host] + ["." ffi] [abstract ["." monad (#+ do)]] [control ["<>" parser - ["<c>" code (#+ Parser)]]] + ["<.>" code (#+ Parser)]]] [data [collection ["." array (#+ Array)] @@ -30,7 +30,7 @@ (def: array::new Handler (custom - [<c>.any + [<code>.any (function (_ extension phase archive lengthC) (do phase.monad [lengthA (analysis/type.with_type Nat @@ -42,7 +42,7 @@ (def: array::length Handler (custom - [<c>.any + [<code>.any (function (_ extension phase archive arrayC) (do phase.monad [[var_id varT] (analysis/type.with_env check.var) @@ -54,7 +54,7 @@ (def: array::read Handler (custom - [(<>.and <c>.any <c>.any) + [(<>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) (do phase.monad [indexA (analysis/type.with_type Nat @@ -68,7 +68,7 @@ (def: array::write Handler (custom - [($_ <>.and <c>.any <c>.any <c>.any) + [($_ <>.and <code>.any <code>.any <code>.any) (function (_ extension phase archive [indexC valueC arrayC]) (do phase.monad [indexA (analysis/type.with_type Nat @@ -84,7 +84,7 @@ (def: array::delete Handler (custom - [($_ <>.and <c>.any <c>.any) + [($_ <>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) (do phase.monad [indexA (analysis/type.with_type Nat @@ -108,25 +108,25 @@ (def: None (for {@.python - host.None} + ffi.None} Any)) (def: Object - (for {@.python (type (host.Object Any))} + (for {@.python (type (ffi.Object Any))} Any)) (def: Function - (for {@.python host.Function} + (for {@.python ffi.Function} Any)) (def: Dict - (for {@.python host.Dict} + (for {@.python ffi.Dict} Any)) (def: object::get Handler (custom - [($_ <>.and <c>.text <c>.any) + [($_ <>.and <code>.text <code>.any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad [objectA (analysis/type.with_type ..Object @@ -138,7 +138,7 @@ (def: object::do Handler (custom - [($_ <>.and <c>.text <c>.any (<>.some <c>.any)) + [($_ <>.and <code>.text <code>.any (<>.some <code>.any)) (function (_ extension phase archive [methodC objectC inputsC]) (do {! phase.monad} [objectA (analysis/type.with_type ..Object @@ -162,7 +162,7 @@ (def: python::constant Handler (custom - [<c>.text + [<code>.text (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer Any)] @@ -171,7 +171,7 @@ (def: python::import Handler (custom - [<c>.text + [<code>.text (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer ..Object)] @@ -180,7 +180,7 @@ (def: python::apply Handler (custom - [($_ <>.and <c>.any (<>.some <c>.any)) + [($_ <>.and <code>.any (<>.some <code>.any)) (function (_ extension phase archive [abstractionC inputsC]) (do {! phase.monad} [abstractionA (analysis/type.with_type ..Function @@ -192,7 +192,7 @@ (def: python::function Handler (custom - [($_ <>.and <c>.nat <c>.any) + [($_ <>.and <code>.nat <code>.any) (function (_ extension phase archive [arity abstractionC]) (do phase.monad [#let [inputT (type.tuple (list.repeat arity Any))] @@ -205,7 +205,7 @@ (def: python::exec Handler (custom - [($_ <>.and <c>.any <c>.any) + [($_ <>.and <code>.any <code>.any) (function (_ extension phase archive [codeC globalsC]) (do phase.monad [codeA (analysis/type.with_type Text diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux index 8bbd32b3c..0fda869e9 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux @@ -1,6 +1,6 @@ (.module: [lux #* - ["." host] + ["." ffi] [abstract ["." monad (#+ do)]] [control @@ -107,15 +107,15 @@ ))) (def: Nil - (for {@.ruby host.Nil} + (for {@.ruby ffi.Nil} Any)) (def: Object - (for {@.ruby (type (host.Object Any))} + (for {@.ruby (type (ffi.Object Any))} Any)) (def: Function - (for {@.ruby host.Function} + (for {@.ruby ffi.Function} Any)) (def: object::get 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 4d403e22e..660ac4991 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 @@ -118,5 +118,5 @@ @self)))))))) ))] _ (/////generation.execute! definition) - _ (/////generation.save! (%.nat (product.right function_name)) definition)] + _ (/////generation.save! (product.right function_name) definition)] (wrap instantiation))) 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 5a4375dad..c307f4302 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 @@ -11,7 +11,8 @@ ["." product] ["." text ("#\." hash) ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] [collection ["." list ("#\." functor)] ["." row]]] @@ -33,12 +34,12 @@ ["//#" /// #_ ["#." synthesis (#+ Synthesis)] ["#." generation] - ["//#" /// (#+ Output) + ["//#" /// ["#." phase] [reference [variable (#+ Register)]] [meta - [archive (#+ Archive) + [archive (#+ Output Archive) ["." artifact (#+ Registry)]]]]]]) (template [<name> <base>] @@ -60,10 +61,6 @@ (type: #export (Generator! i) (-> Phase! Phase Archive i (Operation Statement))) -(def: prefix - Text - "LuxRuntime") - (def: #export high (-> (I64 Any) (I64 Any)) (i64.right_shift 32)) @@ -770,19 +767,18 @@ runtime//lux )) -(def: #export artifact - Text - ..prefix) +(def: module_id + 0) (def: #export generate (Operation [Registry Output]) (do ///////phase.monad [_ (/////generation.execute! ..runtime) - _ (/////generation.save! "0" ..runtime)] + _ (/////generation.save! ..module_id ..runtime)] (wrap [(|> artifact.empty artifact.resource product.right) - (row.row ["0" + (row.row [..module_id (|> ..runtime _.code - (\ encoding.utf8 encode))])]))) + (\ utf8.codec encode))])]))) 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 4d3253d48..55490d3f2 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 @@ -132,5 +132,5 @@ (_.apply/1 @self)))))))) ))] _ (/////generation.execute! definition) - _ (/////generation.save! (%.nat (product.right function_name)) definition)] + _ (/////generation.save! (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 46fa94dd2..e95fc0f49 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 @@ -107,7 +107,7 @@ )) (|> @context (_.apply/* foreigns))])))] _ (/////generation.execute! directive) - _ (/////generation.save! (%.nat artifact_id) directive)] + _ (/////generation.save! artifact_id directive)] (wrap (|> instantiation (_.apply/* initsO+)))))) (def: #export (recur! statement expression archive argsS+) 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 fd1cfa2b4..0da87ff6a 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 @@ -11,7 +11,8 @@ ["." product] ["." text ("#\." hash) ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] [collection ["." list ("#\." functor)] ["." row]]] @@ -55,9 +56,6 @@ (type: #export (Generator! i) (-> Phase! Phase Archive i (Operation Statement))) -(def: prefix - "LuxRuntime") - (def: #export unit (_.string /////synthesis.unit)) @@ -419,17 +417,15 @@ ..runtime//array )) -(def: #export artifact ..prefix) - (def: #export generate (Operation [Registry Output]) (do ///////phase.monad [_ (/////generation.execute! ..runtime) - _ (/////generation.save! (%.nat ..module_id) ..runtime)] + _ (/////generation.save! ..module_id ..runtime)] (wrap [(|> artifact.empty artifact.resource product.right) - (row.row [(%.nat ..module_id) + (row.row [..module_id (|> ..runtime _.code - (\ encoding.utf8 encode))])]))) + (\ utf8.codec encode))])]))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux index 202e922c1..23368285c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -313,5 +313,5 @@ directive (_.def @case @dependencies+ pattern_matching!)] _ (/////generation.execute! directive) - _ (/////generation.save! (%.nat case_artifact) directive)] + _ (/////generation.save! case_artifact directive)] (wrap (_.apply/* @case @dependencies+)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux index f2c71eae8..cc670d277 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -47,7 +47,7 @@ #.Nil (do ///////phase.monad [_ (/////generation.execute! function_definition) - _ (/////generation.save! (%.nat function_id) function_definition)] + _ (/////generation.save! function_id function_definition)] (wrap @function)) _ @@ -59,7 +59,7 @@ function_definition (_.return @function)))] _ (/////generation.execute! directive) - _ (/////generation.save! (%.nat function_id) directive)] + _ (/////generation.save! function_id directive)] (wrap (_.apply/* @function inits))))) (def: input diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index 83f093001..0f932ee38 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -102,7 +102,7 @@ )) (_.apply/* @loop foreigns)]))] _ (/////generation.execute! directive) - _ (/////generation.save! (%.nat loop_artifact) directive)] + _ (/////generation.save! loop_artifact directive)] (wrap (_.apply/* instantiation initsO+))))) (def: #export (recur! statement expression archive argsS+) 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 f12c8f08b..2345ab763 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 @@ -11,7 +11,8 @@ ["." product] ["." text ("#\." hash) ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] [collection ["." list ("#\." functor)] ["." row]]] @@ -425,19 +426,19 @@ runtime//array )) -(def: #export artifact - ..prefix) +(def: module_id + 0) (def: #export generate (Operation [Registry Output]) (/////generation.with_buffer (do ///////phase.monad [_ (/////generation.execute! ..runtime) - _ (/////generation.save! ..prefix ..runtime)] + _ (/////generation.save! ..module_id ..runtime)] (wrap [(|> artifact.empty artifact.resource product.right) - (row.row ["0" + (row.row [..module_id (|> ..runtime _.code - (\ encoding.utf8 encode))])])))) + (\ utf8.codec encode))])])))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index 21d74f8cd..535453f2e 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -107,5 +107,5 @@ (_.do "concat" (list @missing)))))))))))) )))] _ (/////generation.execute! declaration) - _ (/////generation.save! (%.nat function_artifact) declaration)] + _ (/////generation.save! function_artifact declaration)] (wrap instatiation))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index 01befb892..2eb8ec79c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -11,7 +11,8 @@ ["." product] ["." text ("#\." hash) ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] [collection ["." list ("#\." functor)] ["." row]]] @@ -391,11 +392,11 @@ (Operation [Registry Output]) (do ///////phase.monad [_ (/////generation.execute! ..runtime) - _ (/////generation.save! (%.nat ..module_id) ..runtime)] + _ (/////generation.save! ..module_id ..runtime)] (wrap [(|> artifact.empty artifact.resource product.right) - (row.row [(%.nat ..module_id) + (row.row [..module_id (|> ..runtime _.code - (\ encoding.utf8 encode))])]))) + (\ utf8.codec encode))])]))) diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index b45e32c37..cc4cd3f91 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -1,14 +1,15 @@ ## TODO: Write tests ASAP. (.module: [lux #* + ["." meta] [abstract [monad (#+ Monad do)] [equivalence (#+ Equivalence)] [order (#+ Order)] [enum (#+ Enum)]] [control - ["p" parser - ["s" code (#+ Parser)]]] + ["<>" parser + ["<.>" code (#+ Parser)]]] [data [text ["%" format (#+ format)]]] @@ -19,6 +20,7 @@ ["|.|" annotations]]] [math [number + ["n" nat] ["i" int] ["." ratio (#+ Ratio)]]] [type @@ -27,13 +29,40 @@ (abstract: #export (Qty unit) Int - (def: #export in + (def: in (All [unit] (-> Int (Qty unit))) (|>> :abstraction)) - (def: #export out + (def: out (All [unit] (-> (Qty unit) Int)) - (|>> :representation))) + (|>> :representation)) + + (template [<name> <op>] + [(def: #export (<name> param subject) + (All [unit] (-> (Qty unit) (Qty unit) (Qty unit))) + (:abstraction (<op> (:representation param) + (:representation subject))))] + + [+ i.+] + [- i.-] + ) + + (template [<name> <op> <p> <s> <p*s>] + [(def: #export (<name> param subject) + (All [p s] (-> (Qty <p>) (Qty <s>) (Qty <p*s>))) + (:abstraction (<op> (:representation param) + (:representation subject))))] + + [* i.* p s [p s]] + [/ i./ p [p s] s] + ) + ) + +(signature: #export (Unit a) + (: (-> Int (Qty a)) + in) + (: (-> (Qty a) Int) + out)) (signature: #export (Scale s) (: (All [u] (-> (Qty u) (Qty (s u)))) @@ -44,105 +73,76 @@ ratio)) (type: #export Pure - (Qty [])) - -(type: #export (Per d n) - (-> d n)) - -(type: #export (Inverse u) - (|> Pure (Per u))) - -(type: #export (Product p s) - (|> s (Per (Inverse p)))) + (Qty Any)) (def: #export pure (-> Int Pure) - in) + ..in) -(template [<name> <tag>] - [(def: <name> - (-> Text Text) - (|>> (format "{" kind "@" module "}") - (let [[module kind] (name_of <tag>)])))] - - [unit_name #..Unit] - [scale_name #..Scale] - ) +(def: #export number + (-> Pure Int) + ..out) (syntax: #export (unit: {export |export|.parser} - {name s.local_identifier} - {annotations (p.default |annotations|.empty |annotations|.parser)}) - (wrap (list (` (type: (~+ (|export|.format export)) (~ (code.local_identifier name)) - (~ (|annotations|.format annotations)) - (primitive (~ (code.text (unit_name name)))))) - (` (def: (~+ (|export|.format export)) (~ (code.local_identifier (format "@" name))) - (~ (code.local_identifier name)) - (:assume []))) - ))) - -(def: ratio^ + {type_name <code>.local_identifier} + {unit_name <code>.local_identifier} + {annotations (<>.default |annotations|.empty |annotations|.parser)}) + (do meta.monad + [@ meta.current_module_name + #let [g!type (code.local_identifier type_name)]] + (wrap (list (` (type: (~+ (|export|.format export)) (~ g!type) + (~ (|annotations|.format annotations)) + (primitive (~ (code.text (%.name [@ type_name])))))) + + (` (structure: (~+ (|export|.format export)) (~ (code.local_identifier unit_name)) + (..Unit (~ g!type)) + + (def: (~' in) (~! ..in)) + (def: (~' out) (~! ..out)))) + )))) + +(def: scale (Parser Ratio) - (s.tuple (do p.monad - [numerator s.int - _ (p.assert (format "Numerator must be positive: " (%.int numerator)) - (i.> +0 numerator)) - denominator s.int - _ (p.assert (format "Denominator must be positive: " (%.int denominator)) - (i.> +0 denominator))] - (wrap [(.nat numerator) (.nat denominator)])))) + (<code>.tuple (do <>.monad + [numerator <code>.nat + _ (<>.assert (format "Numerator must be positive: " (%.nat numerator)) + (n.> 0 numerator)) + denominator <code>.nat + _ (<>.assert (format "Denominator must be positive: " (%.nat denominator)) + (n.> 0 denominator))] + (wrap [numerator denominator])))) (syntax: #export (scale: {export |export|.parser} - {name s.local_identifier} - {(^slots [#ratio.numerator #ratio.denominator]) ratio^} - {annotations (p.default |annotations|.empty |annotations|.parser)}) - (let [g!scale (code.local_identifier name)] + {type_name <code>.local_identifier} + {scale_name <code>.local_identifier} + {(^slots [#ratio.numerator #ratio.denominator]) ..scale} + {annotations (<>.default |annotations|.empty |annotations|.parser)}) + (do meta.monad + [@ meta.current_module_name + #let [g!scale (code.local_identifier type_name)]] (wrap (list (` (type: (~+ (|export|.format export)) ((~ g!scale) (~' u)) (~ (|annotations|.format annotations)) - (primitive (~ (code.text (scale_name name))) [(~' u)]))) - (` (structure: (~+ (|export|.format export)) (~ (code.local_identifier (format "@" name))) + (primitive (~ (code.text (%.name [@ type_name]))) [(~' u)]))) + + (` (structure: (~+ (|export|.format export)) (~ (code.local_identifier scale_name)) (..Scale (~ g!scale)) (def: (~' scale) - (|>> ..out + (|>> ((~! ..out)) (i.* (~ (code.int (.int numerator)))) (i./ (~ (code.int (.int denominator)))) - ..in)) + ((~! ..in)))) (def: (~' de_scale) - (|>> ..out + (|>> ((~! ..out)) (i.* (~ (code.int (.int denominator)))) (i./ (~ (code.int (.int numerator)))) - ..in)) + ((~! ..in)))) (def: (~' ratio) [(~ (code.nat numerator)) (~ (code.nat denominator))]))) )))) -(template [<name> <op>] - [(def: #export (<name> param subject) - (All [unit] (-> (Qty unit) (Qty unit) (Qty unit))) - (|> subject out (<op> (out param)) in))] - - [u/+ i.+] - [u/- i.-] - ) - -(def: #export (u// param subject) - (All [p s] (-> (Qty p) (Qty s) (|> (Qty s) (Per (Qty p))))) - (function (_ input) - (|> (out subject) - (i.* (out input)) - (i./ (out param)) - in))) - -(def: #export (u/* param subject) - (All [p s] (-> (Qty p) (Qty s) (Product (Qty p) (Qty s)))) - (function (_ input) - (|> subject - out - (i.* (out (input param))) - in))) - (def: #export (re_scale from to quantity) (All [si so u] (-> (Scale si) (Scale so) (Qty (si u)) (Qty (so u)))) (let [[numerator denominator] (ratio./ (\ from ratio) @@ -153,24 +153,24 @@ (i./ (.int denominator)) in))) -(scale: #export Kilo [+1 +1,000]) -(scale: #export Mega [+1 +1,000,000]) -(scale: #export Giga [+1 +1,000,000,000]) +(scale: #export Kilo kilo [1 1,000]) +(scale: #export Mega mega [1 1,000,000]) +(scale: #export Giga giga [1 1,000,000,000]) -(scale: #export Milli [ +1,000 +1]) -(scale: #export Micro [ +1,000,000 +1]) -(scale: #export Nano [+1,000,000,000 +1]) +(scale: #export Milli milli [ 1,000 1]) +(scale: #export Micro micro [ 1,000,000 1]) +(scale: #export Nano nano [1,000,000,000 1]) -(unit: #export Gram) -(unit: #export Meter) -(unit: #export Litre) -(unit: #export Second) +(unit: #export Gram gram) +(unit: #export Meter meter) +(unit: #export Litre litre) +(unit: #export Second second) (structure: #export equivalence (All [unit] (Equivalence (Qty unit))) (def: (= reference sample) - (i.= (out reference) (out sample)))) + (i.= (..out reference) (..out sample)))) (structure: #export order (All [unit] (Order (Qty unit))) @@ -178,7 +178,7 @@ (def: &equivalence ..equivalence) (def: (< reference sample) - (i.< (out reference) (out sample)))) + (i.< (..out reference) (..out sample)))) (structure: #export enum (All [unit] (Enum (Qty unit))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index fa92a673a..0cb7136c4 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -434,38 +434,43 @@ @.js (as_is (ffi.import: Buffer - (#static from [Binary] ..Buffer)) + ["#::." + (#static from [Binary] ..Buffer)]) (ffi.import: FileDescriptor) (ffi.import: Stats - (size ffi.Number) - (mtimeMs ffi.Number) - (isFile [] #io #try ffi.Boolean) - (isDirectory [] #io #try ffi.Boolean)) + ["#::." + (size ffi.Number) + (mtimeMs ffi.Number) + (isFile [] #io #try ffi.Boolean) + (isDirectory [] #io #try ffi.Boolean)]) (ffi.import: FsConstants - (F_OK ffi.Number) - (R_OK ffi.Number) - (W_OK ffi.Number) - (X_OK ffi.Number)) + ["#::." + (F_OK ffi.Number) + (R_OK ffi.Number) + (W_OK ffi.Number) + (X_OK ffi.Number)]) (ffi.import: Fs - (constants FsConstants) - (readFileSync [ffi.String] #io #try Binary) - (appendFileSync [ffi.String Buffer] #io #try Any) - (writeFileSync [ffi.String Buffer] #io #try Any) - (statSync [ffi.String] #io #try Stats) - (accessSync [ffi.String ffi.Number] #io #try Any) - (renameSync [ffi.String ffi.String] #io #try Any) - (utimesSync [ffi.String ffi.Number ffi.Number] #io #try Any) - (unlink [ffi.String] #io #try Any) - (readdirSync [ffi.String] #io #try (Array ffi.String)) - (mkdirSync [ffi.String] #io #try Any) - (rmdirSync [ffi.String] #io #try Any)) + ["#::." + (constants FsConstants) + (readFileSync [ffi.String] #io #try Binary) + (appendFileSync [ffi.String Buffer] #io #try Any) + (writeFileSync [ffi.String Buffer] #io #try Any) + (statSync [ffi.String] #io #try Stats) + (accessSync [ffi.String ffi.Number] #io #try Any) + (renameSync [ffi.String ffi.String] #io #try Any) + (utimesSync [ffi.String ffi.Number ffi.Number] #io #try Any) + (unlink [ffi.String] #io #try Any) + (readdirSync [ffi.String] #io #try (Array ffi.String)) + (mkdirSync [ffi.String] #io #try Any) + (rmdirSync [ffi.String] #io #try Any)]) (ffi.import: JsPath - (sep ffi.String)) + ["#::." + (sep ffi.String)]) (template [<name> <path>] [(def: (<name> _) @@ -669,33 +674,36 @@ (primitive "python_tuple[2]" [left right])) (ffi.import: PyFile - (read [] #io #try Binary) - (write [Binary] #io #try #? Any) - (close [] #io #try #? Any)) + ["#::." + (read [] #io #try Binary) + (write [Binary] #io #try #? Any) + (close [] #io #try #? Any)]) (ffi.import: (open [ffi.String ffi.String] #io #try PyFile)) (ffi.import: (tuple [[ffi.Integer ffi.Integer]] (Tuple/2 ffi.Integer ffi.Integer))) (ffi.import: os - (#static F_OK ffi.Integer) - (#static R_OK ffi.Integer) - (#static W_OK ffi.Integer) - (#static X_OK ffi.Integer) - - (#static mkdir [ffi.String] #io #try #? Any) - (#static access [ffi.String ffi.Integer] #io #try ffi.Boolean) - (#static remove [ffi.String] #io #try #? Any) - (#static rmdir [ffi.String] #io #try #? Any) - (#static rename [ffi.String ffi.String] #io #try #? Any) - (#static utime [ffi.String (Tuple/2 ffi.Integer ffi.Integer)] #io #try #? Any) - (#static listdir [ffi.String] #io #try (Array ffi.String))) + ["#::." + (#static F_OK ffi.Integer) + (#static R_OK ffi.Integer) + (#static W_OK ffi.Integer) + (#static X_OK ffi.Integer) + + (#static mkdir [ffi.String] #io #try #? Any) + (#static access [ffi.String ffi.Integer] #io #try ffi.Boolean) + (#static remove [ffi.String] #io #try #? Any) + (#static rmdir [ffi.String] #io #try #? Any) + (#static rename [ffi.String ffi.String] #io #try #? Any) + (#static utime [ffi.String (Tuple/2 ffi.Integer ffi.Integer)] #io #try #? Any) + (#static listdir [ffi.String] #io #try (Array ffi.String))]) (ffi.import: os/path - (#static isfile [ffi.String] #io #try ffi.Boolean) - (#static isdir [ffi.String] #io #try ffi.Boolean) - (#static sep ffi.String) - (#static getsize [ffi.String] #io #try ffi.Integer) - (#static getmtime [ffi.String] #io #try ffi.Float)) + ["#::." + (#static isfile [ffi.String] #io #try ffi.Boolean) + (#static isdir [ffi.String] #io #try ffi.Boolean) + (#static sep ffi.String) + (#static getsize [ffi.String] #io #try ffi.Integer) + (#static getmtime [ffi.String] #io #try ffi.Float)]) (`` (structure: (file path) (-> Path (File IO)) @@ -859,10 +867,11 @@ @.lua (as_is (ffi.import: LuaFile - (read [ffi.String] #io ffi.String) - (write [ffi.String] #io #? LuaFile) - (flush [] #io ffi.Boolean) - (close [] #io ffi.Boolean)) + ["#::." + (read [ffi.String] #io ffi.String) + (write [ffi.String] #io #? LuaFile) + (flush [] #io ffi.Boolean) + (close [] #io ffi.Boolean)]) (ffi.import: (io/open [ffi.String ffi.String] #io #? LuaFile)) @@ -1111,40 +1120,44 @@ @.ruby (as_is (ffi.import: Time #as RubyTime - (#static at [Frac] RubyTime) - - (to_f [] Frac)) + ["#::." + (#static at [Frac] RubyTime) + (to_f [] Frac)]) (ffi.import: Stat #as RubyStat - (executable? [] Bit) - (size Int) - (mtime [] RubyTime)) + ["#::." + (executable? [] Bit) + (size Int) + (mtime [] RubyTime)]) (ffi.import: File #as RubyFile - (#static SEPARATOR ffi.String) - (#static open [Path ffi.String] #io #try RubyFile) - (#static stat [Path] #io #try RubyStat) - (#static delete [Path] #io #try Int) - (#static file? [Path] #io #try Bit) - (#static directory? [Path] #io #try Bit) - (#static utime [RubyTime RubyTime Path] #io #try Int) - - (read [] #io #try Binary) - (write [Binary] #io #try Int) - (flush [] #io #try #? Any) - (close [] #io #try #? Any)) + ["#::." + (#static SEPARATOR ffi.String) + (#static open [Path ffi.String] #io #try RubyFile) + (#static stat [Path] #io #try RubyStat) + (#static delete [Path] #io #try Int) + (#static file? [Path] #io #try Bit) + (#static directory? [Path] #io #try Bit) + (#static utime [RubyTime RubyTime Path] #io #try Int) + + (read [] #io #try Binary) + (write [Binary] #io #try Int) + (flush [] #io #try #? Any) + (close [] #io #try #? Any)]) (ffi.import: Dir #as RubyDir - (#static open [Path] #io #try RubyDir) - - (children [] #io #try (Array Path)) - (close [] #io #try #? Any)) + ["#::." + (#static open [Path] #io #try RubyDir) + + (children [] #io #try (Array Path)) + (close [] #io #try #? Any)]) (ffi.import: "fileutils" FileUtils #as RubyFileUtils - (#static touch [Path] #io #try #? Any) - (#static move [Path Path] #io #try #? Any) - (#static rmdir [Path] #io #try #? Any) - (#static mkdir [Path] #io #try #? Any)) + ["#::." + (#static touch [Path] #io #try #? Any) + (#static move [Path Path] #io #try #? Any) + (#static rmdir [Path] #io #try #? Any) + (#static mkdir [Path] #io #try #? Any)]) (def: default_separator Text diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux index 07d7ad6be..f04ef63dd 100644 --- a/stdlib/source/lux/world/program.lux +++ b/stdlib/source/lux/world/program.lux @@ -124,8 +124,9 @@ (|>> %.int error! io.io)) (import: NodeJs_Process - (exit [ffi.Number] #io Nothing) - (cwd [] #io Path)) + ["#::." + (exit [ffi.Number] #io Nothing) + (cwd [] #io Path)]) (def: (exit_node_js! code) (-> Exit (IO Nothing)) @@ -137,10 +138,12 @@ (..default_exit! code))) (import: Browser_Window - (close [] Nothing)) + ["#::." + (close [] Nothing)]) (import: Browser_Location - (reload [] Nothing)) + ["#::." + (reload [] Nothing)]) (def: (exit_browser! code) (-> Exit (IO Nothing)) @@ -166,25 +169,31 @@ (..default_exit! code))) (import: Object - (#static entries [Object] (Array (Array ffi.String)))) + ["#::." + (#static entries [Object] (Array (Array ffi.String)))]) (import: NodeJs_OS - (homedir [] #io Path)) + ["#::." + (homedir [] #io Path)]) (import: (require [ffi.String] Any))) @.python (as_is (import: os - (#static getcwd [] #io ffi.String) - (#static _exit [ffi.Integer] #io Nothing)) + ["#::." + (#static getcwd [] #io ffi.String) + (#static _exit [ffi.Integer] #io Nothing)]) (import: os/path - (#static expanduser [ffi.String] #io ffi.String)) + ["#::." + (#static expanduser [ffi.String] #io ffi.String)]) (import: os/environ - (#static keys [] #io (Array ffi.String)) - (#static get [ffi.String] #io ffi.String))) + ["#::." + (#static keys [] #io (Array ffi.String)) + (#static get [ffi.String] #io ffi.String)])) @.lua (as_is (ffi.import: LuaFile - (read [ffi.String] #io #? ffi.String) - (close [] #io ffi.Boolean)) + ["#::." + (read [ffi.String] #io #? ffi.String) + (close [] #io ffi.Boolean)]) (ffi.import: (io/popen [ffi.String] #io #try #? LuaFile)) (ffi.import: (os/getenv [ffi.String] #io #? ffi.String)) @@ -209,17 +218,21 @@ (#try.Failure _) (wrap default))))) @.ruby (as_is (ffi.import: Env #as RubyEnv - (#static keys [] (Array Text)) - (#static fetch [Text] Text)) + ["#::." + (#static keys [] (Array Text)) + (#static fetch [Text] Text)]) (ffi.import: "fileutils" FileUtils #as RubyFileUtils - (#static pwd [] #io Path)) + ["#::." + (#static pwd [] #io Path)]) (ffi.import: Dir #as RubyDir - (#static home [] #io Path)) + ["#::." + (#static home [] #io Path)]) (ffi.import: Kernel #as RubyKernel - (#static exit [Int] #io Nothing))) + ["#::." + (#static exit [Int] #io Nothing)])) @.php (as_is (ffi.import: (exit [Int] #io Nothing)) diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 947e3666a..1efbf39a8 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -1,5 +1,6 @@ (.module: {#.doc "Codecs for values in the JSON format."} [lux #* + ["." debug] [abstract [monad (#+ Monad do)] [equivalence (#+ Equivalence)] @@ -91,9 +92,11 @@ (codec.Codec JSON (unit.Qty unit))) (def: encode - (|>> unit.out (\ ..int_codec encode))) + (|>> ((debug.private unit.out)) + (\ ..int_codec encode))) (def: decode - (|>> (\ ..int_codec decode) (\ try.functor map unit.in)))) + (|>> (\ ..int_codec decode) + (\ try.functor map (debug.private unit.in))))) (poly: encode (with_expansions diff --git a/stdlib/source/program/aedifex/artifact/time/time.lux b/stdlib/source/program/aedifex/artifact/time/time.lux index d14f0a435..5c074c20b 100644 --- a/stdlib/source/program/aedifex/artifact/time/time.lux +++ b/stdlib/source/program/aedifex/artifact/time/time.lux @@ -1,6 +1,6 @@ (.module: [lux #* - ["." time (#+ Time)] + ["." time] [abstract [monad (#+ do)]] [control @@ -15,6 +15,9 @@ ["." // #_ ["#" date]]) +(type: #export Time + time.Time) + (def: #export (format value) (%.Format Time) (let [(^slots [#time.hour #time.minute #time.second]) (time.clock value)] diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index 758f87ab9..6546045a4 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -13,7 +13,8 @@ [binary (#+ Binary)] [text ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] [collection ["." set]] [format @@ -65,7 +66,7 @@ [artifact ///artifact/type.lux_library] (let [pom_data (|> pom (\ xml.codec encode) - (\ encoding.utf8 encode))] + (\ utf8.codec encode))] {#///package.origin (#///repository/origin.Remote "") #///package.library [library (///dependency/status.verified library)] diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index 35ffcf72f..375e803ce 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -13,7 +13,8 @@ [binary (#+ Binary)] [text ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] [collection ["." set]] [format @@ -58,7 +59,7 @@ [identity ///artifact/type.lux_library] (let [pom_data (|> pom (\ xml.codec encode) - (\ encoding.utf8 encode))] + (\ utf8.codec encode))] {#///package.origin (#///origin.Local "") #///package.library (let [library (binary.run tar.writer package)] [library (///dependency/status.verified library)]) diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux index 390d7d7d2..7ca26c311 100644 --- a/stdlib/source/program/aedifex/command/pom.lux +++ b/stdlib/source/program/aedifex/command/pom.lux @@ -11,7 +11,8 @@ [data ["." text ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] [format ["." xml]]] [world @@ -32,7 +33,7 @@ (file.get_file promise.monad fs ///pom.file)) outcome (|> pom (\ xml.codec encode) - (\ encoding.utf8 encode) + (\ utf8.codec encode) (!.use (\ file over_write))) _ (console.write_line //clean.success console)] (wrap ///pom.file))) diff --git a/stdlib/source/program/aedifex/dependency/deployment.lux b/stdlib/source/program/aedifex/dependency/deployment.lux index 04b82d7e2..963602494 100644 --- a/stdlib/source/program/aedifex/dependency/deployment.lux +++ b/stdlib/source/program/aedifex/dependency/deployment.lux @@ -14,7 +14,8 @@ ["." product] [text ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] [collection ["." dictionary] ["." set (#+ Set)] @@ -54,7 +55,7 @@ (function (_ codec extension hash) (|> hash (\ codec encode) - (\ encoding.utf8 encode) + (\ utf8.codec encode) (\ repository upload (format artifact extension)))))] (do {! (try.with promise.monad)} [_ (\ repository upload artifact data)] diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 1d72f0937..89ad6368f 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -19,7 +19,8 @@ ["." maybe] ["." text ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] [format ["." xml (#+ Tag XML)]] [collection @@ -81,7 +82,7 @@ [output (\ ! map (|>> (:coerce java/lang/String) java/lang/String::trim (:coerce Text)) - (\ encoding.utf8 decode actual)) + (\ utf8.codec decode actual)) actual (|> output (text.split_all_with " ") list.head @@ -131,7 +132,7 @@ library_&_status (..hashed repository version_template artifact extension)] (\ promise.monad wrap (do try.monad - [pom (\ encoding.utf8 decode pom_data) + [pom (\ utf8.codec decode pom_data) pom (\ xml.codec decode pom) profile (<xml>.run ///pom.parser (list pom))] (wrap {#///package.origin (#///repository/origin.Remote "") diff --git a/stdlib/source/program/aedifex/input.lux b/stdlib/source/program/aedifex/input.lux index 11e648697..b00829469 100644 --- a/stdlib/source/program/aedifex/input.lux +++ b/stdlib/source/program/aedifex/input.lux @@ -12,7 +12,8 @@ [data [binary (#+ Binary)] ["." text - ["." encoding]]] + [encoding + ["." utf8]]]] [meta ["." location]] [tool @@ -43,7 +44,7 @@ (def: parse_project (-> Binary (Try Project)) (|>> (do> try.monad - [(\ encoding.utf8 decode)] + [(\ utf8.codec decode)] [..parse_lux] [(list) (<c>.run //parser.project)]))) diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux index 811713427..9210534cc 100644 --- a/stdlib/source/program/aedifex/metadata/artifact.lux +++ b/stdlib/source/program/aedifex/metadata/artifact.lux @@ -15,7 +15,8 @@ ["." product] ["." text ["%" format] - ["." encoding]] + [encoding + ["." utf8]]] [format ["." xml (#+ XML)]] [collection @@ -187,7 +188,7 @@ (#try.Success project) (wrap (|> project (do> try.monad - [(\ encoding.utf8 decode)] + [(\ utf8.codec decode)] [(\ xml.codec decode)] [list (<xml>.run ..parser)]))) @@ -204,5 +205,5 @@ (|> metadata ..format (\ xml.codec encode) - (\ encoding.utf8 encode) + (\ utf8.codec encode) (\ repository upload (..uri artifact)))) diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux index fa1bcb750..f6878a023 100644 --- a/stdlib/source/program/aedifex/metadata/snapshot.lux +++ b/stdlib/source/program/aedifex/metadata/snapshot.lux @@ -16,7 +16,8 @@ ["." product] ["." text ["%" format] - ["." encoding]] + [encoding + ["." utf8]]] [format ["." xml (#+ XML)]] [collection @@ -133,7 +134,7 @@ (#try.Success project) (wrap (|> project (do> try.monad - [(\ encoding.utf8 decode)] + [(\ utf8.codec decode)] [(\ xml.codec decode)] [list (<xml>.run ..parser)]))) @@ -147,5 +148,5 @@ (|> metadata ..format (\ xml.codec encode) - (\ encoding.utf8 encode) + (\ utf8.codec encode) (\ repository upload (..uri artifact)))) diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux index 445c92987..f871954c3 100644 --- a/stdlib/source/program/aedifex/package.lux +++ b/stdlib/source/program/aedifex/package.lux @@ -11,7 +11,8 @@ ["." product] ["." binary (#+ Binary)] [text - ["." encoding]] + [encoding + ["." utf8]]] [format ["." xml (#+ XML)]] [collection @@ -50,7 +51,7 @@ {#origin (#//origin.Local "") #library [library #//status.Unverified] #pom [pom - (|> pom (\ xml.codec encode) (\ encoding.utf8 encode)) + (|> pom (\ xml.codec encode) (\ utf8.codec encode)) #//status.Unverified]}) (def: #export dependencies diff --git a/stdlib/source/program/aedifex/repository/identity.lux b/stdlib/source/program/aedifex/repository/identity.lux index 7ec3cceec..ef7b0c934 100644 --- a/stdlib/source/program/aedifex/repository/identity.lux +++ b/stdlib/source/program/aedifex/repository/identity.lux @@ -7,7 +7,8 @@ ["." product] ["." text ["%" format (#+ format)] - ["." encoding]]]]) + [encoding + ["." utf8]]]]]) (type: #export User Text) @@ -36,7 +37,7 @@ (def: #export (basic_auth user password) (-> User Password Text) - (let [credentials (\ encoding.utf8 encode (format user ":" password))] + (let [credentials (\ utf8.codec encode (format user ":" password))] (|> (java/util/Base64::getEncoder) (java/util/Base64$Encoder::encodeToString credentials) (format "Basic ")))) diff --git a/stdlib/source/test/aedifex/artifact/time.lux b/stdlib/source/test/aedifex/artifact/time.lux index 4bf63018c..b14032a8c 100644 --- a/stdlib/source/test/aedifex/artifact/time.lux +++ b/stdlib/source/test/aedifex/artifact/time.lux @@ -11,7 +11,9 @@ [parser ["<.>" text]]] [math - ["." random (#+ Random)]] + ["." random (#+ Random)] + [number + ["i" int]]] [time ["." instant]]] {#program @@ -22,7 +24,10 @@ (def: #export random (Random /.Time) - random.instant) + (do random.monad + [date /date.random + time /time.random] + (wrap (instant.from_date_time date time)))) (def: #export test Test diff --git a/stdlib/source/test/aedifex/artifact/time/date.lux b/stdlib/source/test/aedifex/artifact/time/date.lux index 0f4b5b7d3..932d1698e 100644 --- a/stdlib/source/test/aedifex/artifact/time/date.lux +++ b/stdlib/source/test/aedifex/artifact/time/date.lux @@ -23,7 +23,7 @@ (random.one (function (_ raw) (try.to_maybe (do try.monad - [year (|> raw date.year year.value i.abs (i.% +10,000) year.year)] + [year (|> raw date.year year.value i.abs (i.% +9,000) (i.+ +1,000) year.year)] (date.date year (date.month raw) (date.day_of_month raw))))) diff --git a/stdlib/source/test/aedifex/artifact/time/time.lux b/stdlib/source/test/aedifex/artifact/time/time.lux index bd9bbe071..cd70d1c83 100644 --- a/stdlib/source/test/aedifex/artifact/time/time.lux +++ b/stdlib/source/test/aedifex/artifact/time/time.lux @@ -1,7 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] - ["." time (#+ Time)] + ["." time] [abstract [monad (#+ do)]] [control @@ -16,12 +16,18 @@ {#program ["." /]}) +(def: #export random + (Random /.Time) + (random.one (|>> time.clock (set@ #time.milli_second 0) time.time) + random.time)) + (def: #export test Test (<| (_.covering /._) + (_.for [/.Time]) ($_ _.and (do random.monad - [expected random.time] + [expected ..random] (_.cover [/.format /.parser] (|> expected /.format diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 40a797177..d305c19c9 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -206,25 +206,25 @@ (def: sub_tests Test - (let [tail (: (List Test) - (for {@.old (list)} - (list /extension.test)))] - (_.in_parallel (list& /abstract.test - /control.test - /data.test - /locale.test - /macro.test - /math.test - /meta.test - /time.test - ## /tool.test - /type.test - /world.test - /ffi.test - (for {@.jvm (#.Cons /target/jvm.test tail) - @.old (#.Cons /target/jvm.test tail)} - tail) - )))) + (with_expansions [<target> (for {@.jvm (~~ (as_is /target/jvm.test)) + @.old (~~ (as_is /target/jvm.test))} + (~~ (as_is))) + <extension> (for {@.old (~~ (as_is))} + (~~ (as_is /extension.test)))] + (`` (_.in_parallel (list /abstract.test + /control.test + /data.test + /locale.test + /macro.test + /math.test + /meta.test + /time.test + ## /tool.test + /type.test + /world.test + /ffi.test + <target> + <extension>))))) (def: test Test @@ -248,12 +248,12 @@ ..templates) (<| (_.context "Cross-platform support.") ..cross_platform_support) - + ..sub_tests ))) (program: args (<| io _.run! - (_.times 100) + ((debug.private _.times') (#.Some 2,000) 100) ..test)) diff --git a/stdlib/source/test/lux/ffi.js.lux b/stdlib/source/test/lux/ffi.js.lux index 5ffe1fbeb..ded33ed08 100644 --- a/stdlib/source/test/lux/ffi.js.lux +++ b/stdlib/source/test/lux/ffi.js.lux @@ -19,22 +19,26 @@ ## On Nashorn (/.import: java/lang/String - (new [Uint8Array /.String]) - (getBytes [/.String] Uint8Array)) + ["#::." + (new [Uint8Array /.String]) + (getBytes [/.String] Uint8Array)]) ## On Node (/.import: Buffer - (#static from [/.String /.String] Buffer) - (toString [/.String] /.String)) + ["#::." + (#static from [/.String /.String] Buffer) + (toString [/.String] /.String)]) ## On the browser (/.import: TextEncoder - (new [/.String]) - (encode [/.String] Uint8Array)) + ["#::." + (new [/.String]) + (encode [/.String] Uint8Array)]) (/.import: TextDecoder - (new [/.String]) - (decode [Uint8Array] /.String)) + ["#::." + (new [/.String]) + (decode [Uint8Array] /.String)]) (def: #export test Test diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux index f69af1397..0931481da 100644 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ b/stdlib/source/test/lux/macro/poly/json.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["." debug] [abstract codec [monad (#+ do)] @@ -85,7 +86,7 @@ (def: qty (All [unit] (Random (unit.Qty unit))) - (|> random.int (\ random.monad map unit.in))) + (\ random.monad map (debug.private unit.in) random.int)) (def: gen_record (Random Record) diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index b490469cf..654aeb748 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -23,7 +23,8 @@ ["#." implicit] ["#." quotient] ["#." refinement] - ["#." resource]]) + ["#." resource] + ["#." unit]]) (def: short (Random Text) @@ -176,4 +177,5 @@ /quotient.test /refinement.test /resource.test + /unit.test ))) diff --git a/stdlib/source/test/lux/type/unit.lux b/stdlib/source/test/lux/type/unit.lux new file mode 100644 index 000000000..291f6f6b2 --- /dev/null +++ b/stdlib/source/test/lux/type/unit.lux @@ -0,0 +1,194 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + ["." debug] + ["." meta] + [abstract + [monad (#+ do)] + [equivalence (#+ Equivalence)] + {[0 #spec] + [/ + ["$." equivalence] + ["$." order] + ["$." enum]]}] + [macro + [syntax (#+ syntax:)] + ["." code]] + [math + ["." random (#+ Random)] + [number + ["i" int] + ["." ratio ("#\." equivalence)]]]] + {1 + ["." /]}) + +(template [<name> <type> <unit>] + [(def: (<name> range) + (-> Nat (Random (/.Qty <type>))) + (|> random.int + (\ random.monad map (i.% (.int range))) + (random.filter (|>> (i.= +0) not)) + (\ random.monad map (\ <unit> in))))] + + [meter /.Meter /.meter] + [second /.Second /.second] + ) + +(def: polymorphism + Test + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..meter 1,000))) + (_.for [/.order] + ($order.spec /.order (..meter 1,000))) + (_.for [/.enum] + ($enum.spec /.enum (..meter 1,000))) + )) + +(/.unit: What what) + +(def: unit + Test + (do random.monad + [expected random.int] + (_.for [/.Unit] + (`` ($_ _.and + (~~ (template [<type> <unit>] + [(_.cover [<type> <unit>] + (|> expected + (\ <unit> in) + (\ <unit> out) + (i.= expected)))] + + [/.Gram /.gram] + [/.Meter /.meter] + [/.Litre /.litre] + [/.Second /.second] + )) + (_.cover [/.Pure /.pure /.number] + (|> expected + /.pure + /.number + (i.= expected))) + (_.cover [/.unit:] + (|> expected + (\ ..what in) + (\ ..what out) + (i.= expected))) + ))))) + +(syntax: (natural) + (\ meta.monad map + (|>> code.nat list) + meta.count)) + +(with_expansions [<from> (..natural) + <to> (..natural)] + (/.scale: How how + [<from> <to>]) + + (def: how::from <from>) + (def: how::to <to>) + ) + +(def: scale + Test + (do {! random.monad} + [small (|> random.int + (\ ! map (i.% +1,000)) + (\ ! map (\ /.meter in))) + large (|> random.int + (\ ! map (i.% +1,000)) + (\ ! map (i.* +1,000,000,000)) + (\ ! map (\ /.meter in))) + #let [(^open "meter\.") (: (Equivalence (/.Qty /.Meter)) + /.equivalence)] + unscaled (|> random.int + (\ ! map (i.% +1,000)) + (\ ! map (i.* (.int how::to))) + (\ ! map (\ /.meter in)))] + (_.for [/.Scale] + (`` ($_ _.and + (~~ (template [<type> <scale>] + [(_.cover [<type> <scale>] + (|> large + (\ <scale> scale) + (: (/.Qty (<type> /.Meter))) + (\ <scale> de_scale) + (: (/.Qty /.Meter)) + (meter\= large)))] + + [/.Kilo /.kilo] + [/.Mega /.mega] + [/.Giga /.giga] + )) + (~~ (template [<type> <scale>] + [(_.cover [<type> <scale>] + (|> small + (\ <scale> scale) + (: (/.Qty (<type> /.Meter))) + (\ <scale> de_scale) + (: (/.Qty /.Meter)) + (meter\= small)))] + + [/.Milli /.milli] + [/.Micro /.micro] + [/.Nano /.nano] + )) + (_.cover [/.re_scale] + (|> large (: (/.Qty /.Meter)) + (\ /.kilo scale) (: (/.Qty (/.Kilo /.Meter))) + (/.re_scale /.kilo /.milli) (: (/.Qty (/.Milli /.Meter))) + (/.re_scale /.milli /.kilo) (: (/.Qty (/.Kilo /.Meter))) + (\ /.kilo de_scale) (: (/.Qty /.Meter)) + (meter\= large))) + (_.cover [/.scale:] + (and (|> unscaled + (\ ..how scale) + (\ ..how de_scale) + (meter\= unscaled)) + (ratio\= [..how::from + ..how::to] + (\ ..how ratio)))) + ))))) + +(def: arithmetic + Test + (do random.monad + [#let [zero (\ /.meter in +0) + (^open "meter\.") (: (Equivalence (/.Qty /.Meter)) + /.equivalence)] + left (random.filter (|>> (meter\= zero) not) (..meter 1,000)) + right (..meter 1,000) + extra (..second 1,000)] + (`` ($_ _.and + (~~ (template [<q> <i>] + [(_.cover [<q>] + (i.= (<i> (\ /.meter out left) (\ /.meter out right)) + (\ /.meter out (<q> left right))))] + + [/.+ i.+] + [/.- i.-] + )) + (_.cover [/.*] + (let [expected (i.* (\ /.meter out left) (\ /.meter out right)) + actual ((debug.private /.out) (: (/.Qty [/.Meter /.Meter]) + (/.* left right)))] + (i.= expected actual))) + (_.cover [/./] + (|> right + (/.* left) + (/./ left) + (meter\= right))) + )))) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Qty]) + ($_ _.and + ..polymorphism + ..unit + ..scale + ..arithmetic + ))) |