diff options
Diffstat (limited to '')
16 files changed, 370 insertions, 328 deletions
diff --git a/stdlib/source/lux/abstract/enum.lux b/stdlib/source/lux/abstract/enum.lux index 27690b286..9f074f7c5 100644 --- a/stdlib/source/lux/abstract/enum.lux +++ b/stdlib/source/lux/abstract/enum.lux @@ -9,13 +9,13 @@ (: (-> e e) succ) (: (-> e e) pred)) -(def: (range' <= succ from to) - (All [a] (-> (-> a a Bit) (-> a a) a a (List a))) - (if (<= to from) - (#.Cons from (range' <= succ (succ from) to)) - #.Nil)) - -(def: #export (range (^open ",@.") from to) +(def: #export (range enum from to) {#.doc "An inclusive [from, to] range of values."} (All [a] (-> (Enum a) a a (List a))) - (range' (order.<= ,@&order) ,@succ from to)) + (let [(^open "/@.") enum + <= (order.<= /@&order)] + (loop [end to + output #.Nil] + (if (<= end from) + (recur (/@pred end) (#.Cons end output)) + output)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux index 3bc0a0887..893e662ed 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/extension.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux @@ -3,10 +3,12 @@ [data [collection ["." dictionary]]]] - [// - [runtime (#+ Bundle)]] [/ - ["." common]]) + ["." common] + [//// + [generation + [python + [runtime (#+ Bundle)]]]]]) (def: #export bundle Bundle 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 new file mode 100644 index 000000000..5c6a0cee5 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux @@ -0,0 +1,128 @@ +(.module: + [lux #* + [host (#+ import:)] + [abstract + ["." monad (#+ do)]] + [control + ["." function]] + [data + ["." product] + [number + ["f" frac]] + [collection + ["." dictionary]]] + [target + ["_" python (#+ Expression)]]] + [//// + ["/" bundle] + [// + [generation + [extension (#+ Nullary Unary Binary Trinary + nullary unary binary trinary)] + ["//" python #_ + ["#." runtime (#+ Operation Phase Handler Bundle)]]]]]) + +(def: lux-procs + Bundle + (|> /.empty + (/.install "is" (binary (product.uncurry _.is))) + (/.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 (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 _.-))) + ))) + +(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))))) + +(import: #long java/lang/Double + (#static MIN_VALUE double) + (#static MAX_VALUE double)) + +(template [<name> <const>] + [(def: (<name> _) + (Nullary (Expression Any)) + (_.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-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 _.int/1)) + (/.install "encode" (unary _.repr/1)) + (/.install "decode" (unary //runtime.frac//decode))))) + +(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 _.+))) + (/.install "index" (trinary text//index)) + (/.install "size" (unary _.len/1)) + (/.install "char" (binary (product.uncurry //runtime.text//char))) + (/.install "clip" (trinary text//clip)) + ))) + +(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))))))) + +(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/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux index c0cd734b3..9523b743a 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 @@ -2,60 +2,62 @@ [lux #* [abstract [monad (#+ do)]]] - [/ + ["." / #_ [runtime (#+ Phase)] - ["." primitive] - ["." structure] - ["." reference ("#@." system)] - ["." function] - ["." case] - ["." loop] - ["." /// - ["." extension] - [// + ["#." primitive] + ["#." structure] + ["#." reference ("#@." system)] + ["#." function] + ["#." case] + ["#." loop] + ["//#" /// #_ + ["#." 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) + (^ (////synthesis.variant variantS)) + (/structure.variant generate variantS) - (^ (synthesis.tuple members)) - (structure.tuple generate members) + (^ (////synthesis.tuple members)) + (/structure.tuple generate members) - (#synthesis.Reference value) - (reference@reference value) + (#////synthesis.Reference value) + (/reference@reference value) - (^ (synthesis.branch/case case)) - (case.case generate case) + (^ (////synthesis.branch/case case)) + (/case.case generate case) - (^ (synthesis.branch/let let)) - (case.let generate let) + (^ (////synthesis.branch/let let)) + (/case.let generate let) - (^ (synthesis.branch/if if)) - (case.if generate if) + (^ (////synthesis.branch/if if)) + (/case.if generate if) - (^ (synthesis.loop/scope scope)) - (loop.scope generate scope) + (^ (////synthesis.loop/scope scope)) + (/loop.scope generate scope) - (^ (synthesis.loop/recur updates)) - (loop.recur generate updates) + (^ (////synthesis.loop/recur updates)) + (/loop.recur generate updates) - (^ (synthesis.function/abstraction abstraction)) - (function.function generate abstraction) + (^ (////synthesis.function/abstraction abstraction)) + (/function.function generate abstraction) - (^ (synthesis.function/apply application)) - (function.apply generate application) + (^ (////synthesis.function/apply application)) + (/function.apply generate application) - (#synthesis.Extension extension) - (extension.apply generate extension))) + (#////synthesis.Extension extension) + (///extension.apply generate extension))) 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 aeaa18986..1feff5e51 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 @@ -17,16 +17,18 @@ ["_" python (#+ Expression SVar Statement)]]] ["." // #_ ["#." runtime (#+ Operation Phase)] - ["#." reference] ["#." primitive] - ["#/" // + ["/#" // #_ ["#." reference] - ["#/" // ("#@." monad) + ["/#" // #_ [synthesis ["." case]] - ["#/" // #_ - ["." reference (#+ Register)] - ["#." synthesis (#+ Synthesis Path)]]]]]) + ["/#" // #_ + ["#." synthesis (#+ Synthesis Path)] + ["#." generation] + ["//#" /// #_ + ["#." reference (#+ Register)] + ["#." phase ("#@." monad)]]]]]]) (def: #export register (///reference.local _.var)) @@ -37,18 +39,18 @@ (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. (wrap (_.apply/* (_.lambda (list (..register register)) - bodyO) + bodyO) (list valueO))))) (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 @@ -64,7 +66,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)] @@ -137,18 +139,18 @@ (-> Phase Path (Operation (Statement Any))) (.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 (_.set (list (..register register)) ..peek)) + (///////phase@wrap (_.set (list (..register register)) ..peek)) (^template [<tag> <format>] (^ (<tag> value)) - (////@wrap (_.when (|> value <format> (_.= ..peek) _.not) - fail-pm!))) + (///////phase@wrap (_.when (|> value <format> (_.= ..peek) _.not) + fail-pm!))) ([/////synthesis.path/bit //primitive.bit] [/////synthesis.path/i64 //primitive.i64] [/////synthesis.path/f64 //primitive.f64] @@ -156,42 +158,42 @@ (^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 +0)) ..push!)) + (///////phase@wrap (|> ..peek (_.nth (_.int +0)) ..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 - (_.set (list (..register register)) ..peek-and-pop) - then!))) + (///////phase@wrap ($_ _.then + (_.set (list (..register register)) ..peek-and-pop) + then!))) (^ (/////synthesis.!multi-pop nextP)) (.let [[extra-pops nextP'] (case.count-pops nextP)] - (do ////.monad + (do ///////phase.monad [next! (pattern-matching' generate nextP')] - (////@wrap ($_ _.then - (..multi-pop! (n.+ 2 extra-pops)) - next!)))) + (///////phase@wrap ($_ _.then + (..multi-pop! (n.+ 2 extra-pops)) + next!)))) (^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!)))) @@ -200,7 +202,7 @@ (def: (pattern-matching generate pathP) (-> Phase Path (Operation (Statement Any))) - (do ////.monad + (do ///////phase.monad [pattern-matching! (pattern-matching' generate pathP)] (wrap ($_ _.then (_.while (_.bool true) @@ -209,11 +211,11 @@ (def: (gensym prefix) (-> Text (Operation SVar)) - (:: ////.monad map (|>> %.nat (format prefix) _.var) ///.next)) + (///////phase@map (|>> %.nat (format prefix) _.var) /////generation.next)) (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) @case (..gensym "case") @@ -223,15 +225,15 @@ set.to-list (list@map (function (_ variable) (.case variable - (#reference.Local register) + (#///////reference.Local register) (..register register) - (#reference.Foreign register) + (#///////reference.Foreign register) (..capture register)))))] - _ (///.save! true ["" (_.code @case)] - (_.def @case (list& @init @dependencies+) - ($_ _.then - (_.set (list @cursor) (_.list (list @init))) - (_.set (list @savepoint) (_.list (list))) - pattern-matching!)))] + _ (/////generation.save! true ["" (_.code @case)] + (_.def @case (list& @init @dependencies+) + ($_ _.then + (_.set (list @cursor) (_.list (list @init))) + (_.set (list @savepoint) (_.list (list))) + pattern-matching!)))] (wrap (_.apply/* @case (list& initG @dependencies+))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/extension/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/extension/common.lux deleted file mode 100644 index b9fd166cc..000000000 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/extension/common.lux +++ /dev/null @@ -1,130 +0,0 @@ -(.module: - [lux #* - [host (#+ import:)] - [abstract - ["." monad (#+ do)]] - [control - ["." function]] - [data - ["." product] - [number - ["f" frac]] - [collection - ["." dictionary]]] - [target - ["_" python (#+ Expression)]]] - ["." /// #_ - ["#." runtime (#+ Operation Phase Handler Bundle)] - ["#." primitive] - [// - [extension (#+ Nullary Unary Binary Trinary - nullary unary binary trinary)] - [// - [extension - ["." bundle]]]]]) - -(def: lux-procs - Bundle - (|> bundle.empty - (bundle.install "is" (binary (product.uncurry _.is))) - (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 (function.compose ///runtime.i64//64 (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)) - (bundle.install "char" (unary _.chr/1))))) - -(import: #long java/lang/Double - (#static MIN_VALUE double) - (#static MAX_VALUE double)) - -(template [<name> <const>] - [(def: (<name> _) - (Nullary (Expression Any)) - (_.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-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 _.int/1)) - (bundle.install "encode" (unary _.repr/1)) - (bundle.install "decode" (unary ///runtime.frac//decode))))) - -(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 _.+))) - (bundle.install "index" (trinary text//index)) - (bundle.install "size" (unary _.len/1)) - (bundle.install "char" (binary (product.uncurry ///runtime.text//char))) - (bundle.install "clip" (trinary text//clip)) - ))) - -(def: io-procs - Bundle - (<| (bundle.prefix "io") - (|> bundle.empty - (bundle.install "log" (unary ///runtime.io//log!)) - (bundle.install "error" (unary ///runtime.io//throw!)) - (bundle.install "exit" (unary ///runtime.io//exit!)) - (bundle.install "current-time" (nullary (function (_ _) - (///runtime.io//current-time! ///runtime.unit))))))) - -(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/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux index ed6e53274..f98f9b929 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 @@ -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/* functionO argsO+)))) @@ -37,21 +39,21 @@ (-> Text (List (Expression Any)) (Statement Any) (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 (_.apply/* (_.var function-name) inits))) _ - (do ////.monad - [@closure (:: @ map _.var (///.gensym "closure")) - _ (///.save! true ["" (_.code @closure)] - (_.def @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)] + (_.def @closure + (|> (list.enumerate inits) + (list@map (|>> product.left ..capture))) + ($_ _.then + function-definition + (_.return (_.var function-name)))))] (wrap (_.apply/* @closure inits))))) (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/python/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index 02d4a92ec..0533d7ab5 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 @@ -11,32 +11,37 @@ [collection ["." list ("#@." functor)]]] [target - ["_" python (#+ Expression)]]] + ["_" python (#+ Expression SVar)]]] ["." // #_ [runtime (#+ Operation Phase)] ["#." case] - ["#/" // - ["#/" // - [// - [synthesis (#+ Scope Synthesis)]]]]]) + ["///#" //// #_ + [synthesis (#+ Scope Synthesis)] + ["#." generation] + ["//#" /// #_ + ["#." phase]]]]) + +(def: loop-name + (-> Nat SVar) + (|>> %.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)] - (_.def @loop (|> initsS+ - list.enumerate - (list@map (|>> product.left (n.+ start) //case.register))) - (_.return bodyO)))] + _ (/////generation.save! true ["" (_.code @loop)] + (_.def @loop (|> initsS+ + list.enumerate + (list@map (|>> product.left (n.+ start) //case.register))) + (_.return bodyO)))] (wrap (_.apply/* @loop initsO+)))) (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/* @scope argsO+)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux index da651ad8b..5ecb466b3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux @@ -1,27 +1,15 @@ (.module: [lux (#- i64) - [control - [pipe (#+ cond> new>)]] - [data - [number - ["." frac]]] [target - ["_" python (#+ Expression)]]] - ["." // #_ - ["#." runtime]]) - -(def: #export bit - (-> Bit (Expression Any)) - _.bool) - -(def: #export i64 - (-> (I64 Any) (Expression Any)) - (|>> .int _.long)) - -(def: #export f64 - (-> Frac (Expression Any)) - _.float) - -(def: #export text - (-> Text (Expression Any)) - _.string) + ["_" python (#+ Expression)]]]) + +(template [<type> <name> <implementation>] + [(def: #export <name> + (-> <type> (Expression Any)) + <implementation>)] + + [Bit bit _.bool] + [(I64 Any) i64 (|>> .int _.long)] + [Frac f64 _.float] + [Text text _.string] + ) 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 c3daa9d37..41ff5a802 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,9 +2,11 @@ [lux #* [target ["_" python (#+ Expression)]]] - [/// - ["." reference]]) + ["." /// #_ + ["#." reference]]) (def: #export system - (reference.system (: (-> Text (Expression Any)) _.var) - (: (-> Text (Expression Any)) _.var))) + (let [constant (: (-> Text (Expression Any)) + _.var) + variable constant] + (///reference.system constant variable))) 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 5524980f6..eb18ec80e 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 @@ -18,26 +18,26 @@ [syntax (#+ syntax:)]] [target ["_" python (#+ Expression SVar Computation Literal Statement)]]] - ["." /// - ["//." // - [// - ["/////." name] - ["." synthesis]]]] - ) + ["." ///// #_ + ["#." synthesis] + ["#." generation] + ["//#" /// #_ + ["#." phase] + ["#." name]]]) (template [<name> <base>] [(type: #export <name> (<base> SVar (Expression Any) (Statement Any)))] - [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) @@ -73,7 +73,7 @@ (def: runtime-name (-> Text SVar) - (|>> /////name.normalize + (|>> ///////name.normalize (format ..prefix "_") _.var)) @@ -86,7 +86,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)))))) @@ -332,9 +332,9 @@ (def: #export generate (Operation Any) - (///.with-buffer - (do ////.monad - [_ (///.save! true ["" ..prefix] - (<| (_.comment "-*- coding: utf-8 -*-") - ..runtime))] - (///.save-buffer! ..artifact)))) + (/////generation.with-buffer + (do ///////phase.monad + [_ (/////generation.save! true ["" ..prefix] + (<| (_.comment "-*- coding: utf-8 -*-") + ..runtime))] + (/////generation.save-buffer! ..artifact)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/structure.lux index 954efde26..fe3087ae8 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/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 _.list)))) + (monad.map ///////phase.monad generate) + (///////phase@map _.list)))) (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 cbc89fce9..b35b38137 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -3,11 +3,13 @@ ["_" test (#+ Test)]] ["." / #_ ["#." codec] + ["#." enum] ["#." interval]]) (def: #export test Test ($_ _.and /codec.test + /enum.test /interval.test )) diff --git a/stdlib/source/test/lux/abstract/codec.lux b/stdlib/source/test/lux/abstract/codec.lux index 84a3997b3..0793ee371 100644 --- a/stdlib/source/test/lux/abstract/codec.lux +++ b/stdlib/source/test/lux/abstract/codec.lux @@ -39,7 +39,7 @@ (do r.monad [expected r.bit] (<| (_.context (%.name (name-of /.Codec))) - (_.test "Composition." + (_.test (%.name (name-of /.compose)) (case (|> expected (:: ..codec encode) (:: ..codec decode)) (#try.Success actual) (bit@= expected actual) diff --git a/stdlib/source/test/lux/abstract/enum.lux b/stdlib/source/test/lux/abstract/enum.lux index 926230ce1..b67f846f5 100644 --- a/stdlib/source/test/lux/abstract/enum.lux +++ b/stdlib/source/test/lux/abstract/enum.lux @@ -1,28 +1,68 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] + [data + ["%" text/format (#+ format)] + ["." product] + ["." maybe ("#@." functor)] + [number + ["n" nat]] + [collection + ["." list ("#@." fold)]]] ["_" test (#+ Test)] - [control - ["." function]] [abstract/monad (#+ do)] [math ["r" random (#+ Random)]]] {1 ["." / (#+ Enum)]}) +(def: #export test + Test + (let [limit (: (Random Nat) + (:: r.monad map (n.% 20) r.nat))] + (do r.monad + [start limit + end limit + #let [[start end] (if (n.< end start) + [start end] + [end start]) + range (/.range n.enum start end)]] + (<| (_.context (%.name (name-of /.Enum))) + ($_ _.and + (_.test (%.name (name-of /.range)) + (let [expected-size (|> end (n.- start) inc) + expected-start? (|> range list.head (maybe@map (n.= start)) (maybe.default false)) + expected-end? (|> range list.last (maybe@map (n.= end)) (maybe.default false)) + every-element-is-a-successor? (case range + (#.Cons head tail) + (|> (list@fold (function (_ next [verdict prev]) + [(and verdict + (n.= next (:: n.enum succ prev))) + next]) + [true head] + tail) + product.left) + + #.Nil + false)] + (and (n.= expected-size (list.size range)) + expected-start? + expected-end? + every-element-is-a-successor?))) + ))))) + (def: #export (spec (^open "/@.") gen-sample) (All [a] (-> (Enum a) (Random a) Test)) (do r.monad [sample gen-sample] - (<| (_.context (%.name (name-of /.Order))) + (<| (_.context (%.name (name-of /.Enum))) ($_ _.and (_.test "Successor and predecessor are inverse functions." (and (/@= (|> sample /@succ /@pred) - (function.identity sample)) + sample) (/@= (|> sample /@pred /@succ) - (function.identity sample)) - (not (/@= (|> sample /@succ) - (function.identity sample))) - (not (/@= (|> sample /@pred) - (function.identity sample))))) + sample) + (not (/@= (/@succ sample) + sample)) + (not (/@= (/@pred sample) + sample)))) )))) diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux index 92a8ce00c..063a20518 100644 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ b/stdlib/source/test/lux/macro/poly/json.lux @@ -113,5 +113,4 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (<| (_.seed 14562075782602945288) - ($codec.spec ..equivalence ..codec gen-record)))) + ($codec.spec ..equivalence ..codec gen-record))) |