aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
diff options
context:
space:
mode:
authorEduardo Julian2018-01-08 21:40:06 -0400
committerEduardo Julian2018-01-08 21:40:06 -0400
commit9eaaaf953ba7ce1eeb805603f4e113aa15f5178f (patch)
treeef134eecc8a5767a997fce0637cd64e0ebcee6b1 /new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
parentf523bc14d43286348aeb200bd0554812dc6ef28d (diff)
- Moved all translation code under the JVM path (in preparation for porting the JS back-end).
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux')
-rw-r--r--new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux809
1 files changed, 0 insertions, 809 deletions
diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
deleted file mode 100644
index 84c42244e..000000000
--- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
+++ /dev/null
@@ -1,809 +0,0 @@
-(.module:
- lux
- (lux (control [monad #+ do]
- ["p" parser]
- ["ex" exception #+ exception:])
- (data ["e" error]
- [text]
- text/format
- (coll [list "list/" Functor<List>]
- [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]
- (translation [".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<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)) $.Inst) $.Inst)
- (-> 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))))))
-
-## [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 [<name> <op>]
- [(def: (<name> [inputI maskI])
- Binary
- (|>> inputI ($i.unwrap #$.Long)
- maskI ($i.unwrap #$.Long)
- <op> ($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 [<name> <op>]
- [(def: (<name> [inputI shiftI])
- Binary
- (|>> inputI ($i.unwrap #$.Long)
- shiftI jvm-intI
- <op>
- ($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 [<name> <const> <type>]
- [(def: (<name> _)
- Nullary
- (|>> <const> ($i.wrap <type>)))]
-
- [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 [<name> <type> <op>]
- [(def: (<name> [subjectI paramI])
- Binary
- (|>> subjectI ($i.unwrap <type>)
- paramI ($i.unwrap <type>)
- <op>
- ($i.wrap <type>)))]
-
- [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 [<eq> <lt> <unwrap> <cmp>]
- [(do-template [<name> <reference>]
- [(def: (<name> [subjectI paramI])
- Binary
- (|>> subjectI <unwrap>
- paramI <unwrap>
- <cmp>
- ($i.int <reference>)
- (predicateI $i.IF_ICMPEQ)))]
- [<eq> 0]
- [<lt> -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 [<name> <prepare> <transform>]
- [(def: (<name> inputI)
- Unary
- (|>> inputI <prepare> <transform>))]
-
- [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 [<name> <class> <method> <post> <outputT>]
- [(def: (<name> inputI)
- Unary
- (|>> inputI
- ($i.CHECKCAST "java.lang.String")
- ($i.INVOKEVIRTUAL <class> <method> ($t.method (list) (#.Some <outputT>) (list)) false)
- <post>))]
-
- [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 [<name> <pre-subject> <pre-param> <op> <post>]
- [(def: (<name> [subjectI paramI])
- Binary
- (|>> subjectI <pre-subject>
- paramI <pre-param>
- <op> <post>))]
-
- [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 [<name> <pre-subject> <pre-param> <pre-extra> <op>]
- [(def: (<name> [subjectI paramI extraI])
- Trinary
- (|>> subjectI <pre-subject>
- paramI <pre-param>
- extraI <pre-extra>
- <op>))]
-
- [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 [<name> <method>]
- [(def: (<name> [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" <method> 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 [<name> <method>]
- [(def: (<name> inputI)
- Unary
- (|>> inputI
- ($i.unwrap #$.Double)
- ($i.INVOKESTATIC "java.lang.Math" <method> 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 [<name> <method>]
- [(def: (<name> [inputI paramI])
- Binary
- (|>> inputI ($i.unwrap #$.Double)
- paramI ($i.unwrap #$.Double)
- ($i.INVOKESTATIC "java.lang.Math" <method> 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" "<init>" 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 "<init>" ($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<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)
- )))