From 9eaaaf953ba7ce1eeb805603f4e113aa15f5178f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 8 Jan 2018 21:40:06 -0400 Subject: - Moved all translation code under the JVM path (in preparation for porting the JS back-end). --- .../lang/translation/jvm/procedure/common.jvm.lux | 809 +++++++++++++++++++++ 1 file changed, 809 insertions(+) create mode 100644 new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux (limited to 'new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux') diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux new file mode 100644 index 000000000..c7513fd6e --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -0,0 +1,809 @@ +(.module: + lux + (lux (control [monad #+ do] + ["p" parser] + ["ex" exception #+ exception:]) + (data ["e" error] + [text] + text/format + (coll [list "list/" Functor] + [dict #+ Dict])) + [macro #+ with-gensyms] + (macro [code] + ["s" syntax #+ syntax:]) + [host]) + (luxc ["&" lang] + (lang [".L" host] + (host ["$" jvm] + (jvm ["$t" type] + ["$d" def] + ["$i" inst])) + ["la" analysis] + ["ls" synthesis])) + (/// [".T" runtime] + [".T" case] + [".T" function] + [".T" loop])) + +(host.import java/lang/Long + (#static MIN_VALUE Long) + (#static MAX_VALUE Long)) + +(host.import java/lang/Double + (#static MIN_VALUE Double) + (#static MAX_VALUE Double) + (#static NaN Double) + (#static POSITIVE_INFINITY Double) + (#static NEGATIVE_INFINITY Double)) + +## [Types] +(type: #export Translator + (-> ls.Synthesis (Meta $.Inst))) + +(type: #export Proc + (-> Translator (List ls.Synthesis) (Meta $.Inst))) + +(type: #export Bundle + (Dict Text Proc)) + +(syntax: (Vector [size s.nat] elemT) + (wrap (list (` [(~+ (list.repeat size elemT))])))) + +(type: #export Nullary (-> (Vector +0 $.Inst) $.Inst)) +(type: #export Unary (-> (Vector +1 $.Inst) $.Inst)) +(type: #export Binary (-> (Vector +2 $.Inst) $.Inst)) +(type: #export Trinary (-> (Vector +3 $.Inst) $.Inst)) +(type: #export Variadic (-> (List $.Inst) $.Inst)) + +## [Utils] +(def: $Object $.Type ($t.class "java.lang.Object" (list))) +(def: $Object-Array $.Type ($t.array +1 $Object)) +(def: $Variant $.Type ($t.array +1 $Object)) +(def: $String $.Type ($t.class "java.lang.String" (list))) +(def: $CharSequence $.Type ($t.class "java.lang.CharSequence" (list))) +(def: $Function $.Type ($t.class hostL.function-class (list))) + +(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))) + +(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)) $.Inst) $.Inst) + (-> Text ..Proc)) + (function [(~ g!name)] + (function [(~ g!translate) (~ g!inputs)] + (case (~ g!inputs) + (^ (list (~+ g!input+))) + (do macro.Monad + [(~+ (|> 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 + [inputsI (monad.map @ translate inputsS)] + (wrap (proc inputsI)))))) + +## [Instructions] +(def: lux-intI $.Inst (|>> $i.I2L ($i.wrap #$.Long))) +(def: jvm-intI $.Inst (|>> ($i.unwrap #$.Long) $i.L2I)) + +(def: (array-writeI arrayI idxI elemI) + (-> $.Inst $.Inst $.Inst + $.Inst) + (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) + $i.DUP + idxI jvm-intI + elemI + $i.AASTORE)) + +(def: (predicateI tester) + (-> (-> $.Label $.Inst) + $.Inst) + (<| $i.with-label (function [@then]) + $i.with-label (function [@end]) + (|>> (tester @then) + ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list))) + ($i.GOTO @end) + ($i.label @then) + ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list))) + ($i.label @end) + ))) + +(def: unitI $.Inst ($i.string hostL.unit)) + +## [Procedures] +## [[Lux]] +(def: (lux//is [leftI rightI]) + Binary + (|>> leftI + rightI + (predicateI $i.IF_ACMPEQ))) + +(def: (lux//if [testI thenI elseI]) + Trinary + (caseT.translate-if testI thenI elseI)) + +(def: (lux//try riskyI) + Unary + (|>> riskyI + ($i.CHECKCAST hostL.function-class) + ($i.INVOKESTATIC hostL.runtime-class "try" + ($t.method (list $Function) (#.Some $Object-Array) (list)) + false))) + +(def: (lux//noop valueI) + Unary + valueI) + +(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 [ ] + [(def: ( [inputI maskI]) + Binary + (|>> inputI ($i.unwrap #$.Long) + maskI ($i.unwrap #$.Long) + ($i.wrap #$.Long)))] + + [bit//and $i.LAND] + [bit//or $i.LOR] + [bit//xor $i.LXOR] + ) + +(def: (bit//count inputI) + Unary + (|>> inputI ($i.unwrap #$.Long) + ($i.INVOKESTATIC "java.lang.Long" "bitCount" ($t.method (list $t.long) (#.Some $t.int) (list)) false) + lux-intI)) + +(do-template [ ] + [(def: ( [inputI shiftI]) + Binary + (|>> inputI ($i.unwrap #$.Long) + shiftI jvm-intI + + ($i.wrap #$.Long)))] + + [bit//shift-left $i.LSHL] + [bit//shift-right $i.LSHR] + [bit//unsigned-shift-right $i.LUSHR] + ) + +## [[Arrays]] +(def: (array//new lengthI) + Unary + (|>> lengthI jvm-intI ($i.ANEWARRAY ($t.binary-name "java.lang.Object")))) + +(def: (array//get [arrayI idxI]) + Binary + (<| $i.with-label (function [@is-null]) + $i.with-label (function [@end]) + (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) + idxI jvm-intI + $i.AALOAD + $i.DUP + ($i.IFNULL @is-null) + runtimeT.someI + ($i.GOTO @end) + ($i.label @is-null) + $i.POP + runtimeT.noneI + ($i.label @end)))) + +(def: (array//put [arrayI idxI elemI]) + Trinary + (array-writeI arrayI idxI elemI)) + +(def: (array//remove [arrayI idxI]) + Binary + (array-writeI arrayI idxI $i.NULL)) + +(def: (array//size arrayI) + Unary + (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) + $i.ARRAYLENGTH + lux-intI)) + +## [[Numbers]] +(def: nat-method + $.Method + ($t.method (list $t.long $t.long) (#.Some $t.long) (list))) + +(def: deg-method $.Method nat-method) + +(def: compare-nat-method + $.Method + ($t.method (list $t.long $t.long) (#.Some $t.int) (list))) + +(do-template [ ] + [(def: ( _) + Nullary + (|>> ($i.wrap )))] + + [nat//min ($i.long 0) #$.Long] + [nat//max ($i.long -1) #$.Long] + + [int//min ($i.long Long::MIN_VALUE) #$.Long] + [int//max ($i.long Long::MAX_VALUE) #$.Long] + + [frac//smallest ($i.double Double::MIN_VALUE) #$.Double] + [frac//min ($i.double (f/* -1.0 Double::MAX_VALUE)) #$.Double] + [frac//max ($i.double Double::MAX_VALUE) #$.Double] + [frac//not-a-number ($i.double Double::NaN) #$.Double] + [frac//positive-infinity ($i.double Double::POSITIVE_INFINITY) #$.Double] + [frac//negative-infinity ($i.double Double::NEGATIVE_INFINITY) #$.Double] + + [deg//min ($i.long 0) #$.Long] + [deg//max ($i.long -1) #$.Long] + ) + +(do-template [ ] + [(def: ( [subjectI paramI]) + Binary + (|>> subjectI ($i.unwrap ) + paramI ($i.unwrap ) + + ($i.wrap )))] + + [int//add #$.Long $i.LADD] + [int//sub #$.Long $i.LSUB] + [int//mul #$.Long $i.LMUL] + [int//div #$.Long $i.LDIV] + [int//rem #$.Long $i.LREM] + + [nat//add #$.Long $i.LADD] + [nat//sub #$.Long $i.LSUB] + [nat//mul #$.Long $i.LMUL] + [nat//div #$.Long ($i.INVOKESTATIC hostL.runtime-class "div_nat" nat-method false)] + [nat//rem #$.Long ($i.INVOKESTATIC hostL.runtime-class "rem_nat" nat-method false)] + + [frac//add #$.Double $i.DADD] + [frac//sub #$.Double $i.DSUB] + [frac//mul #$.Double $i.DMUL] + [frac//div #$.Double $i.DDIV] + [frac//rem #$.Double $i.DREM] + + [deg//add #$.Long $i.LADD] + [deg//sub #$.Long $i.LSUB] + [deg//mul #$.Long ($i.INVOKESTATIC hostL.runtime-class "mul_deg" deg-method false)] + [deg//div #$.Long ($i.INVOKESTATIC hostL.runtime-class "div_deg" deg-method false)] + [deg//rem #$.Long $i.LSUB] + [deg//scale #$.Long $i.LMUL] + [deg//reciprocal #$.Long $i.LDIV] + ) + +(do-template [ ] + [(do-template [ ] + [(def: ( [subjectI paramI]) + Binary + (|>> subjectI + paramI + + ($i.int ) + (predicateI $i.IF_ICMPEQ)))] + [ 0] + [ -1])] + + [nat//eq nat//lt ($i.unwrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false)] + [int//eq int//lt ($i.unwrap #$.Long) $i.LCMP] + [frac//eq frac//lt ($i.unwrap #$.Double) $i.DCMPG] + [deg//eq deg//lt ($i.unwrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false)] + ) + +(do-template [ ] + [(def: ( inputI) + Unary + (|>> inputI ))] + + [nat//to-int id id] + [nat//char ($i.unwrap #$.Long) + ((|>> $i.L2I $i.I2C ($i.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) false)))] + + [int//to-nat id id] + [int//to-frac ($i.unwrap #$.Long) (<| ($i.wrap #$.Double) $i.L2D)] + + [frac//to-int ($i.unwrap #$.Double) (<| ($i.wrap #$.Long) $i.D2L)] + [frac//to-deg ($i.unwrap #$.Double) + (<| ($i.wrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "frac_to_deg" + ($t.method (list $t.double) (#.Some $t.long) (list)) false))] + [frac//encode ($i.unwrap #$.Double) + ($i.INVOKESTATIC "java.lang.Double" "toString" ($t.method (list $t.double) (#.Some $String) (list)) false)] + [frac//decode ($i.CHECKCAST "java.lang.String") + ($i.INVOKESTATIC hostL.runtime-class "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) false)] + + [deg//to-frac ($i.unwrap #$.Long) + (<| ($i.wrap #$.Double) ($i.INVOKESTATIC hostL.runtime-class "deg_to_frac" + ($t.method (list $t.long) (#.Some $t.double) (list)) false))] + ) + +## [[Text]] +(do-template [ ] + [(def: ( inputI) + Unary + (|>> inputI + ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL ($t.method (list) (#.Some ) (list)) false) + ))] + + [text//size "java.lang.String" "length" lux-intI $t.int] + [text//hash "java.lang.Object" "hashCode" lux-intI $t.int] + [text//trim "java.lang.String" "trim" id $String] + [text//upper "java.lang.String" "toUpperCase" id $String] + [text//lower "java.lang.String" "toLowerCase" id $String] + ) + +(do-template [ ] + [(def: ( [subjectI paramI]) + Binary + (|>> subjectI + paramI + ))] + + [text//eq id id + ($i.INVOKEVIRTUAL "java.lang.Object" "equals" ($t.method (list $Object) (#.Some $t.boolean) (list)) false) + ($i.wrap #$.Boolean)] + [text//lt ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL "java.lang.String" "compareTo" ($t.method (list $String) (#.Some $t.int) (list)) false) + (<| (predicateI $i.IF_ICMPEQ) ($i.int -1))] + [text//concat ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) false) + id] + [text//contains? ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL "java.lang.String" "contains" ($t.method (list $CharSequence) (#.Some $t.boolean) (list)) false) + ($i.wrap #$.Boolean)] + [text//char ($i.CHECKCAST "java.lang.String") jvm-intI + ($i.INVOKESTATIC hostL.runtime-class "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) false) + id] + ) + +(do-template [ ] + [(def: ( [subjectI paramI extraI]) + Trinary + (|>> subjectI + paramI + extraI + ))] + + [text//clip ($i.CHECKCAST "java.lang.String") jvm-intI jvm-intI + ($i.INVOKESTATIC hostL.runtime-class "text_clip" + ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) false)] + [text//replace-once ($i.CHECKCAST "java.lang.String") + (<| ($i.INVOKESTATIC "java.util.regex.Pattern" "quote" ($t.method (list $String) (#.Some $String) (list)) false) + ($i.CHECKCAST "java.lang.String")) + ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL "java.lang.String" "replaceFirst" ($t.method (list $String $String) (#.Some $String) (list)) false)] + [text//replace-all ($i.CHECKCAST "java.lang.String") + (<| ($i.INVOKESTATIC "java.util.regex.Pattern" "quote" ($t.method (list $String) (#.Some $String) (list)) false) + ($i.CHECKCAST "java.lang.String")) + ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL "java.lang.String" "replaceAll" ($t.method (list $String $String) (#.Some $String) (list)) false)] + ) + +(def: index-method $.Method ($t.method (list $String $t.int) (#.Some $t.int) (list))) +(do-template [ ] + [(def: ( [textI partI startI]) + Trinary + (<| $i.with-label (function [@not-found]) + $i.with-label (function [@end]) + (|>> textI ($i.CHECKCAST "java.lang.String") + partI ($i.CHECKCAST "java.lang.String") + startI jvm-intI + ($i.INVOKEVIRTUAL "java.lang.String" index-method false) + $i.DUP + ($i.int -1) + ($i.IF_ICMPEQ @not-found) + lux-intI + runtimeT.someI + ($i.GOTO @end) + ($i.label @not-found) + $i.POP + runtimeT.noneI + ($i.label @end))))] + + [text//index "indexOf"] + [text//last-index "lastIndexOf"] + ) + +## [[Math]] +(def: math-unary-method ($t.method (list $t.double) (#.Some $t.double) (list))) +(def: math-binary-method ($t.method (list $t.double $t.double) (#.Some $t.double) (list))) + +(do-template [ ] + [(def: ( inputI) + Unary + (|>> inputI + ($i.unwrap #$.Double) + ($i.INVOKESTATIC "java.lang.Math" math-unary-method false) + ($i.wrap #$.Double)))] + + [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"] + ) + +(do-template [ ] + [(def: ( [inputI paramI]) + Binary + (|>> inputI ($i.unwrap #$.Double) + paramI ($i.unwrap #$.Double) + ($i.INVOKESTATIC "java.lang.Math" math-binary-method false) + ($i.wrap #$.Double)))] + + [math//atan2 "atan2"] + [math//pow "pow"] + ) + +(def: (math//round inputI) + Unary + (|>> inputI + ($i.unwrap #$.Double) + ($i.INVOKESTATIC "java.lang.Math" "round" ($t.method (list $t.double) (#.Some $t.long) (list)) false) + $i.L2D + ($i.wrap #$.Double))) + +## [[IO]] +(def: string-method $.Method ($t.method (list $String) #.None (list))) +(def: (io//log messageI) + Unary + (|>> ($i.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) + messageI + ($i.CHECKCAST "java.lang.String") + ($i.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method false) + unitI)) + +(def: (io//error messageI) + Unary + (|>> ($i.NEW "java.lang.Error") + $i.DUP + messageI + ($i.CHECKCAST "java.lang.String") + ($i.INVOKESPECIAL "java.lang.Error" "" string-method false) + $i.ATHROW)) + +(def: (io//exit codeI) + Unary + (|>> codeI jvm-intI + ($i.INVOKESTATIC "java.lang.System" "exit" ($t.method (list $t.int) #.None (list)) false) + $i.NULL)) + +(def: (io//current-time []) + Nullary + (|>> ($i.INVOKESTATIC "java.lang.System" "currentTimeMillis" ($t.method (list) (#.Some $t.long) (list)) false) + ($i.wrap #$.Long))) + +## [[Atoms]] +(def: atom-class Text "java.util.concurrent.atomic.AtomicReference") +(def: (atom//new initI) + Unary + (|>> ($i.NEW atom-class) + $i.DUP + initI + ($i.INVOKESPECIAL atom-class "" ($t.method (list $Object) #.None (list)) false))) + +(def: (atom//read atomI) + Unary + (|>> atomI + ($i.CHECKCAST atom-class) + ($i.INVOKEVIRTUAL atom-class "get" ($t.method (list) (#.Some $Object) (list)) false))) + +(def: (atom//compare-and-swap [atomI oldI newI]) + Trinary + (|>> atomI + ($i.CHECKCAST atom-class) + oldI + newI + ($i.INVOKEVIRTUAL atom-class "compareAndSet" ($t.method (list $Object $Object) (#.Some $t.boolean) (list)) false) + ($i.wrap #$.Boolean))) + +## [[Box]] +(def: empty-boxI + $.Inst + (|>> ($i.int 1) ($i.ANEWARRAY ($t.binary-name "java.lang.Object")))) + +(def: check-boxI + $.Inst + ($i.CHECKCAST ($t.descriptor $Object-Array))) + +(def: (box//new initI) + Unary + (|>> empty-boxI + $i.DUP ($i.int 0) initI $i.AASTORE)) + +(def: (box//read boxI) + Unary + (|>> boxI check-boxI + ($i.int 0) $i.AALOAD)) + +(def: (box//write [valueI boxI]) + Binary + (|>> boxI check-boxI + ($i.int 0) valueI $i.AASTORE + unitI)) + +## [[Processes]] +(def: (process//concurrency-level []) + Nullary + (|>> ($i.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some ($t.class "java.lang.Runtime" (list))) (list)) false) + ($i.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) false) + lux-intI)) + +(def: (process//future procedureI) + Unary + (|>> procedureI ($i.CHECKCAST hostL.function-class) + ($i.INVOKESTATIC hostL.runtime-class "future" + ($t.method (list $Function) (#.Some $Object) (list)) false))) + +(def: (process//schedule [millisecondsI procedureI]) + Binary + (|>> millisecondsI ($i.unwrap #$.Long) + procedureI ($i.CHECKCAST hostL.function-class) + ($i.INVOKESTATIC hostL.runtime-class "schedule" + ($t.method (list $t.long $Function) (#.Some $Object) (list)) false))) + +## [Bundles] +(def: lux-procs + Bundle + (|> (dict.new text.Hash) + (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) + (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) + (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) + (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) + (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) + (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) + (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) + (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) + (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) + (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) + (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) + (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) + (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) + (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) + ))) -- cgit v1.2.3