diff options
Diffstat (limited to 'new-luxc/source/luxc/lang')
12 files changed, 0 insertions, 1455 deletions
diff --git a/new-luxc/source/luxc/lang/host/ruby.lux b/new-luxc/source/luxc/lang/host/ruby.lux deleted file mode 100644 index 61c0f8bb5..000000000 --- a/new-luxc/source/luxc/lang/host/ruby.lux +++ /dev/null @@ -1,223 +0,0 @@ -(.module: - [lux #- not or and] - (lux - (control - pipe) - (data [text] - text/format - (coll [list "list/" Functor<List> Fold<List>])))) - -(type: #export Ruby Text) - -(type: #export Expression Ruby) - -(type: #export Statement Ruby) - -(def: #export nil - Expression - "nil") - -(def: #export bool - (-> Bit Expression) - (|>> (case> #0 "false" - #1 "true"))) - -(def: #export int - (-> Int Expression) - %i) - -(def: #export float - (-> Frac Expression) - %f) - -(def: #export (string value) - (-> Text Expression) - (%t value)) - -(def: #export splat - (-> Expression Expression) - (|>> (format "*"))) - -(def: #export (array-range from to array) - (-> Expression Expression Expression Expression) - (format "(" array "[" from ".." to "])")) - -(def: #export (array elements) - (-> (List Expression) Expression) - (format "([" (text.join-with "," elements) "])")) - -(def: #export (dictionary kvs) - (-> (List [Expression Expression]) Expression) - (format "({" - (|> kvs - (list/map (.function (_ [k v]) - (format k " => " v))) - (text.join-with ", ")) - "})")) - -(def: #export (apply func args) - (-> Expression (List Expression) Expression) - (format "(" func "(" (text.join-with "," args) ")" ")")) - -(def: #export (send method args object) - (-> Text (List Expression) Expression Expression) - (apply (format object "." method) args)) - -(def: #export call - (-> (List Expression) Expression Expression) - (send "call")) - -(def: #export (nth idx array) - (-> Expression Expression Expression) - (format "(" array "[" idx "])")) - -(def: #export (set-nth! idx value array) - (-> Expression Expression Expression Statement) - (format array "[" idx "] = " value ";")) - -(def: #export (field name object) - (-> Text Expression Expression) - (format "(" object "." name ")")) - -(def: #export (length array) - (-> Expression Expression) - (format "(" array ".length)")) - -(def: #export (set! vars value) - (-> (List Text) Expression Statement) - (format (text.join-with ", " vars) " = " value ";")) - -(def: #export (global var) - (-> Text Expression) - (format "$" var)) - -(def: #export (global! var value) - (-> Text Expression Statement) - (set! (list (global var)) value)) - -(def: #export (? test then! else!) - (-> Expression Expression Expression Expression) - (format "(" test " ? " then! " : " else! ")")) - -(def: #export (if! test then! else!) - (-> Expression Statement Statement Statement) - (format "if " test - "\n" then! - "\n" "else" - "\n" else! - "\n" "end;")) - -(def: #export (when! test then!) - (-> Expression Statement Statement) - (format "if " test - "\n" then! - "\n" "end;")) - -(def: #export (cond! clauses else!) - (-> (List [Expression Statement]) Statement Statement) - (list/fold (.function (_ [test then!] next!) - (if! test then! next!)) - else! - (list.reverse clauses))) - -(def: #export (block! statements) - (-> (List Statement) Statement) - (text.join-with " " statements)) - -(def: #export (statement expression) - (-> Expression Statement) - (format expression ";")) - -(def: #export (while! test body) - (-> Expression Statement Statement) - (format "while " test - "\n" body - "\n" "end;")) - -(def: #export (for-in! var array body) - (-> Text Expression Statement Statement) - (format "for " var " in " array "do" "\n" - body "\n" - "end;" "\n")) - -(def: #export (begin! body rescues) - (-> Statement (List [(List Text) Text Statement]) Statement) - (format "begin" - "\n" body "\n" - (|> rescues - (list/map (function (_ [ex-classes ex-value ex-handler]) - (format "rescue " (text.join-with ", " ex-classes) - (case ex-value - "" "" - _ (format " => " ex-value)) - "\n" - ex-handler))) - (text.join-with "\n")) - "\n" "end;")) - -(def: #export (raise message) - (-> Expression Expression) - (format "raise " message ";")) - -(def: #export (return! value) - (-> Expression Statement) - (format "return " value ";")) - -(def: #export (function! name args body) - (-> Text (List Text) Statement Statement) - (format "def " name "(" (text.join-with "," args) ")\n" - body - "\n" "end;")) - -(def: #export (lambda name args body) - (-> (Maybe Text) (List Text) Statement Expression) - (let [proc (format "lambda {" (format "|" (text.join-with ", " args) "|") " " body "}")] - (case name - #.None - (format "(" proc ")") - - (#.Some name) - (format "(" name " = " proc ")")))) - -(template [<name> <op>] - [(def: #export (<name> param subject) - (-> Expression Expression Expression) - (format "(" subject " " <op> " " param ")"))] - - [= "=="] - [< "<"] - [<= "<="] - [> ">"] - [>= ">="] - [+ "+"] - [- "-"] - [* "*"] - [/ "/"] - [% "%"] - [pow "**"] - ) - -(template [<name> <op>] - [(def: #export (<name> param subject) - (-> Expression Expression Expression) - (format "(" param " " <op> " " subject ")"))] - - [or "||"] - [and "&&"] - [bit-or "|"] - [bit-and "&"] - [bit-xor "^"] - ) - -(template [<name> <op>] - [(def: #export (<name> param subject) - (-> Expression Expression Expression) - (format "(" subject " " <op> " " param ")"))] - - [bit-shl "<<"] - [bit-shr ">>"] - ) - -(def: #export (not subject) - (-> Expression Expression) - (format "(!" subject ")")) diff --git a/new-luxc/source/luxc/lang/translation/ruby/case.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/case.jvm.lux deleted file mode 100644 index d83a5cd0a..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/case.jvm.lux +++ /dev/null @@ -1,173 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data text/format - (coll [list "list/" Fold<List>])) - [macro #+ "meta/" Monad<Meta>]) - (luxc [lang] - (lang ["ls" synthesis] - (host [ruby #+ Ruby Expression Statement]))) - [//] - (// [".T" runtime] - [".T" primitive] - [".T" reference])) - -(def: (expression-block body) - (-> Statement Expression) - (ruby.call (list) - (ruby.lambda #.None (list) - body))) - -(def: #export (translate-let translate register valueS bodyS) - (-> (-> ls.Synthesis (Meta Expression)) Nat ls.Synthesis ls.Synthesis - (Meta Expression)) - (do macro.Monad<Meta> - [valueO (translate valueS) - bodyO (translate bodyS)] - (wrap (expression-block - (ruby.block! (list (ruby.set! (list (referenceT.variable register)) valueO) - (ruby.return! bodyO))))))) - -(def: #export (translate-record-get translate valueS path) - (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List [Nat Bit]) - (Meta Expression)) - (do macro.Monad<Meta> - [valueO (translate valueS)] - (wrap (list/fold (function (_ [idx tail?] source) - (let [method (if tail? - runtimeT.product//right - runtimeT.product//left)] - (method source (ruby.int (:coerce Int idx))))) - valueO - path)))) - -(def: #export (translate-if testO thenO elseO) - (-> Expression Expression Expression Expression) - (expression-block - (ruby.if! testO - (ruby.return! thenO) - (ruby.return! elseO)))) - -(def: savepoint - Expression - "pm_cursor_savepoint") - -(def: cursor - Expression - "pm_cursor") - -(def: (push-cursor! value) - (-> Expression Statement) - (ruby.statement (ruby.send "push" (list value) cursor))) - -(def: save-cursor! - Statement - (ruby.statement - (ruby.send "push" - (list (ruby.array-range (ruby.int 0) (ruby.int -1) cursor)) - savepoint))) - -(def: restore-cursor! - Statement - (ruby.set! (list cursor) (ruby.send "pop" (list) savepoint))) - -(def: cursor-top - Expression - (ruby.nth (ruby.- (ruby.int 1) - (ruby.length cursor)) - cursor)) - -(def: pop-cursor! - Statement - (ruby.statement (ruby.send "pop" (list) cursor))) - -(def: pm-error - Expression - (ruby.string "PM-ERROR")) - -(exception: #export (Unrecognized-Path {message Text}) - message) - -(def: (translate-pattern-matching' translate path) - (-> (-> ls.Synthesis (Meta Expression)) Code (Meta Expression)) - (case path - (^code ("lux case exec" (~ bodyS))) - (do macro.Monad<Meta> - [bodyO (translate bodyS)] - (wrap (ruby.return! bodyO))) - - (^code ("lux case pop")) - (meta/wrap pop-cursor!) - - (^code ("lux case bind" (~ [_ (#.Nat register)]))) - (meta/wrap (ruby.set! (list (referenceT.variable register)) cursor-top)) - - (^template [<tag> <format>] - [_ (<tag> value)] - (meta/wrap (ruby.when! (ruby.not (ruby.= (|> value <format>) cursor-top)) - (ruby.raise pm-error)))) - ([#.Int ruby.int] - [#.Bit ruby.bool] - [#.Frac ruby.float] - [#.Text ruby.string]) - - (^template [<pm> <getter>] - (^code (<pm> (~ [_ (#.Nat idx)]))) - (meta/wrap (push-cursor! (<getter> cursor-top (ruby.int (:coerce Int idx)))))) - (["lux case tuple left" runtimeT.product//left] - ["lux case tuple right" runtimeT.product//right]) - - (^template [<pm> <flag>] - (^code (<pm> (~ [_ (#.Nat idx)]))) - (meta/wrap (ruby.block! (list (ruby.set! (list "temp") (runtimeT.sum//get cursor-top (ruby.int (:coerce Int idx)) <flag>)) - (ruby.if! (ruby.= ruby.nil "temp") - (ruby.raise pm-error) - (push-cursor! "temp")))))) - (["lux case variant left" ruby.nil] - ["lux case variant right" (ruby.string "")]) - - (^code ("lux case seq" (~ leftP) (~ rightP))) - (do macro.Monad<Meta> - [leftO (translate-pattern-matching' translate leftP) - rightO (translate-pattern-matching' translate rightP)] - (wrap (ruby.block! (list leftO rightO)))) - - (^code ("lux case alt" (~ leftP) (~ rightP))) - (do macro.Monad<Meta> - [leftO (translate-pattern-matching' translate leftP) - rightO (translate-pattern-matching' translate rightP)] - (wrap (ruby.begin! (ruby.block! (list save-cursor! - leftO)) - (list [(list) "alt_error" (ruby.if! (ruby.= pm-error (ruby.field "message" "alt_error")) - (ruby.block! (list restore-cursor! - rightO)) - (ruby.raise "alt_error"))])))) - - _ - (lang.throw Unrecognized-Path (%code path)) - )) - -(def: (translate-pattern-matching translate path) - (-> (-> ls.Synthesis (Meta Expression)) Code (Meta Expression)) - (do macro.Monad<Meta> - [pattern-matching (translate-pattern-matching' translate path)] - (wrap (ruby.begin! pattern-matching - (list [(list) "alt_error" - (ruby.if! (ruby.= pm-error (ruby.field "message" "alt_error")) - (ruby.raise (ruby.string "Invalid expression for pattern-matching.")) - (ruby.raise "alt_error"))]))))) - -(def: (initialize-pattern-matching stack-init) - (-> Expression Statement) - (ruby.block! (list (ruby.set! (list cursor) (ruby.array (list stack-init))) - (ruby.set! (list savepoint) (ruby.array (list)))))) - -(def: #export (translate-case translate valueS path) - (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis Code (Meta Expression)) - (do macro.Monad<Meta> - [valueO (translate valueS) - pattern-matching (translate-pattern-matching translate path)] - (wrap (expression-block - (ruby.block! (list (initialize-pattern-matching valueO) - pattern-matching)))))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/expression.jvm.lux deleted file mode 100644 index 3016836b9..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/expression.jvm.lux +++ /dev/null @@ -1,85 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:] - ["p" parser]) - (data ["e" error] - text/format) - [macro] - (macro ["s" syntax])) - (luxc ["&" lang] - (lang [".L" variable #+ Variable Register] - [".L" extension] - ["ls" synthesis] - (host [ruby #+ Ruby Expression Statement]))) - [//] - (// [".T" runtime] - [".T" primitive] - [".T" structure] - [".T" function] - [".T" reference] - [".T" case] - [".T" procedure])) - -(template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Invalid-Function-Syntax] - [Unrecognized-Synthesis] - ) - -(def: #export (translate synthesis) - (-> ls.Synthesis (Meta Expression)) - (case synthesis - (^code []) - (:: macro.Monad<Meta> wrap runtimeT.unit) - - (^code [(~ singleton)]) - (translate singleton) - - (^template [<tag> <generator>] - [_ (<tag> value)] - (<generator> value)) - ([#.Bit primitiveT.translate-bit] - [#.Int primitiveT.translate-int] - [#.Frac primitiveT.translate-frac] - [#.Text primitiveT.translate-text]) - - (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bit last?)]) (~ valueS))) - (structureT.translate-variant translate tag last? valueS) - - (^code [(~+ members)]) - (structureT.translate-tuple translate members) - - (^ [_ (#.Form (list [_ (#.Int var)]))]) - (referenceT.translate-variable var) - - [_ (#.Identifier definition)] - (referenceT.translate-definition definition) - - (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS))) - (caseT.translate-let translate register inputS exprS) - - (^code ("lux case" (~ inputS) (~ pathPS))) - (caseT.translate-case translate inputS pathPS) - - (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS))) - (case (s.run environment (p.some s.int)) - (#e.Success environment) - (functionT.translate-function translate environment arity bodyS) - - _ - (&.throw Invalid-Function-Syntax (%code synthesis))) - - (^code ("lux call" (~ functionS) (~+ argsS))) - (functionT.translate-apply translate functionS argsS) - - (^code ((~ [_ (#.Text procedure)]) (~+ argsS))) - (procedureT.translate-procedure translate procedure argsS) - ## (do macro.Monad<Meta> - ## [translation (extensionL.find-translation procedure)] - ## (translation argsS)) - - _ - (&.throw Unrecognized-Synthesis (%code synthesis)))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/function.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/function.jvm.lux deleted file mode 100644 index 64c2bba2e..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/function.jvm.lux +++ /dev/null @@ -1,79 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - (data [product] - [text] - text/format - (coll [list "list/" Functor<List>])) - [macro]) - (luxc ["&" lang] - (lang ["ls" synthesis] - [".L" variable #+ Variable Register] - (host [ruby #+ Ruby Expression Statement]))) - [//] - (// [".T" reference] - [".T" runtime])) - -(def: #export (translate-apply translate functionS argsS+) - (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List ls.Synthesis) (Meta Expression)) - (do macro.Monad<Meta> - [functionO (translate functionS) - argsO+ (monad.map @ translate argsS+)] - (wrap (ruby.call argsO+ functionO)))) - -(def: (input-declaration registers) - (-> (List Register) Statement) - (ruby.set! (list.concat (list (list/map (|>> inc referenceT.variable) registers) - (list "_"))) - "curried")) - -(def: (with-closure inits function-definition) - (-> (List Expression) Statement Expression) - (case inits - #.Nil - function-definition - - _ - (ruby.call inits - (ruby.lambda #.None - (|> (list.enumerate inits) - (list/map (|>> product.left referenceT.closure))) - (ruby.return! function-definition))))) - -(def: #export (translate-function translate env arity bodyS) - (-> (-> ls.Synthesis (Meta Expression)) - (List Variable) ls.Arity ls.Synthesis - (Meta Expression)) - (do macro.Monad<Meta> - [[function-name bodyO] (//.with-sub-context - (do @ - [function-name //.context] - (//.with-anchor [function-name +1] - (translate bodyS)))) - closureO+ (monad.map @ referenceT.translate-variable env) - #let [args-initsO+ (input-declaration (list.n/range +0 (dec arity))) - selfO (ruby.set! (list (referenceT.variable +0)) function-name) - arityO (|> arity .int %i) - limitO (|> arity dec .int %i)]] - (wrap (with-closure closureO+ - (ruby.lambda (#.Some function-name) - (list (ruby.splat "curried")) - (ruby.block! (list (ruby.set! (list "num_args") (ruby.length "curried")) - (ruby.if! (ruby.= arityO "num_args") - (ruby.block! (list selfO - args-initsO+ - (ruby.while! (ruby.bool #1) - (ruby.return! bodyO)))) - (ruby.return! (let [recur (function (_ args) (ruby.call (list args) function-name))] - (ruby.? (ruby.> arityO "num_args") - (let [slice (function (_ from to) - (ruby.array-range from to "curried")) - arity-args (ruby.splat (slice (ruby.int 0) limitO)) - output-func-args (ruby.splat (slice arityO "num_args"))] - (ruby.call (list output-func-args) - (recur arity-args))) - (ruby.lambda #.None - (list (ruby.splat "extra")) - (recur (ruby.splat (|> (ruby.array (list)) - (ruby.send "concat" (list "curried")) - (ruby.send "concat" (list "extra"))))))))))))))))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/loop.jvm.lux deleted file mode 100644 index 3c2124565..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/loop.jvm.lux +++ /dev/null @@ -1,35 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - (data [text] - text/format - (coll [list "list/" Functor<List>])) - [macro]) - (luxc [lang] - (lang ["ls" synthesis] - (host [ruby #+ Ruby Expression Statement]))) - [//] - (// [".T" reference])) - -(def: #export (translate-loop translate offset initsS+ bodyS) - (-> (-> ls.Synthesis (Meta Expression)) Nat (List ls.Synthesis) ls.Synthesis - (Meta Expression)) - (do macro.Monad<Meta> - [loop-name (:: @ map (|>> %code lang.normalize-name) - (macro.gensym "loop")) - initsO+ (monad.map @ translate initsS+) - bodyO (//.with-anchor [loop-name offset] - (translate bodyS)) - #let [registersO+ (|> (list.n/range +0 (dec (list.size initsS+))) - (list/map (|>> (n/+ offset) referenceT.variable)))] - _ (//.save (ruby.function! loop-name registersO+ - (ruby.return! bodyO)))] - (wrap (ruby.apply loop-name initsO+)))) - -(def: #export (translate-recur translate argsS+) - (-> (-> ls.Synthesis (Meta Expression)) (List ls.Synthesis) - (Meta Expression)) - (do macro.Monad<Meta> - [[loop-name offset] //.anchor - argsO+ (monad.map @ translate argsS+)] - (wrap (ruby.apply loop-name argsO+)))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/primitive.jvm.lux deleted file mode 100644 index cc5e5752e..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/primitive.jvm.lux +++ /dev/null @@ -1,34 +0,0 @@ -(.module: - lux - (lux (control pipe) - (data [number] - text/format) - [macro "meta/" Monad<Meta>]) - (luxc (lang (host [ruby #+ Ruby Expression Statement])))) - -(def: #export translate-bit - (-> Bit (Meta Expression)) - (|>> ruby.bool meta/wrap)) - -(def: #export translate-int - (-> Int (Meta Expression)) - (|>> ruby.int meta/wrap)) - -(def: #export translate-frac - (-> Frac (Meta Expression)) - (|>> (cond> [(f/= number.positive-infinity)] - [(new> "(1.0/0.0)")] - - [(f/= number.negative-infinity)] - [(new> "(-1.0/0.0)")] - - [(f/= number.not-a-number)] - [(new> "(0.0/0.0)")] - - ## else - [%f]) - meta/wrap)) - -(def: #export translate-text - (-> Text (Meta Expression)) - (|>> %t meta/wrap)) diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux deleted file mode 100644 index c60938d79..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux +++ /dev/null @@ -1,372 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:] - ["p" parser]) - (data ["e" error] - [text] - text/format - (coll [list "list/" Functor<List>] - (dictionary ["dict" unordered #+ Dict]))) - [macro #+ with-gensyms] - (macro [code] - ["s" syntax #+ syntax:]) - [host]) - (luxc ["&" lang] - (lang ["la" analysis] - ["ls" synthesis] - (host [ruby #+ Ruby Expression Statement]))) - [///] - (/// [".T" runtime] - [".T" case] - [".T" function] - [".T" loop])) - -## [Types] -(type: #export Translator - (-> ls.Synthesis (Meta Expression))) - -(type: #export Proc - (-> Translator (List ls.Synthesis) (Meta Expression))) - -(type: #export Bundle - (Dict Text Proc)) - -(syntax: (Vector {size s.nat} elemT) - (wrap (list (` [(~+ (list.repeat size elemT))])))) - -(type: #export Nullary (-> (Vector +0 Expression) Expression)) -(type: #export Unary (-> (Vector +1 Expression) Expression)) -(type: #export Binary (-> (Vector +2 Expression) Expression)) -(type: #export Trinary (-> (Vector +3 Expression) Expression)) -(type: #export Variadic (-> (List Expression) Expression)) - -## [Utils] -(def: #export (install name unnamed) - (-> Text (-> Text Proc) - (-> Bundle Bundle)) - (dict.put name (unnamed name))) - -(def: #export (prefix prefix bundle) - (-> Text Bundle Bundle) - (|> bundle - dict.entries - (list/map (function (_ [key val]) [(format prefix " " key) val])) - (dict.from-list text.Hash<Text>))) - -(def: (wrong-arity proc expected actual) - (-> Text Nat Nat Text) - (format "Wrong number of arguments for " (%t proc) "\n" - "Expected: " (|> expected .int %i) "\n" - " Actual: " (|> actual .int %i))) - -(syntax: (arity: {name s.local-identifier} {arity s.nat}) - (with-gensyms [g!_ g!proc g!name g!translate g!inputs] - (do @ - [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] - (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!proc)) - (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression) - (-> Text ..Proc)) - (function ((~ g!_) (~ g!name)) - (function ((~ g!_) (~ g!translate) (~ g!inputs)) - (case (~ g!inputs) - (^ (list (~+ g!input+))) - (do macro.Monad<Meta> - [(~+ (|> g!input+ - (list/map (function (_ g!input) - (list g!input (` ((~ g!translate) (~ g!input)))))) - list.concat))] - ((~' wrap) ((~ g!proc) [(~+ g!input+)]))) - - (~' _) - (macro.fail (wrong-arity (~ g!name) +1 (list.size (~ g!inputs)))))))))))))) - -(arity: nullary +0) -(arity: unary +1) -(arity: binary +2) -(arity: trinary +3) - -(def: #export (variadic proc) - (-> Variadic (-> Text Proc)) - (function (_ proc-name) - (function (_ translate inputsS) - (do macro.Monad<Meta> - [inputsI (monad.map @ translate inputsS)] - (wrap (proc inputsI)))))) - -## [Procedures] -## [[Lux]] -(def: (lux//is [leftO rightO]) - Binary - (ruby.= leftO rightO)) - -(def: (lux//if [testO thenO elseO]) - Trinary - (caseT.translate-if testO thenO elseO)) - -(def: (lux//try riskyO) - Unary - (runtimeT.lux//try riskyO)) - -(exception: #export (Wrong-Syntax {message Text}) - message) - -(def: #export (wrong-syntax procedure args) - (-> Text (List ls.Synthesis) Text) - (format "Procedure: " procedure "\n" - "Arguments: " (%code (code.tuple args)))) - -(def: lux//loop - (-> Text Proc) - (function (_ proc-name) - (function (_ translate inputsS) - (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any)) - (#e.Success [offset initsS+ bodyS]) - (loopT.translate-loop translate offset initsS+ bodyS) - - (#e.Error error) - (&.throw Wrong-Syntax (wrong-syntax proc-name inputsS))) - ))) - -(def: lux//recur - (-> Text Proc) - (function (_ proc-name) - (function (_ translate inputsS) - (loopT.translate-recur translate inputsS)))) - -(def: lux-procs - Bundle - (|> (dict.new text.Hash<Text>) - (install "is" (binary lux//is)) - (install "try" (unary lux//try)) - (install "if" (trinary lux//if)) - (install "loop" lux//loop) - (install "recur" lux//recur) - )) - -## [[Bits]] -(template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (<op> paramO subjectO))] - - [bit//and ruby.bit-and] - [bit//or ruby.bit-or] - [bit//xor ruby.bit-xor] - ) - -(def: (bit//left-shift [subjectO paramO]) - Binary - (ruby.bit-and "0xFFFFFFFFFFFFFFFF" - (ruby.bit-shl paramO subjectO))) - -(template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (<op> paramO subjectO))] - - [bit//arithmetic-right-shift ruby.bit-shr] - [bit//logical-right-shift runtimeT.bit//logical-right-shift] - ) - -(def: bit-procs - Bundle - (<| (prefix "bit") - (|> (dict.new text.Hash<Text>) - (install "and" (binary bit//and)) - (install "or" (binary bit//or)) - (install "xor" (binary bit//xor)) - (install "left-shift" (binary bit//left-shift)) - (install "logical-right-shift" (binary bit//logical-right-shift)) - (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift)) - ))) - -## [[Numbers]] -(host.import: java/lang/Double - (#static MIN_VALUE Double) - (#static MAX_VALUE Double)) - -(template [<name> <const> <encode>] - [(def: (<name> _) - Nullary - (<encode> <const>))] - - [frac//smallest Double::MIN_VALUE ruby.float] - [frac//min (f/* -1.0 Double::MAX_VALUE) ruby.float] - [frac//max Double::MAX_VALUE ruby.float] - ) - -(template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (ruby.bit-and "0xFFFFFFFFFFFFFFFF" - (<op> paramO subjectO)))] - - [int//add ruby.+] - [int//sub ruby.-] - [int//mul ruby.*] - ) - -(template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (<op> paramO subjectO))] - - [int//div ruby./] - [int//rem ruby.%] - ) - -(template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (<op> paramO subjectO))] - - [frac//add ruby.+] - [frac//sub ruby.-] - [frac//mul ruby.*] - [frac//div ruby./] - [frac//rem ruby.%] - [frac//= ruby.=] - [frac//< ruby.<] - - [text//= ruby.=] - [text//< ruby.<] - ) - -(template [<name> <cmp>] - [(def: (<name> [subjectO paramO]) - Binary - (<cmp> paramO subjectO))] - - [int//= ruby.=] - [int//< ruby.<] - ) - -(def: frac//encode - Unary - (ruby.send "to_s" (list))) - -(def: (frac//decode inputO) - Unary - (ruby.call (list) - (ruby.lambda #.None (list) - (ruby.block! (list (ruby.set! (list "input") inputO) - (ruby.set! (list "temp") (ruby.send "to_f" (list) "input")) - (ruby.if! (ruby.or (ruby.not (ruby.= (ruby.float 0.0) "temp")) - (ruby.or (ruby.= (ruby.string "0") "input") - (ruby.= (ruby.string "0.0") "input"))) - (ruby.return! (runtimeT.some "temp")) - (ruby.return! runtimeT.none))))))) - -(def: int-procs - Bundle - (<| (prefix "int") - (|> (dict.new text.Hash<Text>) - (install "+" (binary int//add)) - (install "-" (binary int//sub)) - (install "*" (binary int//mul)) - (install "/" (binary int//div)) - (install "%" (binary int//rem)) - (install "=" (binary int//=)) - (install "<" (binary int//<)) - (install "to-frac" (unary (ruby./ (ruby.float 1.0)))) - (install "char" (unary (ruby.send "chr" (list))))))) - -(def: frac-procs - Bundle - (<| (prefix "frac") - (|> (dict.new text.Hash<Text>) - (install "+" (binary frac//add)) - (install "-" (binary frac//sub)) - (install "*" (binary frac//mul)) - (install "/" (binary frac//div)) - (install "%" (binary frac//rem)) - (install "=" (binary frac//=)) - (install "<" (binary frac//<)) - (install "smallest" (nullary frac//smallest)) - (install "min" (nullary frac//min)) - (install "max" (nullary frac//max)) - (install "to-int" (unary (ruby.send "floor" (list)))) - (install "encode" (unary frac//encode)) - (install "decode" (unary frac//decode))))) - -## [[Text]] -(template [<name> <op>] - [(def: <name> - Unary - (ruby.send <op> (list)))] - - [text//size "length"] - ) - -(def: (text//concat [subjectO paramO]) - Binary - (|> subjectO (ruby.+ paramO))) - -(def: (text//char [subjectO paramO]) - Binary - (runtimeT.text//char subjectO paramO)) - -(def: (text//clip [subjectO paramO extraO]) - Trinary - (runtimeT.text//clip subjectO paramO extraO)) - -(def: (text//index [textO partO startO]) - Trinary - (runtimeT.text//index textO partO startO)) - -(def: text-procs - Bundle - (<| (prefix "text") - (|> (dict.new text.Hash<Text>) - (install "=" (binary text//=)) - (install "<" (binary text//<)) - (install "concat" (binary text//concat)) - (install "index" (trinary text//index)) - (install "size" (unary text//size)) - (install "char" (binary text//char)) - (install "clip" (trinary text//clip)) - ))) - -## [[IO]] -(def: (io//log messageO) - Unary - (ruby.or (ruby.apply "puts" (list (ruby.+ (ruby.string "\n") messageO))) - runtimeT.unit)) - -(def: io//error - Unary - ruby.raise) - -(def: io//exit - Unary - (|>> (list) (ruby.apply "exit"))) - -(def: (io//current-time []) - Nullary - (|> "Time" - (ruby.send "now" (list)) - (ruby.send "to_f" (list)) - (ruby.* (ruby.float 1000.0)) - (ruby.send "to_i" (list)))) - -(def: io-procs - Bundle - (<| (prefix "io") - (|> (dict.new text.Hash<Text>) - (install "log" (unary io//log)) - (install "error" (unary io//error)) - (install "exit" (unary io//exit)) - (install "current-time" (nullary io//current-time))))) - -## [Bundles] -(def: #export procedures - Bundle - (<| (prefix "lux") - (|> lux-procs - (dict.merge bit-procs) - (dict.merge int-procs) - (dict.merge frac-procs) - (dict.merge text-procs) - (dict.merge io-procs) - ))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/host.jvm.lux deleted file mode 100644 index 2793b40e8..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/procedure/host.jvm.lux +++ /dev/null @@ -1,89 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - (data [text] - text/format - (coll [list "list/" Functor<List>] - (dictionary ["dict" unordered #+ Dict]))) - [macro "macro/" Monad<Meta>]) - (luxc ["&" lang] - (lang ["la" analysis] - ["ls" synthesis] - (host [ruby #+ Ruby Expression Statement]))) - [///] - (/// [".T" runtime]) - (// ["@" common])) - -## (template [<name> <lua>] -## [(def: (<name> _) @.Nullary <lua>)] - -## [lua//nil "nil"] -## [lua//table "{}"] -## ) - -## (def: (lua//global proc translate inputs) -## (-> Text @.Proc) -## (case inputs -## (^ (list [_ (#.Text name)])) -## (do macro.Monad<Meta> -## [] -## (wrap name)) - -## _ -## (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) - -## (def: (lua//call proc translate inputs) -## (-> Text @.Proc) -## (case inputs -## (^ (list& functionS argsS+)) -## (do macro.Monad<Meta> -## [functionO (translate functionS) -## argsO+ (monad.map @ translate argsS+)] -## (wrap (lua.apply functionO argsO+))) - -## _ -## (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) - -## (def: lua-procs -## @.Bundle -## (|> (dict.new text.Hash<Text>) -## (@.install "nil" (@.nullary lua//nil)) -## (@.install "table" (@.nullary lua//table)) -## (@.install "global" lua//global) -## (@.install "call" lua//call))) - -## (def: (table//call proc translate inputs) -## (-> Text @.Proc) -## (case inputs -## (^ (list& tableS [_ (#.Text field)] argsS+)) -## (do macro.Monad<Meta> -## [tableO (translate tableS) -## argsO+ (monad.map @ translate argsS+)] -## (wrap (lua.method field tableO argsO+))) - -## _ -## (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) - -## (def: (table//get [fieldO tableO]) -## @.Binary -## (runtimeT.lua//get tableO fieldO)) - -## (def: (table//set [fieldO valueO tableO]) -## @.Trinary -## (runtimeT.lua//set tableO fieldO valueO)) - -## (def: table-procs -## @.Bundle -## (<| (@.prefix "table") -## (|> (dict.new text.Hash<Text>) -## (@.install "call" table//call) -## (@.install "get" (@.binary table//get)) -## (@.install "set" (@.trinary table//set))))) - -(def: #export procedures - @.Bundle - (<| (@.prefix "lua") - (dict.new text.Hash<Text>) - ## (|> lua-procs - ## (dict.merge table-procs)) - )) diff --git a/new-luxc/source/luxc/lang/translation/ruby/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/reference.jvm.lux deleted file mode 100644 index 80e78951b..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/reference.jvm.lux +++ /dev/null @@ -1,36 +0,0 @@ -(.module: - lux - (lux [macro] - (data [text] - text/format)) - (luxc ["&" lang] - (lang [".L" variable #+ Variable Register] - (host [ruby #+ Ruby Expression Statement]))) - [//] - (// [".T" runtime])) - -(template [<register> <translation> <prefix>] - [(def: #export (<register> register) - (-> Register Expression) - (format <prefix> (%i (.int register)))) - - (def: #export (<translation> register) - (-> Register (Meta Expression)) - (:: macro.Monad<Meta> wrap (<register> register)))] - - [closure translate-captured "c"] - [variable translate-local "v"]) - -(def: #export (translate-variable var) - (-> Variable (Meta Expression)) - (if (variableL.captured? var) - (translate-captured (variableL.captured-register var)) - (translate-local (.nat var)))) - -(def: #export global - (-> Name Expression) - //.definition-name) - -(def: #export (translate-definition name) - (-> Name (Meta Expression)) - (:: macro.Monad<Meta> wrap (ruby.global (global name)))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux deleted file mode 100644 index 02de3dc7b..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux +++ /dev/null @@ -1,250 +0,0 @@ -(.module: - lux - (lux (control ["p" parser "p/" Monad<Parser>] - [monad #+ do]) - (data text/format - (coll [list "list/" Monad<List>])) - [macro] - (macro [code] - ["s" syntax #+ syntax:]) - [io #+ Process]) - [//] - (luxc [lang] - (lang (host [ruby #+ Ruby Expression Statement])))) - -(def: prefix Text "LuxRuntime") - -(def: #export unit Expression (%t //.unit)) - -(def: (flag value) - (-> Bit Ruby) - (if value - (ruby.string "") - ruby.nil)) - -(def: (variant' tag last? value) - (-> Expression Expression Expression Expression) - (ruby.dictionary (list [(ruby.string //.variant-tag-field) tag] - [(ruby.string //.variant-flag-field) last?] - [(ruby.string //.variant-value-field) value]))) - -(def: #export (variant tag last? value) - (-> Nat Bit Expression Expression) - (variant' (%i (.int tag)) (flag last?) value)) - -(def: #export none - Expression - (variant +0 #0 unit)) - -(def: #export some - (-> Expression Expression) - (variant +1 #1)) - -(def: #export left - (-> Expression Expression) - (variant +0 #0)) - -(def: #export right - (-> Expression Expression) - (variant +1 #1)) - -(type: Runtime Ruby) - -(def: declaration - (s.Syntax [Text (List Text)]) - (p.either (p.seq s.local-identifier (p/wrap (list))) - (s.form (p.seq s.local-identifier (p.some s.local-identifier))))) - -(syntax: (runtime: {[name args] declaration} - definition) - (let [implementation (code.local-identifier (format "@@" name)) - runtime (code.text (format "__" prefix "__" (lang.normalize-name name))) - argsC+ (list/map code.local-identifier args) - argsLC+ (list/map (|>> lang.normalize-name code.text) args) - declaration (` ((~ (code.local-identifier name)) - (~+ argsC+))) - type (` (-> (~+ (list.repeat (list.size argsC+) (` ruby.Ruby))) - ruby.Ruby))] - (wrap (list (` (def: #export (~ declaration) - (~ type) - (ruby.apply (~ runtime) (list (~+ argsC+))))) - (` (def: (~ implementation) - Ruby - (~ (case argsC+ - #.Nil - (` (ruby.set! (list (~ runtime)) (~ definition))) - - _ - (` (let [(~' @) (~ runtime) - (~+ (|> (list.zip2 argsC+ argsLC+) - (list/map (function (_ [left right]) (list left right))) - list/join))] - (ruby.function! (~ runtime) - (list (~+ argsLC+)) - (~ definition)))))))))))) - -(runtime: (lux//try op) - (ruby.begin! (ruby.block! (list (ruby.set! (list "value") (ruby.call (list unit) op)) - (ruby.return! (right "value")))) - (list [(list) "error" - (ruby.return! (left (ruby.field "message" "error")))]))) - -(runtime: (lux//program-args program-args) - (ruby.block! (list (ruby.set! (list "inputs") none) - (ruby.for-in! "value" program-args - (ruby.set! (list "inputs") (some (ruby.array (list "value" "inputs"))))) - (ruby.return! "inputs")))) - -(def: runtime//lux - Runtime - (format @@lux//try "\n" - @@lux//program-args "\n")) - -(runtime: (product//left product index) - (ruby.block! (list (ruby.set! (list "index_min_length") (ruby.+ (ruby.int 1) index)) - (ruby.if! (ruby.> "index_min_length" (ruby.length product)) - ## No need for recursion - (ruby.return! (ruby.nth index product)) - ## Needs recursion - (ruby.return! (product//left (ruby.nth (ruby.- (ruby.int 1) - (ruby.length product)) - product) - (ruby.- (ruby.length product) - "index_min_length"))))))) - -(runtime: (product//right product index) - (ruby.block! (list (ruby.set! (list "index_min_length") (ruby.+ (ruby.int 1) index)) - (ruby.cond! (list [(ruby.= "index_min_length" (ruby.length product)) - ## Last element. - (ruby.return! (ruby.nth index product))] - [(ruby.< "index_min_length" (ruby.length product)) - ## Needs recursion - (ruby.return! (product//right (ruby.nth (ruby.- (ruby.int 1) - (ruby.length product)) - product) - (ruby.- (ruby.length product) - "index_min_length")))]) - ## Must slice - (ruby.return! (ruby.array-range index (ruby.length product) product)))))) - -(runtime: (sum//get sum wantedTag wantsLast) - (let [no-match! (ruby.return! ruby.nil) - sum-tag (ruby.nth (ruby.string //.variant-tag-field) sum) - sum-flag (ruby.nth (ruby.string //.variant-flag-field) sum) - sum-value (ruby.nth (ruby.string //.variant-value-field) sum) - is-last? (ruby.= (ruby.string "") sum-flag) - test-recursion! (ruby.if! is-last? - ## Must recurse. - (ruby.return! (sum//get sum-value (ruby.- sum-tag wantedTag) wantsLast)) - no-match!)] - (ruby.cond! (list [(ruby.= sum-tag wantedTag) - (ruby.if! (ruby.= wantsLast sum-flag) - (ruby.return! sum-value) - test-recursion!)] - - [(ruby.> sum-tag wantedTag) - test-recursion!] - - [(ruby.and (ruby.< sum-tag wantedTag) - (ruby.= (ruby.string "") wantsLast)) - (ruby.return! (variant' (ruby.- wantedTag sum-tag) sum-flag sum-value))]) - - no-match!))) - -(def: runtime//adt - Runtime - (format @@product//left "\n" - @@product//right "\n" - @@sum//get "\n")) - -(runtime: (bit//logical-right-shift param subject) - (let [mask (|> (ruby.int 1) - (ruby.bit-shl (ruby.- param (ruby.int 64))) - (ruby.- (ruby.int 1)))] - (ruby.return! (|> subject - (ruby.bit-shr param) - (ruby.bit-and mask))))) - -(def: runtime//bit - Runtime - @@bit//logical-right-shift) - -(runtime: (text//index subject param start) - (ruby.block! (list (ruby.set! (list "idx") (ruby.send "index" (list param start) subject)) - (ruby.if! (ruby.= ruby.nil "idx") - (ruby.return! none) - (ruby.return! (some "idx")))))) - -(runtime: (text//clip text from to) - (ruby.if! ($_ ruby.and - (ruby.>= (ruby.int 0) from) - (ruby.< (ruby.send "length" (list) text) from) - (ruby.>= (ruby.int 0) to) - (ruby.< (ruby.send "length" (list) text) to) - (ruby.<= to from)) - (ruby.return! (some (ruby.array-range from to text))) - (ruby.return! none))) - -(runtime: (text//char text idx) - (ruby.if! (ruby.and (ruby.>= (ruby.int 0) idx) - (ruby.< (ruby.send "length" (list) text) idx)) - (ruby.return! (some (ruby.send "ord" (list) - (ruby.array-range idx idx text)))) - (ruby.return! none))) - -(def: runtime//text - Runtime - (format @@text//index - @@text//clip - @@text//char)) - -(def: (check-index-out-of-bounds array idx body!) - (-> Expression Expression Statement Statement) - (ruby.if! (ruby.<= (ruby.length array) - idx) - body! - (ruby.raise (ruby.string "Array index out of bounds!")))) - -(runtime: (array//get array idx) - (<| (check-index-out-of-bounds array idx) - (ruby.block! (list (ruby.set! (list "temp") (ruby.nth idx array)) - (ruby.if! (ruby.= ruby.nil "temp") - (ruby.return! none) - (ruby.return! (some "temp"))))))) - -(runtime: (array//put array idx value) - (<| (check-index-out-of-bounds array idx) - (ruby.block! (list (ruby.set-nth! idx value array) - (ruby.return! array))))) - -(def: runtime//array - Runtime - (format @@array//get - @@array//put)) - -(runtime: (box//write value box) - (ruby.block! (list (ruby.set-nth! (ruby.int 0) value box) - (ruby.return! ..unit)))) - -(def: runtime//box - Runtime - (format @@box//write)) - -(def: runtime - Runtime - (format runtime//lux "\n" - runtime//adt "\n" - runtime//bit "\n" - runtime//text "\n" - runtime//array "\n" - runtime//box "\n" - )) - -(def: #export artifact Text (format prefix ".rb")) - -(def: #export translate - (Meta (Process Any)) - (do macro.Monad<Meta> - [_ //.init-module-buffer - _ (//.save runtime)] - (//.save-module! artifact))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/statement.jvm.lux deleted file mode 100644 index a9fbc7152..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/statement.jvm.lux +++ /dev/null @@ -1,48 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - [macro] - (data text/format)) - (luxc (lang [".L" module] - (host [ruby #+ Ruby Expression Statement]))) - [//] - (// [".T" runtime] - [".T" reference] - [".T" eval])) - -(def: #export (translate-def name expressionT expressionO metaV) - (-> Text Type Expression Code (Meta Any)) - (do macro.Monad<Meta> - [current-module macro.current-module-name - #let [def-name [current-module name]]] - (case (macro.get-identifier-ann (name-of #.alias) metaV) - (#.Some real-def) - (do @ - [[realT realA realV] (macro.find-def real-def) - _ (moduleL.define def-name [realT metaV realV])] - (wrap [])) - - _ - (do @ - [#let [def-name (referenceT.global def-name)] - _ (//.save (ruby.global! def-name expressionO)) - expressionV (evalT.eval (ruby.global def-name)) - _ (moduleL.define def-name [expressionT metaV expressionV]) - _ (if (macro.type? metaV) - (case (macro.declared-tags metaV) - #.Nil - (wrap []) - - tags - (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV))) - (wrap [])) - #let [_ (log! (format "DEF " (%name def-name)))]] - (wrap [])) - ))) - -(def: #export (translate-program programO) - (-> Expression (Meta Statement)) - (macro.fail "translate-program NOT IMPLEMENTED YET") - ## (hostT.save (format "var " (referenceT.variable +0) " = " runtimeT.lux//program-args "();" - ## "(" programO ")(null);")) - ) diff --git a/new-luxc/source/luxc/lang/translation/ruby/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/structure.jvm.lux deleted file mode 100644 index 2a1f81d37..000000000 --- a/new-luxc/source/luxc/lang/translation/ruby/structure.jvm.lux +++ /dev/null @@ -1,31 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - (data [text] - text/format) - [macro]) - (luxc ["&" lang] - (lang [synthesis #+ Synthesis] - (host [ruby #+ Ruby Expression Statement]))) - [//] - (// [".T" runtime])) - -(def: #export (translate-tuple translate elemsS+) - (-> (-> Synthesis (Meta Expression)) (List Synthesis) (Meta Expression)) - (case elemsS+ - #.Nil - (:: macro.Monad<Meta> wrap runtimeT.unit) - - (#.Cons singletonS #.Nil) - (translate singletonS) - - _ - (do macro.Monad<Meta> - [elemsT+ (monad.map @ translate elemsS+)] - (wrap (ruby.array elemsT+))))) - -(def: #export (translate-variant translate tag tail? valueS) - (-> (-> Synthesis (Meta Expression)) Nat Bit Synthesis (Meta Expression)) - (do macro.Monad<Meta> - [valueT (translate valueS)] - (wrap (runtimeT.variant tag tail? valueT)))) |