diff options
Diffstat (limited to '')
19 files changed, 1483 insertions, 83 deletions
diff --git a/stdlib/source/lux/host/python.lux b/stdlib/source/lux/host/python.lux index ce9a2e504..d2fe7f9c7 100644 --- a/stdlib/source/lux/host/python.lux +++ b/stdlib/source/lux/host/python.lux @@ -1,7 +1,7 @@ (.module: [lux (#- Code not or and list if cond int comment) [control - pipe] + [pipe (#+ new> case> cond>)]] [data [number ["." frac]] @@ -60,13 +60,15 @@ [Label Code] ) - (abstract: #export Single {} Any) - (abstract: #export Poly {} Any) - (abstract: #export Keyword {} Any) + (template [<var> <brand>] + [(abstract: #export <brand> {} Any) - (type: #export SVar (Var Single)) - (type: #export PVar (Var Poly)) - (type: #export KVar (Var Keyword)) + (type: #export <var> (Var <brand>))] + + [SVar Single] + [PVar Poly] + [KVar Keyword] + ) (def: #export var (-> Text SVar) diff --git a/stdlib/source/lux/host/ruby.lux b/stdlib/source/lux/host/ruby.lux new file mode 100644 index 000000000..6bf113ed0 --- /dev/null +++ b/stdlib/source/lux/host/ruby.lux @@ -0,0 +1,392 @@ +(.module: + [lux (#- Code static int if cond function or and not comment) + [control + [pipe (#+ case> cond> new>)]] + [data + [number + ["." frac]] + ["." text + format] + [collection + ["." list ("#@." functor fold)]]] + [macro + ["." template] + ["." code] + ["s" syntax (#+ syntax:)]] + [type + abstract]]) + +(def: input-separator ", ") +(def: statement-suffix ";") + +(def: nest + (-> Text Text) + (|>> (format text.new-line) + (text.replace-all text.new-line (format text.new-line text.tab)))) + +(abstract: #export (Code brand) + {} + + Text + + (def: #export manual + (-> Text Code) + (|>> :abstraction)) + + (def: #export code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>] + [(with-expansions [<brand> (template.identifier [<type> "'"])] + (`` (abstract: #export (<brand> brand) {} Any)) + (`` (type: #export (<type> brand) + (<super> (<brand> brand)))))] + + [Expression Code] + [Computation Expression] + [Location Computation] + [Var Location] + [Statement Code] + ) + + (template [<type> <super>] + [(with-expansions [<brand> (template.identifier [<type> "'"])] + (`` (abstract: #export <brand> {} Any)) + (`` (type: #export <type> (<super> <brand>))))] + + [Literal Computation] + [Access Location] + [Loop Statement] + [Label Code] + ) + + (template [<var> <brand> <prefix> <constructor>] + [(abstract: #export <brand> {} Any) + + (type: #export <var> (Var <brand>)) + + (def: #export <constructor> + (-> Text <var>) + (|>> (format <prefix>) :abstraction))] + + [GVar Global "$" global] + [IVar Instance "@" instance] + [SVar Static "@@" static] + ) + + (abstract: #export (Local brand) {} Any) + (type: #export LVar (Var (Local Any))) + + (def: #export local + (-> Text LVar) + (|>> :abstraction)) + + (template [<var> <brand> <prefix> <modifier> <unpacker>] + [(abstract: #export <brand> {} Any) + + (type: #export <var> (Var (Local <brand>))) + + (template [<name> <input> <output>] + [(def: #export <name> + (-> <input> <output>) + (|>> :representation (format <prefix>) :abstraction))] + + [<modifier> LVar <var>] + [<unpacker> (Expression Any) (Computation Any)] + )] + + [LVar* Poly "*" variadic splat] + [LVar** PolyKV "**" variadic-kv double-splat] + ) + + (template [<ruby-name> <lux-name>] + [(def: #export <lux-name> (..global <ruby-name>))] + + ["@" latest-error] + ["_" last-string-read] + ["." last-line-number-read] + ["&" last-string-matched] + ["~" last-regexp-match] + ["=" case-insensitivity-flag] + ["/" input-record-separator] + ["\" output-record-separator] + ["0" script-name] + ["*" command-line-arguments] + ["$" process-id] + ["?" exit-status] + ) + + (def: #export nil + Literal + (:abstraction "nil")) + + (def: #export bool + (-> Bit Literal) + (|>> (case> #0 "false" + #1 "true") + :abstraction)) + + (def: sanitize + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replace-all <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical-tab "\v"] + [text.null "\0"] + [text.back-space "\b"] + [text.form-feed "\f"] + [text.new-line "\n"] + [text.carriage-return "\r"] + [text.double-quote (format "\" text.double-quote)] + )) + ))) + + (template [<format> <name> <type> <prep>] + [(def: #export <name> + (-> <type> Literal) + (|>> <prep> <format> :abstraction))] + + [%i int Int (<|)] + [%t string Text ..sanitize] + ) + + (def: #export float + (-> Frac Literal) + (|>> (cond> [(f/= frac.positive-infinity)] + [(new> "(+1.0/0.0)" [])] + + [(f/= frac.negative-infinity)] + [(new> "(-1.0/0.0)" [])] + + [(f/= frac.not-a-number)] + [(new> "(+0.0/-0.0)" [])] + + ## else + [%f]) + :abstraction)) + + (def: #export (array-range from to array) + (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) + (|> (format (:representation from) ".." (:representation to)) + (text.enclose ["[" "]"]) + (format (:representation array)) + :abstraction)) + + (def: #export array + (-> (List (Expression Any)) Literal) + (|>> (list@map (|>> :representation)) + (text.join-with ..input-separator) + (text.enclose ["[" "]"]) + :abstraction)) + + (def: #export hash + (-> (List [(Expression Any) (Expression Any)]) Literal) + (|>> (list@map (.function (_ [k v]) + (format (:representation k) " => " (:representation v)))) + (text.join-with ..input-separator) + (text.enclose ["{" "}"]) + :abstraction)) + + (def: #export (apply/* args func) + (-> (List (Expression Any)) (Expression Any) (Computation Any)) + (|> args + (list@map (|>> :representation)) + (text.join-with ..input-separator) + (text.enclose ["(" ")"]) + (format (:representation func)) + :abstraction)) + + (def: #export (the field object) + (-> Text (Expression Any) Access) + (:abstraction (format (:representation object) "." field))) + + (def: #export (nth idx array) + (-> (Expression Any) (Expression Any) Access) + (|> (:representation idx) + (text.enclose ["[" "]"]) + (format (:representation array)) + :abstraction)) + + (def: #export (? test then else) + (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) + (|> (format (:representation test) " ? " + (:representation then) " : " + (:representation else)) + (text.enclose ["(" ")"]) + :abstraction)) + + (def: #export statement + (-> (Expression Any) (Statement Any)) + (|>> :representation + (text.suffix ..statement-suffix) + :abstraction)) + + (def: #export (then pre! post!) + (-> (Statement Any) (Statement Any) (Statement Any)) + (:abstraction + (format (:representation pre!) + text.new-line + (:representation post!)))) + + (def: #export (set vars value) + (-> (List (Location Any)) (Expression Any) (Statement Any)) + (:abstraction + (format (|> vars + (list@map (|>> :representation)) + (text.join-with ..input-separator)) + " = " (:representation value) ..statement-suffix))) + + (def: (block content) + (-> Text Text) + (format content + text.new-line "end" ..statement-suffix)) + + (def: #export (if test then! else!) + (-> (Expression Any) (Statement Any) (Statement Any) (Statement Any)) + (<| :abstraction + ..block + (format "if " (:representation test) + text.new-line (..nest (:representation then!)) + text.new-line "else" + text.new-line (..nest (:representation else!))))) + + (template [<name> <block>] + [(def: #export (<name> test then!) + (-> (Expression Any) (Statement Any) (Statement Any)) + (<| :abstraction + ..block + (format <block> " " (:representation test) + text.new-line (..nest (:representation then!)))))] + + [when "if"] + [while "while"] + ) + + (def: #export (for-in var array iteration!) + (-> LVar (Expression Any) (Statement Any) (Statement Any)) + (<| :abstraction + ..block + (format "for " (:representation var) + " in " (:representation array) + " do " + text.new-line (..nest (:representation iteration!))))) + + (type: #export Rescue + {#classes (List Text) + #exception LVar + #rescue (Statement Any)}) + + (def: #export (begin body! rescues) + (-> (Statement Any) (List Rescue) (Statement Any)) + (<| :abstraction + ..block + (format "begin" + text.new-line (:representation body!) + (|> rescues + (list@map (.function (_ [classes exception rescue]) + (format text.new-line "rescue " (text.join-with ..input-separator classes) + " => " (:representation exception) + text.new-line (..nest (:representation rescue))))) + (text.join-with text.new-line))))) + + (def: #export (return value) + (-> (Expression Any) (Statement Any)) + (:abstraction (format "return " (:representation value) ..statement-suffix))) + + (def: #export (raise message) + (-> (Expression Any) (Computation Any)) + (:abstraction (format "raise " (:representation message)))) + + (template [<name> <keyword>] + [(def: #export <name> + (Statement Any) + (|> <keyword> + (text.suffix ..statement-suffix) + :abstraction))] + + [next "next"] + [redo "redo"] + [break "break"] + ) + + (def: #export (function name args body!) + (-> LVar (List (Var Any)) (Statement Any) (Statement Any)) + (<| :abstraction + ..block + (format "def " (:representation name) + (|> args + (list@map (|>> :representation)) + (text.join-with ..input-separator) + (text.enclose ["(" ")"])) + text.new-line (:representation body!)))) + + (def: #export (lambda name args body!) + (-> (Maybe LVar) (List (Var Any)) (Statement Any) Literal) + (let [proc (|> (format (|> args + (list@map (|>> :representation)) + (text.join-with ..input-separator) + (text.enclose' "|")) + " " + (:representation body!)) + (text.enclose ["{" "}"]) + (format "lambda "))] + (|> (case name + #.None + proc + + (#.Some name) + (format (:representation name) " = " proc)) + (text.enclose ["(" ")"]) + :abstraction))) + + (template [<op> <name>] + [(def: #export (<name> parameter subject) + (-> (Expression Any) (Expression Any) (Computation Any)) + (:abstraction (format "(" (:representation subject) " " <op> " " (:representation parameter) ")")))] + + ["==" =] + [ "<" <] + ["<=" <=] + [ ">" >] + [">=" >=] + + [ "+" +] + [ "-" -] + [ "*" *] + [ "/" /] + [ "%" %] + ["**" pow] + + ["||" or] + ["&&" and] + [ "|" bit-or] + [ "&" bit-and] + [ "^" bit-xor] + + ["<<" bit-shl] + [">>" bit-shr] + ) + + (def: #export (not subject) + (-> (Expression Any) (Computation Any)) + (:abstraction (format "(!" (:representation subject) ")"))) + + (def: #export (comment commentary on) + (All [brand] (-> Text (Code brand) (Code brand))) + (:abstraction (format "# " (..sanitize commentary) text.new-line + (:representation on)))) + ) + +(def: #export (do method args object) + (-> Text (List (Expression Any)) (Expression Any) (Computation Any)) + (|> object (..the method) (..apply/* args))) + +(def: #export (cond clauses else!) + (-> (List [(Expression Any) (Statement Any)]) (Statement Any) (Statement Any)) + (list@fold (.function (_ [test then!] next!) + (..if test then! next!)) + else! + (list.reverse clauses))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux index dca429854..74b1128c2 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux @@ -113,10 +113,11 @@ (-> Bit Nat Statement) ($_ _.then (_.set @temp (|> idx <prep> .int _.i32 (//runtime.sum//get ..peek-cursor <flag>))) - (_.if (_.= _.null @temp) - fail-pm! - (.if simple? - (_.statement _.null) + (.if simple? + (_.when (_.= _.null @temp) + fail-pm!) + (_.if (_.= _.null @temp) + fail-pm! (push-cursor! @temp)))))] [left-choice _.null (<|)] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux index 9102dd30d..f492479d4 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux @@ -693,29 +693,22 @@ )) (runtime: (array//read idx array) - (let [fail! (_.return ..none)] - (_.if (_.< (..length array) idx) - (with-vars [temp] - ($_ _.then - (_.define temp (_.at idx array)) - (_.if (_.= _.undefined temp) - fail! - (_.return (..some temp))))) - fail!))) + (with-vars [temp] + ($_ _.then + (_.define temp (_.at idx array)) + (_.if (_.= _.undefined temp) + (_.return ..none) + (_.return (..some temp)))))) (runtime: (array//write idx value array) - (_.if (_.< (..length array) idx) - ($_ _.then - (_.set (_.at idx array) value) - (_.return (..some array))) - (_.return ..none))) + ($_ _.then + (_.set (_.at idx array) value) + (_.return array))) (runtime: (array//delete idx array) - (_.if (_.< (..length array) idx) - ($_ _.then - (_.delete (_.at idx array)) - (_.return (..some array))) - (_.return ..none))) + ($_ _.then + (_.delete (_.at idx array)) + (_.return array))) (def: runtime//array Statement diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux index 923f3d1d3..3aa95d673 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux @@ -67,32 +67,32 @@ elseO (generate elseS)] (wrap (_.? testO thenO elseO)))) -(def: @savepoint (_.var "lux_pm_cursor_savepoint")) +(def: @savepoint (_.var "lux_pm_savepoint")) (def: @cursor (_.var "lux_pm_cursor")) (def: @temp (_.var "lux_pm_temp")) -(def: (push-cursor! value) +(def: (push! value) (-> (Expression Any) (Statement Any)) (_.statement (|> @cursor (_.do "append" (list value))))) -(def: peek-and-pop-cursor +(def: peek-and-pop (Expression Any) (|> @cursor (_.do "pop" (list)))) -(def: pop-cursor! +(def: pop! (Statement Any) - (_.statement ..peek-and-pop-cursor)) + (_.statement ..peek-and-pop)) -(def: peek-cursor +(def: peek (Expression Any) (_.nth (_.int -1) @cursor)) -(def: save-cursor! +(def: save! (Statement Any) (.let [cursor (_.slice-from (_.int +0) @cursor)] (_.statement (|> @savepoint (_.do "append" (list cursor)))))) -(def: restore-cursor! +(def: restore! (Statement Any) (_.set (list @cursor) (|> @savepoint (_.do "pop" (list))))) @@ -100,7 +100,7 @@ (exception: #export unrecognized-path) -(def: (multi-pop-cursor! pops) +(def: (multi-pop! pops) (-> Nat (Statement Any)) (_.delete (_.slice-from (_.int (i/* -1 (.int pops))) @cursor))) @@ -108,12 +108,14 @@ [(def: (<name> simple? idx) (-> Bit Nat (Statement Any)) ($_ _.then - (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek-cursor <flag>))) - (_.if (_.= _.none @temp) - fail-pm! - (.if simple? - _.pass - (push-cursor! @temp)))))] + (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>))) + (.if simple? + (_.when (_.= _.none @temp) + fail-pm!) + (_.if (_.= _.none @temp) + fail-pm! + (..push! @temp)) + )))] [left-choice _.none (<|)] [right-choice (_.string "") inc] @@ -124,10 +126,10 @@ ($_ _.then (_.while (_.bool true) ($_ _.then - ..save-cursor! + ..save! pre!)) ($_ _.then - ..restore-cursor! + ..restore! post!))) (def: (pattern-matching' generate pathP) @@ -137,14 +139,14 @@ (:: ////.monad map _.return (generate bodyS)) #/////synthesis.Pop - (////@wrap pop-cursor!) + (////@wrap ..pop!) (#/////synthesis.Bind register) - (////@wrap (_.set (list (..register register)) ..peek-cursor)) + (////@wrap (_.set (list (..register register)) ..peek)) (^template [<tag> <format>] (^ (<tag> value)) - (////@wrap (_.when (|> value <format> (_.= ..peek-cursor) _.not) + (////@wrap (_.when (|> value <format> (_.= ..peek) _.not) fail-pm!))) ([/////synthesis.path/bit //primitive.bit] [/////synthesis.path/i64 //primitive.i64] @@ -163,11 +165,11 @@ [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice]) (^ (/////synthesis.member/left 0)) - (////@wrap (|> ..peek-cursor (_.nth (_.int +0)) push-cursor!)) + (////@wrap (|> ..peek (_.nth (_.int +0)) ..push!)) (^template [<pm> <getter>] (^ (<pm> lefts)) - (////@wrap (|> ..peek-cursor (<getter> (_.int (.int lefts))) push-cursor!))) + (////@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) @@ -175,7 +177,7 @@ (do ////.monad [then! (pattern-matching' generate thenP)] (////@wrap ($_ _.then - (_.set (list (..register register)) ..peek-and-pop-cursor) + (_.set (list (..register register)) ..peek-and-pop) then!))) (^ (/////synthesis.!multi-pop nextP)) @@ -183,7 +185,7 @@ (do ////.monad [next! (pattern-matching' generate nextP')] (////@wrap ($_ _.then - (multi-pop-cursor! (n/+ 2 extra-pops)) + (..multi-pop! (n/+ 2 extra-pops)) next!)))) (^template [<tag> <combinator>] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux index f5a734346..0b84f4741 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux @@ -293,15 +293,10 @@ (def: inc (|>> (_.+ (_.int +1)))) -(template [<name> <top-cmp>] - [(def: (<name> top value) - (-> (Expression Any) (Expression Any) (Computation Any)) - (_.and (|> value (_.>= (_.int +0))) - (|> value (<top-cmp> top))))] - - [within? _.<] - [up-to? _.<=] - ) +(def: (within? top value) + (-> (Expression Any) (Expression Any) (Computation Any)) + (_.and (|> value (_.>= (_.int +0))) + (|> value (_.< top)))) (runtime: (text//clip @text @from @to) (_.return (|> @text (_.slice @from (inc @to))))) @@ -318,26 +313,18 @@ @text//clip @text//char)) -(def: (check-index-out-of-bounds array idx body!) - (-> (Expression Any) (Expression Any) (Statement Any) (Statement Any)) - (_.if (|> idx (_.<= (_.len/1 array))) - body! - (_.raise (_.Exception/1 (_.string "Array index out of bounds!"))))) - (runtime: (array//get array idx) (with-vars [temp] - (<| (check-index-out-of-bounds array idx) - ($_ _.then - (_.set (list temp) (_.nth idx array)) - (_.if (_.= _.none temp) - (_.return ..none) - (_.return (..some temp))))))) + ($_ _.then + (_.set (list temp) (_.nth idx array)) + (_.if (_.= _.none temp) + (_.return ..none) + (_.return (..some temp)))))) (runtime: (array//put array idx value) - (<| (check-index-out-of-bounds array idx) - ($_ _.then - (_.set (list (_.nth idx array)) value) - (_.return array)))) + ($_ _.then + (_.set (list (_.nth idx array)) value) + (_.return array))) (def: runtime//array (Statement Any) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux index 93a83883d..bcae96966 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux @@ -22,9 +22,9 @@ (generate singletonS) _ - (do ////.monad - [elemsT+ (monad.map @ generate elemsS+)] - (wrap (_.list elemsT+))))) + (|> elemsS+ + (monad.map ////.monad generate) + (:: ////.monad map _.list)))) (def: #export (variant generate [lefts right? valueS]) (-> Phase (Variant Synthesis) (Operation (Expression Any))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby.lux new file mode 100644 index 000000000..155d3e13c --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby.lux @@ -0,0 +1,60 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]]] + [/ + [runtime (#+ Phase)] + ["." primitive] + ["." structure] + ["." reference ("#@." system)] + ["." case] + ["." function] + ["." loop] + ["." /// + ["." extension] + [// + ["." synthesis]]]]) + +(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]) + + (^ (synthesis.variant variantS)) + (structure.variant generate variantS) + + (^ (synthesis.tuple members)) + (structure.tuple generate members) + + (#synthesis.Reference value) + (reference@reference value) + + (^ (synthesis.branch/case case)) + (case.case generate case) + + (^ (synthesis.branch/let let)) + (case.let generate let) + + (^ (synthesis.branch/if if)) + (case.if generate if) + + (^ (synthesis.loop/scope scope)) + (loop.scope generate scope) + + (^ (synthesis.loop/recur updates)) + (loop.recur generate updates) + + (^ (synthesis.function/abstraction abstraction)) + (function.function generate abstraction) + + (^ (synthesis.function/apply application)) + (function.apply generate application) + + (#synthesis.Extension extension) + (extension.apply generate extension))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux new file mode 100644 index 000000000..7bc52c318 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux @@ -0,0 +1,224 @@ +(.module: + [lux (#- case let if) + [abstract + [monad (#+ do)]] + [control + ["ex" exception (#+ exception:)]] + [data + ["." text + format] + [collection + ["." list ("#@." functor fold)] + ["." set]]] + [host + ["_" ruby (#+ Expression LVar Statement)]]] + ["." // #_ + ["#." runtime (#+ Operation Phase)] + ["#." reference] + ["#." primitive] + ["#/" // + ["#." reference] + ["#/" // ("#@." monad) + [synthesis + ["." case]] + ["#/" // #_ + ["." reference (#+ Register)] + ["#." synthesis (#+ Synthesis Path)]]]]]) + +(def: #export register + (///reference.local _.local)) + +(def: #export capture + (///reference.foreign _.local)) + +(def: #export (let generate [valueS register bodyS]) + (-> Phase [Synthesis Register Synthesis] + (Operation (Expression Any))) + (do ////.monad + [valueO (generate valueS) + bodyO (generate bodyS)] + ## TODO: Find some way to do 'let' without paying the price of the closure. + (wrap (|> bodyO + _.return + (_.lambda #.None (list (..register register))) + (_.apply/* (list valueO)))))) + +(def: #export (record-get generate valueS pathP) + (-> Phase Synthesis (List (Either Nat Nat)) + (Operation (Expression Any))) + (do ////.monad + [valueO (generate valueS)] + (wrap (list@fold (function (_ side source) + (.let [method (.case side + (^template [<side> <accessor>] + (<side> lefts) + (<accessor> (_.int (.int lefts)))) + ([#.Left //runtime.tuple//left] + [#.Right //runtime.tuple//right]))] + (method source))) + valueO + pathP)))) + +(def: #export (if generate [testS thenS elseS]) + (-> Phase [Synthesis Synthesis Synthesis] + (Operation (Expression Any))) + (do ////.monad + [testO (generate testS) + thenO (generate thenS) + elseO (generate elseS)] + (wrap (_.? testO thenO elseO)))) + +(def: @savepoint (_.local "lux_pm_savepoint")) +(def: @cursor (_.local "lux_pm_cursor")) +(def: @temp (_.local "lux_pm_temp")) + +(def: (push! value) + (-> (Expression Any) (Statement Any)) + (_.statement (|> @cursor (_.do "push" (list value))))) + +(def: peek-and-pop + (Expression Any) + (|> @cursor (_.do "pop" (list)))) + +(def: pop! + (Statement Any) + (_.statement ..peek-and-pop)) + +(def: peek + (Expression Any) + (_.nth (_.int -1) @cursor)) + +(def: save! + (Statement Any) + (.let [cursor (_.array-range (_.int +0) (_.int -1) @cursor)] + (_.statement (|> @savepoint (_.do "push" (list cursor)))))) + +(def: restore! + (Statement Any) + (_.set (list @cursor) (|> @savepoint (_.do "pop" (list))))) + +(def: fail-pm! _.break) + +(exception: #export unrecognized-path) + +(def: (multi-pop! pops) + (-> Nat (Statement Any)) + (_.statement (_.do "slice!" (list (_.int (i/* -1 (.int pops))) + (_.int (.int pops))) + @cursor))) + +(template [<name> <flag> <prep>] + [(def: (<name> simple? idx) + (-> Bit Nat (Statement Any)) + ($_ _.then + (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>))) + (.if simple? + (_.when (_.= _.nil @temp) + fail-pm!) + (_.if (_.= _.nil @temp) + fail-pm! + (..push! @temp)))))] + + [left-choice _.nil (<|)] + [right-choice (_.string "") inc] + ) + +(def: (alternation pre! post!) + (-> (Statement Any) (Statement Any) (Statement Any)) + ($_ _.then + (_.while (_.bool true) + ($_ _.then + ..save! + pre!)) + ($_ _.then + ..restore! + post!))) + +(def: (pattern-matching' generate pathP) + (-> Phase Path (Operation (Statement Any))) + (.case pathP + (^ (/////synthesis.path/then bodyS)) + (:: ////.monad map _.return (generate bodyS)) + + #/////synthesis.Pop + (////@wrap ..pop!) + + (#/////synthesis.Bind register) + (////@wrap (_.set (list (..register register)) ..peek)) + + (^template [<tag> <format>] + (^ (<tag> value)) + (////@wrap (_.when (|> value <format> (_.= ..peek) _.not) + fail-pm!))) + ([/////synthesis.path/bit //primitive.bit] + [/////synthesis.path/i64 //primitive.i64] + [/////synthesis.path/f64 //primitive.f64] + [/////synthesis.path/text //primitive.text]) + + (^template [<complex> <simple> <choice>] + (^ (<complex> idx)) + (////@wrap (<choice> false idx)) + + (^ (<simple> idx nextP)) + (|> nextP + (pattern-matching' generate) + (:: ////.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 (|> ..peek (_.nth (_.int +0)) ..push!)) + + (^template [<pm> <getter>] + (^ (<pm> lefts)) + (////@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 + [then! (pattern-matching' generate thenP)] + (////@wrap ($_ _.then + (_.set (list (..register register)) ..peek-and-pop) + then!))) + + (^ (/////synthesis.!multi-pop nextP)) + (.let [[extra-pops nextP'] (case.count-pops nextP)] + (do ////.monad + [next! (pattern-matching' generate nextP')] + (////@wrap ($_ _.then + (..multi-pop! (n/+ 2 extra-pops)) + next!)))) + + (^template [<tag> <combinator>] + (^ (<tag> preP postP)) + (do ////.monad + [pre! (pattern-matching' generate preP) + post! (pattern-matching' generate postP)] + (wrap (<combinator> pre! post!)))) + ([/////synthesis.path/seq _.then] + [/////synthesis.path/alt ..alternation]) + + _ + (////.throw unrecognized-path []))) + +(def: (pattern-matching generate pathP) + (-> Phase Path (Operation (Statement Any))) + (do ////.monad + [pattern-matching! (pattern-matching' generate pathP)] + (wrap ($_ _.then + (_.while (_.bool true) + pattern-matching!) + (_.statement (_.raise (_.string case.pattern-matching-error))))))) + +(def: #export (case generate [valueS pathP]) + (-> Phase [Synthesis Path] (Operation (Expression Any))) + (do ////.monad + [initG (generate valueS) + pattern-matching! (pattern-matching generate pathP)] + (wrap (|> ($_ _.then + (_.set (list @cursor) (_.array (list initG))) + (_.set (list @savepoint) (_.array (list))) + pattern-matching!) + (_.lambda #.None (list)) + (_.do "call" (list)))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension.lux new file mode 100644 index 000000000..a40b4953f --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension.lux @@ -0,0 +1,15 @@ +(.module: + [lux #* + [data + [collection + ["." dictionary]]]] + [// + [runtime (#+ Bundle)]] + [/ + ["." common] + ["." host]]) + +(def: #export bundle + Bundle + (|> common.bundle + (dictionary.merge host.bundle))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/common.lux new file mode 100644 index 000000000..eda6782b3 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/common.lux @@ -0,0 +1,159 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." function]] + [data + ["." product] + ["." text] + [collection + ["." dictionary]]] + [host (#+ import:) + ["_" ruby (#+ 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 _.=))) + (bundle.install "try" (unary ///runtime.lux//try)))) + +(def: keep-i64 + (All [input] + (-> (-> input (Expression Any)) + (-> input (Expression Any)))) + (function.compose (_.bit-and (_.manual "0xFFFFFFFFFFFFFFFF")))) + +(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 (..keep-i64 (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 (..keep-i64 (product.uncurry _.+)))) + (bundle.install "-" (binary (..keep-i64 (product.uncurry _.-)))) + ))) + +(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: int-procs + Bundle + (<| (bundle.prefix "int") + (|> bundle.empty + (bundle.install "<" (binary (product.uncurry _.<))) + (bundle.install "*" (binary (..keep-i64 (product.uncurry _.*)))) + (bundle.install "/" (binary (product.uncurry _./))) + (bundle.install "%" (binary (product.uncurry _.%))) + (bundle.install "frac" (unary (_./ (_.float +1.0)))) + (bundle.install "char" (unary (_.do "chr" (list))))))) + +(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 (_.do "floor" (list)))) + (bundle.install "encode" (unary (_.do "to_s" (list)))) + (bundle.install "decode" (unary ///runtime.f64//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 _.+))) + (bundle.install "index" (trinary text//index)) + (bundle.install "size" (unary (_.the "length"))) + (bundle.install "char" (binary (product.uncurry ///runtime.text//char))) + (bundle.install "clip" (trinary text//clip)) + ))) + +(def: (io//log! messageG) + (Unary (Expression Any)) + (_.or (_.apply/* (list (|> messageG (_.+ (_.string text.new-line)))) + (_.local "puts")) + ///runtime.unit)) + +(def: io//error! + (Unary (Expression Any)) + _.raise) + +(def: (io//exit! code) + (Unary (Expression Any)) + (_.apply/* (list code) (_.local "exit"))) + +(def: (io//current-time! _) + (Nullary (Expression Any)) + (|> (_.local "Time") + (_.do "now" (list)) + (_.do "to_f" (list)) + (_.* (_.float +1000.0)) + (_.do "to_i" (list)))) + +(def: io-procs + Bundle + (<| (bundle.prefix "io") + (|> bundle.empty + (bundle.install "log" (unary ..io//log!)) + (bundle.install "error" (unary ..io//error!)) + (bundle.install "exit" (unary ..io//exit!)) + (bundle.install "current-time" (nullary ..io//current-time!))))) + +(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/phase/generation/ruby/extension/host.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/host.lux new file mode 100644 index 000000000..c8b6dcb27 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/host.lux @@ -0,0 +1,25 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [data + ["." product] + [collection + ["." dictionary]]] + [host + ["_" ruby (#+ Expression)]]] + ["." /// #_ + ["#." runtime (#+ Handler Bundle)] + ["#/" // #_ + ["#." extension (#+ Nullary Unary Binary Trinary Variadic + nullary unary binary trinary variadic)] + ["#/" // + ["#." extension + ["." bundle]] + ["#/" // #_ + ["#." synthesis]]]]]) + +(def: #export bundle + Bundle + (<| (bundle.prefix "ruby") + bundle.empty)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/function.lux new file mode 100644 index 000000000..486b68592 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/function.lux @@ -0,0 +1,100 @@ +(.module: + [lux (#- function) + [abstract + ["." monad (#+ do)]] + [control + pipe] + [data + ["." product] + [text + format] + [collection + ["." list ("#@." functor fold)]]] + [host + ["_" ruby (#+ Expression Statement)]]] + ["." // #_ + [runtime (#+ Operation Phase)] + ["#." reference] + ["#." case] + ["#/" // + ["#." reference] + ["#/" // + ["." // #_ + [reference (#+ Register Variable)] + [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)] + [synthesis (#+ Synthesis)]]]]]) + +(def: #export (apply generate [functionS argsS+]) + (-> Phase (Application Synthesis) (Operation (Expression Any))) + (do ////.monad + [functionO (generate functionS) + argsO+ (monad.map @ generate argsS+)] + (wrap (_.apply/* argsO+ functionO)))) + +(def: #export capture + (///reference.foreign _.local)) + +(def: (with-closure inits function-definition) + (-> (List (Expression Any)) (Expression Any) (Expression Any)) + (case inits + #.Nil + function-definition + + _ + (|> function-definition + _.return + (_.lambda #.None + (|> (list.enumerate inits) + (list@map (|>> product.left ..capture)))) + (_.do "call" inits)))) + +(def: input + (|>> inc //case.register)) + +(def: #export (function generate [environment arity bodyS]) + (-> Phase (Abstraction Synthesis) (Operation (Expression Any))) + (do ////.monad + [[function-name bodyO] (///.with-context + (do @ + [function-name ///.context] + (///.with-anchor (_.local function-name) + (generate bodyS)))) + closureO+ (: (Operation (List (Expression Any))) + (monad.map @ (:: //reference.system variable) environment)) + #let [@curried (_.local "curried") + arityO (|> arity .int _.int) + limitO (|> arity dec .int _.int) + @num-args (_.local "num_args") + @self (_.local function-name) + initialize-self! (_.set (list (//case.register 0)) @self) + initialize! (list@fold (.function (_ post pre!) + ($_ _.then + pre! + (_.set (list (..input post)) (_.nth (|> post .int _.int) @curried)))) + initialize-self! + (list.indices arity))]] + (wrap (with-closure closureO+ + (_.lambda (#.Some @self) (list (_.variadic @curried)) + ($_ _.then + (_.set (list @num-args) (_.the "length" @curried)) + (_.cond (list [(|> @num-args (_.= arityO)) + ($_ _.then + initialize! + (_.return bodyO))] + [(|> @num-args (_.> arityO)) + (let [slice (.function (_ from to) + (_.array-range from to @curried)) + arity-args (_.splat (slice (_.int +0) limitO)) + output-func-args (_.splat (slice arityO @num-args))] + (_.return (|> @self + (_.do "call" (list arity-args)) + (_.do "call" (list output-func-args)))))]) + ## (|> @num-args (_.< arityO)) + (let [@missing (_.local "missing")] + (_.return (_.lambda #.None (list (_.variadic @missing)) + (_.return (|> @self + (_.do "call" (list (_.splat (|> (_.array (list)) + (_.do "concat" (list @curried)) + (_.do "concat" (list @missing)))))))))))) + )))) + )) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/loop.lux new file mode 100644 index 000000000..91eb3eeb2 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/loop.lux @@ -0,0 +1,40 @@ +(.module: + [lux (#- Scope) + [abstract + ["." monad (#+ do)]] + [data + ["." product] + [text + format] + [collection + ["." list ("#@." functor)]]] + [host + ["_" ruby (#+ Expression)]]] + ["." // #_ + [runtime (#+ Operation Phase)] + ["#." case] + ["#/" // + ["#/" // + [// + [synthesis (#+ Scope Synthesis)]]]]]) + +(def: #export (scope generate [start initsS+ bodyS]) + (-> Phase (Scope Synthesis) (Operation (Expression Any))) + (do ////.monad + [@loop (:: @ map (|>> %n (format "loop") _.local) ///.next) + initsO+ (monad.map @ generate initsS+) + bodyO (///.with-anchor @loop + (generate bodyS))] + (wrap (|> (_.return bodyO) + (_.lambda (#.Some @loop) + (|> initsS+ + list.enumerate + (list@map (|>> product.left (n/+ start) //case.register)))) + (_.apply/* initsO+))))) + +(def: #export (recur generate argsS+) + (-> Phase (List Synthesis) (Operation (Expression Any))) + (do ////.monad + [@scope ///.anchor + argsO+ (monad.map @ generate argsS+)] + (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/primitive.lux new file mode 100644 index 000000000..4ec058ffe --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/primitive.lux @@ -0,0 +1,27 @@ +(.module: + [lux (#- i64) + [control + [pipe (#+ cond> new>)]] + [data + [number + ["." frac]]] + [host + ["_" ruby (#+ Expression)]]] + ["." // #_ + ["#." runtime]]) + +(def: #export bit + (-> Bit (Expression Any)) + _.bool) + +(def: #export i64 + (-> (I64 Any) (Expression Any)) + (|>> .int _.int)) + +(def: #export f64 + (-> Frac (Expression Any)) + _.float) + +(def: #export text + (-> Text (Expression Any)) + _.string) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/reference.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/reference.lux new file mode 100644 index 000000000..6ff021863 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/reference.lux @@ -0,0 +1,11 @@ +(.module: + [lux #* + [host + ["_" ruby (#+ Expression)]]] + [// + [// + ["." reference]]]) + +(def: #export system + (reference.system (: (-> Text (Expression Any)) _.local) + (: (-> Text (Expression Any)) _.local))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux new file mode 100644 index 000000000..b3dcbd8ee --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux @@ -0,0 +1,320 @@ +(.module: + [lux (#- inc) + [abstract + [monad (#+ do)]] + [control + ["." function] + ["p" parser]] + [data + [number (#+ hex) + ["." i64]] + ["." text + format] + [collection + ["." list ("#@." functor)]]] + ["." macro + ["." code] + ["s" syntax (#+ syntax:)]] + [host + ["_" ruby (#+ Expression LVar Computation Literal Statement)]]] + ["." /// + ["//." // + [// + ["/////." name] + ["." synthesis]]]] + ) + +(template [<name> <base>] + [(type: #export <name> + (<base> LVar (Expression Any) (Statement Any)))] + + [Operation ///.Operation] + [Phase ///.Phase] + [Handler ///.Handler] + [Bundle ///.Bundle] + ) + +(def: prefix Text "LuxRuntime") + +(def: #export unit (_.string synthesis.unit)) + +(def: (flag value) + (-> Bit Literal) + (if value + (_.string "") + _.nil)) + +(def: #export variant-tag-field "_lux_tag") +(def: #export variant-flag-field "_lux_flag") +(def: #export variant-value-field "_lux_value") + +(def: (variant' tag last? value) + (-> (Expression Any) (Expression Any) (Expression Any) Literal) + (_.hash (list [(_.string ..variant-tag-field) tag] + [(_.string ..variant-flag-field) last?] + [(_.string ..variant-value-field) value]))) + +(def: #export (variant tag last? value) + (-> Nat Bit (Expression Any) Literal) + (variant' (_.int (.int tag)) (..flag last?) value)) + +(def: #export none + Literal + (variant 0 #0 unit)) + +(def: #export some + (-> (Expression Any) Literal) + (variant 1 #1)) + +(def: #export left + (-> (Expression Any) Literal) + (variant 0 #0)) + +(def: #export right + (-> (Expression Any) Literal) + (variant 1 #1)) + +(def: runtime-name + (-> Text LVar) + (|>> /////name.normalize + (format ..prefix "_") + _.local)) + +(def: (feature name definition) + (-> LVar (-> LVar (Statement Any)) (Statement Any)) + (definition name)) + +(syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))} + body) + (wrap (list (` (let [(~+ (|> vars + (list@map (function (_ var) + (list (code.local-identifier var) + (` (_.local (~ (code.text (/////name.normalize var)))))))) + list.concat))] + (~ body)))))) + +(syntax: (runtime: {declaration (p.or s.local-identifier + (s.form (p.and s.local-identifier + (p.some s.local-identifier))))} + code) + (case declaration + (#.Left name) + (macro.with-gensyms [g!_] + (let [nameC (code.local-identifier name) + code-nameC (code.local-identifier (format "@" name)) + runtime-nameC (` (runtime-name (~ (code.text name))))] + (wrap (list (` (def: #export (~ nameC) LVar (~ runtime-nameC))) + (` (def: (~ code-nameC) + (Statement Any) + (..feature (~ runtime-nameC) + (function ((~ g!_) (~ nameC)) + (~ code))))))))) + + (#.Right [name inputs]) + (macro.with-gensyms [g!_] + (let [nameC (code.local-identifier name) + code-nameC (code.local-identifier (format "@" name)) + runtime-nameC (` (runtime-name (~ (code.text name)))) + inputsC (list@map code.local-identifier inputs) + inputs-typesC (list@map (function.constant (` (_.Expression Any))) + inputs)] + (wrap (list (` (def: #export ((~ nameC) (~+ inputsC)) + (-> (~+ inputs-typesC) (Computation Any)) + (_.apply/* (list (~+ inputsC)) (~ runtime-nameC)))) + (` (def: (~ code-nameC) + (Statement Any) + (..feature (~ runtime-nameC) + (function ((~ g!_) (~ g!_)) + (..with-vars [(~+ inputsC)] + (_.function (~ g!_) (list (~+ inputsC)) + (~ code))))))))))))) + +(def: tuple-size + (_.the "length")) + +(def: last-index + (|>> ..tuple-size (_.- (_.int +1)))) + +(runtime: (tuple//left lefts tuple) + (with-vars [last-index-right] + ($_ _.then + (_.set (list last-index-right) (..last-index tuple)) + (_.if (_.> lefts last-index-right) + ## No need for recursion + (_.return (_.nth lefts tuple)) + ## Needs recursion + (_.return (tuple//left (_.- last-index-right lefts) + (_.nth last-index-right tuple))))))) + +(runtime: (tuple//right lefts tuple) + (with-vars [last-index-right right-index] + ($_ _.then + (_.set (list last-index-right) (..last-index tuple)) + (_.set (list right-index) (_.+ (_.int +1) lefts)) + (_.cond (list [(_.= right-index last-index-right) + (_.return (_.nth right-index tuple))] + [(_.> right-index last-index-right) + ## Needs recursion. + (_.return (tuple//right (_.- last-index-right lefts) + (_.nth last-index-right tuple)))]) + (_.return (_.array-range right-index (..tuple-size tuple) tuple))) + ))) + +(runtime: (sum//get sum wantsLast wantedTag) + (let [no-match! (_.return _.nil) + sum-tag (_.nth (_.int +0) sum) + sum-flag (_.nth (_.int +1) sum) + sum-value (_.nth (_.int +2) sum) + is-last? (_.= (_.string "") sum-flag) + test-recursion! (_.if is-last? + ## Must recurse. + (_.return (sum//get sum-value wantsLast (_.- sum-tag wantedTag))) + no-match!)] + (_.cond (list [(_.= sum-tag wantedTag) + (_.if (_.= wantsLast sum-flag) + (_.return sum-value) + test-recursion!)] + + [(_.> sum-tag wantedTag) + test-recursion!] + + [(_.and (_.< sum-tag wantedTag) + (_.= (_.string "") wantsLast)) + (_.return (variant' (_.- wantedTag sum-tag) sum-flag sum-value))]) + + no-match!))) + +(def: runtime//adt + (Statement Any) + ($_ _.then + @tuple//left + @tuple//right + @sum//get)) + +(runtime: (lux//try risky) + (with-vars [error value] + (_.begin ($_ _.then + (_.set (list value) (_.do "call" (list ..unit) risky)) + (_.return (..right value))) + (list [(list) error + (_.return (..left (_.the "message" error)))])))) + +(runtime: (lux//program-args raw) + (with-vars [tail head] + ($_ _.then + (_.set (list tail) ..none) + (<| (_.for-in head raw) + (_.set (list tail) (..some (_.array (list head tail))))) + (_.return tail)))) + +(def: runtime//lux + (Statement Any) + ($_ _.then + @lux//try + @lux//program-args)) + +(runtime: (i64//logic-right-shift param subject) + (let [mask (|> (_.int +1) + (_.bit-shl (_.- param (_.int +64))) + (_.- (_.int +1)))] + (_.return (|> subject + (_.bit-shr param) + (_.bit-and mask))))) + +(def: runtime//i64 + (Statement Any) + @i64//logic-right-shift) + +(runtime: (f64//decode inputG) + (with-vars [@input @temp] + ($_ _.then + (_.set (list @input) inputG) + (_.set (list @temp) (_.do "to_f" (list) @input)) + (_.if ($_ _.or + (_.not (_.= (_.float +0.0) @temp)) + (_.= (_.string "0") @input) + (_.= (_.string ".0") @input) + (_.= (_.string "0.0") @input)) + (_.return (..some @temp)) + (_.return ..none))))) + +(def: runtime//f64 + (Statement Any) + @f64//decode) + +(runtime: (text//index subject param start) + (with-vars [idx] + ($_ _.then + (_.set (list idx) (|> subject (_.do "index" (list param start)))) + (_.if (_.= _.nil idx) + (_.return ..none) + (_.return (..some idx)))))) + +(def: (within? top value) + (-> (Expression Any) (Expression Any) (Computation Any)) + (_.and (|> value (_.>= (_.int +0))) + (|> value (_.< top)))) + +(runtime: (text//clip @text @from @to) + (_.return (|> @text (_.array-range @from @to)))) + +(runtime: (text//char idx text) + (_.if (|> idx (within? (_.the "length" text))) + (_.return (..some (|> text (_.array-range idx idx) (_.do "ord" (list))))) + (_.return ..none))) + +(def: runtime//text + (Statement Any) + ($_ _.then + @text//index + @text//clip + @text//char)) + +(runtime: (array//get array idx) + (with-vars [temp] + ($_ _.then + (_.set (list temp) (_.nth idx array)) + (_.if (_.= _.nil temp) + (_.return ..none) + (_.return (..some temp)))))) + +(runtime: (array//put array idx value) + ($_ _.then + (_.set (list (_.nth idx array)) value) + (_.return array))) + +(def: runtime//array + (Statement Any) + ($_ _.then + @array//get + @array//put)) + +(runtime: (box//write value box) + ($_ _.then + (_.set (list (_.nth (_.int +0) box)) value) + (_.return ..unit))) + +(def: runtime//box + (Statement Any) + @box//write) + +(def: runtime + (Statement Any) + ($_ _.then + runtime//adt + runtime//lux + runtime//i64 + runtime//f64 + runtime//text + runtime//array + runtime//box + )) + +(def: #export artifact ..prefix) + +(def: #export generate + (Operation Any) + (///.with-buffer + (do ////.monad + [_ (///.save! ["" ..prefix] ..runtime)] + (///.save-buffer! ..artifact)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/structure.lux new file mode 100644 index 000000000..b3d3046c8 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/structure.lux @@ -0,0 +1,36 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [host + ["_" ruby (#+ Expression)]]] + ["." // #_ + ["#." runtime (#+ Operation Phase)] + ["#." primitive] + ["#//" /// + ["#/" // #_ + [analysis (#+ Variant Tuple)] + ["#." synthesis (#+ Synthesis)]]]]) + +(def: #export (tuple generate elemsS+) + (-> Phase (Tuple Synthesis) (Operation (Expression Any))) + (case elemsS+ + #.Nil + (:: ////.monad wrap (//primitive.text /////synthesis.unit)) + + (#.Cons singletonS #.Nil) + (generate singletonS) + + _ + (|> elemsS+ + (monad.map ////.monad generate) + (:: ////.monad 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))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 42f4c9f81..f73319739 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -3,8 +3,8 @@ [structure (#+)] [reference (#+)] [case (#+)] - [loop (#+)] [function (#+)] + [loop (#+)] [extension (#+) [common (#+)] [host (#+)]])] @@ -38,6 +38,7 @@ [host [js (#+)] [python (#+)] + [ruby (#+)] [scheme (#+)]] [tool [compiler @@ -47,6 +48,8 @@ <host-modules>] [python (#+) <host-modules>] + [ruby (#+) + <host-modules>] [scheme (#+) <host-modules>]]]]] ## [control @@ -375,4 +378,7 @@ (<| io _.run! (_.times 100) + ## (_.seed 16966479879996440699) + ## (_.seed 16140950815046933697) + ## (_.seed 8804587020128699091) ..test)) |