diff options
Diffstat (limited to '')
16 files changed, 359 insertions, 324 deletions
diff --git a/stdlib/source/lux/abstract/equivalence.lux b/stdlib/source/lux/abstract/equivalence.lux index eacb4a48f..ccfc55928 100644 --- a/stdlib/source/lux/abstract/equivalence.lux +++ b/stdlib/source/lux/abstract/equivalence.lux @@ -8,13 +8,6 @@ (: (-> a a Bit) =)) -(def: #export (product left right) - (All [l r] (-> (Equivalence l) (Equivalence r) (Equivalence [l r]))) - (structure - (def: (= [a b] [x y]) - (and (:: left = a x) - (:: right = b y))))) - (def: #export (sum left right) (All [l r] (-> (Equivalence l) (Equivalence r) (Equivalence (| l r)))) (structure @@ -29,11 +22,18 @@ _ false)))) +(def: #export (product left right) + (All [l r] (-> (Equivalence l) (Equivalence r) (Equivalence [l r]))) + (structure + (def: (= [a b] [x y]) + (and (:: left = a x) + (:: right = b y))))) + (def: #export (rec sub) (All [a] (-> (-> (Equivalence a) (Equivalence a)) (Equivalence a))) (structure (def: (= left right) - (sub (rec sub) left right)))) + (sub = left right)))) (structure: #export contravariant (Contravariant Equivalence) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux new file mode 100644 index 000000000..b64cf2427 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux @@ -0,0 +1,15 @@ +(.module: + [lux #* + [data + [collection + ["." dictionary]]]] + ["." / #_ + ["#." common] + [//// + [generation + [lua + [runtime (#+ Bundle)]]]]]) + +(def: #export bundle + Bundle + /common.bundle) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux new file mode 100644 index 000000000..e7e4ce933 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux @@ -0,0 +1,147 @@ +(.module: + [lux #* + [host (#+ import:)] + [abstract + ["." monad (#+ do)]] + [control + ["." function]] + [data + ["." product] + [number + ["f" frac]] + [collection + ["." dictionary]]] + [target + ["_" lua (#+ Expression Literal)]]] + [//// + ["/" bundle] + [// + [generation + [extension (#+ Nullary Unary Binary Trinary + nullary unary binary trinary)] + ["//" lua #_ + ["#." runtime (#+ Operation Phase Handler Bundle)]]]]]) + +(template: (!unary function) + (|>> list _.apply/* (|> (_.var function)))) + +(def: lux-procs + Bundle + (|> /.empty + (/.install "is" (binary (product.uncurry _.=))) + (/.install "try" (unary //runtime.lux//try)))) + +(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 (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 _.-))) + ))) + +(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.0)))) + (/.install "char" (unary (!unary "string.char")))))) + +(import: #long java/lang/Double + (#static MIN_VALUE double) + (#static MAX_VALUE double)) + +(template [<name> <const>] + [(def: (<name> _) + (Nullary Literal) + (_.float <const>))] + + [frac//smallest (java/lang/Double::MIN_VALUE)] + [frac//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] + [frac//max (java/lang/Double::MAX_VALUE)] + ) + +(def: frac//decode + (Unary (Expression Any)) + (|>> list _.apply/* (|> (_.var "tonumber")) _.return (_.closure (list)) //runtime.lux//try)) + +(def: frac-procs + Bundle + (<| (/.prefix "frac") + (|> /.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 frac//smallest)) + (/.install "min" (nullary frac//min)) + (/.install "max" (nullary frac//max)) + (/.install "int" (unary (!unary "math.floor"))) + (/.install "encode" (unary (!unary "tostring"))) + (/.install "decode" (unary ..frac//decode))))) + +(def: (text//char [subjectO paramO]) + (Binary (Expression Any)) + (//runtime.text//char subjectO paramO)) + +(def: (text//clip [paramO extraO subjectO]) + (Trinary (Expression Any)) + (//runtime.text//clip subjectO paramO extraO)) + +(def: (text//index [startO partO textO]) + (Trinary (Expression Any)) + (//runtime.text//index textO partO startO)) + +(def: text-procs + Bundle + (<| (/.prefix "text") + (|> /.empty + (/.install "=" (binary (product.uncurry _.=))) + (/.install "<" (binary (product.uncurry _.<))) + (/.install "concat" (binary (product.uncurry (function.flip _.concat)))) + (/.install "index" (trinary text//index)) + (/.install "size" (unary (|>> list _.apply/* (|> (_.var "string.len"))))) + (/.install "char" (binary (product.uncurry //runtime.text//char))) + (/.install "clip" (trinary text//clip)) + ))) + +(def: (io//log! messageO) + (Unary (Expression Any)) + (_.or (_.apply/* (list messageO) (_.var "print")) + //runtime.unit)) + +(def: io-procs + Bundle + (<| (/.prefix "io") + (|> /.empty + (/.install "log" (unary ..io//log!)) + (/.install "error" (unary (!unary "error"))) + (/.install "exit" (unary (!unary "os.exit"))) + (/.install "current-time" (nullary (function (_ _) + (|> (_.var "os.time") + (_.apply/* (list)) + (_.* (_.int +1,000))))))))) + +(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) + ))) 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 893e662ed..536416b9d 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 @@ -3,8 +3,8 @@ [data [collection ["." dictionary]]]] - [/ - ["." common] + ["." / #_ + ["#." common] [//// [generation [python @@ -12,4 +12,4 @@ (def: #export bundle Bundle - common.bundle) + /common.bundle) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux index 6d3500416..24b40808f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux @@ -2,60 +2,62 @@ [lux #* [abstract [monad (#+ do)]]] - [/ + ["." / #_ [runtime (#+ Phase)] - ["." primitive] - ["." structure] - ["." reference ("#@." system)] - ["." case] - ["." loop] - ["." function] - ["." /// - ["." extension] - [// + ["#." 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/lua/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux index c74ceb8c7..89a58a788 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux @@ -13,16 +13,18 @@ ["_" lua (#+ Expression Var Statement)]]] ["." // #_ ["#." runtime (#+ Operation Phase)] - ["#." reference] ["#." primitive] - ["#/" // + ["/#" // #_ ["#." reference] - ["#/" // ("#@." monad) + ["/#" // #_ [synthesis - ["." case]] - ["#/" // #_ - ["." reference (#+ Register)] - ["#." synthesis (#+ Synthesis Path)]]]]]) + ["/" case]] + ["/#" // #_ + ["#." synthesis (#+ Synthesis Path)] + ["/#" // #_ + ["/#" // #_ + [reference (#+ Register)] + ["#." phase ("#@." monad)]]]]]]]) (def: #export register (///reference.local _.var)) @@ -33,7 +35,7 @@ (def: #export (let generate [valueS register bodyS]) (-> Phase [Synthesis Register Synthesis] (Operation (Expression Any))) - (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. @@ -45,7 +47,7 @@ (def: #export (record-get generate valueS pathP) (-> Phase Synthesis (List (Either Nat Nat)) (Operation (Expression Any))) - (do ////.monad + (do ///////phase.monad [valueO (generate valueS)] (wrap (list@fold (function (_ side source) (.let [method (.case side @@ -61,7 +63,7 @@ (def: #export (if generate [testS thenS elseS]) (-> Phase [Synthesis Synthesis Synthesis] (Operation (Expression Any))) - (do ////.monad + (do ///////phase.monad [testO (generate testS) thenO (generate thenS) elseO (generate elseS)] @@ -134,18 +136,18 @@ (-> Phase Path (Operation Statement)) (.case pathP (^ (/////synthesis.path/then bodyS)) - (:: ////.monad map _.return (generate bodyS)) + (///////phase@map _.return (generate bodyS)) #/////synthesis.Pop - (////@wrap ..pop!) + (///////phase@wrap ..pop!) (#/////synthesis.Bind register) - (////@wrap (_.let (list (..register register)) ..peek)) + (///////phase@wrap (_.let (list (..register register)) ..peek)) (^template [<tag> <format>] (^ (<tag> value)) - (////@wrap (_.when (|> value <format> (_.= ..peek) _.not) - fail!))) + (///////phase@wrap (_.when (|> value <format> (_.= ..peek) _.not) + fail!))) ([/////synthesis.path/bit //primitive.bit] [/////synthesis.path/i64 //primitive.i64] [/////synthesis.path/f64 //primitive.f64] @@ -153,34 +155,34 @@ (^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@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 (|> ..peek (_.nth (_.int +1)) ..push!)) + (///////phase@wrap (|> ..peek (_.nth (_.int +1)) ..push!)) (^template [<pm> <getter>] (^ (<pm> lefts)) - (////@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))) + (///////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 ////.monad + (do ///////phase.monad [then! (pattern-matching' generate thenP)] - (////@wrap ($_ _.then - (_.let (list (..register register)) ..peek-and-pop) - then!))) + (///////phase@wrap ($_ _.then + (_.let (list (..register register)) ..peek-and-pop) + then!))) (^template [<tag> <combinator>] (^ (<tag> preP postP)) - (do ////.monad + (do ///////phase.monad [pre! (pattern-matching' generate preP) post! (pattern-matching' generate postP)] (wrap (<combinator> pre! post!)))) @@ -189,16 +191,16 @@ (def: (pattern-matching generate pathP) (-> Phase Path (Operation Statement)) - (do ////.monad + (do ///////phase.monad [pattern-matching! (pattern-matching' generate pathP)] (wrap ($_ _.then (_.while (_.bool true) pattern-matching!) - (_.statement (|> (_.var "error") (_.apply/* (list (_.string case.pattern-matching-error))))))))) + (_.statement (|> (_.var "error") (_.apply/* (list (_.string /.pattern-matching-error))))))))) (def: #export (case generate [valueS pathP]) (-> Phase [Synthesis Path] (Operation (Expression Any))) - (do ////.monad + (do ///////phase.monad [initG (generate valueS) pattern-matching! (pattern-matching generate pathP)] (wrap (|> ($_ _.then diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/extension.lux deleted file mode 100644 index 3bc0a0887..000000000 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/extension.lux +++ /dev/null @@ -1,13 +0,0 @@ -(.module: - [lux #* - [data - [collection - ["." dictionary]]]] - [// - [runtime (#+ Bundle)]] - [/ - ["." common]]) - -(def: #export bundle - Bundle - common.bundle) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/extension/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/extension/common.lux deleted file mode 100644 index 5b57e7538..000000000 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/extension/common.lux +++ /dev/null @@ -1,148 +0,0 @@ -(.module: - [lux #* - [host (#+ import:)] - [abstract - ["." monad (#+ do)]] - [control - ["." function]] - [data - ["." product] - [number - ["f" frac]] - [collection - ["." dictionary]]] - [target - ["_" lua (#+ Expression Literal)]]] - ["." /// #_ - ["#." runtime (#+ Operation Phase Handler Bundle)] - ["#." primitive] - [// - [extension (#+ Nullary Unary Binary Trinary - nullary unary binary trinary)] - [// - [extension - ["." bundle]]]]]) - -(template: (!unary function) - (|>> list _.apply/* (|> (_.var function)))) - -(def: lux-procs - Bundle - (|> bundle.empty - (bundle.install "is" (binary (product.uncurry _.=))) - (bundle.install "try" (unary ///runtime.lux//try)))) - -(def: i64-procs - Bundle - (<| (bundle.prefix "i64") - (|> bundle.empty - (bundle.install "and" (binary (product.uncurry _.bit-and))) - (bundle.install "or" (binary (product.uncurry _.bit-or))) - (bundle.install "xor" (binary (product.uncurry _.bit-xor))) - (bundle.install "left-shift" (binary (product.uncurry _.bit-shl))) - (bundle.install "logical-right-shift" (binary (product.uncurry ///runtime.i64//logic-right-shift))) - (bundle.install "arithmetic-right-shift" (binary (product.uncurry _.bit-shr))) - (bundle.install "=" (binary (product.uncurry _.=))) - (bundle.install "+" (binary (product.uncurry _.+))) - (bundle.install "-" (binary (product.uncurry _.-))) - ))) - -(def: int-procs - Bundle - (<| (bundle.prefix "int") - (|> bundle.empty - (bundle.install "<" (binary (product.uncurry _.<))) - (bundle.install "*" (binary (product.uncurry _.*))) - (bundle.install "/" (binary (product.uncurry _./))) - (bundle.install "%" (binary (product.uncurry _.%))) - (bundle.install "frac" (unary (_./ (_.float +1.0)))) - (bundle.install "char" (unary (!unary "string.char")))))) - -(import: #long java/lang/Double - (#static MIN_VALUE double) - (#static MAX_VALUE double)) - -(template [<name> <const>] - [(def: (<name> _) - (Nullary Literal) - (_.float <const>))] - - [frac//smallest (java/lang/Double::MIN_VALUE)] - [frac//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] - [frac//max (java/lang/Double::MAX_VALUE)] - ) - -(def: frac//decode - (Unary (Expression Any)) - (|>> list _.apply/* (|> (_.var "tonumber")) _.return (_.closure (list)) ///runtime.lux//try)) - -(def: frac-procs - Bundle - (<| (bundle.prefix "frac") - (|> 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 frac//smallest)) - (bundle.install "min" (nullary frac//min)) - (bundle.install "max" (nullary frac//max)) - (bundle.install "int" (unary (!unary "math.floor"))) - (bundle.install "encode" (unary (!unary "tostring"))) - (bundle.install "decode" (unary ..frac//decode))))) - -(def: (text//char [subjectO paramO]) - (Binary (Expression Any)) - (///runtime.text//char subjectO paramO)) - -(def: (text//clip [paramO extraO subjectO]) - (Trinary (Expression Any)) - (///runtime.text//clip subjectO paramO extraO)) - -(def: (text//index [startO partO textO]) - (Trinary (Expression Any)) - (///runtime.text//index textO partO startO)) - -(def: text-procs - Bundle - (<| (bundle.prefix "text") - (|> bundle.empty - (bundle.install "=" (binary (product.uncurry _.=))) - (bundle.install "<" (binary (product.uncurry _.<))) - (bundle.install "concat" (binary (product.uncurry (function.flip _.concat)))) - (bundle.install "index" (trinary text//index)) - (bundle.install "size" (unary (|>> list _.apply/* (|> (_.var "string.len"))))) - (bundle.install "char" (binary (product.uncurry ///runtime.text//char))) - (bundle.install "clip" (trinary text//clip)) - ))) - -(def: (io//log! messageO) - (Unary (Expression Any)) - (_.or (_.apply/* (list messageO) (_.var "print")) - ///runtime.unit)) - -(def: io-procs - Bundle - (<| (bundle.prefix "io") - (|> bundle.empty - (bundle.install "log" (unary ..io//log!)) - (bundle.install "error" (unary (!unary "error"))) - (bundle.install "exit" (unary (!unary "os.exit"))) - (bundle.install "current-time" (nullary (function (_ _) - (|> (_.var "os.time") - (_.apply/* (list)) - (_.* (_.int +1,000))))))))) - -(def: #export bundle - 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) - ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index 7bac2e107..fe58b821a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -14,18 +14,20 @@ ["#." runtime (#+ Operation Phase)] ["#." reference] ["#." case] - ["#/" // + ["/#" // #_ ["#." reference] - ["#/" // - ["." // #_ + ["//#" /// #_ + [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)] + [synthesis (#+ Synthesis)] + ["#." generation] + ["//#" /// #_ [reference (#+ Register Variable)] [arity (#+ Arity)] - [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)] - [synthesis (#+ Synthesis)]]]]]) + ["#." phase]]]]]) (def: #export (apply generate [functionS argsS+]) (-> Phase (Application Synthesis) (Operation (Expression Any))) - (do ////.monad + (do ///////phase.monad [functionO (generate functionS) argsO+ (monad.map @ generate argsS+)] (wrap (_.apply/* argsO+ functionO)))) @@ -37,21 +39,21 @@ (-> Text (List (Expression Any)) Statement (Operation (Expression Any))) (case inits #.Nil - (do ////.monad - [_ (///.save! true ["" function-name] - function-definition)] + (do ///////phase.monad + [_ (/////generation.save! true ["" function-name] + function-definition)] (wrap (|> (_.var function-name) (_.apply/* inits)))) _ - (do ////.monad - [@closure (:: @ map _.var (///.gensym "closure")) - _ (///.save! true ["" (_.code @closure)] - (_.function @closure - (|> (list.enumerate inits) - (list@map (|>> product.left ..capture))) - ($_ _.then - function-definition - (_.return (_.var function-name)))))] + (do ///////phase.monad + [@closure (:: @ map _.var (/////generation.gensym "closure")) + _ (/////generation.save! true ["" (_.code @closure)] + (_.function @closure + (|> (list.enumerate inits) + (list@map (|>> product.left ..capture))) + ($_ _.then + function-definition + (_.return (_.var function-name)))))] (wrap (_.apply/* inits @closure))))) (def: input @@ -59,11 +61,11 @@ (def: #export (function generate [environment arity bodyS]) (-> Phase (Abstraction Synthesis) (Operation (Expression Any))) - (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)))) closureO+ (: (Operation (List (Expression Any))) (monad.map @ (:: //reference.system variable) environment)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux index f1bb7fb84..f2f96759a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux @@ -11,32 +11,37 @@ [collection ["." list ("#@." functor)]]] [target - ["_" lua (#+ Expression)]]] + ["_" lua (#+ Expression Var)]]] ["." // #_ [runtime (#+ Operation Phase)] ["#." case] - ["#/" // - ["#/" // - [// - [synthesis (#+ Scope Synthesis)]]]]]) + ["///#" //// #_ + [synthesis (#+ Scope Synthesis)] + ["#." generation] + ["//#" /// #_ + ["#." phase]]]]) + +(def: loop-name + (-> Nat Var) + (|>> %.nat (format "loop") _.var)) (def: #export (scope generate [start initsS+ bodyS]) (-> Phase (Scope Synthesis) (Operation (Expression Any))) - (do ////.monad - [@loop (:: @ map (|>> %.nat (format "loop") _.var) ///.next) + (do ///////phase.monad + [@loop (:: @ map ..loop-name /////generation.next) initsO+ (monad.map @ generate initsS+) - bodyO (///.with-anchor @loop + bodyO (/////generation.with-anchor @loop (generate bodyS)) - _ (///.save! true ["" (_.code @loop)] - (_.function @loop (|> initsS+ - list.enumerate - (list@map (|>> product.left (n.+ start) //case.register))) - (_.return bodyO)))] + _ (/////generation.save! true ["" (_.code @loop)] + (_.function @loop (|> initsS+ + list.enumerate + (list@map (|>> product.left (n.+ start) //case.register))) + (_.return bodyO)))] (wrap (_.apply/* initsO+ @loop)))) (def: #export (recur generate argsS+) (-> Phase (List Synthesis) (Operation (Expression Any))) - (do ////.monad - [@scope ///.anchor + (do ///////phase.monad + [@scope /////generation.anchor argsO+ (monad.map @ generate argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/primitive.lux index 4e326d1a3..6cce70f05 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/primitive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/primitive.lux @@ -1,27 +1,15 @@ (.module: [lux (#- i64) - [control - [pipe (#+ cond> new>)]] - [data - [number - ["." frac]]] [target - ["_" lua (#+ Literal)]]] - ["." // #_ - ["#." runtime]]) - -(def: #export bit - (-> Bit Literal) - _.bool) - -(def: #export i64 - (-> (I64 Any) Literal) - (|>> .int _.int)) - -(def: #export f64 - (-> Frac Literal) - _.float) - -(def: #export text - (-> Text Literal) - _.string) + ["_" lua (#+ Literal)]]]) + +(template [<name> <type> <implementation>] + [(def: #export <name> + (-> <type> Literal) + <implementation>)] + + [bit Bit _.bool] + [i64 (I64 Any) (|>> .int _.int)] + [f64 Frac _.float] + [text Text _.string] + ) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/reference.lux index ad8e4c6a0..8b6fedb0b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/reference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/reference.lux @@ -3,8 +3,10 @@ [target ["_" lua (#+ Expression)]]] [/// - ["." reference]]) + ["/" reference]]) (def: #export system - (reference.system (: (-> Text (Expression Any)) _.var) - (: (-> Text (Expression Any)) _.var))) + (let [constant (: (-> Text (Expression Any)) + _.var) + variable constant] + (/.system constant variable))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index 47e58fc57..760759b05 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -18,26 +18,26 @@ [syntax (#+ syntax:)]] [target ["_" lua (#+ Expression Location Var Computation Literal Statement)]]] - ["." /// - ["//." // - [// - ["/////." name] - ["." synthesis]]]] - ) + ["." ///// #_ + ["#." synthesis] + ["#." generation] + ["//#" /// #_ + ["#." phase] + ["#." name]]]) (template [<name> <base>] [(type: #export <name> (<base> Var (Expression Any) Statement))] - [Operation ///.Operation] - [Phase ///.Phase] - [Handler ///.Handler] - [Bundle ///.Bundle] + [Operation /////generation.Operation] + [Phase /////generation.Phase] + [Handler /////generation.Handler] + [Bundle /////generation.Bundle] ) (def: prefix Text "LuxRuntime") -(def: #export unit (_.string synthesis.unit)) +(def: #export unit (_.string /////synthesis.unit)) (def: (flag value) (-> Bit Literal) @@ -79,7 +79,7 @@ (def: runtime-name (-> Text Var) - (|>> /////name.normalize + (|>> ///////name.normalize (format ..prefix "_") _.var)) @@ -92,7 +92,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)))))) @@ -356,8 +356,8 @@ (def: #export generate (Operation Any) - (///.with-buffer - (do ////.monad - [_ (///.save! true ["" ..prefix] - ..runtime)] - (///.save-buffer! ..artifact)))) + (/////generation.with-buffer + (do ///////phase.monad + [_ (/////generation.save! true ["" ..prefix] + ..runtime)] + (/////generation.save-buffer! ..artifact)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux index d7c26c8a0..3ef7d505d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux @@ -7,30 +7,30 @@ ["." // #_ ["#." runtime (#+ Operation Phase)] ["#." primitive] - ["#//" /// - ["#/" // #_ - [analysis (#+ Variant Tuple)] - ["#." synthesis (#+ Synthesis)]]]]) + ["///#" //// #_ + [analysis (#+ Variant Tuple)] + ["#." synthesis (#+ Synthesis)] + ["//#" /// #_ + ["#." phase ("#@." monad)]]]]) (def: #export (tuple generate elemsS+) (-> Phase (Tuple Synthesis) (Operation (Expression Any))) (case elemsS+ #.Nil - (:: ////.monad wrap (//primitive.text /////synthesis.unit)) + (///////phase@wrap (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) (generate singletonS) _ (|> elemsS+ - (monad.map ////.monad generate) - (:: ////.monad map _.array)))) + (monad.map ///////phase.monad generate) + (///////phase@map _.array)))) (def: #export (variant generate [lefts right? valueS]) (-> Phase (Variant Synthesis) (Operation (Expression Any))) - (:: ////.monad map - (//runtime.variant (if right? - (inc lefts) - lefts) - right?) - (generate valueS))) + (let [tag (if right? + (inc lefts) + lefts)] + (///////phase@map (//runtime.variant tag right?) + (generate valueS)))) diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index b35b38137..b18d1c61b 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -4,6 +4,7 @@ ["." / #_ ["#." codec] ["#." enum] + ["#." equivalence] ["#." interval]]) (def: #export test @@ -11,5 +12,5 @@ ($_ _.and /codec.test /enum.test - /interval.test - )) + /equivalence.test + /interval.test)) diff --git a/stdlib/source/test/lux/abstract/equivalence.lux b/stdlib/source/test/lux/abstract/equivalence.lux index ac0084e82..7ae9b37af 100644 --- a/stdlib/source/test/lux/abstract/equivalence.lux +++ b/stdlib/source/test/lux/abstract/equivalence.lux @@ -3,13 +3,45 @@ ["_" test (#+ Test)] [abstract/monad (#+ do)] [data + ["." bit ("#@." equivalence)] [text - ["%" format (#+ format)]]] + ["%" format (#+ format)]] + [number + ["n" nat] + ["i" int]]] [math ["r" random (#+ Random)]]] {1 ["." / (#+ Equivalence)]}) +(def: #export test + Test + (do r.monad + [leftN r.nat + rightN r.nat + leftI r.int + rightI r.int] + (<| (_.context (%.name (name-of /._))) + ($_ _.and + (_.test (%.name (name-of /.sum)) + (let [equivalence (/.sum n.equivalence i.equivalence)] + (and (bit@= (:: n.equivalence = leftN leftN) + (:: equivalence = (#.Left leftN) (#.Left leftN))) + (bit@= (:: n.equivalence = leftN rightN) + (:: equivalence = (#.Left leftN) (#.Left rightN))) + (bit@= (:: i.equivalence = leftI leftI) + (:: equivalence = (#.Right leftI) (#.Right leftI))) + (bit@= (:: i.equivalence = leftI rightI) + (:: equivalence = (#.Right leftI) (#.Right rightI)))))) + (_.test (%.name (name-of /.product)) + (let [equivalence (/.product n.equivalence i.equivalence)] + (and (bit@= (and (:: n.equivalence = leftN leftN) + (:: i.equivalence = leftI leftI)) + (:: equivalence = [leftN leftI] [leftN leftI])) + (bit@= (and (:: n.equivalence = leftN rightN) + (:: i.equivalence = leftI rightI)) + (:: equivalence = [leftN leftI] [rightN rightI]))))))))) + (def: #export (spec (^open "_@.") generator) (All [a] (-> (Equivalence a) (Random a) Test)) (do r.monad |