diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation')
10 files changed, 0 insertions, 1376 deletions
diff --git a/new-luxc/source/luxc/lang/translation/python/case.jvm.lux b/new-luxc/source/luxc/lang/translation/python/case.jvm.lux deleted file mode 100644 index 809b32c23..000000000 --- a/new-luxc/source/luxc/lang/translation/python/case.jvm.lux +++ /dev/null @@ -1,266 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [number] - [text] - text/format - (coll [list "list/" Functor<List> Fold<List>] - (set ["set" unordered #+ Set]))) - [macro #+ "meta/" Monad<Meta>] - (macro [code])) - (luxc [lang] - (lang [".L" variable #+ Register Variable] - ["ls" synthesis #+ Synthesis Path] - (host [python #+ Expression Statement Except SVar @@]))) - [//] - (// [".T" runtime] - [".T" primitive] - [".T" reference])) - -(def: #export (translate-let translate register valueS bodyS) - (-> (-> Synthesis (Meta Expression)) Register Synthesis Synthesis - (Meta Expression)) - (do macro.Monad<Meta> - [valueO (translate valueS) - bodyO (translate bodyS) - #let [$register (referenceT.variable register)]] - (wrap (|> bodyO - (python.lambda (list $register)) - (python.apply (list valueO)))))) - -(def: #export (translate-record-get translate valueS pathP) - (-> (-> Synthesis (Meta Expression)) 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 (python.int (:coerce Int idx))))) - valueO - pathP)))) - -(def: #export (translate-if testO thenO elseO) - (-> Expression Expression Expression Expression) - (python.if testO thenO elseO)) - -(def: $savepoint (python.var "pm_cursor_savepoint")) -(def: $cursor (python.var "pm_cursor")) - -(def: (push-cursor! value) - (-> Expression Statement) - (python.do! - (python.send (list value) - "append" (@@ $cursor)))) - -(def: save-cursor! - Statement - (python.do! - (python.send (list (python.slice-from (python.int 0) (@@ $cursor))) - "append" (@@ $savepoint)))) - -(def: restore-cursor! - Statement - (python.set! (list $cursor) - (python.send (list) "pop" (@@ $savepoint)))) - -(def: cursor-top - Expression - (python.nth (python.int -1) (@@ $cursor))) - -(def: pop-cursor! - Statement - (python.do! - (python.send (list) "pop" (@@ $cursor)))) - -(def: pm-error (python.string "PM-ERROR")) - -(def: (new-Exception error) - (-> Expression Expression) - (python.apply (list error) (python.global "Exception"))) - -(def: fail-pm! (python.raise! (new-Exception pm-error))) - -(def: $temp (python.var "temp")) - -(exception: #export (Unrecognized-Path {message Text}) - message) - -(def: $alt_error (python.var "alt_error")) - -(def: (pm-catch! handler!) - (-> Statement Except) - [(list "Exception") $alt_error - (python.if! (python.= pm-error (python.apply (list (@@ $alt_error)) (python.global "str"))) - handler! - (python.raise! (@@ $alt_error)))]) - -(def: (translate-pattern-matching' translate pathP) - (-> (-> Synthesis (Meta Expression)) Path (Meta Statement)) - (case pathP - (^code ("lux case exec" (~ bodyS))) - (do macro.Monad<Meta> - [bodyO (translate bodyS)] - (wrap (python.return! bodyO))) - - (^code ("lux case pop")) - (meta/wrap pop-cursor!) - - (^code ("lux case bind" (~ [_ (#.Nat register)]))) - (meta/wrap (python.set! (list (referenceT.variable register)) cursor-top)) - - (^template [<tag> <format>] - [_ (<tag> value)] - (meta/wrap (python.when! (python.not (python.= (|> value <format>) cursor-top)) - fail-pm!))) - ([#.Nat (<| python.int (:coerce Int))] - [#.Int python.int] - [#.Rev (<| python.int (:coerce Int))] - [#.Bit python.bool] - [#.Frac python.float] - [#.Text python.string]) - - (^template [<pm> <getter>] - (^code (<pm> (~ [_ (#.Nat idx)]))) - (meta/wrap (push-cursor! (<getter> cursor-top (python.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 ($_ python.then! - (python.set! (list $temp) (runtimeT.sum//get cursor-top (python.int (:coerce Int idx)) <flag>)) - (python.if! (python.= python.none (@@ $temp)) - fail-pm! - (push-cursor! (@@ $temp)))))) - (["lux case variant left" python.none] - ["lux case variant right" (python.string "")]) - - (^code ("lux case seq" (~ leftP) (~ rightP))) - (do macro.Monad<Meta> - [leftO (translate-pattern-matching' translate leftP) - rightO (translate-pattern-matching' translate rightP)] - (wrap ($_ python.then! - 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 (python.try! ($_ python.then! - save-cursor! - leftO) - (list (pm-catch! - ($_ python.then! - restore-cursor! - rightO)))))) - - _ - (lang.throw Unrecognized-Path (%code pathP)) - )) - -(def: (translate-pattern-matching translate pathP) - (-> (-> Synthesis (Meta Expression)) Path (Meta Statement)) - (do macro.Monad<Meta> - [pattern-matching (translate-pattern-matching' translate pathP)] - (wrap (python.try! pattern-matching - (list (pm-catch! - (python.raise! (new-Exception (python.string "Invalid expression for pattern-matching."))))))))) - -(def: (initialize-pattern-matching! stack-init) - (-> Expression Statement) - ($_ python.then! - (python.set! (list $cursor) (python.list (list stack-init))) - (python.set! (list $savepoint) (python.list (list))))) - -(def: empty (Set Variable) (set.new number.Hash<Int>)) - -(type: Storage - {#bindings (Set Variable) - #dependencies (Set Variable)}) - -(def: (path-variables pathP) - (-> Path Storage) - (loop [pathP pathP - outer-variables {#bindings empty - #dependencies empty}] - ## TODO: Remove (let [outer recur]) once loops can have names. - (let [outer recur] - (case pathP - (^code ("lux case bind" (~ [_ (#.Nat register)]))) - (update@ #bindings (set.add (.int register)) - outer-variables) - - (^or (^code ("lux case seq" (~ leftP) (~ rightP))) - (^code ("lux case alt" (~ leftP) (~ rightP)))) - (list/fold outer outer-variables (list leftP rightP)) - - (^code ("lux case exec" (~ bodyS))) - (loop [bodyS bodyS - inner-variables outer-variables] - ## TODO: Remove (let [inner recur]) once loops can have names. - (let [inner recur] - (case bodyS - (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bit last?)]) (~ valueS))) - (inner valueS inner-variables) - - (^code [(~+ members)]) - (list/fold inner inner-variables members) - - (^ [_ (#.Form (list [_ (#.Int var)]))]) - (if (set.member? (get@ #bindings inner-variables) var) - inner-variables - (update@ #dependencies (set.add var) inner-variables)) - - (^code ("lux call" (~ functionS) (~+ argsS))) - (list/fold inner inner-variables (#.Cons functionS argsS)) - - (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS))) - (|> environment - (list/map (|>> (list) code.form)) - (list/fold inner inner-variables)) - - (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS))) - (list/fold inner (update@ #bindings (set.add (.int register)) - inner-variables) - (list inputS exprS)) - - (^code ("lux case" (~ inputS) (~ pathPS))) - (|> inner-variables (inner inputS) (outer pathPS)) - - (^code ((~ [_ (#.Text procedure)]) (~+ argsS))) - (list/fold inner inner-variables argsS) - - _ - inner-variables))) - - _ - outer-variables)))) - -(def: generated-name - (-> Text (Meta SVar)) - (|>> macro.gensym - (:: macro.Monad<Meta> map (|>> %code - lang.normalize-name - python.var)))) - -(def: #export (translate-case translate valueS pathP) - (-> (-> Synthesis (Meta Expression)) Synthesis Path (Meta Expression)) - (do macro.Monad<Meta> - [valueO (translate valueS) - $case (generated-name "case") - $value (generated-name "value") - #let [$dependencies+ (|> (path-variables pathP) - (get@ #dependencies) - set.to-list - (list/map referenceT.local)) - @dependencies+ (list/map @@ $dependencies+)] - pattern-matching! (translate-pattern-matching translate pathP) - _ (//.save (python.def! $case (list& $value $dependencies+) - ($_ python.then! - (initialize-pattern-matching! (@@ $value)) - pattern-matching!)))] - (wrap (python.apply (list& valueO @dependencies+) (@@ $case))))) diff --git a/new-luxc/source/luxc/lang/translation/python/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/python/expression.jvm.lux deleted file mode 100644 index 0bbfb2f2c..000000000 --- a/new-luxc/source/luxc/lang/translation/python/expression.jvm.lux +++ /dev/null @@ -1,87 +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 [python #+ Expression Statement]))) - [//] - (// [".T" runtime] - [".T" primitive] - [".T" structure] - [".T" function] - [".T" reference] - [".T" case] - [".T" procedure])) - -(do-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] - [#.Nat primitiveT.translate-nat] - [#.Int primitiveT.translate-int] - [#.Rev primitiveT.translate-rev] - [#.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/python/function.jvm.lux b/new-luxc/source/luxc/lang/translation/python/function.jvm.lux deleted file mode 100644 index d081dd52b..000000000 --- a/new-luxc/source/luxc/lang/translation/python/function.jvm.lux +++ /dev/null @@ -1,99 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - pipe) - (data [product] - [text] - text/format - (coll [list "list/" Functor<List> Fold<List>])) - [macro]) - (luxc ["&" lang] - (lang ["ls" synthesis] - [".L" variable #+ Variable] - (host [python #+ Expression Statement @@]))) - [//] - (// [".T" reference])) - -(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 (python.apply argsO+ functionO)))) - -(def: $curried (python.var "curried")) - -(def: (input-declaration register) - (python.set! (list (referenceT.variable (inc register))) - (python.nth (|> register .int python.int) - (@@ $curried)))) - -(def: (with-closure function-name inits function-definition) - (-> Text (List Expression) Statement (Meta Expression)) - (let [$closure (python.var (format function-name "___CLOSURE"))] - (case inits - #.Nil - (do macro.Monad<Meta> - [_ (//.save function-definition)] - (wrap (python.global function-name))) - - _ - (do macro.Monad<Meta> - [_ (//.save (python.def! $closure - (|> (list.enumerate inits) - (list/map (|>> product.left referenceT.closure))) - ($_ python.then! - function-definition - (python.return! (python.global function-name)))))] - (wrap (python.apply inits (@@ $closure))))))) - -(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+ (|> (list.n/range +0 (dec arity)) - (list/map input-declaration) - (case> #.Nil - python.no-op! - - (#.Cons head tail) - (list/fold python.then! head tail))) - arityO (|> arity .int python.int) - @curried (@@ $curried) - $num_args (python.var "num_args") - @num_args (@@ $num_args) - $function (python.var function-name) - @function (@@ $function)]] - (with-closure function-name closureO+ - (python.def! $function (list (python.poly $curried)) - ($_ python.then! - (let [@len (python.global "len")] - (python.set! (list $num_args) (python.apply (list @curried) @len))) - (python.if! (python.= arityO @num_args) - ($_ python.then! - (python.set! (list (referenceT.variable +0)) @function) - args-initsO+ - (python.while! (python.bool #1) - (python.return! bodyO))) - (python.if! (python.> arityO @num_args) - (let [arity-args (python.slice (python.int 0) arityO @curried) - output-func-args (python.slice arityO @num_args @curried)] - (python.return! (|> @function - (python.apply-poly (list) arity-args) - (python.apply-poly (list) output-func-args)))) - (let [$next (python.var "next") - $missing (python.var "missing")] - ($_ python.then! - (python.def! $next (list (python.poly $missing)) - (python.return! (|> @function - (python.apply-poly (list) (|> @curried - (python.+ (@@ $missing))))))) - (python.return! (@@ $next))))))))) - )) diff --git a/new-luxc/source/luxc/lang/translation/python/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/python/loop.jvm.lux deleted file mode 100644 index f6e3ca4c3..000000000 --- a/new-luxc/source/luxc/lang/translation/python/loop.jvm.lux +++ /dev/null @@ -1,36 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - (data [text] - text/format - (coll [list "list/" Functor<List>])) - [macro]) - (luxc [lang] - (lang ["ls" synthesis] - (host [python #+ 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 (|> (macro.gensym "loop") - (:: @ map (|>> %code lang.normalize-name))) - initsO+ (monad.map @ translate initsS+) - bodyO (//.with-anchor [loop-name offset] - (translate bodyS)) - #let [$loop-name (python.var loop-name) - @loop-name (@@ $loop-name)] - _ (//.save (python.def! $loop-name (|> (list.n/range +0 (dec (list.size initsS+))) - (list/map (|>> (n/+ offset) referenceT.variable))) - (python.return! bodyO)))] - (wrap (python.apply initsO+ @loop-name)))) - -(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 (python.apply argsO+ (python.global loop-name))))) diff --git a/new-luxc/source/luxc/lang/translation/python/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/python/primitive.jvm.lux deleted file mode 100644 index f88c34fce..000000000 --- a/new-luxc/source/luxc/lang/translation/python/primitive.jvm.lux +++ /dev/null @@ -1,20 +0,0 @@ -(.module: - lux - (lux [macro "meta/" Monad<Meta>]) - (luxc (lang (host [python #+ Expression Statement])))) - -(def: #export translate-bit - (-> Bit (Meta Expression)) - (|>> python.bool meta/wrap)) - -(def: #export translate-int - (-> Int (Meta Expression)) - (|>> python.int meta/wrap)) - -(def: #export translate-frac - (-> Frac (Meta Expression)) - (|>> python.float meta/wrap)) - -(def: #export translate-text - (-> Text (Meta Expression)) - (|>> python.string meta/wrap)) diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux deleted file mode 100644 index 8ffe03f49..000000000 --- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux +++ /dev/null @@ -1,341 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:] - ["p" parser]) - (data ["e" error] - [text] - text/format - [number] - (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 [python #+ 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 - (python.is 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]] -(do-template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (<op> paramO subjectO))] - - [bit//and python.bit-and] - [bit//or python.bit-or] - [bit//xor python.bit-xor] - ) - -(def: (bit//left-shift [subjectO paramO]) - Binary - (|> (python.bit-shl paramO subjectO) - runtimeT.bit//64)) - -(do-template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (<op> paramO subjectO))] - - [bit//arithmetic-right-shift python.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)) - -(do-template [<name> <const> <encode>] - [(def: (<name> _) - Nullary - (<encode> <const>))] - - [frac//smallest Double::MIN_VALUE python.float] - [frac//min (f/* -1.0 Double::MAX_VALUE) python.float] - [frac//max Double::MAX_VALUE python.float] - ) - -(do-template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (|> subjectO - (<op> paramO) - runtimeT.bit//64))] - - [int//add python.+] - [int//sub python.-] - [int//mul python.*] - ) - -(do-template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (|> subjectO - (<op> paramO)))] - - [int//div python./] - [int//rem python.%] - ) - -(do-template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (<op> paramO subjectO))] - - [frac//add python.+] - [frac//sub python.-] - [frac//mul python.*] - [frac//div python./] - [frac//rem python.%] - [frac//= python.=] - [frac//< python.<] - - [text//= python.=] - [text//< python.<] - ) - -(do-template [<name> <cmp>] - [(def: (<name> [subjectO paramO]) - Binary - (<cmp> paramO subjectO))] - - [int//= python.=] - [int//< python.<] - ) - -(def: (apply1 func) - (-> Expression (-> Expression Expression)) - (function (_ value) - (python.apply (list value) func))) - -(def: (send0 method) - (-> Text (-> Expression Expression)) - (function (_ object) - (python.send (list) method object))) - -(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 (apply1 (python.global "float")))) - (install "char" (unary (apply1 (python.global "chr"))))))) - -(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 (apply1 (python.global "int")))) - (install "encode" (unary (apply1 (python.global "repr")))) - (install "decode" (unary runtimeT.frac//decode))))) - -## [[Text]] -(def: (text//concat [subjectO paramO]) - Binary - (|> subjectO (python.+ 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 (apply1 (python.global "len")))) - (install "char" (binary text//char)) - (install "clip" (trinary text//clip)) - ))) - -## [[IO]] -(def: io-procs - Bundle - (<| (prefix "io") - (|> (dict.new text.Hash<Text>) - (install "log" (unary runtimeT.io//log!)) - (install "error" (unary runtimeT.io//throw!)) - (install "exit" (unary runtimeT.io//exit!)) - (install "current-time" (nullary (function (_ _) - (runtimeT.io//current-time! runtimeT.unit))))))) - -## [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/python/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/host.jvm.lux deleted file mode 100644 index af82491b6..000000000 --- a/new-luxc/source/luxc/lang/translation/python/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])) - -## (do-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/python/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/python/reference.jvm.lux deleted file mode 100644 index e8bcae522..000000000 --- a/new-luxc/source/luxc/lang/translation/python/reference.jvm.lux +++ /dev/null @@ -1,42 +0,0 @@ -(.module: - lux - (lux [macro] - (data [text] - text/format)) - (luxc ["&" lang] - (lang [".L" variable #+ Variable Register] - (host [python #+ Expression Statement SVar @@]))) - [//] - (// [".T" runtime])) - -(do-template [<register> <translation> <prefix>] - [(def: #export (<register> register) - (-> Register SVar) - (python.var (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 (local var) - (-> Variable SVar) - (if (variableL.captured? var) - (closure (variableL.captured-register var)) - (variable (.nat var)))) - -(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 SVar) - (|>> //.definition-name python.var)) - -(def: #export (translate-definition name) - (-> Name (Meta Expression)) - (:: macro.Monad<Meta> wrap (@@ (global name)))) diff --git a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux deleted file mode 100644 index e5beb9872..000000000 --- a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux +++ /dev/null @@ -1,365 +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 [python #+ Expression Statement @@])))) - -(def: prefix Text "LuxRuntime") - -(def: #export unit Expression (python.string //.unit)) - -(def: (flag value) - (-> Bit Expression) - (if value - (python.string "") - python.none)) - -(def: (variant' tag last? value) - (-> Expression Expression Expression Expression) - (python.dict (list [(python.string //.variant-tag-field) tag] - [(python.string //.variant-flag-field) last?] - [(python.string //.variant-value-field) value]))) - -(def: #export (variant tag last? value) - (-> Nat Bit Expression Expression) - (variant' (python.int (.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 Statement) - -(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 (format "__" prefix "__" (lang.normalize-name name)) - $runtime (` (python.var (~ (code.text runtime)))) - @runtime (` (@@ (~ $runtime))) - argsC+ (list/map code.local-identifier args) - argsLC+ (list/map (|>> lang.normalize-name code.text (~) (python.var) (`)) - args) - declaration (` ((~ (code.local-identifier name)) - (~+ argsC+))) - type (` (-> (~+ (list.repeat (list.size argsC+) (` python.Expression))) - python.Expression))] - (wrap (list (` (def: (~' #export) (~ declaration) - (~ type) - (python.apply (list (~+ argsC+)) (~ @runtime)))) - (` (def: (~ implementation) - python.Statement - (~ (case argsC+ - #.Nil - (` (python.set! (list (~ $runtime)) (~ definition))) - - _ - (` (let [(~+ (|> (list.zip2 argsC+ argsLC+) - (list/map (function (_ [left right]) - (list left (` (@@ (~ right)))))) - list/join))] - (python.def! (~ $runtime) - (list (~+ argsLC+)) - (~ definition)))))))))))) - -(syntax: (with-vars {vars (s.tuple (p.many s.local-identifier))} - body) - (wrap (list (` (let [(~+ (|> vars - (list/map (function (_ var) - (list (code.local-identifier var) - (` (python.var (~ (code.text (lang.normalize-name var)))))))) - list/join))] - (~ body)))))) - -(runtime: (lux//try op) - (let [$error (python.var "error") - $value (python.var "value")] - (python.try! ($_ python.then! - (python.set! (list $value) (python.apply (list unit) op)) - (python.return! (right (@@ $value)))) - (list [(list "Exception") $error - (python.return! (left (python.apply (list (@@ $error)) (python.global "str"))))])))) - -(runtime: (lux//program-args program-args) - (let [$inputs (python.var "inputs") - $value (python.var "value")] - ($_ python.then! - (python.set! (list $inputs) none) - (<| (python.for-in! $value program-args) - (python.set! (list $inputs) - (some (python.tuple (list (@@ $value) (@@ $inputs)))))) - (python.return! (@@ $inputs))))) - -(def: runtime//lux - Runtime - ($_ python.then! - @@lux//try - @@lux//program-args)) - -(runtime: (io//log! message) - ($_ python.then! - (python.print! message) - (python.return! ..unit))) - -(def: (exception message) - (-> Expression Expression) - (python.apply (list message) (python.global "Exception"))) - -(runtime: (io//throw! message) - ($_ python.then! - (python.raise! (exception message)) - (python.return! ..unit))) - -(runtime: (io//exit! code) - ($_ python.then! - (python.import! "sys") - (python.do! (|> (python.global "sys") (python.send (list code) "exit"))) - (python.return! ..unit))) - -(runtime: (io//current-time! _) - ($_ python.then! - (python.import! "time") - (python.return! (let [time (|> (python.global "time") - (python.send (list) "time") - (python.* (python.int 1,000)))] - (python.apply (list time) (python.global "int")))))) - -(def: runtime//io - Runtime - ($_ python.then! - @@io//log! - @@io//throw! - @@io//exit! - @@io//current-time!)) - -(runtime: (product//left product index) - (let [$index_min_length (python.var "index_min_length")] - ($_ python.then! - (python.set! (list $index_min_length) (python.+ (python.int 1) index)) - (python.if! (python.> (@@ $index_min_length) (python.length product)) - ## No need for recursion - (python.return! (python.nth index product)) - ## Needs recursion - (python.return! (product//left (python.nth (python.- (python.int 1) - (python.length product)) - product) - (python.- (python.length product) - (@@ $index_min_length)))))))) - -(runtime: (product//right product index) - (let [$index_min_length (python.var "index_min_length")] - ($_ python.then! - (python.set! (list $index_min_length) (python.+ (python.int 1) index)) - (python.cond! (list [(python.= (@@ $index_min_length) (python.length product)) - ## Last element. - (python.return! (python.nth index product))] - [(python.< (@@ $index_min_length) (python.length product)) - ## Needs recursion - (python.return! (product//right (python.nth (python.- (python.int 1) - (python.length product)) - product) - (python.- (python.length product) - (@@ $index_min_length))))]) - ## Must slice - (python.return! (python.slice-from index product)))))) - -(runtime: (sum//get sum wantedTag wantsLast) - (let [no-match! (python.return! python.none) - sum-tag (python.nth (python.string //.variant-tag-field) sum) - sum-flag (python.nth (python.string //.variant-flag-field) sum) - sum-value (python.nth (python.string //.variant-value-field) sum) - is-last? (python.= (python.string "") sum-flag) - test-recursion! (python.if! is-last? - ## Must recurse. - (python.return! (sum//get sum-value (python.- sum-tag wantedTag) wantsLast)) - no-match!)] - (python.cond! (list [(python.= sum-tag wantedTag) - (python.if! (python.= wantsLast sum-flag) - (python.return! sum-value) - test-recursion!)] - - [(python.> sum-tag wantedTag) - test-recursion!] - - [(python.and (python.< sum-tag wantedTag) - (python.= (python.string "") wantsLast)) - (python.return! (variant' (python.- wantedTag sum-tag) sum-flag sum-value))]) - - no-match!))) - -(def: runtime//adt - Runtime - ($_ python.then! - @@product//left - @@product//right - @@sum//get)) - -(def: full-64-bits (python.code "0xFFFFFFFFFFFFFFFF")) - -(runtime: (bit//64 input) - (with-vars [capped] - (python.cond! (list [(|> input (python.> full-64-bits)) - (python.return! (|> input (python.bit-and full-64-bits) bit//64))] - [(|> input (python.> (python.code "0x7FFFFFFFFFFFFFFF"))) - ($_ python.then! - (python.set! (list capped) - (python.apply (list (|> (python.code "0x10000000000000000") - (python.- input))) - (python.global "int"))) - (python.if! (|> (@@ capped) (python.<= (python.code "9223372036854775807L"))) - (python.return! (|> (@@ capped) (python.* (python.int -1)))) - (python.return! (python.code "-9223372036854775808L"))))]) - (python.return! input)))) - -(runtime: (bit//logical-right-shift param subject) - (let [mask (|> (python.int 1) - (python.bit-shl (python.- param (python.int 64))) - (python.- (python.int 1)))] - (python.return! (|> subject - (python.bit-shr param) - (python.bit-and mask))))) - -(def: runtime//bit - Runtime - ($_ python.then! - @@bit//64 - @@bit//logical-right-shift)) - -(runtime: (frac//decode input) - (let [$ex (python.var "ex")] - (python.try! - (python.return! (..some (python.apply (list input) (python.global "float")))) - (list [(list "Exception") $ex - (python.return! ..none)])))) - -(def: runtime//frac - Runtime - ($_ python.then! - @@frac//decode)) - -(runtime: (text//index subject param start) - (with-vars [idx] - ($_ python.then! - (python.set! (list idx) (python.send (list param start) "find" subject)) - (python.if! (python.= (python.int -1) (@@ idx)) - (python.return! ..none) - (python.return! (..some (@@ idx))))))) - -(def: inc (|>> (python.+ (python.int 1)))) - -(do-template [<name> <top-cmp>] - [(def: (<name> top value) - (-> Expression Expression Expression) - (python.and (|> value (python.>= (python.int 0))) - (|> value (<top-cmp> top))))] - - [within? python.<] - [up-to? python.<=] - ) - -(runtime: (text//clip @text @from @to) - (with-vars [length] - ($_ python.then! - (python.set! (list length) (python.length @text)) - (python.if! ($_ python.and - (|> @to (within? (@@ length))) - (|> @from (up-to? @to))) - (python.return! (..some (|> @text (python.slice @from (inc @to))))) - (python.return! ..none))))) - -(runtime: (text//char text idx) - (python.if! (|> idx (within? (python.length text))) - (python.return! (..some (python.apply (list (|> text (python.slice idx (inc idx)))) - (python.global "ord")))) - (python.return! ..none))) - -(def: runtime//text - Runtime - ($_ python.then! - @@text//index - @@text//clip - @@text//char)) - -(def: (check-index-out-of-bounds array idx body!) - (-> Expression Expression Statement Statement) - (python.if! (|> idx (python.<= (python.length array))) - body! - (python.raise! (exception (python.string "Array index out of bounds!"))))) - -(runtime: (array//get array idx) - (with-vars [temp] - (<| (check-index-out-of-bounds array idx) - ($_ python.then! - (python.set! (list temp) (python.nth idx array)) - (python.if! (python.= python.none (@@ temp)) - (python.return! ..none) - (python.return! (..some (@@ temp)))))))) - -(runtime: (array//put array idx value) - (<| (check-index-out-of-bounds array idx) - ($_ python.then! - (python.set-nth! idx value array) - (python.return! array)))) - -(def: runtime//array - Runtime - ($_ python.then! - @@array//get - @@array//put)) - -(runtime: (box//write value box) - ($_ python.then! - (python.set-nth! (python.int 0) value box) - (python.return! ..unit))) - -(def: runtime//box - Runtime - @@box//write) - -(def: runtime - Runtime - ($_ python.then! - runtime//lux - runtime//adt - runtime//bit - runtime//frac - runtime//text - runtime//array - runtime//box - runtime//io - )) - -(def: #export artifact Text (format prefix ".py")) - -(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/python/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/python/structure.jvm.lux deleted file mode 100644 index 158cf3a2c..000000000 --- a/new-luxc/source/luxc/lang/translation/python/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 [python #+ 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 (python.tuple 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)))) |