aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/abstract/algebra.lux1
-rw-r--r--stdlib/source/lux/data/format/json.lux22
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js.lux17
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux (renamed from stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension/common.lux)155
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux (renamed from stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension/host.lux)80
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux55
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux82
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension.lux15
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux37
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux17
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux10
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux41
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux25
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux52
-rw-r--r--stdlib/source/test/lux/abstract.lux2
-rw-r--r--stdlib/source/test/lux/abstract/codec.lux36
-rw-r--r--stdlib/source/test/lux/extension.lux14
17 files changed, 360 insertions, 301 deletions
diff --git a/stdlib/source/lux/abstract/algebra.lux b/stdlib/source/lux/abstract/algebra.lux
index 2813ed0e7..0d066fb4f 100644
--- a/stdlib/source/lux/abstract/algebra.lux
+++ b/stdlib/source/lux/abstract/algebra.lux
@@ -3,7 +3,6 @@
[control
functor]])
-## Types
(type: #export (Algebra f a)
(-> (f a) a))
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 60d57abab..c42093710 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -51,6 +51,10 @@
[Object (Dictionary String JSON)]
)
+(def: #export object
+ (-> (List [String JSON]) JSON)
+ (|>> (dictionary.from-list text.hash) #..Object))
+
(syntax: #export (json token)
{#.doc (doc "A simple way to produce JSON literals."
(json #1)
@@ -66,15 +70,15 @@
(^template [<ast-tag> <ctor> <json-tag>]
[_ (<ast-tag> value)]
(wrap (list (` (: JSON (<json-tag> (~ (<ctor> value))))))))
- ([#.Bit code.bit #Boolean]
- [#.Frac code.frac #Number]
- [#.Text code.text #String])
+ ([#.Bit code.bit #..Boolean]
+ [#.Frac code.frac #..Number]
+ [#.Text code.text #..String])
[_ (#.Tag ["" "null"])]
- (wrap (list (` (: JSON #Null))))
+ (wrap (list (` (: JSON #..Null))))
[_ (#.Tuple members)]
- (wrap (list (` (: JSON (#Array ((~! row) (~+ (list@map wrapper members))))))))
+ (wrap (list (` (: JSON (#..Array ((~! row) (~+ (list@map wrapper members))))))))
[_ (#.Record pairs)]
(do ..monad
@@ -87,7 +91,9 @@
_
(macro.fail "Wrong syntax for JSON object.")))
pairs)]
- (wrap (list (` (: JSON (#Object ((~! dictionary.from-list) (~! text.hash) (list (~+ pairs')))))))))
+ (wrap (list (` (: JSON (#..Object ((~! dictionary.from-list)
+ (~! text.hash)
+ (list (~+ pairs')))))))))
_
(wrap (list token)))))
@@ -115,7 +121,7 @@
(#try.Failure ($_ text@compose "Missing field '" key "' on object.")))
_
- (#try.Failure ($_ text@compose "Cannot get field '" key "' of a non-object."))))
+ (#try.Failure ($_ text@compose "Cannot get field '" key "' on a non-object."))))
(def: #export (set key value json)
{#.doc "A JSON object field setter."}
@@ -125,7 +131,7 @@
(#try.Success (#Object (dictionary.put key value obj)))
_
- (#try.Failure ($_ text@compose "Cannot set field '" key "' of a non-object."))))
+ (#try.Failure ($_ text@compose "Cannot set field '" key "' on a non-object."))))
(template [<name> <tag> <type> <desc>]
[(def: #export (<name> key json)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js.lux
new file mode 100644
index 000000000..81d2fe57b
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js.lux
@@ -0,0 +1,17 @@
+(.module:
+ [lux #*
+ [data
+ [collection
+ ["." dictionary]]]]
+ ["." / #_
+ ["#." common]
+ ["#." host]
+ [////
+ [generation
+ [js
+ [runtime (#+ Bundle)]]]]])
+
+(def: #export bundle
+ Bundle
+ (dictionary.merge /common.bundle
+ /host.bundle))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux
index c5c4d15ff..966815a29 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension/common.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux
@@ -16,17 +16,20 @@
["." dictionary]]]
[target
["_" js (#+ Literal Expression Statement)]]]
- ["." /// #_
- ["#." runtime (#+ Operation Phase Handler Bundle)]
- ["#." primitive]
+ ["." //// #_
+ ["/" bundle]
["/#" // #_
- [extension (#+ Nullary Unary Binary Trinary
- nullary unary binary trinary)]
- ["/#" //
- ["." extension
- ["." bundle]]
- [//
- [synthesis (#+ %synthesis)]]]]])
+ ["." extension]
+ [generation
+ [extension (#+ Nullary Unary Binary Trinary
+ nullary unary binary trinary)]
+ ["//" js #_
+ ["#." runtime (#+ Operation Phase Handler Bundle)]
+ ["#." primitive]]]
+ [//
+ [synthesis (#+ %synthesis)]
+ [///
+ ["#" phase]]]]])
(def: #export (custom [parser handler])
(All [s]
@@ -46,11 +49,11 @@
(template [<name> <op>]
[(def: (<name> [paramG subjectG])
(Binary Expression)
- (<op> subjectG (///runtime.i64//to-number paramG)))]
+ (<op> subjectG (//runtime.i64//to-number paramG)))]
- [i64//left-shift ///runtime.i64//left-shift]
- [i64//arithmetic-right-shift ///runtime.i64//arithmetic-right-shift]
- [i64//logical-right-shift ///runtime.i64//logic-right-shift]
+ [i64//left-shift //runtime.i64//left-shift]
+ [i64//arithmetic-right-shift //runtime.i64//arithmetic-right-shift]
+ [i64//logical-right-shift //runtime.i64//logic-right-shift]
)
## [[Numbers]]
@@ -61,7 +64,7 @@
(template [<name> <const>]
[(def: (<name> _)
(Nullary Expression)
- (///primitive.f64 <const>))]
+ (//primitive.f64 <const>))]
[f64//smallest (java/lang/Double::MIN_VALUE)]
[f64//min (f.* -1.0 (java/lang/Double::MAX_VALUE))]
@@ -74,11 +77,11 @@
(_.apply/* (_.var "parseFloat"))
_.return
(_.closure (list))
- ///runtime.lux//try))
+ //runtime.lux//try))
(def: i64//char
(Unary Expression)
- (|>> ///runtime.i64//to-number
+ (|>> //runtime.i64//to-number
(list)
(_.apply/* (_.var "String.fromCharCode"))))
@@ -89,18 +92,18 @@
(def: (text//clip [startG endG subjectG])
(Trinary Expression)
- (///runtime.text//clip startG endG subjectG))
+ (//runtime.text//clip startG endG subjectG))
(def: (text//index [startG partG subjectG])
(Trinary Expression)
- (///runtime.text//index startG partG subjectG))
+ (//runtime.text//index startG partG subjectG))
## [[IO]]
(def: (io//log messageG)
(Unary Expression)
($_ _.,
- (///runtime.io//log messageG)
- ///runtime.unit))
+ (//runtime.io//log messageG)
+ //runtime.unit))
(def: (io//exit codeG)
(Unary Expression)
@@ -111,7 +114,7 @@
($_ _.and
(_.not (_.= _.undefined (_.type-of @@process)))
(_.the "exit" @@process)
- (_.do "exit" (list (///runtime.i64//to-number codeG)) @@process))
+ (_.do "exit" (list (//runtime.i64//to-number codeG)) @@process))
(_.do "close" (list) @@window)
(_.do "reload" (list) @@location))))
@@ -119,7 +122,7 @@
(Nullary Expression)
(|> (_.new (_.var "Date") (list))
(_.do "getTime" (list))
- ///runtime.i64//from-number))
+ //runtime.i64//from-number))
## TODO: Get rid of this ASAP
(def: lux::syntax-char-case!
@@ -142,7 +145,7 @@
(_.return branchG)])))
conditionals))]
(wrap (_.apply/* (_.closure (list)
- (_.switch (_.the ///runtime.i64-low-field inputG)
+ (_.switch (_.the //runtime.i64-low-field inputG)
conditionalsG
(#.Some (_.return elseG))))
(list)))))]))
@@ -150,75 +153,75 @@
## [Bundles]
(def: lux-procs
Bundle
- (|> bundle.empty
- (bundle.install "syntax char case!" lux::syntax-char-case!)
- (bundle.install "is" (binary (product.uncurry _.=)))
- (bundle.install "try" (unary ///runtime.lux//try))))
+ (|> /.empty
+ (/.install "syntax char case!" lux::syntax-char-case!)
+ (/.install "is" (binary (product.uncurry _.=)))
+ (/.install "try" (unary //runtime.lux//try))))
(def: i64-procs
Bundle
- (<| (bundle.prefix "i64")
- (|> bundle.empty
- (bundle.install "and" (binary (product.uncurry ///runtime.i64//and)))
- (bundle.install "or" (binary (product.uncurry ///runtime.i64//or)))
- (bundle.install "xor" (binary (product.uncurry ///runtime.i64//xor)))
- (bundle.install "left-shift" (binary i64//left-shift))
- (bundle.install "logical-right-shift" (binary i64//logical-right-shift))
- (bundle.install "arithmetic-right-shift" (binary i64//arithmetic-right-shift))
- (bundle.install "=" (binary (product.uncurry ///runtime.i64//=)))
- (bundle.install "<" (binary (product.uncurry ///runtime.i64//<)))
- (bundle.install "+" (binary (product.uncurry ///runtime.i64//+)))
- (bundle.install "-" (binary (product.uncurry ///runtime.i64//-)))
- (bundle.install "*" (binary (product.uncurry ///runtime.i64//*)))
- (bundle.install "/" (binary (product.uncurry ///runtime.i64///)))
- (bundle.install "%" (binary (product.uncurry ///runtime.i64//%)))
- (bundle.install "f64" (unary ///runtime.i64//to-number))
- (bundle.install "char" (unary i64//char))
+ (<| (/.prefix "i64")
+ (|> /.empty
+ (/.install "and" (binary (product.uncurry //runtime.i64//and)))
+ (/.install "or" (binary (product.uncurry //runtime.i64//or)))
+ (/.install "xor" (binary (product.uncurry //runtime.i64//xor)))
+ (/.install "left-shift" (binary i64//left-shift))
+ (/.install "logical-right-shift" (binary i64//logical-right-shift))
+ (/.install "arithmetic-right-shift" (binary i64//arithmetic-right-shift))
+ (/.install "=" (binary (product.uncurry //runtime.i64//=)))
+ (/.install "<" (binary (product.uncurry //runtime.i64//<)))
+ (/.install "+" (binary (product.uncurry //runtime.i64//+)))
+ (/.install "-" (binary (product.uncurry //runtime.i64//-)))
+ (/.install "*" (binary (product.uncurry //runtime.i64//*)))
+ (/.install "/" (binary (product.uncurry //runtime.i64///)))
+ (/.install "%" (binary (product.uncurry //runtime.i64//%)))
+ (/.install "f64" (unary //runtime.i64//to-number))
+ (/.install "char" (unary i64//char))
)))
(def: f64-procs
Bundle
- (<| (bundle.prefix "f64")
- (|> bundle.empty
- (bundle.install "+" (binary (product.uncurry _.+)))
- (bundle.install "-" (binary (product.uncurry _.-)))
- (bundle.install "*" (binary (product.uncurry _.*)))
- (bundle.install "/" (binary (product.uncurry _./)))
- (bundle.install "%" (binary (product.uncurry _.%)))
- (bundle.install "=" (binary (product.uncurry _.=)))
- (bundle.install "<" (binary (product.uncurry _.<)))
- (bundle.install "smallest" (nullary f64//smallest))
- (bundle.install "min" (nullary f64//min))
- (bundle.install "max" (nullary f64//max))
- (bundle.install "i64" (unary ///runtime.i64//from-number))
- (bundle.install "encode" (unary (_.do "toString" (list))))
- (bundle.install "decode" (unary f64//decode)))))
+ (<| (/.prefix "f64")
+ (|> /.empty
+ (/.install "+" (binary (product.uncurry _.+)))
+ (/.install "-" (binary (product.uncurry _.-)))
+ (/.install "*" (binary (product.uncurry _.*)))
+ (/.install "/" (binary (product.uncurry _./)))
+ (/.install "%" (binary (product.uncurry _.%)))
+ (/.install "=" (binary (product.uncurry _.=)))
+ (/.install "<" (binary (product.uncurry _.<)))
+ (/.install "smallest" (nullary f64//smallest))
+ (/.install "min" (nullary f64//min))
+ (/.install "max" (nullary f64//max))
+ (/.install "i64" (unary //runtime.i64//from-number))
+ (/.install "encode" (unary (_.do "toString" (list))))
+ (/.install "decode" (unary f64//decode)))))
(def: text-procs
Bundle
- (<| (bundle.prefix "text")
- (|> bundle.empty
- (bundle.install "=" (binary (product.uncurry _.=)))
- (bundle.install "<" (binary (product.uncurry _.<)))
- (bundle.install "concat" (binary text//concat))
- (bundle.install "index" (trinary text//index))
- (bundle.install "size" (unary (|>> (_.the "length") ///runtime.i64//from-number)))
- (bundle.install "char" (binary (product.uncurry ///runtime.text//char)))
- (bundle.install "clip" (trinary text//clip))
+ (<| (/.prefix "text")
+ (|> /.empty
+ (/.install "=" (binary (product.uncurry _.=)))
+ (/.install "<" (binary (product.uncurry _.<)))
+ (/.install "concat" (binary text//concat))
+ (/.install "index" (trinary text//index))
+ (/.install "size" (unary (|>> (_.the "length") //runtime.i64//from-number)))
+ (/.install "char" (binary (product.uncurry //runtime.text//char)))
+ (/.install "clip" (trinary text//clip))
)))
(def: io-procs
Bundle
- (<| (bundle.prefix "io")
- (|> bundle.empty
- (bundle.install "log" (unary io//log))
- (bundle.install "error" (unary ///runtime.io//error))
- (bundle.install "exit" (unary io//exit))
- (bundle.install "current-time" (nullary io//current-time)))))
+ (<| (/.prefix "io")
+ (|> /.empty
+ (/.install "log" (unary io//log))
+ (/.install "error" (unary //runtime.io//error))
+ (/.install "exit" (unary io//exit))
+ (/.install "current-time" (nullary io//current-time)))))
(def: #export bundle
Bundle
- (<| (bundle.prefix "lux")
+ (<| (/.prefix "lux")
(|> lux-procs
(dictionary.merge i64-procs)
(dictionary.merge f64-procs)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux
index c44e1bdff..592446e93 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension/host.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux
@@ -13,24 +13,26 @@
["_" js (#+ Expression)]]]
["." // #_
["#." common (#+ custom)]
- ["/#" // #_
- ["#." runtime (#+ Operation Phase Handler Bundle
- with-vars)]
- ["#." primitive]
+ ["//#" /// #_
+ ["/" bundle]
["/#" // #_
- [extension (#+ Nullary Unary Binary Trinary
- nullary unary binary trinary)]
- ["/#" //
- ["." extension
- ["." bundle]]]]]])
+ ["." extension]
+ [generation
+ [extension (#+ Nullary Unary Binary Trinary
+ nullary unary binary trinary)]
+ ["//" js #_
+ ["#." runtime (#+ Operation Phase Handler Bundle
+ with-vars)]]]
+ ["///#" //// #_
+ ["#." phase]]]]])
(def: array::new
(Unary Expression)
- (|>> ///runtime.i64//to-number list (_.new (_.var "Array"))))
+ (|>> //runtime.i64//to-number list (_.new (_.var "Array"))))
(def: array::length
(Unary Expression)
- (|>> (_.the "length") ///runtime.i64//from-number))
+ (|>> (_.the "length") //runtime.i64//from-number))
(def: (array::read [indexG arrayG])
(Binary Expression)
@@ -38,28 +40,28 @@
(def: (array::write [indexG valueG arrayG])
(Trinary Expression)
- (///runtime.array//write indexG valueG arrayG))
+ (//runtime.array//write indexG valueG arrayG))
(def: (array::delete [indexG arrayG])
(Binary Expression)
- (///runtime.array//delete indexG arrayG))
+ (//runtime.array//delete indexG arrayG))
(def: array
Bundle
- (<| (bundle.prefix "array")
- (|> bundle.empty
- (bundle.install "new" (unary array::new))
- (bundle.install "length" (unary array::length))
- (bundle.install "read" (binary array::read))
- (bundle.install "write" (trinary array::write))
- (bundle.install "delete" (binary array::delete))
+ (<| (/.prefix "array")
+ (|> /.empty
+ (/.install "new" (unary array::new))
+ (/.install "length" (unary array::length))
+ (/.install "read" (binary array::read))
+ (/.install "write" (trinary array::write))
+ (/.install "delete" (binary array::delete))
)))
(def: object::new
(custom
[($_ <>.and <s>.any (<>.some <s>.any))
(function (_ extension phase [constructorS inputsS])
- (do /////.monad
+ (do ////////phase.monad
[constructorG (phase constructorS)
inputsG (monad.map @ phase inputsS)]
(wrap (_.new constructorG inputsG))))]))
@@ -69,7 +71,7 @@
(custom
[($_ <>.and <s>.text <s>.any)
(function (_ extension phase [fieldS objectS])
- (do /////.monad
+ (do ////////phase.monad
[objectG (phase objectS)]
(wrap (_.the fieldS objectG))))]))
@@ -78,7 +80,7 @@
(custom
[($_ <>.and <s>.text <s>.any (<>.some <s>.any))
(function (_ extension phase [methodS objectS inputsS])
- (do /////.monad
+ (do ////////phase.monad
[objectG (phase objectS)
inputsG (monad.map @ phase inputsS)]
(wrap (_.do methodS inputsG objectG))))]))
@@ -93,22 +95,22 @@
(def: object
Bundle
- (<| (bundle.prefix "object")
- (|> bundle.empty
- (bundle.install "new" object::new)
- (bundle.install "get" object::get)
- (bundle.install "do" object::do)
- (bundle.install "null" (nullary object::null))
- (bundle.install "null?" (unary object::null?))
- (bundle.install "undefined" (nullary object::undefined))
- (bundle.install "undefined?" (unary object::undefined?))
+ (<| (/.prefix "object")
+ (|> /.empty
+ (/.install "new" object::new)
+ (/.install "get" object::get)
+ (/.install "do" object::do)
+ (/.install "null" (nullary object::null))
+ (/.install "null?" (unary object::null?))
+ (/.install "undefined" (nullary object::undefined))
+ (/.install "undefined?" (unary object::undefined?))
)))
(def: js::constant
(custom
[<s>.text
(function (_ extension phase name)
- (do /////.monad
+ (do ////////phase.monad
[]
(wrap (_.var name))))]))
@@ -116,18 +118,18 @@
(custom
[($_ <>.and <s>.any (<>.some <s>.any))
(function (_ extension phase [abstractionS inputsS])
- (do /////.monad
+ (do ////////phase.monad
[abstractionG (phase abstractionS)
inputsG (monad.map @ phase inputsS)]
(wrap (_.apply/* abstractionG inputsG))))]))
(def: #export bundle
Bundle
- (<| (bundle.prefix "js")
- (|> bundle.empty
- (bundle.install "constant" js::constant)
- (bundle.install "apply" js::apply)
- (bundle.install "type-of" (unary _.type-of))
+ (<| (/.prefix "js")
+ (|> /.empty
+ (/.install "constant" js::constant)
+ (/.install "apply" js::apply)
+ (/.install "type-of" (unary _.type-of))
(dictionary.merge ..array)
(dictionary.merge ..object)
)))
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 c0cd734b3..ebfbda2a0 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
@@ -2,60 +2,63 @@
[lux #*
[abstract
[monad (#+ do)]]]
- [/
+ ["." / #_
[runtime (#+ Phase)]
- ["." primitive]
- ["." structure]
- ["." reference ("#@." system)]
- ["." function]
- ["." case]
- ["." loop]
- ["." ///
+ ["#." primitive]
+ ["#." structure]
+ ["#." reference ("#@." system)]
+ ["#." case]
+ ["#." loop]
+ ["#." function]
+ ["//#" /// #_
["." extension]
- [//
+ ["/#" // #_
[analysis (#+)]
- ["." synthesis]]]])
+ ["." synthesis]
+ ["//#" /// #_
+ ["#." phase ("#@." monad)]]]]])
(def: #export (generate synthesis)
Phase
(case synthesis
(^template [<tag> <generator>]
(^ (<tag> value))
- (:: ///.monad wrap (<generator> value)))
- ([synthesis.bit primitive.bit]
- [synthesis.i64 primitive.i64]
- [synthesis.f64 primitive.f64]
- [synthesis.text primitive.text])
+ (//////phase@wrap (<generator> value)))
+ ([synthesis.bit /primitive.bit]
+ [synthesis.i64 /primitive.i64]
+ [synthesis.f64 /primitive.f64]
+ [synthesis.text /primitive.text])
(^ (synthesis.variant variantS))
- (structure.variant generate variantS)
+ (/structure.variant generate variantS)
(^ (synthesis.tuple members))
- (structure.tuple generate members)
+ (/structure.tuple generate members)
(#synthesis.Reference value)
- (reference@reference value)
+ (/reference@reference value)
(^ (synthesis.branch/case case))
- (case.case generate case)
+ (/case.case generate case)
(^ (synthesis.branch/let let))
- (case.let generate let)
+ (/case.let generate let)
(^ (synthesis.branch/if if))
- (case.if generate if)
+ (/case.if generate if)
(^ (synthesis.loop/scope scope))
- (loop.scope generate scope)
+ (/loop.scope generate scope)
(^ (synthesis.loop/recur updates))
- (loop.recur generate updates)
+ (/loop.recur generate updates)
(^ (synthesis.function/abstraction abstraction))
- (function.function generate abstraction)
+ (/function.function generate abstraction)
(^ (synthesis.function/apply application))
- (function.apply generate application)
+ (/function.apply generate application)
(#synthesis.Extension extension)
- (extension.apply generate extension)))
+ (extension.apply generate extension)
+ ))
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 d9956579c..79b63ba13 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
@@ -16,14 +16,16 @@
["#." runtime (#+ Operation Phase)]
["#." reference]
["#." primitive]
- ["#/" // #_
+ ["/#" // #_
["#." reference]
- ["#/" // ("#@." monad)
- [synthesis
- ["." case]]
- ["#/" // #_
- [reference (#+ Register)]
- ["#." synthesis (#+ Synthesis Path)]]]]])
+ ["/#" // #_
+ ["#." synthesis #_
+ ["#/." case]]
+ ["/#" // #_
+ ["#." synthesis (#+ Synthesis Path)]
+ ["//#" /// #_
+ [reference (#+ Register)]
+ ["#." phase ("#@." monad)]]]]]])
(def: #export register
(///reference.local _.var))
@@ -31,7 +33,7 @@
(def: #export (let generate [valueS register bodyS])
(-> Phase [Synthesis Register Synthesis]
(Operation Computation))
- (do ////.monad
+ (do ///////phase.monad
[valueO (generate valueS)
bodyO (generate bodyS)]
## TODO: Find some way to do 'let' without paying the price of the closure.
@@ -42,7 +44,7 @@
(def: #export (record-get generate valueS pathP)
(-> Phase Synthesis (List (Either Nat Nat))
(Operation Expression))
- (do ////.monad
+ (do ///////phase.monad
[valueO (generate valueS)]
(wrap (list@fold (function (_ side source)
(.let [method (.case side
@@ -58,7 +60,7 @@
(def: #export (if generate [testS thenS elseS])
(-> Phase [Synthesis Synthesis Synthesis]
(Operation Computation))
- (do ////.monad
+ (do ///////phase.monad
[testO (generate testS)
thenO (generate thenS)
elseO (generate elseS)]
@@ -138,20 +140,20 @@
(-> Phase Path (Operation Statement))
(.case pathP
(^ (/////synthesis.path/then bodyS))
- (do ////.monad
+ (do ///////phase.monad
[body! (generate bodyS)]
(wrap (_.return body!)))
#/////synthesis.Pop
- (////@wrap pop-cursor!)
+ (///////phase@wrap pop-cursor!)
(#/////synthesis.Bind register)
- (////@wrap (_.define (..register register) ..peek-cursor))
+ (///////phase@wrap (_.define (..register register) ..peek-cursor))
(^template [<tag> <format> <=>]
(^ (<tag> value))
- (////@wrap (_.when (|> value <format> (<=> ..peek-cursor) _.not)
- fail-pm!)))
+ (///////phase@wrap (_.when (|> value <format> (<=> ..peek-cursor) _.not)
+ fail-pm!)))
([/////synthesis.path/bit //primitive.bit _.=]
[/////synthesis.path/i64 (<| //primitive.i64 .int) //runtime.i64//=]
[/////synthesis.path/f64 //primitive.f64 _.=]
@@ -159,62 +161,62 @@
(^template [<complex> <simple> <choice>]
(^ (<complex> idx))
- (////@wrap (<choice> false idx))
+ (///////phase@wrap (<choice> false idx))
(^ (<simple> idx nextP))
(|> nextP
(pattern-matching' generate)
- (:: ////.monad map (_.then (<choice> true idx)))))
+ (:: ///////phase.monad 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))
- (////@wrap (push-cursor! (_.at (_.i32 +0) ..peek-cursor)))
+ (///////phase@wrap (push-cursor! (_.at (_.i32 +0) ..peek-cursor)))
## Extra optimization
(^ (/////synthesis.path/seq
(/////synthesis.member/left 0)
(/////synthesis.!bind-top register thenP)))
- (do ////.monad
+ (do ///////phase.monad
[then! (pattern-matching' generate thenP)]
- (////@wrap ($_ _.then
- (_.define (..register register) (_.at (_.i32 +0) ..peek-cursor))
- then!)))
+ (///////phase@wrap ($_ _.then
+ (_.define (..register register) (_.at (_.i32 +0) ..peek-cursor))
+ then!)))
(^template [<pm> <getter>]
(^ (<pm> lefts))
- (////@wrap (push-cursor! (<getter> (_.i32 (.int lefts)) ..peek-cursor)))
+ (///////phase@wrap (push-cursor! (<getter> (_.i32 (.int lefts)) ..peek-cursor)))
## Extra optimization
(^ (/////synthesis.path/seq
(<pm> lefts)
(/////synthesis.!bind-top register thenP)))
- (do ////.monad
+ (do ///////phase.monad
[then! (pattern-matching' generate thenP)]
- (////@wrap ($_ _.then
- (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek-cursor))
- then!))))
+ (///////phase@wrap ($_ _.then
+ (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek-cursor))
+ then!))))
([/////synthesis.member/left //runtime.tuple//left]
[/////synthesis.member/right //runtime.tuple//right])
(^ (/////synthesis.!bind-top register thenP))
- (do ////.monad
+ (do ///////phase.monad
[then! (pattern-matching' generate thenP)]
- (////@wrap ($_ _.then
- (_.define (..register register) ..peek-and-pop-cursor)
- then!)))
+ (///////phase@wrap ($_ _.then
+ (_.define (..register register) ..peek-and-pop-cursor)
+ then!)))
(^ (/////synthesis.!multi-pop nextP))
- (.let [[extra-pops nextP'] (case.count-pops nextP)]
- (do ////.monad
+ (.let [[extra-pops nextP'] (////synthesis/case.count-pops nextP)]
+ (do ///////phase.monad
[next! (pattern-matching' generate nextP')]
- (////@wrap ($_ _.then
- (multi-pop-cursor! (n.+ 2 extra-pops))
- next!))))
+ (///////phase@wrap ($_ _.then
+ (multi-pop-cursor! (n.+ 2 extra-pops))
+ next!))))
(^template [<tag> <combinator>]
(^ (<tag> leftP rightP))
- (do ////.monad
+ (do ///////phase.monad
[left! (pattern-matching' generate leftP)
right! (pattern-matching' generate rightP)]
(wrap (<combinator> left! right!))))
@@ -223,16 +225,16 @@
(def: (pattern-matching generate pathP)
(-> Phase Path (Operation Statement))
- (do ////.monad
+ (do ///////phase.monad
[pattern-matching! (pattern-matching' generate pathP)]
(wrap ($_ _.then
(_.do-while (_.boolean false)
pattern-matching!)
- (_.throw (_.string case.pattern-matching-error))))))
+ (_.throw (_.string ////synthesis/case.pattern-matching-error))))))
(def: #export (case generate [valueS pathP])
(-> Phase [Synthesis Path] (Operation Computation))
- (do ////.monad
+ (do ///////phase.monad
[stack-init (generate valueS)
path! (pattern-matching generate pathP)
#let [closure (<| (_.closure (list))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension.lux
deleted file mode 100644
index 71739bfc9..000000000
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/extension.lux
+++ /dev/null
@@ -1,15 +0,0 @@
-(.module:
- [lux #*
- [data
- [collection
- ["." dictionary]]]]
- [//
- [runtime (#+ Bundle)]]
- [/
- ["." common]
- ["." host]])
-
-(def: #export bundle
- Bundle
- (dictionary.merge common.bundle
- host.bundle))
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 ec48162c5..75399ef04 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
@@ -14,35 +14,35 @@
[runtime (#+ Operation Phase)]
["#." reference]
["#." case]
- ["#/" //
+ ["/#" // #_
["#." reference]
- ["#/" // ("#@." monad)
- ["." // #_
- [reference (#+ Register Variable)]
+ ["//#" /// #_
+ [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)]
+ [synthesis (#+ Synthesis)]
+ ["#." generation]
+ ["//#" /// #_
[arity (#+ Arity)]
- [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)]
- [synthesis (#+ Synthesis)]]]]])
+ [reference (#+ Register Variable)]
+ ["#." phase ("#@." monad)]]]]])
(def: #export (apply generate [functionS argsS+])
(-> Phase (Application Synthesis) (Operation Computation))
- (do ////.monad
+ (do ///////phase.monad
[functionO (generate functionS)
argsO+ (monad.map @ generate argsS+)]
(wrap (_.apply/* functionO argsO+))))
-(def: #export capture
- (///reference.foreign _.var))
-
(def: (with-closure inits function-definition)
(-> (List Expression) Computation (Operation Computation))
- (////@wrap
+ (///////phase@wrap
(case inits
#.Nil
function-definition
_
- (let [closure (_.closure (|> (list.enumerate inits)
- (list@map (|>> product.left ..capture)))
+ (let [capture (///reference.foreign _.var)
+ closure (_.closure (|> (list.enumerate inits)
+ (list@map (|>> product.left capture)))
(_.return function-definition))]
(_.apply/* closure inits)))))
@@ -55,14 +55,15 @@
(def: #export (function generate [environment arity bodyS])
(-> Phase (Abstraction Synthesis) (Operation Computation))
- (do ////.monad
- [[function-name bodyO] (///.with-context
+ (do ///////phase.monad
+ [[function-name bodyO] (/////generation.with-context
(do @
- [function-name ///.context]
- (///.with-anchor (_.var function-name)
+ [function-name /////generation.context]
+ (/////generation.with-anchor (_.var function-name)
(generate bodyS))))
+ #let [capture (:: //reference.system variable)]
closureO+ (: (Operation (List Expression))
- (monad.map @ (:: //reference.system variable) environment))
+ (monad.map @ capture environment))
#let [arityO (|> arity .int _.i32)
@num-args (_.var "num_args")
@self (_.var function-name)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux
index 101c49b95..3479de19b 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux
@@ -14,18 +14,19 @@
["." // #_
[runtime (#+ Operation Phase)]
["#." case]
- ["#/" //
- ["#/" //
- [//
- [synthesis (#+ Scope Synthesis)]]]]])
+ ["///#" //// #_
+ [synthesis (#+ Scope Synthesis)]
+ ["#." generation]
+ ["//#" /// #_
+ ["#." phase]]]])
(def: @scope (_.var "scope"))
(def: #export (scope generate [start initsS+ bodyS])
(-> Phase (Scope Synthesis) (Operation Computation))
- (do ////.monad
+ (do ///////phase.monad
[initsO+ (monad.map @ generate initsS+)
- bodyO (///.with-anchor @scope
+ bodyO (/////generation.with-anchor @scope
(generate bodyS))
#let [closure (_.function @scope
(|> initsS+
@@ -36,7 +37,7 @@
(def: #export (recur generate argsS+)
(-> Phase (List Synthesis) (Operation Computation))
- (do ////.monad
- [@scope ///.anchor
+ (do ///////phase.monad
+ [@scope /////generation.anchor
argsO+ (monad.map @ generate argsS+)]
(wrap (_.apply/* @scope argsO+))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux
index 4ac7483fa..183b35650 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux
@@ -2,10 +2,10 @@
[lux #*
[target
["_" js (#+ Expression)]]]
- [//
- [//
- ["." reference]]])
+ [///
+ ["/" reference]])
(def: #export system
- (reference.system (: (-> Text Expression) _.var)
- (: (-> Text Expression) _.var)))
+ (let [constant (: (-> Text Expression) _.var)
+ variable constant]
+ (/.system constant variable)))
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 949e663c7..1c1b7379d 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
@@ -18,21 +18,22 @@
[syntax (#+ syntax:)]]
[target
["_" js (#+ Expression Var Computation Statement)]]]
- ["." ///
- ["//." //
- [//
- ["/////." name]
- ["." synthesis]]]]
+ ["." ///// #_
+ ["#." synthesis]
+ ["#." generation]
+ ["//#" /// #_
+ ["#." phase]
+ ["#." name]]]
)
(template [<name> <base>]
[(type: #export <name>
(<base> Var Expression Statement))]
- [Operation ///.Operation]
- [Phase ///.Phase]
- [Handler ///.Handler]
- [Bundle ///.Bundle]
+ [Operation /////generation.Operation]
+ [Phase /////generation.Phase]
+ [Handler /////generation.Handler]
+ [Bundle /////generation.Bundle]
)
(type: #export (Generator i)
@@ -53,7 +54,7 @@
(def: #export variant-flag-field "_lux_flag")
(def: #export variant-value-field "_lux_value")
-(def: #export unit Computation (_.string synthesis.unit))
+(def: #export unit Computation (_.string /////synthesis.unit))
(def: #export (flag value)
(-> Bit Computation)
@@ -85,12 +86,12 @@
(def: variable
(-> Text Var)
- (|>> /////name.normalize
+ (|>> ///////name.normalize
_.var))
(def: runtime-name
(-> Text Var)
- (|>> /////name.normalize
+ (|>> ///////name.normalize
(format ..prefix "$")
_.var))
@@ -103,7 +104,7 @@
(wrap (list (` (let [(~+ (|> vars
(list;map (function (_ var)
(list (code.local-identifier var)
- (` (_.var (~ (code.text (/////name.normalize var))))))))
+ (` (_.var (~ (code.text (///////name.normalize var))))))))
list.concat))]
(~ body))))))
@@ -734,10 +735,10 @@
(def: #export generate
(Operation Any)
- (///.with-buffer
- (do ////.monad
- [_ (///.save! true ["" ..prefix]
- ($_ _.then
- _.use-strict
- ..runtime))]
- (///.save-buffer! ..artifact))))
+ (/////generation.with-buffer
+ (do ///////phase.monad
+ [_ (/////generation.save! true ["" ..prefix]
+ ($_ _.then
+ _.use-strict
+ ..runtime))]
+ (/////generation.save-buffer! ..artifact))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux
index c721c991c..a1f05d050 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux
@@ -7,10 +7,11 @@
["." // #_
["#." runtime (#+ Operation Phase)]
["#." primitive]
- ["#//" ///
- ["#/" // #_
- [analysis (#+ Variant Tuple)]
- ["#." synthesis (#+ Synthesis)]]]])
+ ["///#" //// #_
+ [analysis (#+ Variant Tuple)]
+ ["#." synthesis (#+ Synthesis)]
+ ["//#" ///
+ ["#." phase ("#@." monad)]]]])
(def: unit Expression (//primitive.text /////synthesis.unit))
@@ -18,21 +19,21 @@
(-> Phase (Tuple Synthesis) (Operation Expression))
(case elemsS+
#.Nil
- (:: ////.monad wrap ..unit)
+ (///////phase@wrap ..unit)
(#.Cons singletonS #.Nil)
(generate singletonS)
_
- (do ////.monad
+ (do ///////phase.monad
[elemsT+ (monad.map @ generate elemsS+)]
(wrap (_.array elemsT+)))))
(def: #export (variant generate [lefts right? valueS])
(-> Phase (Variant Synthesis) (Operation Expression))
- (:: ////.monad map
- (//runtime.variant (_.i32 (.int (if right?
- (inc lefts)
- lefts)))
- (//runtime.flag right?))
- (generate valueS)))
+ (let [tag (if right?
+ (inc lefts)
+ lefts)]
+ (///////phase@map (//runtime.variant (_.i32 (.int tag))
+ (//runtime.flag right?))
+ (generate valueS))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux
index 8a80953e9..e75c8e41e 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux
@@ -6,11 +6,12 @@
[text
["%" format (#+ format)]]]
[type (#+ :share)]]
- ["." //
- ["#/" // ("#@." monad)
- ["#/" // #_
- [synthesis (#+ Synthesis)]
- ["#." reference (#+ Register Variable Reference)]]]])
+ ["." //// #_
+ [synthesis (#+ Synthesis)]
+ ["#." generation]
+ ["//#" /// #_
+ ["#." reference (#+ Register Variable Reference)]
+ ["#." phase ("#@." monad)]]])
(signature: #export (System expression)
(: (-> Register expression)
@@ -18,13 +19,13 @@
(: (-> Register expression)
foreign)
(: (All [anchor directive]
- (-> Variable (//.Operation anchor expression directive)))
+ (-> Variable (////generation.Operation anchor expression directive)))
variable)
(: (All [anchor directive]
- (-> Name (//.Operation anchor expression directive)))
+ (-> Name (////generation.Operation anchor expression directive)))
constant)
(: (All [anchor directive]
- (-> Reference (//.Operation anchor expression directive)))
+ (-> Reference (////generation.Operation anchor expression directive)))
reference))
(def: (variable-maker prefix variable)
@@ -33,17 +34,16 @@
(-> Register expression)))
(|>> %.nat (format prefix) variable))
-(def: #export foreign
- (All [expression]
- (-> (-> Text expression)
- (-> Register expression)))
- (variable-maker "f"))
+(template [<sigil> <name>]
+ [(def: #export <name>
+ (All [expression]
+ (-> (-> Text expression)
+ (-> Register expression)))
+ (variable-maker <sigil>))]
-(def: #export local
- (All [expression]
- (-> (-> Text expression)
- (-> Register expression)))
- (variable-maker "l"))
+ ["f" foreign]
+ ["l" local]
+ )
(def: #export (system constant variable)
(All [expression]
@@ -55,27 +55,27 @@
{(-> Text expression)
variable}
{(All [anchor directive]
- (-> Variable (//.Operation anchor expression directive)))
- (|>> (case> (#////reference.Local register)
+ (-> Variable (////generation.Operation anchor expression directive)))
+ (|>> (case> (#//////reference.Local register)
(local register)
- (#////reference.Foreign register)
+ (#//////reference.Foreign register)
(foreign register))
- ///@wrap)})
+ //////phase@wrap)})
constant (:share [expression]
{(-> Text expression)
constant}
{(All [anchor directive]
- (-> Name (//.Operation anchor expression directive)))
- (|>> //.remember (///@map constant))})]
+ (-> Name (////generation.Operation anchor expression directive)))
+ (|>> ////generation.remember (//////phase@map constant))})]
(structure
(def: local local)
(def: foreign foreign)
(def: variable variable)
(def: constant constant)
(def: reference
- (|>> (case> (#////reference.Constant value)
+ (|>> (case> (#//////reference.Constant value)
(constant value)
- (#////reference.Variable value)
+ (#//////reference.Variable value)
(variable value)))))))
diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux
index 4d37ed458..cbc89fce9 100644
--- a/stdlib/source/test/lux/abstract.lux
+++ b/stdlib/source/test/lux/abstract.lux
@@ -2,10 +2,12 @@
[lux #*
["_" test (#+ Test)]]
["." / #_
+ ["#." codec]
["#." interval]])
(def: #export test
Test
($_ _.and
+ /codec.test
/interval.test
))
diff --git a/stdlib/source/test/lux/abstract/codec.lux b/stdlib/source/test/lux/abstract/codec.lux
index b6bbdd91e..84a3997b3 100644
--- a/stdlib/source/test/lux/abstract/codec.lux
+++ b/stdlib/source/test/lux/abstract/codec.lux
@@ -5,7 +5,12 @@
[control
["." try]]
[data
- ["%" text/format (#+ format)]]
+ ["." bit ("#@." equivalence)]
+ ["%" text/format (#+ format)]
+ [format
+ ["." json (#+ JSON)]]
+ [collection
+ [dictionary]]]
[math
["r" random (#+ Random)]]]
{1
@@ -13,6 +18,35 @@
[//
[equivalence (#+ Equivalence)]]]})
+(def: json
+ (Codec JSON Bit)
+ (let [field "value"]
+ (structure
+ (def: encode
+ (|>> #json.Boolean
+ [field]
+ list
+ (json.object)))
+ (def: decode
+ (json.get-boolean field)))))
+
+(def: codec
+ (Codec Text Bit)
+ (/.compose json.codec ..json))
+
+(def: #export test
+ Test
+ (do r.monad
+ [expected r.bit]
+ (<| (_.context (%.name (name-of /.Codec)))
+ (_.test "Composition."
+ (case (|> expected (:: ..codec encode) (:: ..codec decode))
+ (#try.Success actual)
+ (bit@= expected actual)
+
+ (#try.Failure error)
+ false)))))
+
(def: #export (spec (^open "/@.") (^open "/@.") generator)
(All [m a] (-> (Equivalence a) (Codec m a) (Random a) Test))
(do r.monad
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index 23c33c620..6160294c4 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -14,12 +14,14 @@
["%" format (#+ format)]]]
[tool
[compiler
- ["." analysis]
- ["." synthesis]
- ["." directive]
- [phase
- [analysis
- ["." type]]]]]
+ [language
+ [lux
+ ["." analysis]
+ ["." synthesis]
+ ["." directive]
+ [phase
+ [analysis
+ ["." type]]]]]]]
["_" test (#+ Test)]]
{1
["." / (#+ analysis: synthesis: generation: directive:)]})