diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/lang/translation/scheme/extension/common.jvm.lux | 389 |
1 files changed, 389 insertions, 0 deletions
diff --git a/stdlib/source/lux/lang/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/lang/translation/scheme/extension/common.jvm.lux new file mode 100644 index 000000000..140045aaf --- /dev/null +++ b/stdlib/source/lux/lang/translation/scheme/extension/common.jvm.lux @@ -0,0 +1,389 @@ +(.module: + lux + (lux (control [monad #+ do] + ["ex" exception #+ exception:]) + (data ["e" error] + [product] + [text] + text/format + [number #+ hex] + (coll [list "list/" Functor<List>] + (dictionary ["dict" unordered #+ Dict]))) + [macro #+ with-gensyms] + (macro [code] + ["s" syntax #+ syntax:]) + [host]) + (///// (host ["_" scheme #+ Expression Computation]) + [compiler] + [synthesis #+ Synthesis]) + [///runtime #+ Operation Translator]) + +## [Types] +(type: #export Extension + (-> Translator (List Synthesis) (Operation Computation))) + +(type: #export Bundle + (Dict Text Extension)) + +(syntax: (Vector {size s.nat} elemT) + (wrap (list (` [(~+ (list.repeat size elemT))])))) + +(type: #export Nullary (-> (Vector +0 Expression) Computation)) +(type: #export Unary (-> (Vector +1 Expression) Computation)) +(type: #export Binary (-> (Vector +2 Expression) Computation)) +(type: #export Trinary (-> (Vector +3 Expression) Computation)) +(type: #export Variadic (-> (List Expression) Computation)) + +## [Utils] +(def: #export (install name unnamed) + (-> Text (-> Text Extension) + (-> 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>))) + +(exception: #export (wrong-arity {extension Text} {expected Nat} {actual Nat}) + (ex.report ["Extension" (%t extension)] + ["Expected" (|> expected .int %i)] + ["Actual" (|> actual .int %i)])) + +(syntax: (arity: {name s.local-symbol} {arity s.nat}) + (with-gensyms [g!_ g!extension 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!extension)) + (-> (-> (..Vector (~ (code.nat arity)) Expression) Computation) + (-> Text ..Extension)) + (function ((~ g!_) (~ g!name)) + (function ((~ g!_) (~ g!translate) (~ g!inputs)) + (case (~ g!inputs) + (^ (list (~+ g!input+))) + (do compiler.Monad<Operation> + [(~+ (|> g!input+ + (list/map (function (_ g!input) + (list g!input (` ((~ g!translate) (~ g!input)))))) + list.concat))] + ((~' wrap) ((~ g!extension) [(~+ g!input+)]))) + + (~' _) + (compiler.throw wrong-arity [(~ g!name) +1 (list.size (~ g!inputs))]))))))))))) + +(arity: nullary +0) +(arity: unary +1) +(arity: binary +2) +(arity: trinary +3) + +(def: #export (variadic extension) + (-> Variadic (-> Text Extension)) + (function (_ extension-name) + (function (_ translate inputsS) + (do compiler.Monad<Operation> + [inputsI (monad.map @ translate inputsS)] + (wrap (extension inputsI)))))) + +## [Extensions] +## [[Lux]] +(def: extensions/lux + Bundle + (|> (dict.new text.Hash<Text>) + (install "is?" (binary (product.uncurry _.eq?/2))) + (install "try" (unary ///runtime.lux//try)))) + +## [[Bits]] +(do-template [<name> <op>] + [(def: (<name> [subjectO paramO]) + Binary + (<op> paramO subjectO))] + + [bit//and _.bit-and/2] + [bit//or _.bit-or/2] + [bit//xor _.bit-xor/2] + ) + +(def: (bit//left-shift [subjectO paramO]) + Binary + (_.arithmetic-shift/2 (_.remainder/2 (_.int 64) paramO) + subjectO)) + +(def: (bit//arithmetic-right-shift [subjectO paramO]) + Binary + (_.arithmetic-shift/2 (|> paramO (_.remainder/2 (_.int 64)) (_.*/2 (_.int -1))) + subjectO)) + +(def: (bit//logical-right-shift [subjectO paramO]) + Binary + (///runtime.bit//logical-right-shift (_.remainder/2 (_.int 64) paramO) subjectO)) + +(def: extensions/bit + 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)) + ))) + +## [[Arrays]] +(def: (array//new size0) + Unary + (_.make-vector/2 size0 _.nil)) + +(def: (array//get [arrayO idxO]) + Binary + (///runtime.array//get arrayO idxO)) + +(def: (array//put [arrayO idxO elemO]) + Trinary + (///runtime.array//put arrayO idxO elemO)) + +(def: (array//remove [arrayO idxO]) + Binary + (///runtime.array//put arrayO idxO _.nil)) + +(def: extensions/array + 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 _.vector-length/1)) + ))) + +## [[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> <frac>] + [(def: (<name> _) + Nullary + (_.float <frac>))] + + [frac//not-a-number number.not-a-number] + [frac//positive-infinity number.positive-infinity] + [frac//negative-infinity number.negative-infinity] + ) + +(do-template [<name> <op>] + [(def: (<name> [subjectO paramO]) + Binary + (|> subjectO (<op> paramO)))] + + [int//+ _.+/2] + [int//- _.-/2] + [int//* _.*/2] + [int/// _.quotient/2] + [int//% _.remainder/2] + ) + +(do-template [<name> <op>] + [(def: (<name> [subjectO paramO]) + Binary + (<op> paramO subjectO))] + + [frac//+ _.+/2] + [frac//- _.-/2] + [frac//* _.*/2] + [frac/// _.//2] + [frac//% _.mod/2] + [frac//= _.=/2] + [frac//< _.</2] + + [text//= _.string=?/2] + [text//< _.string<?/2] + ) + +(do-template [<name> <cmp>] + [(def: (<name> [subjectO paramO]) + Binary + (<cmp> paramO subjectO))] + + [int//= _.=/2] + [int//< _.</2] + ) + +(def: int//char (|>> _.integer->char/1 _.string/1)) + +(def: extensions/int + 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 "to-frac" (unary (|>> (_.//2 (_.float 1.0))))) + (install "char" (unary int//char))))) + +(def: extensions/frac + 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 _.exact/1)) + (install "encode" (unary _.number->string/1)) + (install "decode" (unary ///runtime.frac//decode))))) + +## [[Text]] +(def: (text//char [subjectO paramO]) + Binary + (_.string/1 (_.string-ref/2 subjectO paramO))) + +(def: (text//clip [subjectO startO endO]) + Trinary + (_.substring/3 subjectO startO endO)) + +(def: extensions/text + Bundle + (<| (prefix "text") + (|> (dict.new text.Hash<Text>) + (install "=" (binary text//=)) + (install "<" (binary text//<)) + (install "concat" (binary (product.uncurry _.string-append/2))) + (install "size" (unary _.string-length/1)) + (install "char" (binary text//char)) + (install "clip" (trinary text//clip))))) + +## [[Math]] +(def: (math//pow [subject param]) + Binary + (_.expt/2 param subject)) + +(def: math-func + (-> Text Unary) + (|>> _.global _.apply/1)) + +(def: extensions/math + Bundle + (<| (prefix "math") + (|> (dict.new text.Hash<Text>) + (install "cos" (unary (math-func "cos"))) + (install "sin" (unary (math-func "sin"))) + (install "tan" (unary (math-func "tan"))) + (install "acos" (unary (math-func "acos"))) + (install "asin" (unary (math-func "asin"))) + (install "atan" (unary (math-func "atan"))) + (install "exp" (unary (math-func "exp"))) + (install "log" (unary (math-func "log"))) + (install "ceil" (unary (math-func "ceiling"))) + (install "floor" (unary (math-func "floor"))) + (install "pow" (binary math//pow)) + ))) + +## [[IO]] +(def: (io//log input) + Unary + (_.begin (list (_.display/1 input) + _.newline/0))) + +(def: (void code) + (-> Expression Computation) + (_.begin (list code (_.string synthesis.unit)))) + +(def: extensions/io + Bundle + (<| (prefix "io") + (|> (dict.new text.Hash<Text>) + (install "log" (unary (|>> io//log ..void))) + (install "error" (unary _.raise/1)) + (install "exit" (unary _.exit/1)) + (install "current-time" (nullary (function (_ _) (///runtime.io//current-time (_.string synthesis.unit)))))))) + +## [[Atoms]] +(def: atom//new + Unary + (|>> (list) _.vector/*)) + +(def: (atom//read atom) + Unary + (_.vector-ref/2 atom (_.int 0))) + +(def: (atom//compare-and-swap [atomO oldO newO]) + Trinary + (///runtime.atom//compare-and-swap atomO oldO newO)) + +(def: extensions/atom + 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))))) + +## [[Box]] +(def: (box//write [valueO boxO]) + Binary + (///runtime.box//write valueO boxO)) + +(def: extensions/box + Bundle + (<| (prefix "box") + (|> (dict.new text.Hash<Text>) + (install "new" (unary atom//new)) + (install "read" (unary atom//read)) + (install "write" (binary box//write))))) + +## [[Processes]] +(def: (process//parallelism-level []) + Nullary + (_.int 1)) + +(def: extensions/process + Bundle + (<| (prefix "process") + (|> (dict.new text.Hash<Text>) + (install "parallelism-level" (nullary process//parallelism-level)) + (install "schedule" (binary (product.uncurry ///runtime.process//schedule))) + ))) + +## [Bundles] +(def: #export extensions + Bundle + (<| (prefix "lux") + (|> extensions/lux + (dict.merge extensions/bit) + (dict.merge extensions/int) + (dict.merge extensions/frac) + (dict.merge extensions/text) + (dict.merge extensions/array) + (dict.merge extensions/math) + (dict.merge extensions/io) + (dict.merge extensions/atom) + (dict.merge extensions/box) + (dict.merge extensions/process) + ))) |