diff options
Diffstat (limited to '')
15 files changed, 1491 insertions, 131 deletions
diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux index 31e1759a0..c084055b7 100644 --- a/new-luxc/source/luxc/lang/extension/statement.lux +++ b/new-luxc/source/luxc/lang/extension/statement.lux @@ -71,7 +71,7 @@ (do @ [_ (ensure-valid-alias def-name annotationsV valueC) _ (lang.with-scope - (statementT.translate-def def-name Void id annotationsI annotationsV))] + (statementT.translate-def def-name Void id annotationsV))] (wrap [])) #.None @@ -88,7 +88,7 @@ (tc.clean valueT)) valueI (expressionT.translate (expressionS.synthesize syntheses valueA)) _ (lang.with-scope - (statementT.translate-def def-name valueT valueI annotationsI annotationsV))] + (statementT.translate-def def-name valueT valueI annotationsV))] (wrap [])))))) _ diff --git a/new-luxc/source/luxc/lang/translation/js.lux b/new-luxc/source/luxc/lang/translation/js.lux new file mode 100644 index 000000000..6cc19e01d --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js.lux @@ -0,0 +1,8 @@ +(.module: + lux) + +(type: #export JS Text) + +(type: #export Expression JS) + +(type: #export Statement JS) diff --git a/new-luxc/source/luxc/lang/translation/js/case.jvm.lux b/new-luxc/source/luxc/lang/translation/js/case.jvm.lux new file mode 100644 index 000000000..a005a45a1 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/case.jvm.lux @@ -0,0 +1,185 @@ +(.module: + lux + (lux (control [monad #+ do]) + (data text/format + (coll [list "list/" Fold<List>]))) + (luxc (lang ["ls" synthesis])) + [//] + (// [".T" runtime] + [".T" primitive] + [".T" reference])) + +(def: #export (translate-let translate valueS register bodyS) + (-> (-> ls.Synthesis (Meta //.Expression)) ls.Synthesis Nat ls.Synthesis + (Meta //.Expression)) + (do macro.Monad<Meta> + [valueJS (translate valueS) + bodyJS (translate bodyS)] + (wrap (format "(function() {" + "var " (referenceT.variable register) " = " valueJS ";" + "return " bodyJS ";" + "})()")))) + +(def: #export (translate-record-get translate valueS path) + (-> (-> ls.Synthesis (Meta //.Expression)) ls.Synthesis (List [Nat Bool]) + (Meta //.Expression)) + (do macro.Monad<Meta> + [valueJS (translate valueS)] + (wrap (list/fold (function [source [idx tail?]] + (let [method (if tail? runtimeT.product//right runtimeT.product//left)] + (format method "(" source "," idx ")"))) + (format "(" valueJS ")") + path)))) + +(def: #export (translate-if translate testS thenS elseS) + (-> (-> ls.Synthesis (Meta //.Expression)) ls.Synthesis ls.Synthesis ls.Synthesis + (Meta //.Expression)) + (do macro.Monad<Meta> + [testJS (translate testS) + thenJS (translate thenS) + elseJS (translate elseS)] + (wrap (format "(" testJS " ? " thenJS " : " elseJS ")")))) + +(def: savepoint + //.Expression + "pm_cursor_savepoint") + +(def: cursor + //.Expression + "pm_cursor") + +(def: (push-cursor value) + (-> //.Expression //.Expression) + (format cursor ".push(" value ");")) + +(def: save-cursor + //.Statement + (format savepoint ".push(" cursor ".slice());")) + +(def: restore-cursor + //.Statement + (format cursor " = " savepoint ".pop();")) + +(def: peek-cursor + //.Expression + (format cursor "[" cursor ".length - 1]")) + +(def: pop-cursor + //.Statement + (format cursor ".pop();")) + +(def: pm-error + //.Expression + (%t "PM-ERROR")) + +(def: fail-pattern-matching + //.Statement + (format "throw " pm-error ";")) + +(def: (translate-pattern-matching' translate path) + (-> (-> ls.Synthesis (Meta //.Expression)) Code (Meta //.Expression)) + (case path + (^code ("lux case exec" (~ bodyS))) + (do macro.Monad<Meta> + [bodyJS (translate bodyS)] + (wrap (format "return " bodyJS ";"))) + + (^code ("lux case pop")) + (wrap pop-cursor) + + (^code ("lux case bind" (~ [_ (#.Nat register)]))) + (wrap (format "var " (referenceT.variable register) " = " peek-cursor ";")) + + (^template [<tag> <translate>] + [_ (<tag> value)] + (do macro.Monad<Meta> + [valueJS (<translate> value)] + (wrap (format "if(!" (format runtimeT.int//= "(" peek-cursor "," valueJS ")") ") { " fail-pattern-matching " }")))) + ([#.Nat primitiveT.translate-nat] + [#.Int primitiveT.translate-int] + [#.Deg primitiveT.translate-deg]) + + (^template [<tag> <format>] + (<tag> value) + (wrap (format "if(" peek-cursor " !== " (<format> value) ") { " fail-pattern-matching " }"))) + ([#.Bool %b] + [#.Frac %f] + [#.Text %t]) + + (^template [<pm> <getter>] + (^code (<pm> (~ [_ (#.Nat idx)]))) + (wrap (push-cursor (format <getter> "(" peek-cursor "," (|> idx nat-to-int %i) ")")))) + (["lux case tuple left" runtimeT.product//left] + ["lux case tuple right" runtimeT.product//right]) + + (^template [<pm> <flag>] + (^code (<pm> (~ [_ (#.Nat idx)]))) + (wrap (format "temp = " runtimeT.sum//get "(" peek-cursor "," (|> idx nat-to-int %i) "," <flag> ");" + "if(temp !== null) {" + (push-cursor "temp") + "}" + "else {" + fail-pattern-matching + "}"))) + (["lux case variant left" "null"] + ["lux case variant right" "\"\""]) + + (^code ("lux case seq" (~ leftP) (~ rightP))) + (do macro.Monad<Meta> + [leftJS (translate-pattern-matching' translate leftP) + rightJS (translate-pattern-matching' translate rightP)] + (wrap (format leftJS rightJS))) + + (^code ("lux case alt" (~ leftP) (~ rightP))) + (do macro.Monad<Meta> + [leftJS (translate-pattern-matching' translate leftP) + rightJS (translate-pattern-matching' translate rightP)] + (wrap (format "try {" + save-cursor + leftJS + "}" + "catch(ex) {" + "if(ex === " pm-error ") {" + restore-cursor + rightJS + "}" + "else {" + "throw ex;" + "}" + "}"))) + )) + +(def: report-pattern-matching-error + //.Statement + (format "if(ex === " pm-error ") {" + "throw \"Invalid expression for pattern-matching.\";" + "}" + "else {" + "throw ex;" + "}")) + +(def: (translate-pattern-matching translate path) + (-> (-> ls.Synthesis (Meta //.Expression)) Code (Meta //.Expression)) + (do macro.Monad<Meta> + [pmJS (translate-pattern-matching' translate path)] + (wrap (format "try {" pmJS "}" + "catch(ex) {" + report-pattern-matching-error + "}")))) + +(def: (initialize-pattern-matching stack-init) + (-> //.Expression //.Statement) + (format "var temp;" + "var " cursor " = [" stack-init "];" + "var " savepoint " = [];")) + +(def: #export (translate-case translate valueS path) + (-> (-> ls.Synthesis (Meta //.Expression)) ls.Synthesis Code (Meta //.Expression)) + (do macro.Monad<Meta> + [valueJS (translate valueS) + pmJS (translate-pattern-matching translate path)] + (wrap (format "(function() {" + "\"use strict\";" + (initialize-pattern-matching valueJS) + pmJS + "})()")))) diff --git a/new-luxc/source/luxc/lang/translation/js/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/js/expression.jvm.lux new file mode 100644 index 000000000..a25013305 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/expression.jvm.lux @@ -0,0 +1,73 @@ +(.module: + lux + (lux (control [monad #+ do] + ["ex" exception #+ exception:] + ["p" parser])) + (luxc ["&" lang] + (lang ["ls" synthesis])) + [//] + (// [".T" runtime] + [".T" primitive] + [".T" structure] + [".T" reference] + [".T" function] + [".T" loop] + [".T" case])) + +(exception: #export Unrecognized-Synthesis) + +(def: #export (translate synthesis) + (-> ls.Synthesis (Meta //.Expression)) + (case synthesis + (^code []) + (wrap runtimeT.unit) + + (^code [(~ singleton)]) + (translate singleton) + + (^template [<tag> <generator>] + [_ (<tag> value)] + (<generator> value)) + ([#.Bool primitiveT.translate-bool] + [#.Nat primitiveT.translate-nat] + [#.Int primitiveT.translate-int] + [#.Deg primitiveT.translate-deg] + [#.Frac primitiveT.translate-frac] + [#.Text primitiveT.translate-text]) + + (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bool last?)]) (~ valueS))) + (structureT.translate-variant translate tag last? valueS) + + (^code [(~+ members)]) + (structureT.translate-tuple translate members) + + (^ [_ (#.Form (list [_ (#.Int var)]))]) + (if (variableL.captured? var) + (referenceT.translate-captured var) + (referenceT.translate-local var)) + + [_ (#.Symbol 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) + + (^multi (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS))) + [(s.run environment (p.some s.int)) (#e.Success environment)]) + (functionT.translate-function translate environment arity bodyS) + + (^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/js/function.jvm.lux b/new-luxc/source/luxc/lang/translation/js/function.jvm.lux new file mode 100644 index 000000000..4debb077b --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/function.jvm.lux @@ -0,0 +1,75 @@ +(.module: + lux + (lux (control [monad #+ do]) + (data [text] + text/format + (coll [list "list/" Functor<List>])) + [macro]) + (luxc ["&" lang] + (lang ["ls" synthesis] + [".L" variable #+ Variable])) + [//] + (// [".T" reference] + [".T" loop])) + +(def: #export (translate-apply translate functionS argsS+) + (-> (-> ls.Synthesis (Meta //.Expression)) ls.Synthesis (List ls.Synthesis) (Meta //.Expression)) + (do macro.Monad<Meta> + [functionJS (translate functionS) + argsJS+ (monad.map @ translate argsS+)] + (wrap (format functionJS "(" (text.join-with "," argsJS+) ")")))) + +(def: (input-declaration register) + (format "var " (referenceT.variable (n/inc register)) " = arguments[" (|> register nat-to-int %i) "];")) + +(def: (with-closure inits function) + (-> (List //.Expression) //.Expression //.Expression) + (let [closure (case inits + #.Nil + (list) + + _ + (|> (list.n/range +0 (n/dec (list.size inits))) + (list/map referenceT.closure)))] + (format "(function(" (text.join-with "," closure) ") {" + "return " function + ";})(" (text.join-with "," inits) ")"))) + +(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 bodyJS] (hostL.with-sub-context + (translate bodyS)) + closureJS+ (monad.map @ translate env) + #let [args-initsJS+ (|> (list.n/range +0 (n/dec arity)) + (list/map input-declaration) + (text.join-with "")) + selfJS (format "var " (referenceT.variable +0) " = " function-name ";") + loop-startJs (format "var " loopT.loop-name " = " function-name ";") + arityJS (|> arity nat-to-int %i)]] + (wrap (<| (with-closure closureJS+) + (format "(function " function-name "() {" + "\"use strict\";" + "var num_args = arguments.length;" + "if(num_args == " arity ") {" + selfJS + loop-startJs + args-initsJS+ + (format "while(true) {" + "return " bodyJS ";" + "}") + "}" + "else if(num_args > " arityJS ") {" + "return " function-name ".apply(null, [].slice.call(arguments,0," arityJS "))" + ".apply(null, [].slice.call(arguments," arityJS "));" + "}" + ## Less than arity + "else {" + "var curried = [].slice.call(arguments);" + "return function() { " + "return " function-name ".apply(null, curried.concat([].slice.call(arguments)));" + " };" + "}" + "})"))))) diff --git a/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux new file mode 100644 index 000000000..64b2e5b39 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux @@ -0,0 +1,31 @@ +(.module: + lux + (lux (control [monad #+ do]) + (data [text] + text/format + (coll [list "list/" Functor<List>])) + [macro]) + (luxc (lang ["ls" synthesis])) + [//] + (// [".T" reference])) + +(def: #export loop-name Text "_loop") + +(def: #export (translate-loop translate offset initsS+ bodyS) + (-> (-> ls.Synthesis (Meta //.Expression)) Nat (List ls.Synthesis) ls.Synthesis + (Meta //.Expression)) + (do macro.Monad<Meta> + [initsJS+ (monad.map @ translate initsS+) + bodyJS (translate bodyS) + #let [registersJS+ (|> (list.n/range +0 (n/dec (list.size initsS+))) + (list/map (|>> (n/+ offset) referenceT.variable)))]] + (wrap (format "(function " loop-name "(" (text.join-with "," registersJS+) ") {" + "return " bodyJS ";" + "})(" (text.join-with "," initsJS+) ")")))) + +(def: #export (translate-iter translate offset argsS+) + (-> (-> ls.Synthesis (Meta //.Expression)) Nat (List ls.Synthesis) + (Meta //.Expression)) + (do macro.Monad<Meta> + [argsJS+ (monad.map @ translate argsS+)] + (wrap (format loop-name "(" (text.join-with "," argsJS+) ")")))) diff --git a/new-luxc/source/luxc/lang/translation/js/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/js/primitive.jvm.lux new file mode 100644 index 000000000..860cc7fae --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/primitive.jvm.lux @@ -0,0 +1,56 @@ +(.module: + lux + (lux (control pipe) + (data [bit] + [number] + text/format) + [macro "meta/" Monad<Meta>]) + [//] + (// [".T" runtime])) + +(def: #export translate-bool + (-> Bool (Meta //.Expression)) + (|>> %b meta/wrap)) + +(def: low-mask Nat (n/dec (bit.shift-left +32 +1))) + +(def: #export (translate-nat value) + (-> Nat (Meta //.Expression)) + (let [high (|> value + (bit.shift-right +32) + nat-to-int %i) + low (|> value + (bit.and low-mask) + nat-to-int %i)] + (meta/wrap (format runtimeT.int//new "(" high "," low ")")))) + +(def: #export translate-int + (-> Int (Meta //.Expression)) + (|>> int-to-nat translate-nat)) + +(def: deg-to-nat + (-> Deg Nat) + (|>> (:! Nat))) + +(def: #export translate-deg + (-> Deg (Meta //.Expression)) + (|>> deg-to-nat translate-nat)) + +(def: #export translate-frac + (-> Frac (Meta //.Expression)) + (|>> (cond> [(f/= number.positive-infinity)] + [(new> "Infinity")] + + [(f/= number.negative-infinity)] + [(new> "-Infinity")] + + [(f/= number.not-a-number)] + [(new> "NaN")] + + ## else + [%f]) + meta/wrap)) + +(def: #export translate-text + (-> Text (Meta //.Expression)) + (|>> %t meta/wrap)) diff --git a/new-luxc/source/luxc/lang/translation/js/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure.jvm.lux new file mode 100644 index 000000000..66c7fe6f5 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/procedure.jvm.lux @@ -0,0 +1,27 @@ +(.module: + lux + (lux (control [monad #+ do] + ["ex" exception #+ exception:]) + (data [maybe] + text/format + (coll [dict]))) + (luxc ["&" lang] + (lang ["ls" synthesis])) + [//] + (/ ["/." common] + ["/." host])) + +(exception: #export Unknown-Procedure) + +(def: procedures + /common.Bundle + (|> /common.procedures + (dict.merge /host.procedures))) + +(def: #export (translate-procedure translate name args) + (-> (-> ls.Synthesis (Meta //.Expression)) Text (List ls.Synthesis) + (Meta //.Expression)) + (<| (maybe.default (&.throw Unknown-Procedure (%t name))) + (do maybe.Monad<Maybe> + [proc (dict.get name procedures)] + (wrap (proc translate args))))) diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux new file mode 100644 index 000000000..b0dbe4533 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux @@ -0,0 +1,633 @@ +(.module: + lux + (lux (control [monad #+ do]) + (data ["e" error] + [text] + text/format + (coll [list "list/" Functor<List>] + [dict #+ Dict])) + [macro #+ with-gensyms] + (macro [code] + ["s" syntax #+ syntax:])) + (luxc ["&" lang] + (lang ["la" analysis] + ["ls" synthesis])) + [///] + (/// [".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 nat-to-int %i) "\n" + " Actual: " (|> actual nat-to-int %i))) + +(syntax: (arity: [name s.local-symbol] [arity s.nat]) + (with-gensyms [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-symbol name)) (~ g!proc)) + (-> (-> (..Vector (~ (code.nat arity)) ///.Expression) ///.Expression) + (-> Text ..Proc)) + (function [(~ g!name)] + (function [(~ 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)))))) + +(def: (self-contained content) + (-> //.Expression //.Expression) + (format "(" content ")")) + +(def: (void action) + (-> //.Expression //.Expression) + (format "(" action "," runtimeT.unit ")")) + +## [Procedures] +## [[Lux]] +(def: (lux//is [leftJS rightJS]) + Binary + (self-contained (format leftJS " === " rightJS))) + +(def: (lux//if [testJS thenJS elseJS]) + Trinary + (caseT.translate-if testJS thenJS elseJS)) + +(def: (lux//try riskyJS) + Unary + (format runtimeT.lux//try "(" riskyJS ")")) + +(def: (lux//noop valueJS) + Unary + valueJS) + +(exception: #export Wrong-Syntax) +(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)))) + +## [[Bits]] +(do-template [<name> <op>] + [(def: (<name> [subjectJS paramJS]) + Binary + (format <op> "(" subjectJS "," paramJS ")"))] + + [bit//and runtimeT.bit//and] + [bit//or runtimeT.bit//or] + [bit//xor runtimeT.bit//xor] + [bit//shift-left runtimeT.bit//shift-left] + [bit//shift-right runtimeT.bit//shift-right] + [bit//unsigned-shift-right runtimeT.bit//unsigned-shift-right] + ) + +(def: (bit//count subjectJS) + Unary + (format runtimeT.bit//count "(" subjectJS ")")) + +## [[Arrays]] +(def: (array//new sizeJS) + Unary + (self-contained (format "new Array(" runtimeT.int//to-number "(" sizeJS ")" ")"))) + +(def: (array//get [arrayJS idxJS]) + Binary + (format runtimeT.array//get "(" arrayJS "," idxJS ")")) + +(def: (array//put [arrayJS idxJS elemJS]) + Trinary + (format runtimeT.array//put "(" arrayJS "," idxJS "," elemJS ")")) + +(def: (array//remove [arrayJS idxJS]) + Binary + (format runtimeT.array//remove "(" arrayJS "," idxJS ")")) + +(def: (array//size arrayJS) + Unary + (format arrayJS ".length")) + +## [[Numbers]] +(do-template [<name> <encode> <type>] + [(def: (<name> _) + Nullary + (<encode> <const>))] + + [nat//min 0 js-int] + [nat//max -1 js-int] + + [int//min Long::MIN_VALUE js-int] + [int//max Long::MAX_VALUE js-int] + + [frac//smallest Double::MIN_VALUE js-frac] + [frac//min (f/* -1.0 Double::MAX_VALUE) js-frac] + [frac//max Double::MAX_VALUE js-frac] + [frac//not-a-number Double::NaN js-frac] + [frac//positive-infinity Double::POSITIVE_INFINITY js-frac] + [frac//negative-infinity Double::NEGATIVE_INFINITY js-frac] + + [deg//min 0 js-int] + [deg//max -1 js-int] + ) + +(do-template [<name> <op>] + [(def: (<name> [subjectJS paramJS]) + Binary + (format <op> "(" subjectJS "," paramJS ")"))] + + [int//add runtimeT.int//+] + [int//sub runtimeT.int//-] + [int//mul runtimeT.int//*] + [int//div runtimeT.int///] + [int//rem runtimeT.int//%] + + [nat//add runtimeT.int//+] + [nat//sub runtimeT.int//-] + [nat//mul runtimeT.int//*] + [nat//div runtimeT.nat///] + [nat//rem runtimeT.nat//%] + + [deg//add runtimeT.int//+] + [deg//sub runtimeT.int//-] + [deg//mul runtimeT.deg//*] + [deg//div runtimeT.deg///] + [deg//rem runtimeT.int//-] + [deg//scale runtimeT.int//*] + [deg//reciprocal runtimeT.int///] + ) + +(do-template [<name> <op>] + [(def: (<name> [subjectJS paramJS]) + Binary + (self-contained (format subjectJS " " <op> " " paramJS)))] + + [frac//add "+"] + [frac//sub "-"] + [frac//mul "*"] + [frac//div "/"] + [frac//rem "%"] + [frac//= "=="] + [frac//< "<"] + [text//= "=="] + [text//< "<"] + ) + +(do-template [<name> <cmp>] + [(def: (<name> [subjectJS paramJS]) + Binary + (format <cmp> "(" subjectJS "," paramJS ")"))] + + [nat//= runtimeT.int//=] + [nat//< runtimeT.nat//<] + [int//= runtimeT.int//=] + [int//< runtimeT.int//<] + [deg//= runtimeT.int//=] + [deg//< runtimeT.nat//<] + ) + +(do-template [<name>] + [(def: (<name> inputJS) + Unary + inputJS)] + + [nat//to-int] + [int//to-nat] + ) + +(def: (frac//encode inputJS) + Unary + (format (self-contained inputJS) ".toString()")) + +(def: (frac//decode inputJS) + Unary + (format "parseFloat(" inputJS ")")) + +(do-template [<name> <transform>] + [(def: (<name> inputJS) + Unary + (<transform> "(" inputJS ")"))] + + [int//to-frac runtimeT.int//to-number] + [frac//to-int runtimeT.int//from-number] + [frac//to-deg runtimeT.deg//from-frac] + [deg//to-frac runtimeT.deg//to-frac] + [text//hash runtimeT.text//hash] + ) + +(def: (nat//char inputJS) + Unary + (format "String.fromCharCode" "(" (int//to-frac inputJS) ")")) + +## [[Text]] +(do-template [<name> <op>] + [(def: (<name> inputJS) + Unary + (format inputJS <op>))] + + [text//size ".length"] + [text//trim ".trim()"] + [text//upper ".toUpperCase()"] + [text//lower ".toLowerCase()"] + ) + +(do-template [<name> <method>] + [(def: (<name> [subjectJS paramJS]) + Binary + (format subjectJS "." <method> "(" paramJS ")"))] + + [text//concat "concat"] + [text//contains? "includes"] + ) + +(def: (text//char [subjectJS paramJS]) + Binary + (format runtimeT.text//char "(" subjectJS "," paramJS ")")) + +(do-template [<name> <runtime>] + [(def: (<name> [subjectJS paramJS extraJS]) + Trinary + (format <runtime> "(" subjectJS "," paramJS "," extraJS ")"))] + + [text//clip runtimeT.text//clip] + [text//replace-all runtimeT.text//replace-all] + ) + +(def: (text//replace-once [subjectJS paramJS extraJS]) + Trinary + (format subjectJS "." <method> "(" paramJS "," extraJS ")")) + +(do-template [<name> <method>] + [(def: (<name> [textJS partJS startJS]) + Trinary + (format <method> "(" textJS "," partJS "," startJS ")"))] + + [text//index runtimeT.text//index] + [text//last-index runtimeT.text//last-index] + ) + +## [[Math]] +(do-template [<name> <method>] + [(def: (<name> inputJS) + Unary + (format "Math." <method> "(" inputJS ")"))] + + [math//cos "cos"] + [math//sin "sin"] + [math//tan "tan"] + [math//acos "acos"] + [math//asin "asin"] + [math//atan "atan"] + [math//cosh "cosh"] + [math//sinh "sinh"] + [math//tanh "tanh"] + [math//exp "exp"] + [math//log "log"] + [math//root2 "sqrt"] + [math//root3 "cbrt"] + [math//ceil "ceil"] + [math//floor "floor"] + [math//round "round"] + ) + +(do-template [<name> <method>] + [(def: (<name> [inputJS paramJS]) + Binary + (format "Math." <method> "(" inputJS "," paramJS ")"))] + + [math//atan2 "atan2"] + [math//pow "pow"] + ) + +## [[IO]] +(def: (io//log messageJS) + Unary + (void (format "console.log(" messageJS ")"))) + +(def: (io//error messageJS) + Unary + (format runtimeT.io//error "(" messageJS ")")) + +(def: (io//exit codeJS) + Unary + (format "(process && process.exit && process.exit(" (int//to-frac codeJS) "))")) + +(def: (io//current-time []) + Nullary + (frac//to-int "(new Date()).getTime()")) + +## [[Atoms]] +(def: (atom//new initJS) + Unary + (format "{" runtimeT.atom-field ":" initJS "}")) + +(def: (atom//read atomJS) + Unary + (format atomJS "." runtimeT.atom-field)) + +(def: (atom//compare-and-swap [atomJS oldJS newJS]) + Trinary + (format atom//compare-and-swap "(" atomJS "," oldJS "," newJS ")")) + +## [[Box]] +(def: (box//new initJS) + Unary + (format "[" initJS "]")) + +(def: (box//read boxJS) + Unary + (format "[" boxJS "][0]")) + +(def: (box//write [valueJS boxJS]) + Binary + (void (format (box//read boxJS) " = " valueJS))) + +## [[Processes]] +(def: (process//concurrency-level []) + Nullary + (frac//to-int "1")) + +(def: (process//future procedureJS) + Unary + (format "setTimeout(" + "function() {" procedureJS "(null)" "}" + ",0)")) + +(def: (process//schedule [milli-secondsJS procedureJS]) + Binary + (format "setTimeout(" + "function() {" procedureJS "(null)" "}" + "," (int//to-frac milli-secondsJS) ")")) + +## [Bundles] +(def: lux-procs + Bundle + (|> (dict.new text.Hash<Text>) + (install "noop" (unary lux//noop)) + (install "is" (binary lux//is)) + (install "try" (unary lux//try)) + (install "if" (trinary lux//if)) + (install "loop" lux//loop) + (install "recur" lux//recur) + )) + +(def: bit-procs + Bundle + (<| (prefix "bit") + (|> (dict.new text.Hash<Text>) + (install "count" (unary bit//count)) + (install "and" (binary bit//and)) + (install "or" (binary bit//or)) + (install "xor" (binary bit//xor)) + (install "shift-left" (binary bit//shift-left)) + (install "unsigned-shift-right" (binary bit//unsigned-shift-right)) + (install "shift-right" (binary bit//shift-right)) + ))) + +(def: nat-procs + Bundle + (<| (prefix "nat") + (|> (dict.new text.Hash<Text>) + (install "+" (binary nat//add)) + (install "-" (binary nat//sub)) + (install "*" (binary nat//mul)) + (install "/" (binary nat//div)) + (install "%" (binary nat//rem)) + (install "=" (binary nat//eq)) + (install "<" (binary nat//lt)) + (install "min" (nullary nat//min)) + (install "max" (nullary nat//max)) + (install "to-int" (unary nat//to-int)) + (install "char" (unary nat//char))))) + +(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//eq)) + (install "<" (binary int//lt)) + (install "min" (nullary int//min)) + (install "max" (nullary int//max)) + (install "to-nat" (unary int//to-nat)) + (install "to-frac" (unary int//to-frac))))) + +(def: deg-procs + Bundle + (<| (prefix "deg") + (|> (dict.new text.Hash<Text>) + (install "+" (binary deg//add)) + (install "-" (binary deg//sub)) + (install "*" (binary deg//mul)) + (install "/" (binary deg//div)) + (install "%" (binary deg//rem)) + (install "=" (binary deg//eq)) + (install "<" (binary deg//lt)) + (install "scale" (binary deg//scale)) + (install "reciprocal" (binary deg//reciprocal)) + (install "min" (nullary deg//min)) + (install "max" (nullary deg//max)) + (install "to-frac" (unary deg//to-frac))))) + +(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//eq)) + (install "<" (binary frac//lt)) + (install "smallest" (nullary frac//smallest)) + (install "min" (nullary frac//min)) + (install "max" (nullary frac//max)) + (install "not-a-number" (nullary frac//not-a-number)) + (install "positive-infinity" (nullary frac//positive-infinity)) + (install "negative-infinity" (nullary frac//negative-infinity)) + (install "to-deg" (unary frac//to-deg)) + (install "to-int" (unary frac//to-int)) + (install "encode" (unary frac//encode)) + (install "decode" (unary frac//decode))))) + +(def: text-procs + Bundle + (<| (prefix "text") + (|> (dict.new text.Hash<Text>) + (install "=" (binary text//eq)) + (install "<" (binary text//lt)) + (install "concat" (binary text//concat)) + (install "index" (trinary text//index)) + (install "size" (unary text//size)) + (install "hash" (unary text//hash)) + (install "replace-once" (trinary text//replace-once)) + (install "replace-all" (trinary text//replace-all)) + (install "char" (binary text//char)) + (install "clip" (trinary text//clip)) + (install "upper" (unary text//upper)) + (install "lower" (unary text//lower)) + ))) + +(def: array-procs + Bundle + (<| (prefix "array") + (|> (dict.new text.Hash<Text>) + (install "new" (unary array//new)) + (install "get" (binary array//get)) + (install "put" (trinary array//put)) + (install "remove" (binary array//remove)) + (install "size" (unary array//size)) + ))) + +(def: math-procs + Bundle + (<| (prefix "math") + (|> (dict.new text.Hash<Text>) + (install "cos" (unary math//cos)) + (install "sin" (unary math//sin)) + (install "tan" (unary math//tan)) + (install "acos" (unary math//acos)) + (install "asin" (unary math//asin)) + (install "atan" (unary math//atan)) + (install "cosh" (unary math//cosh)) + (install "sinh" (unary math//sinh)) + (install "tanh" (unary math//tanh)) + (install "exp" (unary math//exp)) + (install "log" (unary math//log)) + (install "root2" (unary math//root2)) + (install "root3" (unary math//root3)) + (install "ceil" (unary math//ceil)) + (install "floor" (unary math//floor)) + (install "round" (unary math//round)) + (install "atan2" (binary math//atan2)) + (install "pow" (binary math//pow)) + ))) + +(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))))) + +(def: atom-procs + Bundle + (<| (prefix "atom") + (|> (dict.new text.Hash<Text>) + (install "new" (unary atom//new)) + (install "read" (unary atom//read)) + (install "compare-and-swap" (trinary atom//compare-and-swap))))) + +(def: box-procs + Bundle + (<| (prefix "box") + (|> (dict.new text.Hash<Text>) + (install "new" (unary box//new)) + (install "read" (unary box//read)) + (install "write" (binary box//write))))) + +(def: process-procs + Bundle + (<| (prefix "process") + (|> (dict.new text.Hash<Text>) + (install "concurrency-level" (nullary process//concurrency-level)) + (install "future" (unary process//future)) + (install "schedule" (binary process//schedule)) + ))) + +(def: #export procedures + Bundle + (<| (prefix "lux") + (|> (dict.new text.Hash<Text>) + (dict.merge lux-procs) + (dict.merge bit-procs) + (dict.merge nat-procs) + (dict.merge int-procs) + (dict.merge deg-procs) + (dict.merge frac-procs) + (dict.merge text-procs) + (dict.merge array-procs) + (dict.merge math-procs) + (dict.merge io-procs) + (dict.merge atom-procs) + (dict.merge box-procs) + (dict.merge process-procs) + ))) diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux new file mode 100644 index 000000000..4ac0d2022 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/procedure/host.jvm.lux @@ -0,0 +1,149 @@ +(.module: + lux + (lux (control [monad #+ do]) + (data [text] + text/format + (coll [list "list/" Functor<List>] + [dict #+ Dict])) + [macro "macro/" Monad<Meta>]) + (luxc ["&" lang] + (lang ["la" analysis] + ["ls" synthesis])) + [///] + (/// [".T" runtime]) + (// ["@" common])) + +(do-template [<name> <js>] + [(def: (<name> _) @.Nullary <js>)] + + [js//null "null"] + [js//undefined "undefined"] + [js//object "{}"] + ) + +(def: (js//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: (js//call proc translate inputs) + (-> Text @.Proc) + (case inputs + (^ (list& functionS argsS+)) + (do macro.Monad<Meta> + [functionJS (translate functionS) + argsJS+ (monad.map @ translate argsS+)] + (wrap (format "(" functionJS ")(" + (text.join-with "," argsJS+) + ")"))) + + _ + (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) + +(def: js-procs + @.Bundle + (|> (dict.new text.Hash<Text>) + (@.install "null" (@.nullary js//null)) + (@.install "undefined" (@.nullary js//undefined)) + (@.install "object" (@.nullary js//object)) + (@.install "global" js//global) + (@.install "call" js//call))) + +(def: (object//new proc translate inputs) + (-> Text @.Proc) + (case inputs + (^ (list& constructorS argsS+)) + (do macro.Monad<Meta> + [constructorJS (translate constructorS) + argsJS+ (monad.map @ translate argsS+)] + (wrap (format "new (" constructorJS ")(" + (text.join-with "," argsJS+) + ")"))) + + _ + (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) + +(def: (object//call proc translate inputs) + (-> Text @.Proc) + (case inputs + (^ (list& objectS fieldS argsS+)) + (do macro.Monad<Meta> + [objectJS (translate objectS) + fieldJS (translate fieldS) + argsJS+ (monad.map @ translate argsS+)] + (wrap (format runtimeT.js//call + "(" objectJS + "," fieldJS + "," "[" (text.join-with "," argsJS+) "]" + ")"))) + + _ + (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) + +(def: (object//get [fieldJS objectJS]) + @.Binary + (format runtimeT.js//get "(" objectJS "," fieldJS ")")) + +(def: (object//set [fieldJS valueJS objectJS]) + @.Trinary + (format runtimeT.js//set "(" objectJS "," fieldJS "," valueJS ")")) + +(def: (object//delete [fieldJS objectJS]) + @.Binary + (format runtimeT.js//delete "(" objectJS "," fieldJS ")")) + +(def: object-procs + @.Bundle + (<| (@.prefix "object") + (|> (dict.new text.Hash<Text>) + (@.install "new" object//new) + (@.install "call" object//call) + (@.install "get" (@.binary object//get)) + (@.install "set" (@.trinary object//set)) + (@.install "delete" (@.binary object//delete)) + ))) + +(def: (array//literal elementsJS+) + @.Variadic + (format "[" (text.join-with "," elementsJS+) "]")) + +(def: (array//read [indexJS arrayJS]) + @.Binary + (format runtimeT.array//get "(" arrayJS "," indexJS ")")) + +(def: (array//write [indexJS valueJS arrayJS]) + @.Binary + (format runtimeT.array//put "(" arrayJS "," indexJS "," valueJS ")")) + +(def: (array//delete [indexJS arrayJS]) + @.Binary + (format runtimeT.array//remove "(" arrayJS "," indexJS ")")) + +(def: (array//length arrayJS) + @.Unary + (format arrayJS ".length")) + +(def: array-procs + @.Bundle + (<| (@.prefix "array") + (|> (dict.new text.Hash<Text>) + (@.install "literal" array//literal) + (@.install "read" array//read) + (@.install "write" array//write) + (@.install "delete" array//delete) + (@.install "length" array//length) + ))) + +(def: #export procedures + @.Bundle + (<| (@.prefix "js") + (|> (dict.merge js-procs) + (dict.merge object-procs) + (dict.merge array-procs) + ))) diff --git a/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux new file mode 100644 index 000000000..33cf3ed7d --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux @@ -0,0 +1,28 @@ +(.module: + lux + (lux [macro] + (data [text] + text/format)) + (luxc ["&" lang]) + [//] + (// [".T" runtime])) + +(do-template [<register> <translation> <prefix>] + [(def: #export (<register> register) + (-> Nat //.Expression) + (format <prefix> (%n register))) + + (def: #export (<translation> register) + (-> Nat (Meta //.Expression)) + (:: macro.Monad<Meta> wrap (<register> register)))] + + [closure translate-local "c"] + [variable translate-captured "v"]) + +(def: #export (global [module name]) + (-> Ident //.Expression) + (format (text.replace-all "/" "_" module) "$" (&.normalize-name name))) + +(def: #export (translate-definition name) + (-> Ident (Meta //.Expression)) + (:: macro.Monad<Meta> wrap (global name))) diff --git a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux index c3c00fde9..742185c2e 100644 --- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux @@ -2,52 +2,47 @@ lux (lux (data text/format) (macro [code] - ["s" syntax #+ syntax:]))) - -(type: #export JS Text) - -(type: Expression JS) - -(type: Statement JS) + ["s" syntax #+ syntax:])) + [//]) (def: prefix Text "LuxRuntime") -(def: #export unit Expression (%t "\u0000")) +(def: #export unit //.Expression (%t "\u0000")) (def: (flag value) - (-> Bool JS) + (-> Bool //.JS) (if value (%t "") "null")) (def: #export (variant tag last? value) - (-> Nat Bool Expression Expression) + (-> Nat Bool //.Expression //.Expression) (format "[" (%i (nat-to-int tag)) "," (flag last?) "," value "]")) (def: none - Expression + //.Expression (variant +0 false unit)) (def: some - (-> Expression Expression) + (-> //.Expression //.Expression) (variant +1 true)) (def: left - (-> Expression Expression) + (-> //.Expression //.Expression) (variant +0 false)) (def: right - (-> Expression Expression) + (-> //.Expression //.Expression) (variant +1 true)) -(type: Runtime JS) +(type: Runtime //.JS) (def: (runtime-name name) (-> Text Text) (format prefix "$" name)) (def: (feature name definition) - (-> Text (-> Text Expression) Statement) + (-> Text (-> Text //.Expression) //.Statement) (format "var " name " = " (definition name) ";\n")) (syntax: (runtime-implementation-name [runtime-name s.local-symbol]) @@ -55,7 +50,7 @@ (template: (runtime: <lux-name> <js-name> <js-definition>) (def: #export <lux-name> Text (runtime-name <js-name>)) - (`` (def: (~~ (runtime-implementation-name <lux-name>)) + (`` (def: ((~' ~~) (runtime-implementation-name <lux-name>)) Runtime (feature <lux-name> (function [(~' @)] @@ -146,101 +141,11 @@ __product//right __sum//get)) -(template: (bit-operation: <lux-name> <js-name> <op>) - (runtime: <lux-name> <js-name> - (format "(function " @ "(input,mask) {" - "return " int//new "(input.H " <op> " mask.H, input.L " <op> " mask.L);" - "})"))) - -(bit-operation: bit//and "andI64" "&") -(bit-operation: bit//or "orI64" "|") -(bit-operation: bit//xor "xorI64" "^") - -(runtime: bit//not "notI64" - (format "(function " @ "(i64) {" - "return " int//new "(~i64.H,~i64.L);" - "})")) - -(runtime: bit//count "countI64" - (format "(function " @ "(input) {" - "var hs = (input.H).toString(2);" - "var ls = (input.L).toString(2);" - "var num1s = hs.concat(ls).replace(/0/g,'').length;" - "return " int//from-number "(num1s);" - "})")) - -(runtime: bit//shift-left "shlI64" - (format "(function " @ "(input,shift) {" - "shift &= 63;" - (format "if(shift === 0) {" - "return input;" - "}" - "else {" - (format "if (shift < 32) {" - "var high = (input.H << shift) | (input.L >>> (32 - shift));" - "var low = input.L << shift;" - "return " int//new "(high, low);" - "}" - "else {" - "var high = (input.L << (shift - 32));" - "return " int//new "(high, 0);" - "}") - "}") - "})")) - -(runtime: bit//signed-shift-right "shrI64" - (format "(function " @ "(input,shift) {" - "shift &= 63;" - (format "if(shift === 0) {" - "return input;" - "}" - "else {" - (format "if (shift < 32) {" - "var high = input.H >> shift;" - "var low = (input.L >>> shift) | (input.H << (32 - shift));" - "return " int//new "(high, low);" - "}" - "else {" - "var low = (input.H >> (shift - 32));" - "var high = input.H >= 0 ? 0 : -1;" - "return " int//new "(high, low);" - "}") - "}") - "})")) - -(runtime: bit//shift-right "ushrI64" - (format "(function " @ "(input,shift) {" - "shift &= 63;" - (format "if(shift === 0) {" - "return input;" - "}" - "else {" - (format "if (shift < 32) {" - "var high = input.H >>> shift;" - "var low = (input.L >>> shift) | (input.H << (32 - shift));" - "return " int//new "(high, low);" - "}" - "else if(shift === 32) {" - "return " int//new "(0, input.H);" - "}" - "else {" - "var low = (input.H >>> (shift - 32));" - "return " int//new "(0, low);" - "}") - "}") +(runtime: int//new "makeI64" + (format "(function " @ "(high,low) {" + "return { H: (high|0), L: (low|0)};" "})")) -(def: runtime//bit - Runtime - (format __bit//and - __bit//or - __bit//xor - __bit//not - __bit//count - __bit//shift-left - __bit//signed-shift-right - __bit//shift-right)) - (runtime: int//2^16 "TWO_PWR_16" "(1 << 16)") @@ -266,11 +171,6 @@ (runtime: int//zero "ZERO" "{ H: (0|0), L: (0|0)}") -(runtime: int//new "makeI64" - (format "(function " @ "(high,low) {" - "return { H: (high|0), L: (low|0)};" - "})")) - (runtime: int//min "MIN_VALUE_I64" "{ H: (0x80000000|0), L: (0|0)}") @@ -313,6 +213,21 @@ "return " int//new "((x48 << 16) | x32, (x16 << 16) | x00);" "})")) +(template: (bit-operation: <lux-name> <js-name> <op>) + (runtime: <lux-name> <js-name> + (format "(function " (~' @) "(input,mask) {" + "return " int//new "(input.H " <op> " mask.H, input.L " <op> " mask.L);" + "})"))) + +(bit-operation: bit//and "andI64" "&") +(bit-operation: bit//or "orI64" "|") +(bit-operation: bit//xor "xorI64" "^") + +(runtime: bit//not "notI64" + (format "(function " @ "(i64) {" + "return " int//new "(~i64.H,~i64.L);" + "})")) + (runtime: int//negate "negateI64" (format "(function " @ "(i64) {" (format "if(" int//= "(" int//min ",i64)) {" @@ -342,6 +257,86 @@ "}") "})")) +(runtime: bit//count "countI64" + (format "(function " @ "(input) {" + "var hs = (input.H).toString(2);" + "var ls = (input.L).toString(2);" + "var num1s = hs.concat(ls).replace(/0/g,'').length;" + "return " int//from-number "(num1s);" + "})")) + +(runtime: bit//shift-left "shlI64" + (format "(function " @ "(input,shift) {" + "shift &= 63;" + (format "if(shift === 0) {" + "return input;" + "}" + "else {" + (format "if (shift < 32) {" + "var high = (input.H << shift) | (input.L >>> (32 - shift));" + "var low = input.L << shift;" + "return " int//new "(high, low);" + "}" + "else {" + "var high = (input.L << (shift - 32));" + "return " int//new "(high, 0);" + "}") + "}") + "})")) + +(runtime: bit//signed-shift-right "shrI64" + (format "(function " @ "(input,shift) {" + "shift &= 63;" + (format "if(shift === 0) {" + "return input;" + "}" + "else {" + (format "if (shift < 32) {" + "var high = input.H >> shift;" + "var low = (input.L >>> shift) | (input.H << (32 - shift));" + "return " int//new "(high, low);" + "}" + "else {" + "var low = (input.H >> (shift - 32));" + "var high = input.H >= 0 ? 0 : -1;" + "return " int//new "(high, low);" + "}") + "}") + "})")) + +(runtime: bit//shift-right "ushrI64" + (format "(function " @ "(input,shift) {" + "shift &= 63;" + (format "if(shift === 0) {" + "return input;" + "}" + "else {" + (format "if (shift < 32) {" + "var high = input.H >>> shift;" + "var low = (input.L >>> shift) | (input.H << (32 - shift));" + "return " int//new "(high, low);" + "}" + "else if(shift === 32) {" + "return " int//new "(0, input.H);" + "}" + "else {" + "var low = (input.H >>> (shift - 32));" + "return " int//new "(0, low);" + "}") + "}") + "})")) + +(def: runtime//bit + Runtime + (format __bit//and + __bit//or + __bit//xor + __bit//not + __bit//count + __bit//shift-left + __bit//signed-shift-right + __bit//shift-right)) + (runtime: int//- "subI64" (format "(function " @ "(l,r) {" "return " int//+ "(l, " int//negate "(r));" @@ -1037,12 +1032,6 @@ __array//put __array//remove)) -(runtime: io//log "log" - (format "(function " @ "(message) {" - "console.log(message);" - (format "return " &&/unit ";") - "})")) - (runtime: io//error "error" (format "(function " @ "(message) {" "throw new Error(message);" @@ -1050,8 +1039,35 @@ (def: runtime//io Runtime - (format __io//log - __io//error)) + (format __io//error)) + +(def: #export atom-field Text "V") + +(runtime: atom//compare-and-swap "atomCompareAndSwap" + (format "(function " @ "(atom,old,new) {" + "if(atom." atom-field " === old) {" + "atom." atom-field " = new;" + "return true;" + "}" + "else {" + "return false;" + "}" + "})")) + +(def: runtime//atom + Runtime + (format __atom//compare-and-swap)) + +(runtime: js//get "jsGetField" + (format "(function " @ "(object, field) {" + "var temp = object[field];" + (format "if(temp !== undefined) {" + (format "return " (some "temp") ";") + "}" + "else {" + (format "return " none ";") + "}") + "})")) (runtime: js//set "jsSetField" (format "(function " @ "(object, field, input) {" @@ -1072,7 +1088,8 @@ (def: runtime//js Runtime - (format __js//set + (format __js//get + __js//set __js//delete __js//call)) @@ -1087,10 +1104,11 @@ runtime//text runtime//array runtime//io + runtime//atom runtime//js)) (def: #export artifact Text (format prefix ".js")) -(def: #export generate - (Meta Unit) - (&&/save-js! artifact runtime)) +## (def: #export generate +## (Meta Unit) +## (&&/save-js! artifact runtime)) diff --git a/new-luxc/source/luxc/lang/translation/js/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/js/statement.jvm.lux new file mode 100644 index 000000000..e430d22ae --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/statement.jvm.lux @@ -0,0 +1,47 @@ +(.module: + lux + (lux (control [monad #+ do]) + [macro] + (data text/format)) + (luxc (lang [".L" module])) + [//] + (// [".T" runtime] + [".T" reference])) + +(def: #export (translate-def name expressionT expressionJS metaV) + (-> Text Type //.Expression Code (Meta Unit)) + (do macro.Monad<Meta> + [current-module macro.current-module-name + #let [def-ident [current-module name]]] + (case (macro.get-symbol-ann (ident-for #.alias) metaV) + (#.Some real-def) + (do @ + [[realT realA realV] (macro.find-def real-def) + _ (moduleL.define def-ident [realT metaV realV])] + (wrap [])) + + _ + (do @ + [#let [def-name (referenceT.global def-ident)] + ## _ (hostT.save (format "var " def-name " = " expressionJS ";")) + #let [expressionV (: Top [])] + ## expressionV (hostT.eval def-name) + _ (moduleL.define def-ident [expressionT metaV expressionV]) + _ (if (macro.type? metaV) + (case (macro.declared-tags metaV) + #.Nil + (wrap []) + + tags + (moduleL.declare-tags tags (macro.export? metaV) (:! Type expressionV))) + (wrap [])) + #let [_ (log! (format "DEF " (%ident def-ident)))]] + (wrap [])) + ))) + +(def: #export (translate-program programJS) + (-> //.Expression (Meta //.Statement)) + (macro.fail "translate-program NOT IMPLEMENTED YET") + ## (hostT.save (format "var " (referenceT.variable +0) " = " runtimeT.lux//program-args "();" + ## "(" programJS ")(null);")) + ) diff --git a/new-luxc/source/luxc/lang/translation/js/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/js/structure.jvm.lux new file mode 100644 index 000000000..54f578bee --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/structure.jvm.lux @@ -0,0 +1,30 @@ +(.module: + lux + (lux (control [monad #+ do]) + (data [text] + text/format) + [macro]) + (luxc ["&" lang] + (lang [synthesis #+ Synthesis])) + [//] + (// [".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 (format "[" (text.join-with "," elemsT+) "]"))))) + +(def: #export (translate-variant translate tag tail? valueS) + (-> (-> Synthesis (Meta //.Expression)) Nat Bool Synthesis (Meta //.Expression)) + (do macro.Monad<Meta> + [valueT (translate valueS)] + (wrap (runtimeT.variant tag tail? valueT)))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux index 1b828535f..5edd62aec 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux @@ -31,8 +31,8 @@ (host.import (java/lang/Class c) (getField [String] #try Field)) -(def: #export (translate-def def-name valueT valueI metaI metaV) - (-> Text Type $.Inst $.Inst Code (Meta Unit)) +(def: #export (translate-def def-name valueT valueI metaV) + (-> Text Type $.Inst Code (Meta Unit)) (do macro.Monad<Meta> [current-module macro.current-module-name #let [def-ident [current-module def-name]]] |