aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2021-01-12 17:31:48 -0400
committerEduardo Julian2021-01-12 17:31:48 -0400
commit5dbf134346424602b0104d1f749c1a9eac6f21af (patch)
treeac77441b9fcbc66a6f9ef1e5a55ccf0b1bcc996e /stdlib/source
parent8aac0c573c29d2829242d66539a9e027d03ff8ec (diff)
Compiler now shows suggestions when encountering unknown definitions.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/collection/list.lux45
-rw-r--r--stdlib/source/lux/data/collection/set.lux17
-rw-r--r--stdlib/source/lux/data/collection/set/multi.lux2
-rw-r--r--stdlib/source/lux/data/maybe.lux4
-rw-r--r--stdlib/source/lux/host.old.lux24
-rw-r--r--stdlib/source/lux/meta.lux74
-rw-r--r--stdlib/source/lux/target/python.lux123
-rw-r--r--stdlib/source/lux/time/month.lux13
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux53
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux7
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux20
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux21
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux240
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux79
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux11
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/reference.lux14
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux222
-rw-r--r--stdlib/source/program/aedifex/artifact/build.lux43
-rw-r--r--stdlib/source/test/aedifex/artifact/build.lux34
-rw-r--r--stdlib/source/test/lux/abstract.lux2
-rw-r--r--stdlib/source/test/lux/abstract/hash.lux39
-rw-r--r--stdlib/source/test/lux/data/collection/list.lux5
-rw-r--r--stdlib/source/test/lux/data/collection/set.lux5
-rw-r--r--stdlib/source/test/lux/data/collection/set/multi.lux8
-rw-r--r--stdlib/source/test/lux/data/maybe.lux5
-rw-r--r--stdlib/source/test/lux/data/name.lux5
-rw-r--r--stdlib/source/test/lux/data/text.lux4
-rw-r--r--stdlib/source/test/lux/locale.lux22
-rw-r--r--stdlib/source/test/lux/time/month.lux93
32 files changed, 789 insertions, 464 deletions
diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux
index 62e88645a..432e98abd 100644
--- a/stdlib/source/lux/data/collection/list.lux
+++ b/stdlib/source/lux/data/collection/list.lux
@@ -316,16 +316,11 @@
(def: &equivalence
(..equivalence (\ super &equivalence)))
- (def: (hash value)
- (case value
- #.Nil
- 2
-
- (#.Cons head tail)
- ($_ n.* 3
- (n.+ (\ super hash head)
- (hash tail)))
- )))
+ (def: hash
+ (\ ..fold fold
+ (function (_ member hash)
+ (n.+ (\ super hash member) hash))
+ 0)))
(structure: #export monoid
(All [a] (Monoid (List a)))
@@ -333,8 +328,11 @@
(def: identity #.Nil)
(def: (compose xs ys)
(case xs
- #.Nil ys
- (#.Cons x xs') (#.Cons x (compose xs' ys)))))
+ #.Nil
+ ys
+
+ (#.Cons x xs')
+ (#.Cons x (compose xs' ys)))))
(open: "." ..monoid)
@@ -343,8 +341,11 @@
(def: (map f ma)
(case ma
- #.Nil #.Nil
- (#.Cons a ma') (#.Cons (f a) (map f ma')))))
+ #.Nil
+ #.Nil
+
+ (#.Cons a ma')
+ (#.Cons (f a) (map f ma')))))
(open: "." ..functor)
@@ -389,15 +390,21 @@
(def: #export (empty? xs)
(All [a] (Predicate (List a)))
(case xs
- #.Nil true
- _ false))
+ #.Nil
+ true
+
+ _
+ false))
(def: #export (member? eq xs x)
(All [a] (-> (Equivalence a) (List a) a Bit))
(case xs
- #.Nil #0
- (#.Cons x' xs') (or (\ eq = x x')
- (member? eq xs' x))))
+ #.Nil
+ #0
+
+ (#.Cons x' xs')
+ (or (\ eq = x x')
+ (member? eq xs' x))))
(template [<name> <output> <side> <doc>]
[(def: #export (<name> xs)
diff --git a/stdlib/source/lux/data/collection/set.lux b/stdlib/source/lux/data/collection/set.lux
index d0341b402..ca95a7a4b 100644
--- a/stdlib/source/lux/data/collection/set.lux
+++ b/stdlib/source/lux/data/collection/set.lux
@@ -2,16 +2,17 @@
[lux #*
[abstract
[equivalence (#+ Equivalence)]
+ [hash (#+ Hash)]
[predicate (#+ Predicate)]
- [monoid (#+ Monoid)]
- ["." hash (#+ Hash)]]
+ [monoid (#+ Monoid)]]
[data
[collection
- ["//" dictionary (#+ Dictionary)]
["." list ("#\." fold)]]]
[math
[number
- ["n" nat]]]])
+ ["n" nat]]]]
+ ["." // #_
+ ["#" dictionary (#+ Dictionary)]])
(type: #export (Set a)
(Dictionary a Any))
@@ -71,10 +72,10 @@
(def: &equivalence ..equivalence)
- (def: (hash (^@ set [hash _]))
- (list\fold (function (_ elem acc) (n.+ (\ hash hash elem) acc))
- 0
- (..to_list set))))
+ (def: (hash set)
+ (|> set
+ ..to_list
+ (\ (list.hash (..member_hash set)) hash))))
(structure: #export (monoid hash)
(All [a] (-> (Hash a) (Monoid (Set a))))
diff --git a/stdlib/source/lux/data/collection/set/multi.lux b/stdlib/source/lux/data/collection/set/multi.lux
index fe5b2b8cb..6fd3a4671 100644
--- a/stdlib/source/lux/data/collection/set/multi.lux
+++ b/stdlib/source/lux/data/collection/set/multi.lux
@@ -130,7 +130,7 @@
(def: (hash (^:representation set))
(let [[hash _] set]
(list\fold (function (_ [elem multiplicity] acc)
- (|> elem (\ hash hash) (n.+ multiplicity) (n.+ acc)))
+ (|> elem (\ hash hash) (n.* multiplicity) (n.+ acc)))
0
(dictionary.entries set)))))
)
diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux
index 6584eaf6a..a5a51300f 100644
--- a/stdlib/source/lux/data/maybe.lux
+++ b/stdlib/source/lux/data/maybe.lux
@@ -87,10 +87,10 @@
(def: (hash value)
(case value
#.None
- 2
+ 0
(#.Some value)
- (.nat ("lux i64 *" (.int 3) (.int (\ super hash value)))))))
+ (\ super hash value))))
(structure: #export (with monad)
(All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a))))))
diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux
index 0d95d6e9e..2fc846e18 100644
--- a/stdlib/source/lux/host.old.lux
+++ b/stdlib/source/lux/host.old.lux
@@ -1634,25 +1634,29 @@
[=args (member_def_arg_bindings type_params class member)]
(member_def_interop type_params kind class =args member method_prefix import_format))))
-(def: (interface? class)
- (All [a] (-> (primitive "java.lang.Class" [a]) Bit))
- ("jvm invokevirtual:java.lang.Class:isInterface:" class))
+(type: (java/lang/Class a)
+ (primitive "java.lang.Class" [a]))
+
+(def: interface?
+ (All [a] (-> (java/lang/Class a) Bit))
+ (|>> "jvm invokevirtual:java.lang.Class:isInterface:"))
(def: (load_class class_name)
- (-> Text (Try (primitive "java.lang.Class" [Any])))
- (try ("jvm invokestatic:java.lang.Class:forName:java.lang.String" class_name)))
+ (-> Text (Try (java/lang/Class Any)))
+ (..try ("jvm invokestatic:java.lang.Class:forName:java.lang.String" class_name)))
(def: (class_kind [class_name _])
(-> Class_Declaration (Meta Class_Kind))
- (let [class_name (sanitize class_name)]
- (case (load_class class_name)
- (#.Right class)
+ (let [class_name (..sanitize class_name)]
+ (case (..load_class class_name)
+ (#try.Success class)
(\ meta.monad wrap (if (interface? class)
#Interface
#Class))
- (#.Left _)
- (meta.fail (format "Unknown class: " class_name)))))
+ (#try.Failure error)
+ (meta.fail (format "Cannot load class: " class_name text.new_line
+ error)))))
(syntax: #export (import:
{class_decl ..class_decl^}
diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux
index e081280be..36a2294a2 100644
--- a/stdlib/source/lux/meta.lux
+++ b/stdlib/source/lux/meta.lux
@@ -12,7 +12,9 @@
["." text ("#\." monoid equivalence)]
["." name ("#\." codec equivalence)]
[collection
- ["." list ("#\." monoid monad)]]]
+ ["." list ("#\." monoid monad)]
+ [dictionary
+ ["." plist]]]]
[macro
["." code]]
[math
@@ -74,18 +76,6 @@
(#try.Success [compiler' ma])
(ma compiler')))))
-(def: (get k plist)
- (All [a]
- (-> Text (List [Text a]) (Maybe a)))
- (case plist
- #.Nil
- #.None
-
- (#.Cons [k' v] plist')
- (if (text\= k k')
- (#.Some v)
- (get k plist'))))
-
(def: #export (run' compiler action)
(All [a] (-> Lux (Meta a) (Try [Lux a])))
(action compiler))
@@ -128,7 +118,7 @@
(def: #export (find_module name)
(-> Text (Meta Module))
(function (_ compiler)
- (case (get name (get@ #.modules compiler))
+ (case (plist.get name (get@ #.modules compiler))
(#.Some module)
(#try.Success [compiler module])
@@ -178,11 +168,11 @@
(-> (List [Text Module]) Text Text Text
(Maybe Macro))
(do maybe.monad
- [$module (get module modules)
+ [$module (plist.get module modules)
definition (: (Maybe Global)
(|> (: Module $module)
(get@ #.definitions)
- (get name)))]
+ (plist.get name)))]
(case definition
(#.Alias [r_module r_name])
(find_macro' modules this_module r_module r_name)
@@ -215,7 +205,7 @@
(def: #export (module_exists? module)
(-> Text (Meta Bit))
(function (_ compiler)
- (#try.Success [compiler (case (get module (get@ #.modules compiler))
+ (#try.Success [compiler (case (plist.get module (get@ #.modules compiler))
(#.Some _)
#1
@@ -286,13 +276,15 @@
{#.doc "Looks-up a definition's whole data in the available modules (including the current one)."}
(-> Name (Meta Global))
(do ..monad
- [name (normalize name)]
+ [name (normalize name)
+ #let [[normal_module normal_short] name]]
(function (_ compiler)
(case (: (Maybe Global)
(do maybe.monad
- [#let [[v_prefix v_name] name]
- (^slots [#.definitions]) (get v_prefix (get@ #.modules compiler))]
- (get v_name definitions)))
+ [(^slots [#.definitions]) (|> compiler
+ (get@ #.modules)
+ (plist.get normal_module))]
+ (plist.get normal_short definitions)))
(#.Some definition)
(#try.Success [compiler definition])
@@ -302,15 +294,39 @@
(#try.Failure ($_ text\compose
"Unknown definition: " (name\encode name) text.new_line
" Current module: " current_module text.new_line
- (case (get current_module (get@ #.modules compiler))
+ (case (plist.get current_module (get@ #.modules compiler))
(#.Some this_module)
- ($_ text\compose
- " Imports: " (|> this_module (get@ #.imports) (text.join_with separator)) text.new_line
- " Aliases: " (|> this_module (get@ #.module_aliases) (list\map (function (_ [alias real]) ($_ text\compose alias " => " real))) (text.join_with separator)) text.new_line)
+ (let [candidates (|> compiler
+ (get@ #.modules)
+ (list\map (function (_ [module_name module])
+ (|> module
+ (get@ #.definitions)
+ (list.all (function (_ [def_name global])
+ (case global
+ (#.Definition _)
+ (if (text\= normal_short def_name)
+ (#.Some (name\encode [module_name def_name]))
+ #.None)
+
+ (#.Alias _)
+ #.None))))))
+ list.concat
+ (text.join_with separator))
+ imports (|> this_module
+ (get@ #.imports)
+ (text.join_with separator))
+ aliases (|> this_module
+ (get@ #.module_aliases)
+ (list\map (function (_ [alias real]) ($_ text\compose alias " => " real)))
+ (text.join_with separator))]
+ ($_ text\compose
+ " Candidates: " candidates text.new_line
+ " Imports: " imports text.new_line
+ " Aliases: " aliases text.new_line))
_
"")
- " All Known modules: " (|> compiler (get@ #.modules) (list\map product.left) (text.join_with separator)) text.new_line)))))))
+ " All known modules: " (|> compiler (get@ #.modules) (list\map product.left) (text.join_with separator)) text.new_line)))))))
(def: #export (find_export name)
{#.doc "Looks-up a definition's type in the available modules (including the current one)."}
@@ -376,7 +392,7 @@
{#.doc "The entire list of globals in a module (including the non-exported/private ones)."}
(-> Text (Meta (List [Text Global])))
(function (_ compiler)
- (case (get module (get@ #.modules compiler))
+ (case (plist.get module (get@ #.modules compiler))
#.None
(#try.Failure ($_ text\compose "Unknown module: " module))
@@ -422,7 +438,7 @@
(do ..monad
[#let [[module name] type_name]
module (find_module module)]
- (case (get name (get@ #.types module))
+ (case (plist.get name (get@ #.types module))
(#.Some [tags _])
(wrap (#.Some tags))
@@ -473,7 +489,7 @@
=module (..find_module module)
this_module_name ..current_module_name
imported! (..imported? module)]
- (case (get name (get@ #.tags =module))
+ (case (plist.get name (get@ #.tags =module))
(#.Some [idx tag_list exported? type])
(if (or (text\= this_module_name module)
(and imported! exported?))
diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux
index b71947d0b..3f0211e33 100644
--- a/stdlib/source/lux/target/python.lux
+++ b/stdlib/source/lux/target/python.lux
@@ -1,15 +1,12 @@
(.module:
- [lux (#- Code not or and list if cond int comment)
+ [lux (#- Location Code not or and list if cond int comment)
[abstract
["." enum]]
[control
[pipe (#+ new> case> cond>)]
[parser
- ["s" code]]]
+ ["<.>" code]]]
[data
- [number
- ["n" nat]
- ["f" frac]]
["." text
["%" format (#+ format)]]
[collection
@@ -18,15 +15,21 @@
["." template]
["." code]
[syntax (#+ syntax:)]]
+ [math
+ [number
+ ["n" nat]
+ ["f" frac]]]
[type
abstract]])
-(def: expression (-> Text Text) (text.enclose ["(" ")"]))
+(def: expression
+ (-> Text Text)
+ (text.enclose ["(" ")"]))
(def: nest
(-> Text Text)
- (|>> (format text.new-line)
- (text.replace-all text.new-line (format text.new-line text.tab))))
+ (|>> (format text.new_line)
+ (text.replace_all text.new_line (format text.new_line text.tab))))
(abstract: #export (Code brand)
Text
@@ -40,7 +43,7 @@
(|>> :representation))
(template [<type> <super>]
- [(with-expansions [<brand> (template.identifier [<type> "'"])]
+ [(with_expansions [<brand> (template.identifier [<type> "'"])]
(`` (abstract: #export (<brand> brand) Any))
(`` (type: #export (<type> brand)
(<super> (<brand> brand)))))]
@@ -53,7 +56,7 @@
)
(template [<type> <super>]
- [(with-expansions [<brand> (template.identifier [<type> "'"])]
+ [(with_expansions [<brand> (template.identifier [<type> "'"])]
(`` (abstract: #export <brand> Any))
(`` (type: #export <type> (<super> <brand>))))]
@@ -108,11 +111,11 @@
(-> Frac Literal)
(`` (|>> (cond> (~~ (template [<lux> <python>]
[[(f.= <lux>)]
- [(new> (format "float(" text.double-quote <python> text.double-quote ")") [])]]
+ [(new> (format "float(" text.double_quote <python> text.double_quote ")") [])]]
- [f.positive-infinity "inf"]
- [f.negative-infinity "-inf"]
- [f.not-a-number "nan"]
+ [f.positive_infinity "inf"]
+ [f.negative_infinity "-inf"]
+ [f.not_a_number "nan"]
))
## else
@@ -122,43 +125,43 @@
(def: sanitize
(-> Text Text)
(`` (|>> (~~ (template [<find> <replace>]
- [(text.replace-all <find> <replace>)]
+ [(text.replace_all <find> <replace>)]
["\" "\\"]
[text.tab "\t"]
- [text.vertical-tab "\v"]
+ [text.vertical_tab "\v"]
[text.null "\0"]
- [text.back-space "\b"]
- [text.form-feed "\f"]
- [text.new-line "\n"]
- [text.carriage-return "\r"]
- [text.double-quote (format "\" text.double-quote)]
+ [text.back_space "\b"]
+ [text.form_feed "\f"]
+ [text.new_line "\n"]
+ [text.carriage_return "\r"]
+ [text.double_quote (format "\" text.double_quote)]
))
)))
(def: #export string
(-> Text Literal)
(|>> ..sanitize
- (text.enclose [text.double-quote text.double-quote])
+ (text.enclose [text.double_quote text.double_quote])
:abstraction))
- (def: (composite-literal left-delimiter right-delimiter entry-serializer)
+ (def: (composite_literal left_delimiter right_delimiter entry_serializer)
(All [a]
(-> Text Text (-> a Text)
(-> (List a) Literal)))
(function (_ entries)
(<| :abstraction
..expression
- (format left-delimiter
+ (format left_delimiter
(|> entries
- (list\map entry-serializer)
- (text.join-with ", "))
- right-delimiter))))
+ (list\map entry_serializer)
+ (text.join_with ", "))
+ right_delimiter))))
(template [<name> <pre> <post>]
[(def: #export <name>
(-> (List (Expression Any)) Literal)
- (composite-literal <pre> <post> ..code))]
+ (composite_literal <pre> <post> ..code))]
[tuple "(" ")"]
[list "[" "]"]
@@ -170,7 +173,7 @@
..expression
(format (:representation list) "[" (:representation from) ":" (:representation to) "]")))
- (def: #export (slice-from from list)
+ (def: #export (slice_from from list)
(-> (Expression Any) (Expression Any) Access)
(<| :abstraction
..expression
@@ -178,21 +181,21 @@
(def: #export dict
(-> (List [(Expression Any) (Expression Any)]) (Computation Any))
- (composite-literal "{" "}" (.function (_ [k v]) (format (:representation k) " : " (:representation v)))))
+ (composite_literal "{" "}" (.function (_ [k v]) (format (:representation k) " : " (:representation v)))))
(def: #export (apply/* func args)
(-> (Expression Any) (List (Expression Any)) (Computation Any))
(<| :abstraction
..expression
- (format (:representation func) "(" (text.join-with ", " (list\map ..code args)) ")")))
+ (format (:representation func) "(" (text.join_with ", " (list\map ..code args)) ")")))
(template [<name> <brand> <prefix>]
[(def: (<name> var)
(-> (Expression Any) Text)
(format <prefix> (:representation var)))]
- [splat-poly Poly "*"]
- [splat-keyword Keyword "**"]
+ [splat_poly Poly "*"]
+ [splat_keyword Keyword "**"]
)
(template [<name> <splat>]
@@ -203,11 +206,11 @@
(format (:representation func)
(format "(" (|> args
(list\map (function (_ arg) (format (:representation arg) ", ")))
- (text.join-with ""))
+ (text.join_with ""))
(<splat> extra) ")"))))]
- [apply-poly splat-poly]
- [apply-keyword splat-keyword]
+ [apply_poly splat_poly]
+ [apply_keyword splat_keyword]
)
(def: #export (the name object)
@@ -224,8 +227,8 @@
(-> (Expression Any) (Computation Any)))
(|>> (..the method) (<apply> args extra)))]
- [do-poly apply-poly]
- [do-keyword apply-keyword]
+ [do_poly apply_poly]
+ [do_keyword apply_keyword]
)
(def: #export (nth idx array)
@@ -257,11 +260,11 @@
[/ "/"]
[% "%"]
[** "**"]
- [bit-or "|"]
- [bit-and "&"]
- [bit-xor "^"]
- [bit-shl "<<"]
- [bit-shr ">>"]
+ [bit_or "|"]
+ [bit_and "&"]
+ [bit_xor "^"]
+ [bit_shl "<<"]
+ [bit_shr ">>"]
[or "or"]
[and "and"]
@@ -277,13 +280,13 @@
(-> (List (Var Any)) (Expression Any) (Computation Any))
(<| :abstraction
..expression
- (format "lambda " (|> arguments (list\map ..code) (text.join-with ", ")) ": "
+ (format "lambda " (|> arguments (list\map ..code) (text.join_with ", ")) ": "
(:representation body))))
(def: #export (set vars value)
(-> (List (Location Any)) (Expression Any) (Statement Any))
(:abstraction
- (format (|> vars (list\map ..code) (text.join-with ", "))
+ (format (|> vars (list\map ..code) (text.join_with ", "))
" = "
(:representation value))))
@@ -296,7 +299,7 @@
(:abstraction
(format "if " (:representation test) ":"
(..nest (:representation then!))
- text.new-line "else:"
+ text.new_line "else:"
(..nest (:representation else!)))))
(def: #export (when test then!)
@@ -309,7 +312,7 @@
(-> (Statement Any) (Statement Any) (Statement Any))
(:abstraction
(format (:representation pre!)
- text.new-line
+ text.new_line
(:representation post!))))
(template [<keyword> <0>]
@@ -327,7 +330,7 @@
(format "while " (:representation test) ":"
(..nest (:representation body!)))))
- (def: #export (for-in var inputs body!)
+ (def: #export (for_in var inputs body!)
(-> SVar (Expression Any) (Statement Any) Loop)
(:abstraction
(format "for " (:representation var) " in " (:representation inputs) ":"
@@ -353,10 +356,10 @@
(..nest (:representation body!))
(|> excepts
(list\map (function (_ [classes exception catch!])
- (format text.new-line "except (" (text.join-with ", " (list\map ..code classes))
+ (format text.new_line "except (" (text.join_with ", " (list\map ..code classes))
") as " (:representation exception) ":"
(..nest (:representation catch!)))))
- (text.join-with "")))))
+ (text.join_with "")))))
(template [<name> <keyword>]
[(def: #export (<name> message)
@@ -373,16 +376,16 @@
(-> SVar (List (Ex [k] (Var k))) (Statement Any) (Statement Any))
(:abstraction
(format "def " (:representation name)
- "(" (|> args (list\map ..code) (text.join-with ", ")) "):"
+ "(" (|> args (list\map ..code) (text.join_with ", ")) "):"
(..nest (:representation body)))))
- (def: #export (import module-name)
+ (def: #export (import module_name)
(-> Text (Statement Any))
- (:abstraction (format "import " module-name)))
+ (:abstraction (format "import " module_name)))
(def: #export (comment commentary on)
(All [brand] (-> Text (Code brand) (Code brand)))
- (:abstraction (format "# " (..sanitize commentary) text.new-line
+ (:abstraction (format "# " (..sanitize commentary) text.new_line
(:representation on))))
)
@@ -393,20 +396,20 @@
else!
(list.reverse clauses)))
-(syntax: (arity-inputs {arity s.nat})
+(syntax: (arity_inputs {arity <code>.nat})
(wrap (case arity
0 (.list)
_ (|> (dec arity)
(enum.range n.enum 0)
- (list\map (|>> %.nat code.local-identifier))))))
+ (list\map (|>> %.nat code.local_identifier))))))
-(syntax: (arity-types {arity s.nat})
+(syntax: (arity_types {arity <code>.nat})
(wrap (list.repeat arity (` (Expression Any)))))
(template [<arity> <function>+]
- [(with-expansions [<apply> (template.identifier ["apply/" <arity>])
- <inputs> (arity-inputs <arity>)
- <types> (arity-types <arity>)
+ [(with_expansions [<apply> (template.identifier ["apply/" <arity>])
+ <inputs> (arity_inputs <arity>)
+ <types> (arity_types <arity>)
<definitions> (template.splice <function>+)]
(def: #export (<apply> function <inputs>)
(-> (Expression Any) <types> (Computation Any))
diff --git a/stdlib/source/lux/time/month.lux b/stdlib/source/lux/time/month.lux
index ba0408e34..60d66ce28 100644
--- a/stdlib/source/lux/time/month.lux
+++ b/stdlib/source/lux/time/month.lux
@@ -2,6 +2,7 @@
[lux #*
[abstract
[equivalence (#+ Equivalence)]
+ [hash (#+ Hash)]
[order (#+ Order)]
[enum (#+ Enum)]]
[control
@@ -70,7 +71,11 @@
(exception: #export (invalid_month {number Nat})
(exception.report
- ["Number" (\ n.decimal encode number)]))
+ ["Number" (\ n.decimal encode number)]
+ ["Valid range" ($_ "lux text concat"
+ (\ n.decimal encode (..number #January))
+ " ~ "
+ (\ n.decimal encode (..number #December)))]))
(def: #export (by_number number)
(-> Nat (Try Month))
@@ -81,6 +86,12 @@
_ (exception.throw ..invalid_month [number])))
)
+(structure: #export hash
+ (Hash Month)
+
+ (def: &equivalence ..equivalence)
+ (def: hash ..number))
+
(structure: #export order
(Order Month)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux
index 536416b9d..6c09e4123 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux
@@ -1,8 +1,5 @@
(.module:
- [lux #*
- [data
- [collection
- ["." dictionary]]]]
+ [lux #*]
["." / #_
["#." common]
[////
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
index 1c58fec4c..14cc5f338 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
@@ -6,10 +6,11 @@
["." function]]
[data
["." product]
- [number
- ["f" frac]]
[collection
["." dictionary]]]
+ [math
+ [number
+ ["f" frac]]]
[target
["_" python (#+ Expression)]]]
[////
@@ -21,39 +22,34 @@
["//" python #_
["#." runtime (#+ Operation Phase Handler Bundle)]]]]])
-(def: lux-procs
+(def: lux_procs
Bundle
(|> /.empty
(/.install "is" (binary (product.uncurry _.is)))
(/.install "try" (unary //runtime.lux//try))))
-(def: i64-procs
+(def: i64_procs
Bundle
(<| (/.prefix "i64")
(|> /.empty
- (/.install "and" (binary (product.uncurry _.bit-and)))
- (/.install "or" (binary (product.uncurry _.bit-or)))
- (/.install "xor" (binary (product.uncurry _.bit-xor)))
- (/.install "left-shift" (binary (function.compose //runtime.i64//64 (product.uncurry _.bit-shl))))
- (/.install "logical-right-shift" (binary (product.uncurry //runtime.i64//logic-right-shift)))
- (/.install "arithmetic-right-shift" (binary (product.uncurry _.bit-shr)))
+ (/.install "and" (binary (product.uncurry _.bit_and)))
+ (/.install "or" (binary (product.uncurry _.bit_or)))
+ (/.install "xor" (binary (product.uncurry _.bit_xor)))
+ (/.install "left-shift" (binary (function.compose //runtime.i64//64 (product.uncurry _.bit_shl))))
+ (/.install "logical-right-shift" (binary (product.uncurry //runtime.i64//logic_right_shift)))
+ (/.install "arithmetic-right-shift" (binary (product.uncurry _.bit_shr)))
+ (/.install "<" (binary (product.uncurry _.<)))
(/.install "=" (binary (product.uncurry _.=)))
(/.install "+" (binary (product.uncurry _.+)))
(/.install "-" (binary (product.uncurry _.-)))
- )))
-
-(def: int-procs
- Bundle
- (<| (/.prefix "int")
- (|> /.empty
- (/.install "<" (binary (product.uncurry _.<)))
(/.install "*" (binary (product.uncurry _.*)))
(/.install "/" (binary (product.uncurry _./)))
(/.install "%" (binary (product.uncurry _.%)))
- (/.install "frac" (unary _.float/1))
- (/.install "char" (unary _.chr/1)))))
+ (/.install "f64" (unary _.float/1))
+ (/.install "char" (unary _.chr/1))
+ )))
-(def: frac-procs
+(def: frac_procs
Bundle
(<| (/.prefix "frac")
(|> /.empty
@@ -76,7 +72,7 @@
(Trinary (Expression Any))
(//runtime.text//index textO partO startO))
-(def: text-procs
+(def: text_procs
Bundle
(<| (/.prefix "text")
(|> /.empty
@@ -89,22 +85,21 @@
(/.install "clip" (trinary text//clip))
)))
-(def: io-procs
+(def: io_procs
Bundle
(<| (/.prefix "io")
(|> /.empty
(/.install "log" (unary //runtime.io//log!))
(/.install "error" (unary //runtime.io//throw!))
(/.install "exit" (unary //runtime.io//exit!))
- (/.install "current-time" (nullary (function.constant (//runtime.io//current-time! //runtime.unit)))))))
+ (/.install "current-time" (nullary (function.constant (//runtime.io//current_time! //runtime.unit)))))))
(def: #export bundle
Bundle
(<| (/.prefix "lux")
- (|> lux-procs
- (dictionary.merge i64-procs)
- (dictionary.merge int-procs)
- (dictionary.merge frac-procs)
- (dictionary.merge text-procs)
- (dictionary.merge io-procs)
+ (|> lux_procs
+ (dictionary.merge i64_procs)
+ (dictionary.merge frac_procs)
+ (dictionary.merge text_procs)
+ (dictionary.merge io_procs)
)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
index b8dbfc4ce..02197dc02 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
@@ -10,7 +10,7 @@
[runtime (#+ Phase Phase!)]
["#." primitive]
["#." structure]
- ["#." reference ("#\." system)]
+ ["#." reference]
["#." case]
["#." loop]
["#." function]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
index 3a828bbb9..4ba85c9b5 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
@@ -41,6 +41,7 @@
(do ///////phase.monad
[valueO (generate archive valueS)
bodyO (generate archive bodyS)]
+ ## TODO: Find some way to do 'let' without paying the price of the closure.
(wrap (_.apply/* (_.closure (list (..register register))
(_.return bodyO))
(list valueO)))))
@@ -258,7 +259,7 @@
(#.Cons cons))]
(wrap (_.cond clauses ..fail_pm!)))
- (^template [<tag> <format> <type>]
+ (^template [<tag> <format>]
[(<tag> cons)
(do {! ///////phase.monad}
[cases (monad.map ! (function (_ [match then])
@@ -267,8 +268,8 @@
(wrap (_.switch ..peek_cursor
cases
(#.Some ..fail_pm!))))])
- ([#/////synthesis.F64_Fork //primitive.f64 Frac]
- [#/////synthesis.Text_Fork //primitive.text Text])
+ ([#/////synthesis.F64_Fork //primitive.f64]
+ [#/////synthesis.Text_Fork //primitive.text])
(#/////synthesis.Then bodyS)
(statement expression archive bodyS)
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 0d47e9fe8..89fd86bb6 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
@@ -2,8 +2,6 @@
[lux (#- function)
[abstract
["." monad (#+ do)]]
- [control
- pipe]
[data
["." product]
[text
@@ -24,9 +22,9 @@
["#." generation (#+ Context)]
["//#" /// #_
[arity (#+ Arity)]
+ ["#." phase ("#\." monad)]
[reference
- [variable (#+ Register Variable)]]
- ["#." phase ("#\." monad)]]]]])
+ [variable (#+ Register Variable)]]]]]])
(def: #export (apply generate archive [functionS argsS+])
(Generator (Application Synthesis))
@@ -51,12 +49,14 @@
(_.return (_.function @self (list) function_body)))
(_.apply/* @self inits)])))
-(def: @curried (_.var "curried"))
+(def: @curried
+ (_.var "curried"))
(def: input
(|>> inc //case.register))
-(def: @@arguments (_.var "arguments"))
+(def: @@arguments
+ (_.var "arguments"))
(def: (@scope function_name)
(-> Context Text)
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 a6cc85b10..c0f697584 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
@@ -5,8 +5,8 @@
["." monad (#+ do)]]
[control
["." function]
- ["p" parser
- ["s" code]]]
+ ["<>" parser
+ ["<.>" code]]]
[data
["." product]
["." text ("#\." hash)
@@ -32,7 +32,7 @@
["#." reference]
["//#" /// #_
["#." synthesis (#+ Synthesis)]
- ["#." generation (#+ Buffer)]
+ ["#." generation]
["//#" /// (#+ Output)
["#." phase]
[reference
@@ -73,7 +73,9 @@
(let [mask (dec (i64.left_shift 32 1))]
(|>> (i64.and mask))))
-(def: #export unit Computation (_.string /////synthesis.unit))
+(def: #export unit
+ Computation
+ (_.string /////synthesis.unit))
(def: #export (flag value)
(-> Bit Computation)
@@ -85,7 +87,7 @@
(-> Var (-> Var Expression) Statement)
(_.define name (definition name)))
-(syntax: #export (with_vars {vars (s.tuple (p.some s.local_identifier))}
+(syntax: #export (with_vars {vars (<code>.tuple (<>.some <code>.local_identifier))}
body)
(do {! meta.monad}
[ids (monad.seq ! (list.repeat (list.size vars) meta.count))]
@@ -105,9 +107,9 @@
[(` (_.var (~ (code.text identifier))))
(code.local_identifier identifier)]))
-(syntax: (runtime: {declaration (p.or s.local_identifier
- (s.form (p.and s.local_identifier
- (p.some s.local_identifier))))}
+(syntax: (runtime: {declaration (<>.or <code>.local_identifier
+ (<code>.form (<>.and <code>.local_identifier
+ (<>.some <code>.local_identifier))))}
code)
(case declaration
(#.Left name)
@@ -786,7 +788,7 @@
(def: #export artifact
Text
- prefix)
+ ..prefix)
(def: #export generate
(Operation [Registry Output])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
index d7e02b980..93300a02d 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
@@ -6,16 +6,20 @@
[runtime (#+ Phase)]
["#." primitive]
["#." structure]
- ["#." reference ("#\." system)]
+ ["#." reference]
["#." function]
["#." case]
["#." loop]
- ["//#" /// #_
- ["#." extension]
+ ["/#" // #_
+ ["#." reference]
["/#" // #_
- ["#." synthesis]
- ["//#" /// #_
- ["#." phase ("#\." monad)]]]]])
+ ["#." extension]
+ ["/#" // #_
+ ["#." synthesis]
+ ["//#" /// #_
+ ["#." phase ("#\." monad)]
+ [reference (#+)
+ [variable (#+)]]]]]]])
(def: #export (generate archive synthesis)
Phase
@@ -35,7 +39,7 @@
(/structure.tuple generate archive members)
(#////synthesis.Reference value)
- (/reference\reference archive value)
+ (//reference.reference /reference.system archive value)
(^ (////synthesis.branch/case case))
(/case.case generate archive case)
@@ -46,6 +50,9 @@
(^ (////synthesis.branch/if if))
(/case.if generate archive if)
+ (^ (////synthesis.branch/get get))
+ (/case.get generate archive get)
+
(^ (////synthesis.loop/scope scope))
(/loop.scope generate archive scope)
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 4d5fc7f06..36700cf0c 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
@@ -1,22 +1,24 @@
(.module:
[lux (#- case let if)
[abstract
- [monad (#+ do)]]
+ ["." monad (#+ do)]]
[control
- ["ex" exception (#+ exception:)]]
+ [exception (#+ exception:)]]
[data
["." text
["%" format (#+ format)]]
- [number
- ["n" nat]
- ["i" int]]
[collection
["." list ("#\." functor fold)]
["." set]]]
+ [math
+ [number
+ ["n" nat]
+ ["i" int]]]
[target
["_" python (#+ Expression SVar Statement)]]]
["." // #_
["#." runtime (#+ Operation Phase Generator)]
+ ["#." reference]
["#." primitive]
["/#" // #_
["#." reference]
@@ -24,19 +26,22 @@
[synthesis
["." case]]
["/#" // #_
- ["#." synthesis (#+ Synthesis Path)]
+ ["#." synthesis (#+ Member Synthesis Path)]
["#." generation]
["//#" /// #_
- ["#." reference (#+ Register)]
+ [reference
+ ["#." variable (#+ Register)]]
["#." phase ("#\." monad)]
[meta
[archive (#+ Archive)]]]]]]])
(def: #export register
- (///reference.local _.var))
+ (-> Register SVar)
+ (|>> (///reference.local //reference.system) :assume))
(def: #export capture
- (///reference.foreign _.var))
+ (-> Register SVar)
+ (|>> (///reference.foreign //reference.system) :assume))
(def: #export (let generate archive [valueS register bodyS])
(Generator [Synthesis Register Synthesis])
@@ -48,8 +53,16 @@
bodyO)
(list valueO)))))
-(def: #export (record-get generate archive [valueS pathP])
- (Generator [Synthesis (List (Either Nat Nat))])
+(def: #export (if generate archive [testS thenS elseS])
+ (Generator [Synthesis Synthesis Synthesis])
+ (do ///////phase.monad
+ [testO (generate archive testS)
+ thenO (generate archive thenS)
+ elseO (generate archive elseS)]
+ (wrap (_.? testO thenO elseO))))
+
+(def: #export (get generate archive [pathP valueS])
+ (Generator [(List Member) Synthesis])
(do ///////phase.monad
[valueO (generate archive valueS)]
(wrap (list\fold (function (_ side source)
@@ -63,14 +76,6 @@
valueO
pathP))))
-(def: #export (if generate archive [testS thenS elseS])
- (Generator [Synthesis Synthesis Synthesis])
- (do ///////phase.monad
- [testO (generate archive testS)
- thenO (generate archive thenS)
- elseO (generate archive elseS)]
- (wrap (_.? testO thenO elseO))))
-
(def: @savepoint (_.var "lux_pm_savepoint"))
(def: @cursor (_.var "lux_pm_cursor"))
(def: @temp (_.var "lux_pm_temp"))
@@ -79,13 +84,13 @@
(-> (Expression Any) (Statement Any))
(_.statement (|> @cursor (_.do "append" (list value)))))
-(def: peek-and-pop
+(def: peek_and_pop
(Expression Any)
(|> @cursor (_.do "pop" (list))))
(def: pop!
(Statement Any)
- (_.statement ..peek-and-pop))
+ (_.statement ..peek_and_pop))
(def: peek
(Expression Any)
@@ -93,18 +98,18 @@
(def: save!
(Statement Any)
- (.let [cursor (_.slice-from (_.int +0) @cursor)]
+ (.let [cursor (_.slice_from (_.int +0) @cursor)]
(_.statement (|> @savepoint (_.do "append" (list cursor))))))
(def: restore!
(Statement Any)
(_.set (list @cursor) (|> @savepoint (_.do "pop" (list)))))
-(def: fail-pm! _.break)
+(def: fail_pm! _.break)
-(def: (multi-pop! pops)
+(def: (multi_pop! pops)
(-> Nat (Statement Any))
- (_.delete (_.slice-from (_.int (i.* -1 (.int pops))) @cursor)))
+ (_.delete (_.slice_from (_.int (i.* -1 (.int pops))) @cursor)))
(template [<name> <flag> <prep>]
[(def: (<name> simple? idx)
@@ -113,14 +118,14 @@
(_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>)))
(.if simple?
(_.when (_.= _.none @temp)
- fail-pm!)
+ fail_pm!)
(_.if (_.= _.none @temp)
- fail-pm!
+ fail_pm!
(..push! @temp))
)))]
- [left-choice _.none (<|)]
- [right-choice (_.string "") inc]
+ [left_choice _.none (<|)]
+ [right_choice (_.string "") inc]
)
(def: (alternation pre! post!)
@@ -134,79 +139,114 @@
..restore!
post!)))
-(def: (pattern-matching' generate archive pathP)
+(def: (pattern_matching' generate archive)
(-> Phase Archive Path (Operation (Statement Any)))
- (.case pathP
- (^ (/////synthesis.path/then bodyS))
- (///////phase\map _.return (generate archive bodyS))
-
- #/////synthesis.Pop
- (///////phase\wrap ..pop!)
-
- (#/////synthesis.Bind register)
- (///////phase\wrap (_.set (list (..register register)) ..peek))
-
- (^template [<tag> <format>]
- [(^ (<tag> value))
- (///////phase\wrap (_.when (|> value <format> (_.= ..peek) _.not)
- fail-pm!))])
- ([/////synthesis.path/bit //primitive.bit]
- [/////synthesis.path/i64 //primitive.i64]
- [/////synthesis.path/f64 //primitive.f64]
- [/////synthesis.path/text //primitive.text])
-
- (^template [<complex> <simple> <choice>]
- [(^ (<complex> idx))
- (///////phase\wrap (<choice> false idx))
-
- (^ (<simple> idx nextP))
- (|> nextP
- (pattern-matching' generate archive)
- (///////phase\map (_.then (<choice> true idx))))])
- ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
- [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
-
- (^ (/////synthesis.member/left 0))
- (///////phase\wrap (|> ..peek (_.nth (_.int +0)) ..push!))
-
- (^template [<pm> <getter>]
- [(^ (<pm> lefts))
- (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))])
- ([/////synthesis.member/left //runtime.tuple//left]
- [/////synthesis.member/right //runtime.tuple//right])
-
- (^ (/////synthesis.!bind-top register thenP))
- (do ///////phase.monad
- [then! (pattern-matching' generate archive thenP)]
- (///////phase\wrap ($_ _.then
- (_.set (list (..register register)) ..peek-and-pop)
- then!)))
-
- (^ (/////synthesis.!multi-pop nextP))
- (.let [[extra-pops nextP'] (case.count-pops nextP)]
+ (function (recur pathP)
+ (.case pathP
+ (^ (/////synthesis.path/then bodyS))
+ (///////phase\map _.return (generate archive bodyS))
+
+ #/////synthesis.Pop
+ (///////phase\wrap ..pop!)
+
+ (#/////synthesis.Bind register)
+ (///////phase\wrap (_.set (list (..register register)) ..peek))
+
+ (#/////synthesis.Bit_Fork when thenP elseP)
+ (do {! ///////phase.monad}
+ [then! (recur thenP)
+ else! (.case elseP
+ (#.Some elseP)
+ (recur elseP)
+
+ #.None
+ (wrap ..fail_pm!))]
+ (wrap (.if when
+ (_.if ..peek
+ then!
+ else!)
+ (_.if ..peek
+ else!
+ then!))))
+
+ (#/////synthesis.I64_Fork cons)
+ (do {! ///////phase.monad}
+ [clauses (monad.map ! (function (_ [match then])
+ (do !
+ [then! (recur then)]
+ (wrap [(_.= (//primitive.i64 (.int match))
+ ..peek)
+ then!])))
+ (#.Cons cons))]
+ (wrap (_.cond clauses
+ ..fail_pm!)))
+
+ (^template [<tag> <format>]
+ [(<tag> cons)
+ (do {! ///////phase.monad}
+ [clauses (monad.map ! (function (_ [match then])
+ (\ ! map
+ (|>> [(_.= (<format> match)
+ ..peek)])
+ (recur then)))
+ (#.Cons cons))]
+ (wrap (_.cond clauses
+ ..fail_pm!)))])
+ ([#/////synthesis.F64_Fork //primitive.f64]
+ [#/////synthesis.Text_Fork //primitive.text])
+
+ (^template [<complex> <simple> <choice>]
+ [(^ (<complex> idx))
+ (///////phase\wrap (<choice> false idx))
+
+ (^ (<simple> idx nextP))
+ (|> nextP
+ recur
+ (///////phase\map (_.then (<choice> true idx))))])
+ ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice]
+ [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice])
+
+ (^ (/////synthesis.member/left 0))
+ (///////phase\wrap (|> ..peek (_.nth (_.int +0)) ..push!))
+
+ (^template [<pm> <getter>]
+ [(^ (<pm> lefts))
+ (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))])
+ ([/////synthesis.member/left //runtime.tuple//left]
+ [/////synthesis.member/right //runtime.tuple//right])
+
+ (^ (/////synthesis.!bind_top register thenP))
(do ///////phase.monad
- [next! (pattern-matching' generate archive nextP')]
+ [then! (recur thenP)]
(///////phase\wrap ($_ _.then
- (..multi-pop! (n.+ 2 extra-pops))
- next!))))
-
- (^template [<tag> <combinator>]
- [(^ (<tag> preP postP))
- (do ///////phase.monad
- [pre! (pattern-matching' generate archive preP)
- post! (pattern-matching' generate archive postP)]
- (wrap (<combinator> pre! post!)))])
- ([/////synthesis.path/seq _.then]
- [/////synthesis.path/alt ..alternation])))
-
-(def: (pattern-matching generate archive pathP)
+ (_.set (list (..register register)) ..peek_and_pop)
+ then!)))
+
+ (^ (/////synthesis.!multi_pop nextP))
+ (.let [[extra_pops nextP'] (case.count_pops nextP)]
+ (do ///////phase.monad
+ [next! (recur nextP')]
+ (///////phase\wrap ($_ _.then
+ (..multi_pop! (n.+ 2 extra_pops))
+ next!))))
+
+ (^template [<tag> <combinator>]
+ [(^ (<tag> preP postP))
+ (do ///////phase.monad
+ [pre! (recur preP)
+ post! (recur postP)]
+ (wrap (<combinator> pre! post!)))])
+ ([/////synthesis.path/seq _.then]
+ [/////synthesis.path/alt ..alternation]))))
+
+(def: (pattern_matching generate archive pathP)
(-> Phase Archive Path (Operation (Statement Any)))
(do ///////phase.monad
- [pattern-matching! (pattern-matching' generate archive pathP)]
+ [pattern_matching! (pattern_matching' generate archive pathP)]
(wrap ($_ _.then
(_.while (_.bool true)
- pattern-matching!)
- (_.raise (_.Exception/1 (_.string case.pattern-matching-error)))))))
+ pattern_matching!)
+ (_.raise (_.Exception/1 (_.string case.pattern_matching_error)))))))
(def: (gensym prefix)
(-> Text (Operation SVar))
@@ -216,24 +256,24 @@
(Generator [Synthesis Path])
(do ///////phase.monad
[initG (generate archive valueS)
- pattern-matching! (pattern-matching generate archive pathP)
+ pattern_matching! (pattern_matching generate archive pathP)
@case (..gensym "case")
@init (..gensym "init")
#let [@dependencies+ (|> (case.storage pathP)
(get@ #case.dependencies)
- set.to-list
+ set.to_list
(list\map (function (_ variable)
(.case variable
- (#///////reference.Local register)
+ (#///////variable.Local register)
(..register register)
- (#///////reference.Foreign register)
+ (#///////variable.Foreign register)
(..capture register)))))]
#let [directive (_.def @case (list& @init @dependencies+)
($_ _.then
(_.set (list @cursor) (_.list (list @init)))
(_.set (list @savepoint) (_.list (list)))
- pattern-matching!))]
+ pattern_matching!))]
_ (/////generation.execute! directive)
_ (/////generation.save! (_.code @case) directive)]
(wrap (_.apply/* @case (list& initG @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 5ce811dfd..a4149f120 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
@@ -2,14 +2,14 @@
[lux (#- function)
[abstract
["." monad (#+ do)]]
- [control
- pipe]
[data
["." product]
+ [text
+ ["%" format (#+ format)]]
[collection
["." list ("#\." functor fold)]]]
[target
- ["_" python (#+ Expression Statement)]]]
+ ["_" python (#+ SVar Expression Statement)]]]
["." // #_
[runtime (#+ Operation Phase Generator)]
["#." reference]
@@ -19,11 +19,12 @@
["//#" /// #_
[analysis (#+ Variant Tuple Environment Abstraction Application Analysis)]
[synthesis (#+ Synthesis)]
- ["#." generation]
+ ["#." generation (#+ Context)]
["//#" /// #_
- [reference (#+ Register Variable)]
[arity (#+ Arity)]
- ["#." phase]]]]])
+ ["#." phase]
+ [reference
+ [variable (#+ Register Variable)]]]]]])
(def: #export (apply generate archive [functionS argsS+])
(Generator (Application Synthesis))
@@ -33,16 +34,17 @@
(wrap (_.apply/* functionO argsO+))))
(def: #export capture
- (///reference.foreign _.var))
+ (-> Register SVar)
+ (|>> (///reference.foreign //reference.system) :assume))
-(def: (with-closure function-name inits function-definition)
+(def: (with_closure function_name inits function_definition)
(-> Text (List (Expression Any)) (Statement Any) (Operation (Expression Any)))
(case inits
#.Nil
(do ///////phase.monad
- [_ (/////generation.execute! function-definition)
- _ (/////generation.save! function-name function-definition)]
- (wrap (_.apply/* (_.var function-name) inits)))
+ [_ (/////generation.execute! function_definition)
+ _ (/////generation.save! function_name function_definition)]
+ (wrap (_.apply/* (_.var function_name) inits)))
_
(do {! ///////phase.monad}
@@ -51,60 +53,63 @@
(|> (list.enumeration inits)
(list\map (|>> product.left ..capture)))
($_ _.then
- function-definition
- (_.return (_.var function-name))))]
- _ (/////generation.execute! function-definition)
+ function_definition
+ (_.return (_.var function_name))))]
+ _ (/////generation.execute! function_definition)
_ (/////generation.save! (_.code @closure) directive)]
(wrap (_.apply/* @closure inits)))))
(def: input
(|>> inc //case.register))
+(def: (@scope function_name)
+ (-> Context Text)
+ (format (///reference.artifact function_name) "_scope"))
+
(def: #export (function generate archive [environment arity bodyS])
(Generator (Abstraction Synthesis))
(do {! ///////phase.monad}
- [[function-name bodyO] (/////generation.with-new-context
+ [[function_name bodyO] (/////generation.with_new_context archive
(do !
- [function-name (\ ! map ///reference.artifact-name
- /////generation.context)]
- (/////generation.with-anchor (_.var function-name)
+ [function_name (\ ! map ..@scope
+ (/////generation.context archive))]
+ (/////generation.with_anchor (_.var function_name)
(generate archive bodyS))))
- closureO+ (: (Operation (List (Expression Any)))
- (monad.map ! (\ //reference.system variable) environment))
- #let [function-name (///reference.artifact-name function-name)
+ environment (monad.map ! (generate archive) environment)
+ #let [function_name (///reference.artifact function_name)
@curried (_.var "curried")
arityO (|> arity .int _.int)
- @num-args (_.var "num_args")
- @self (_.var function-name)
- apply-poly (.function (_ args func)
- (_.apply-poly (list) args func))
- initialize-self! (_.set (list (//case.register 0)) @self)
+ @num_args (_.var "num_args")
+ @self (_.var function_name)
+ apply_poly (.function (_ args func)
+ (_.apply_poly (list) args func))
+ initialize_self! (_.set (list (//case.register 0)) @self)
initialize! (list\fold (.function (_ post pre!)
($_ _.then
pre!
(_.set (list (..input post)) (_.nth (|> post .int _.int) @curried))))
- initialize-self!
+ initialize_self!
(list.indices arity))]]
- (with-closure function-name closureO+
+ (with_closure function_name environment
(_.def @self (list (_.poly @curried))
($_ _.then
- (_.set (list @num-args) (_.len/1 @curried))
- (_.cond (list [(|> @num-args (_.= arityO))
+ (_.set (list @num_args) (_.len/1 @curried))
+ (_.cond (list [(|> @num_args (_.= arityO))
($_ _.then
initialize!
(_.return bodyO))]
- [(|> @num-args (_.> arityO))
- (let [arity-inputs (_.slice (_.int +0) arityO @curried)
- extra-inputs (_.slice arityO @num-args @curried)]
+ [(|> @num_args (_.> arityO))
+ (let [arity_inputs (_.slice (_.int +0) arityO @curried)
+ extra_inputs (_.slice arityO @num_args @curried)]
(_.return (|> @self
- (apply-poly arity-inputs)
- (apply-poly extra-inputs))))])
- ## (|> @num-args (_.< arityO))
+ (apply_poly arity_inputs)
+ (apply_poly extra_inputs))))])
+ ## (|> @num_args (_.< arityO))
(let [@next (_.var "next")
@missing (_.var "missing")]
($_ _.then
(_.def @next (list (_.poly @missing))
- (_.return (|> @self (apply-poly (|> @curried (_.+ @missing))))))
+ (_.return (|> @self (apply_poly (|> @curried (_.+ @missing))))))
(_.return @next)
)))
)))
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 14868757d..d8914d1e6 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
@@ -4,12 +4,13 @@
["." monad (#+ do)]]
[data
["." product]
- [number
- ["n" nat]]
[text
["%" format (#+ format)]]
[collection
["." list ("#\." functor)]]]
+ [math
+ [number
+ ["n" nat]]]
[target
["_" python (#+ Expression SVar)]]]
["." // #_
@@ -21,16 +22,16 @@
["//#" /// #_
["#." phase]]]])
-(def: loop-name
+(def: loop_name
(-> Nat SVar)
(|>> %.nat (format "loop") _.var))
(def: #export (scope generate archive [start initsS+ bodyS])
(Generator (Scope Synthesis))
(do {! ///////phase.monad}
- [@loop (\ ! map ..loop-name /////generation.next)
+ [@loop (\ ! map ..loop_name /////generation.next)
initsO+ (monad.map ! (generate archive) initsS+)
- bodyO (/////generation.with-anchor @loop
+ bodyO (/////generation.with_anchor @loop
(generate archive bodyS))
#let [directive (_.def @loop (|> initsS+
list.enumeration
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/reference.lux
index 41ff5a802..0f7629614 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/reference.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/reference.lux
@@ -2,11 +2,11 @@
[lux #*
[target
["_" python (#+ Expression)]]]
- ["." /// #_
- ["#." reference]])
+ [///
+ [reference (#+ System)]])
-(def: #export system
- (let [constant (: (-> Text (Expression Any))
- _.var)
- variable constant]
- (///reference.system constant variable)))
+(structure: #export system
+ (System (Expression Any))
+
+ (def: constant _.var)
+ (def: variable _.var))
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 7469aaa7d..876fab6a9 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
@@ -1,32 +1,39 @@
(.module:
[lux (#- inc)
+ ["." meta]
[abstract
- [monad (#+ do)]]
+ ["." monad (#+ do)]]
[control
["." function]
- ["p" parser
- ["s" code]]]
+ ["<>" parser
+ ["<.>" code]]]
[data
- [number (#+ hex)
- ["." i64]]
- ["." text
- ["%" format (#+ format)]]
+ ["." product]
+ ["." text ("#\." hash)
+ ["%" format (#+ format)]
+ ["." encoding]]
[collection
- ["." list ("#\." functor)]]]
+ ["." list ("#\." functor)]
+ ["." row]]]
["." macro
- ["." code]
- [syntax (#+ syntax:)]]
+ [syntax (#+ syntax:)]
+ ["." code]]
+ [math
+ [number (#+ hex)
+ ["." i64]]]
[target
["_" python (#+ Expression SVar Computation Literal Statement)]]]
["." /// #_
["#." reference]
["//#" /// #_
+ ["$" version]
["#." synthesis]
- ["#." generation (#+ Buffer)]
- ["//#" /// #_
+ ["#." generation]
+ ["//#" /// (#+ Output)
["#." phase]
[meta
- [archive (#+ Archive)]]]]])
+ [archive (#+ Archive)
+ ["." artifact (#+ Registry)]]]]]])
(template [<name> <base>]
[(type: #export <name>
@@ -77,74 +84,78 @@
(-> (Expression Any) Literal)
(..variant 1 #1))
-(def: runtime-name
+(def: (runtime_name name)
(-> Text SVar)
- (|>> ///reference.sanitize
- (format ..prefix "_")
- _.var))
+ (let [identifier (format ..prefix
+ "_" (%.nat $.version)
+ "_" (%.nat (text\hash name)))]
+ (_.var identifier)))
(def: (feature name definition)
(-> SVar (-> SVar (Statement Any)) (Statement Any))
(definition name))
-(syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))}
+(syntax: #export (with_vars {vars (<code>.tuple (<>.some <code>.local_identifier))}
body)
- (wrap (list (` (let [(~+ (|> vars
- (list\map (function (_ var)
- (list (code.local-identifier var)
- (` (_.var (~ (code.text (///reference.sanitize var))))))))
- list.concat))]
- (~ body))))))
-
-(syntax: (runtime: {declaration (p.or s.local-identifier
- (s.form (p.and s.local-identifier
- (p.some s.local-identifier))))}
+ (do {! meta.monad}
+ [ids (monad.seq ! (list.repeat (list.size vars) meta.count))]
+ (wrap (list (` (let [(~+ (|> vars
+ (list.zip/2 ids)
+ (list\map (function (_ [id var])
+ (list (code.local_identifier var)
+ (` (_.var (~ (code.text (format "v" (%.nat id)))))))))
+ list.concat))]
+ (~ body)))))))
+
+(syntax: (runtime: {declaration (<>.or <code>.local_identifier
+ (<code>.form (<>.and <code>.local_identifier
+ (<>.some <code>.local_identifier))))}
code)
(case declaration
(#.Left name)
- (macro.with-gensyms [g!_]
- (let [nameC (code.local-identifier name)
- code-nameC (code.local-identifier (format "@" name))
- runtime-nameC (` (runtime-name (~ (code.text name))))]
- (wrap (list (` (def: #export (~ nameC) SVar (~ runtime-nameC)))
- (` (def: (~ code-nameC)
+ (macro.with_gensyms [g!_]
+ (let [nameC (code.local_identifier name)
+ code_nameC (code.local_identifier (format "@" name))
+ runtime_nameC (` (runtime_name (~ (code.text name))))]
+ (wrap (list (` (def: #export (~ nameC) SVar (~ runtime_nameC)))
+ (` (def: (~ code_nameC)
(Statement Any)
- (..feature (~ runtime-nameC)
+ (..feature (~ runtime_nameC)
(function ((~ g!_) (~ nameC))
(~ code)))))))))
(#.Right [name inputs])
- (macro.with-gensyms [g!_]
- (let [nameC (code.local-identifier name)
- code-nameC (code.local-identifier (format "@" name))
- runtime-nameC (` (runtime-name (~ (code.text name))))
- inputsC (list\map code.local-identifier inputs)
- inputs-typesC (list\map (function.constant (` (_.Expression Any)))
+ (macro.with_gensyms [g!_]
+ (let [nameC (code.local_identifier name)
+ code_nameC (code.local_identifier (format "@" name))
+ runtime_nameC (` (runtime_name (~ (code.text name))))
+ inputsC (list\map code.local_identifier inputs)
+ inputs_typesC (list\map (function.constant (` (_.Expression Any)))
inputs)]
(wrap (list (` (def: #export ((~ nameC) (~+ inputsC))
- (-> (~+ inputs-typesC) (Computation Any))
- (_.apply/* (~ runtime-nameC) (list (~+ inputsC)))))
- (` (def: (~ code-nameC)
+ (-> (~+ inputs_typesC) (Computation Any))
+ (_.apply/* (~ runtime_nameC) (list (~+ inputsC)))))
+ (` (def: (~ code_nameC)
(Statement Any)
- (..feature (~ runtime-nameC)
+ (..feature (~ runtime_nameC)
(function ((~ g!_) (~ g!_))
- (..with-vars [(~+ inputsC)]
+ (..with_vars [(~+ inputsC)]
(_.def (~ g!_) (list (~+ inputsC))
(~ code)))))))))))))
(runtime: (lux//try op)
- (with-vars [error value]
+ (with_vars [error value]
(_.try ($_ _.then
(_.set (list value) (_.apply/* op (list unit)))
(_.return (right value)))
(list [(list (_.var "Exception")) error
(_.return (left (_.str/1 error)))]))))
-(runtime: (lux//program-args program-args)
- (with-vars [inputs value]
+(runtime: (lux//program_args program_args)
+ (with_vars [inputs value]
($_ _.then
(_.set (list inputs) none)
- (<| (_.for-in value program-args)
+ (<| (_.for_in value program_args)
(_.set (list inputs)
(some (_.tuple (list value inputs)))))
(_.return inputs))))
@@ -153,7 +164,7 @@
(Statement Any)
($_ _.then
@lux//try
- @lux//program-args
+ @lux//program_args
))
(runtime: (io//log! message)
@@ -172,7 +183,7 @@
(_.statement (|> (_.var "sys") (_.do "exit" (list code))))
(_.return ..unit)))
-(runtime: (io//current-time! _)
+(runtime: (io//current_time! _)
($_ _.then
(_.import "time")
(_.return (|> (_.var "time")
@@ -186,63 +197,63 @@
@io//log!
@io//throw!
@io//exit!
- @io//current-time!
+ @io//current_time!
))
-(def: last-index
+(def: last_index
(|>> _.len/1 (_.- (_.int +1))))
-(with-expansions [<recur> (as-is ($_ _.then
- (_.set (list lefts) (_.- last-index-right lefts))
- (_.set (list tuple) (_.nth last-index-right tuple))))]
+(with_expansions [<recur> (as_is ($_ _.then
+ (_.set (list lefts) (_.- last_index_right lefts))
+ (_.set (list tuple) (_.nth last_index_right tuple))))]
(runtime: (tuple//left lefts tuple)
- (with-vars [last-index-right]
+ (with_vars [last_index_right]
(<| (_.while (_.bool true))
($_ _.then
- (_.set (list last-index-right) (..last-index tuple))
- (_.if (_.> lefts last-index-right)
+ (_.set (list last_index_right) (..last_index tuple))
+ (_.if (_.> lefts last_index_right)
## No need for recursion
(_.return (_.nth lefts tuple))
## Needs recursion
<recur>)))))
(runtime: (tuple//right lefts tuple)
- (with-vars [last-index-right right-index]
+ (with_vars [last_index_right right_index]
(<| (_.while (_.bool true))
($_ _.then
- (_.set (list last-index-right) (..last-index tuple))
- (_.set (list right-index) (_.+ (_.int +1) lefts))
- (_.cond (list [(_.= last-index-right right-index)
- (_.return (_.nth right-index tuple))]
- [(_.> last-index-right right-index)
+ (_.set (list last_index_right) (..last_index tuple))
+ (_.set (list right_index) (_.+ (_.int +1) lefts))
+ (_.cond (list [(_.= last_index_right right_index)
+ (_.return (_.nth right_index tuple))]
+ [(_.> last_index_right right_index)
## Needs recursion.
<recur>])
- (_.return (_.slice-from right-index tuple)))
+ (_.return (_.slice_from right_index tuple)))
)))))
(runtime: (sum//get sum wantsLast wantedTag)
- (let [no-match! (_.return _.none)
- sum-tag (_.nth (_.int +0) sum)
- sum-flag (_.nth (_.int +1) sum)
- sum-value (_.nth (_.int +2) sum)
- is-last? (_.= (_.string "") sum-flag)
- test-recursion! (_.if is-last?
+ (let [no_match! (_.return _.none)
+ sum_tag (_.nth (_.int +0) sum)
+ sum_flag (_.nth (_.int +1) sum)
+ sum_value (_.nth (_.int +2) sum)
+ is_last? (_.= (_.string "") sum_flag)
+ test_recursion! (_.if is_last?
## Must recurse.
- (_.return (sum//get sum-value wantsLast (_.- sum-tag wantedTag)))
- no-match!)]
- (_.cond (list [(_.= sum-tag wantedTag)
- (_.if (_.= wantsLast sum-flag)
- (_.return sum-value)
- test-recursion!)]
+ (_.return (sum//get sum_value wantsLast (_.- sum_tag wantedTag)))
+ no_match!)]
+ (_.cond (list [(_.= sum_tag wantedTag)
+ (_.if (_.= wantsLast sum_flag)
+ (_.return sum_value)
+ test_recursion!)]
- [(_.> sum-tag wantedTag)
- test-recursion!]
+ [(_.> sum_tag wantedTag)
+ test_recursion!]
- [(_.and (_.< sum-tag wantedTag)
+ [(_.and (_.< sum_tag wantedTag)
(_.= (_.string "") wantsLast))
- (_.return (variant' (_.- wantedTag sum-tag) sum-flag sum-value))])
+ (_.return (variant' (_.- wantedTag sum_tag) sum_flag sum_value))])
- no-match!)))
+ no_match!)))
(def: runtime//adt
(Statement Any)
@@ -252,14 +263,14 @@
@sum//get
))
-(def: full-64-bits
+(def: full_64_bits
Literal
(_.manual "0xFFFFFFFFFFFFFFFF"))
(runtime: (i64//64 input)
- (with-vars [capped]
- (_.cond (list [(|> input (_.> full-64-bits))
- (_.return (|> input (_.bit-and full-64-bits) i64//64))]
+ (with_vars [capped]
+ (_.cond (list [(|> input (_.> full_64_bits))
+ (_.return (|> input (_.bit_and full_64_bits) i64//64))]
[(|> input (_.> (: Literal (_.manual "0x7FFFFFFFFFFFFFFF"))))
($_ _.then
(_.set (list capped)
@@ -270,23 +281,23 @@
(_.return (: Literal (_.manual "-9223372036854775808L")))))])
(_.return input))))
-(runtime: (i64//logic-right-shift param subject)
+(runtime: (i64//logic_right_shift param subject)
(let [mask (|> (_.int +1)
- (_.bit-shl (_.- param (_.int +64)))
+ (_.bit_shl (_.- param (_.int +64)))
(_.- (_.int +1)))]
(_.return (|> subject
- (_.bit-shr param)
- (_.bit-and mask)))))
+ (_.bit_shr param)
+ (_.bit_and mask)))))
(def: runtime//i64
(Statement Any)
($_ _.then
@i64//64
- @i64//logic-right-shift
+ @i64//logic_right_shift
))
(runtime: (frac//decode input)
- (with-vars [ex]
+ (with_vars [ex]
(_.try
(_.return (..some (_.float/1 input)))
(list [(list (_.var "Exception")) ex
@@ -299,7 +310,7 @@
))
(runtime: (text//index subject param start)
- (with-vars [idx]
+ (with_vars [idx]
($_ _.then
(_.set (list idx) (|> subject (_.do "find" (list param start))))
(_.if (_.= (_.int -1) idx)
@@ -340,14 +351,19 @@
runtime//io
))
-(def: #export artifact ..prefix)
+(def: #export artifact
+ ..prefix)
(def: #export generate
- (Operation (Buffer (Statement Any)))
- (/////generation.with-buffer
+ (Operation [Registry Output])
+ (/////generation.with_buffer
(do ///////phase.monad
- [#let [directive (<| (_.comment "-*- coding: utf-8 -*-")
- ..runtime)]
- _ (/////generation.execute! directive)
- _ (/////generation.save! ..prefix directive)]
- /////generation.buffer)))
+ [_ (/////generation.execute! ..runtime)
+ _ (/////generation.save! ..prefix ..runtime)]
+ (wrap [(|> artifact.empty
+ artifact.resource
+ product.right)
+ (row.row ["0"
+ (|> ..runtime
+ _.code
+ (\ encoding.utf8 encode))])]))))
diff --git a/stdlib/source/program/aedifex/artifact/build.lux b/stdlib/source/program/aedifex/artifact/build.lux
new file mode 100644
index 000000000..d9a8b729e
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact/build.lux
@@ -0,0 +1,43 @@
+(.module:
+ [lux #*
+ [abstract
+ [equivalence (#+ Equivalence)]
+ [monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<.>" xml (#+ Parser)]
+ ["<.>" text]]]
+ [data
+ [text
+ ["%" format]]
+ [format
+ ["." xml (#+ XML)]]]
+ [math
+ [number
+ ["." nat]]]])
+
+(type: #export Build
+ Nat)
+
+(def: #export equivalence
+ (Equivalence Build)
+ nat.equivalence)
+
+(def: tag
+ xml.Tag
+ ["" "buildNumber"])
+
+(def: #export format
+ (-> Build XML)
+ (|>> %.nat
+ #xml.Text
+ list
+ (#xml.Node ..tag xml.attributes)))
+
+(def: #export parser
+ (Parser Build)
+ (do <>.monad
+ [_ (<xml>.node ..tag)]
+ (<text>.embed (<>.codec nat.decimal
+ (<text>.many <text>.decimal))
+ (<xml>.children <xml>.text))))
diff --git a/stdlib/source/test/aedifex/artifact/build.lux b/stdlib/source/test/aedifex/artifact/build.lux
new file mode 100644
index 000000000..d0920b44c
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/build.lux
@@ -0,0 +1,34 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
+ [control
+ ["." try ("#\." functor)]
+ [parser
+ ["<.>" xml]]]
+ [math
+ ["." random]]]
+ {#program
+ ["." /]})
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Build]
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence random.nat))
+
+ (do random.monad
+ [expected random.nat]
+ (_.cover [/.format /.parser]
+ (|> expected
+ /.format
+ (<xml>.run /.parser)
+ (try\map (\ /.equivalence = expected))
+ (try.default false))))
+ ))))
diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux
index 9fd3986b8..b31c10617 100644
--- a/stdlib/source/test/lux/abstract.lux
+++ b/stdlib/source/test/lux/abstract.lux
@@ -8,6 +8,7 @@
["#/." cofree]]
["#." enum]
["#." equivalence]
+ ["#." hash]
["#." fold]
["#." functor
["#/." contravariant]]
@@ -46,6 +47,7 @@
/codec.test
/enum.test
/equivalence.test
+ /hash.test
/fold.test
/interval.test
/monoid.test
diff --git a/stdlib/source/test/lux/abstract/hash.lux b/stdlib/source/test/lux/abstract/hash.lux
new file mode 100644
index 000000000..c527fb9c9
--- /dev/null
+++ b/stdlib/source/test/lux/abstract/hash.lux
@@ -0,0 +1,39 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ [functor
+ ["$." contravariant]]]}]
+ [data
+ ["." bit ("#\." equivalence)]]
+ [math
+ ["." random]
+ [number
+ ["." nat]]]]
+ {1
+ ["." / (#+ Hash)
+ [//
+ [equivalence (#+ Equivalence)]]]})
+
+(def: #export test
+ Test
+ (do random.monad
+ [leftN random.nat
+ rightN random.nat
+ #let [hash (: (Equivalence (/.Hash Nat))
+ (structure
+ (def: (= (^open "left\.") (^open "right\."))
+ (and (bit\= (left\= (left\hash leftN) (left\hash leftN))
+ (right\= (right\hash leftN) (right\hash leftN)))
+ (bit\= (left\= (left\hash rightN) (left\hash rightN))
+ (right\= (right\hash rightN) (right\hash rightN)))
+ (bit\= (left\= (left\hash leftN) (left\hash rightN))
+ (right\= (right\hash leftN) (right\hash rightN)))))))]]
+ (<| (_.covering /._)
+ ($_ _.and
+ (_.for [/.functor]
+ ($contravariant.spec hash nat.hash /.functor))
+ ))))
diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux
index 6306f62fc..3efc42254 100644
--- a/stdlib/source/test/lux/data/collection/list.lux
+++ b/stdlib/source/test/lux/data/collection/list.lux
@@ -7,6 +7,7 @@
{[0 #spec]
[/
["$." equivalence]
+ ["$." hash]
["$." monoid]
["$." fold]
["$." functor]
@@ -49,6 +50,10 @@
($_ _.and
(_.for [/.equivalence]
($equivalence.spec (/.equivalence n.equivalence) ..random))
+ (_.for [/.hash]
+ (|> random.nat
+ (\ random.monad map (|>> list))
+ ($hash.spec (/.hash n.hash))))
(_.for [/.monoid]
($monoid.spec (/.equivalence n.equivalence) /.monoid ..random))
(_.for [/.fold]
diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux
index 6f981af91..282749f5e 100644
--- a/stdlib/source/test/lux/data/collection/set.lux
+++ b/stdlib/source/test/lux/data/collection/set.lux
@@ -7,6 +7,7 @@
{[0 #spec]
[/
["$." equivalence]
+ ["$." hash]
["$." monoid]]}]
[data
["." bit ("#\." equivalence)]
@@ -33,6 +34,10 @@
($_ _.and
(_.for [/.equivalence]
($equivalence.spec /.equivalence (random.set n.hash size random.nat)))
+ (_.for [/.hash]
+ (|> random.nat
+ (\ random.monad map (|>> list (/.from_list n.hash)))
+ ($hash.spec /.hash)))
(_.for [/.monoid]
($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat)))
diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux
index 9d9572795..718c971c3 100644
--- a/stdlib/source/test/lux/data/collection/set/multi.lux
+++ b/stdlib/source/test/lux/data/collection/set/multi.lux
@@ -7,7 +7,8 @@
["." predicate]
{[0 #spec]
[/
- ["$." equivalence]]}]
+ ["$." equivalence]
+ ["$." hash]]}]
[data
["." bit ("#\." equivalence)]
[collection
@@ -50,6 +51,11 @@
(`` ($_ _.and
(_.for [/.equivalence]
($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat)))
+ (_.for [/.hash]
+ (|> random.nat
+ (\ random.monad map (function (_ single)
+ (/.add 1 single (/.new n.hash))))
+ ($hash.spec /.hash)))
(_.cover [/.to_list /.from_list]
(|> sample
diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux
index 64f9b5ff5..017d0799b 100644
--- a/stdlib/source/test/lux/data/maybe.lux
+++ b/stdlib/source/test/lux/data/maybe.lux
@@ -6,6 +6,7 @@
{[0 #spec]
[/
["$." equivalence]
+ ["$." hash]
["$." monoid]
["$." functor]
["$." apply]
@@ -31,6 +32,10 @@
($_ _.and
(_.for [/.equivalence]
($equivalence.spec (/.equivalence n.equivalence) (random.maybe random.nat)))
+ (_.for [/.hash]
+ (|> random.nat
+ (\ random.monad map (|>> #.Some))
+ ($hash.spec (/.hash n.hash))))
(_.for [/.monoid]
($monoid.spec (/.equivalence n.equivalence) /.monoid (random.maybe random.nat)))
(_.for [/.functor]
diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux
index 7912994c3..f68a58d9a 100644
--- a/stdlib/source/test/lux/data/name.lux
+++ b/stdlib/source/test/lux/data/name.lux
@@ -6,6 +6,7 @@
{[0 #spec]
[/
["$." equivalence]
+ ["$." hash]
["$." order]
["$." codec]]}]
[control
@@ -45,6 +46,10 @@
($_ _.and
(_.for [/.equivalence]
($equivalence.spec /.equivalence (..random sizeM1 sizeS1)))
+ (_.for [/.hash]
+ (|> (random.ascii 2)
+ (\ ! map (|>> [""]))
+ ($hash.spec /.hash)))
(_.for [/.order]
($order.spec /.order (..random sizeM1 sizeS1)))
(_.for [/.codec]
diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux
index a5d11685f..c89ca97ba 100644
--- a/stdlib/source/test/lux/data/text.lux
+++ b/stdlib/source/test/lux/data/text.lux
@@ -6,6 +6,7 @@
{[0 #spec]
[/
["$." equivalence]
+ ["$." hash]
["$." order]
["$." monoid]]}]
[control
@@ -238,6 +239,9 @@
($_ _.and
(_.for [/.equivalence]
($equivalence.spec /.equivalence (random.ascii 2)))
+ (_.for [/.hash]
+ (|> (random.ascii 2)
+ ($hash.spec /.hash)))
(_.for [/.order]
($order.spec /.order (random.ascii 2)))
(_.for [/.monoid]
diff --git a/stdlib/source/test/lux/locale.lux b/stdlib/source/test/lux/locale.lux
index 5693eb2c4..23cb63a97 100644
--- a/stdlib/source/test/lux/locale.lux
+++ b/stdlib/source/test/lux/locale.lux
@@ -5,7 +5,8 @@
[monad (#+ do)]
{[0 #spec]
[/
- ["$." equivalence]]}]
+ ["$." equivalence]
+ ["$." hash]]}]
[math
["." random (#+ Random) ("#\." monad)]]
[data
@@ -51,6 +52,25 @@
($_ _.and
(_.for [/.equivalence]
($equivalence.spec /.equivalence ..random_locale))
+ (_.for [/.hash]
+ (do {! random.monad}
+ [fixed_language ..random_language
+ fixed_territory ..random_territory
+ fixed_encoding ..random_encoding]
+ ($_ _.and
+ (|> ..random_language
+ (\ ! map (function (_ language)
+ (/.locale language (#.Some fixed_territory) (#.Some fixed_encoding))))
+ ($hash.spec /.hash))
+ (|> ..random_territory
+ (\ ! map (function (_ territory)
+ (/.locale fixed_language (#.Some territory) (#.Some fixed_encoding))))
+ ($hash.spec /.hash))
+ (|> ..random_encoding
+ (\ ! map (function (_ encoding)
+ (/.locale fixed_language (#.Some fixed_territory) (#.Some encoding))))
+ ($hash.spec /.hash))
+ )))
(do random.monad
[language ..random_language
diff --git a/stdlib/source/test/lux/time/month.lux b/stdlib/source/test/lux/time/month.lux
index d7078fa65..2cecfced6 100644
--- a/stdlib/source/test/lux/time/month.lux
+++ b/stdlib/source/test/lux/time/month.lux
@@ -1,38 +1,89 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
+ [monad (#+ do)]
+ ["." predicate]
{[0 #spec]
[/
["$." equivalence]
+ ["$." hash]
["$." order]
["$." enum]]}]
+ [control
+ ["." try ("#\." functor)]
+ ["." exception]]
+ [data
+ [collection
+ ["." set]
+ ["." list ("#\." functor fold)]]]
[math
- ["r" random (#+ Random) ("#\." monad)]]]
+ ["." random (#+ Random)]
+ [number
+ ["n" nat]]]]
{1
- ["." / (#+ Month)]})
+ ["." /
+ [//
+ ["." duration]]]})
-(def: #export month
- (Random Month)
- (r.either (r.either (r.either (r\wrap #/.January)
- (r.either (r\wrap #/.February)
- (r\wrap #/.March)))
- (r.either (r\wrap #/.April)
- (r.either (r\wrap #/.May)
- (r\wrap #/.June))))
- (r.either (r.either (r\wrap #/.July)
- (r.either (r\wrap #/.August)
- (r\wrap #/.September)))
- (r.either (r\wrap #/.October)
- (r.either (r\wrap #/.November)
- (r\wrap #/.December))))))
+(def: #export random
+ (Random /.Month)
+ (let [december (/.number #/.December)]
+ (|> random.nat
+ (\ random.monad map (|>> (n.% december) inc))
+ (random.one (|>> /.by_number try.to_maybe)))))
(def: #export test
Test
- (<| (_.context (%.name (name_of /._)))
+ (<| (_.covering /._)
+ (_.for [/.Month])
($_ _.and
- ($equivalence.spec /.equivalence ..month)
- ($order.spec /.order ..month)
- ($enum.spec /.enum ..month)
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+ (_.for [/.hash]
+ ($hash.spec /.hash ..random))
+ (_.for [/.order]
+ ($order.spec /.order ..random))
+ (_.for [/.enum]
+ ($enum.spec /.enum ..random))
+
+ (do random.monad
+ [expected ..random
+ invalid (random.filter (predicate.unite (n.< (/.number #/.January))
+ (n.> (/.number #/.December)))
+ random.nat)]
+ ($_ _.and
+ (_.cover [/.number /.by_number]
+ (|> expected
+ /.number
+ /.by_number
+ (try\map (\ /.equivalence = expected))
+ (try.default false)))
+ (_.cover [/.invalid_month]
+ (case (/.by_number invalid)
+ (#try.Failure error)
+ (exception.match? /.invalid_month error)
+
+ (#try.Success _)
+ false))
+ (_.cover [/.year]
+ (let [all (list.size /.year)
+ uniques (set.size (set.from_list /.hash /.year))]
+ (and (n.= (/.number #/.December)
+ all)
+ (n.= all
+ uniques))))
+ (_.cover [/.days]
+ (let [expected (.nat (duration.query duration.day duration.normal_year))]
+ (|> /.year
+ (list\map /.days)
+ (list\fold n.+ 0)
+ (n.= expected))))
+ (_.cover [/.leap_year_days]
+ (let [expected (.nat (duration.query duration.day duration.leap_year))]
+ (|> /.year
+ (list\map /.leap_year_days)
+ (list\fold n.+ 0)
+ (n.= expected))))
+ ))
)))