diff options
Diffstat (limited to '')
3 files changed, 579 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/translation/php/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure.jvm.lux new file mode 100644 index 000000000..9748167ca --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/php/procedure.jvm.lux @@ -0,0 +1,30 @@ +(.module: + lux + (lux (control [monad #+ do] + ["ex" exception #+ exception:]) + (data [maybe] + [text] + text/format + (coll [dict]))) + (luxc ["&" lang] + (lang ["ls" synthesis] + (host ["_" php #+ Expression Statement]))) + [//] + (/ ["/." common] + ["/." host])) + +(exception: #export (Unknown-Procedure {message Text}) + message) + +(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/php/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux new file mode 100644 index 000000000..384a88056 --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux @@ -0,0 +1,460 @@ +(.module: + lux + (lux (control [monad #+ do] + ["ex" exception #+ exception:] + ["p" parser]) + (data ["e" error] + [text] + text/format + [number] + (coll [list "list/" Functor<List>] + [dict #+ Dict])) + [macro #+ with-gensyms] + (macro [code] + ["s" syntax #+ syntax:]) + [host]) + (luxc ["&" lang] + (lang ["la" analysis] + ["ls" synthesis] + (host ["_" php #+ 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 nat-to-int %i) "\n" + " Actual: " (|> actual nat-to-int %i))) + +(syntax: (arity: [name s.local-symbol] [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-symbol 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 +## (_.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)) + +## (def: (lux//noop valueO) +## Unary +## valueO) + +## (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 "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) +## )) + +## ## [[Bits]] +## (do-template [<name> <op>] +## [(def: (<name> [subjectO paramO]) +## Binary +## (<op> paramO subjectO))] + +## [bit//and _.bit-and] +## [bit//or _.bit-or] +## [bit//xor _.bit-xor] +## ) + +## (def: (bit//shift-left [subjectO paramO]) +## Binary +## (|> (_.bit-shl paramO subjectO) +## runtimeT.bit//64)) + +## (do-template [<name> <op>] +## [(def: (<name> [subjectO paramO]) +## Binary +## (<op> paramO subjectO))] + +## [bit//shift-right _.bit-shr] +## [bit//unsigned-shift-right runtimeT.bit//shift-right] +## ) + +## (def: bit-procs +## Bundle +## (<| (prefix "bit") +## (|> (dict.new text.Hash<Text>) +## (install "count" (unary runtimeT.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)) +## ))) + +## ## [[Arrays]] +## (def: (array//new sizeO) +## Unary +## (|> _.none +## list _.list +## (_.* sizeO))) + +## (def: (array//get [arrayO idxO]) +## Binary +## (runtimeT.array//get arrayO idxO)) + +## (def: (array//put [arrayO idxO elemO]) +## Trinary +## (runtimeT.array//put arrayO idxO elemO)) + +## (def: (array//remove [arrayO idxO]) +## Binary +## (runtimeT.array//put arrayO idxO _.none)) + +## (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 _.length)) +## ))) + +## ## [[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 _.float] +## [frac//min (f/* -1.0 Double::MAX_VALUE) _.float] +## [frac//max Double::MAX_VALUE _.float] +## ) + +(do-template [<name> <expression>] + [(def: (<name> _) + Nullary + <expression>)] + + [int//min (|> (_.int -2) (_.** (_.int 63)))] + [int//max (|> (_.int 2) (_.** (_.int 63)) (_.- (_.int 1)))] + ) + +## (do-template [<name> <label>] +## [(def: (<name> _) +## Nullary +## (_.apply (list (_.string <label>)) (_.global "float")))] + +## [frac//not-a-number "nan"] +## [frac//positive-infinity "inf"] +## [frac//negative-infinity "-inf"] +## ) + +(do-template [<name> <op>] + [(def: (<name> [subjectO paramO]) + Binary + (|> subjectO + (<op> paramO)))] + + [int//+ _.+] + [int//- _.-] + [int//* _.*] + [int/// _./] + [int//% _.%] + ) + +## (do-template [<name> <op>] +## [(def: (<name> [subjectO paramO]) +## Binary +## (<op> paramO subjectO))] + +## [frac//+ _.+] +## [frac//- _.-] +## [frac//* _.*] +## [frac/// _./] +## [frac//% _.%] +## [frac//= _.=] +## [frac//< _.<] + +## [text//= _.=] +## [text//< _.<] +## ) + +(do-template [<name> <cmp>] + [(def: (<name> [subjectO paramO]) + Binary + (<cmp> paramO subjectO))] + + [int//= _.=] + [int//< _.<] + ) + +(def: int-procs + Bundle + (<| (prefix "int") + (|> (dict.new text.Hash<Text>) + (install "+" (binary int//+)) + (install "-" (binary int//-)) + (install "*" (binary int//*)) + (install "/" (binary int///)) + (install "%" (binary int//%)) + (install "=" (binary int//=)) + (install "<" (binary int//<)) + (install "min" (nullary int//min)) + (install "max" (nullary int//max)) + (install "to-frac" (unary _.floatval/1))))) + +## (def: frac-procs +## Bundle +## (<| (prefix "frac") +## (|> (dict.new text.Hash<Text>) +## (install "+" (binary frac//+)) +## (install "-" (binary frac//-)) +## (install "*" (binary frac//*)) +## (install "/" (binary frac///)) +## (install "%" (binary frac//%)) +## (install "=" (binary frac//=)) +## (install "<" (binary frac//<)) +## (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-int" (unary (apply1 (_.global "int")))) +## (install "encode" (unary (apply1 (_.global "repr")))) +## (install "decode" (unary runtimeT.frac//decode))))) + +## ## [[Text]] +## (def: (text//concat [subjectO paramO]) +## Binary +## (|> subjectO (_.+ paramO))) + +## (def: (text//char [subjectO paramO]) +## Binary +## (runtimeT.text//char subjectO paramO)) + +## (def: (text//replace-all [subjectO paramO extraO]) +## Trinary +## (_.send (list paramO extraO) "replace" subjectO)) + +## (def: (text//replace-once [subjectO paramO extraO]) +## Trinary +## (_.send (list paramO extraO (_.int 1)) "replace" subjectO)) + +## (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 (_.global "len")))) +## (install "hash" (unary (apply1 (_.global "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 (send0 "upper"))) +## (install "lower" (unary (send0 "lower"))) +## ))) + +## ## [[Math]] +## (def: (math//pow [subject param]) +## Binary +## (|> subject (_.** param))) + +## (def: math-procs +## Bundle +## (<| (prefix "math") +## (|> (dict.new text.Hash<Text>) +## (install "cos" (unary runtimeT.math//cos)) +## (install "sin" (unary runtimeT.math//sin)) +## (install "tan" (unary runtimeT.math//tan)) +## (install "acos" (unary runtimeT.math//acos)) +## (install "asin" (unary runtimeT.math//asin)) +## (install "atan" (unary runtimeT.math//atan)) +## (install "exp" (unary runtimeT.math//exp)) +## (install "log" (unary runtimeT.math//log)) +## (install "ceil" (unary runtimeT.math//ceil)) +## (install "floor" (unary runtimeT.math//floor)) +## (install "pow" (binary math//pow)) +## ))) + +## ## [[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))))))) + +## ## [[Atoms]] +## (def: atom//new +## Unary +## (|>> [(_.string runtimeT.atom//field)] (list) _.dict)) + +## (def: atom//read +## Unary +## (_.nth (_.string runtimeT.atom//field))) + +## (def: (atom//compare-and-swap [atomO oldO newO]) +## Trinary +## (runtimeT.atom//compare-and-swap atomO oldO newO)) + +## (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))))) + +## ## [[Processes]] +## (def: (process//concurrency-level []) +## Nullary +## (_.int 1)) + +## (def: (process//schedule [milli-secondsO procedureO]) +## Binary +## (runtimeT.process//schedule milli-secondsO procedureO)) + +## (def: process-procs +## Bundle +## (<| (prefix "process") +## (|> (dict.new text.Hash<Text>) +## (install "concurrency-level" (nullary process//concurrency-level)) +## (install "future" (unary runtimeT.process//future)) +## (install "schedule" (binary process//schedule)) +## ))) + +## [Bundles] +(def: #export procedures + Bundle + (<| (prefix "lux") + (|> (dict.new text.Hash<Text>) + ## lux-procs + ## (dict.merge bit-procs) + (dict.merge int-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 process-procs) + ))) diff --git a/new-luxc/source/luxc/lang/translation/php/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure/host.jvm.lux new file mode 100644 index 000000000..c1b43da2f --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/php/procedure/host.jvm.lux @@ -0,0 +1,89 @@ +(.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] + (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)) + )) |