diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation')
14 files changed, 27 insertions, 669 deletions
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 index 14e37efb8..f9e00be2a 100644 --- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux @@ -210,9 +210,6 @@ Nullary (<encode> <const>))] - [nat//min 0 runtimeT.int] - [nat//max -1 runtimeT.int] - [int//min Long::MIN_VALUE runtimeT.int] [int//max Long::MAX_VALUE runtimeT.int] @@ -238,12 +235,6 @@ [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//*] @@ -275,21 +266,10 @@ 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] + [deg//< runtimeT.int//<] ) (def: (frac//encode inputJS) @@ -314,7 +294,7 @@ [text//hash runtimeT.text//hash] ) -(def: (nat//char inputJS) +(def: (int//char inputJS) Unary (format "String.fromCharCode" "(" (int//to-frac inputJS) ")")) @@ -479,22 +459,6 @@ (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift)) ))) -(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//=)) - (install "<" (binary nat//<)) - (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") @@ -508,8 +472,8 @@ (install "<" (binary int//<)) (install "min" (nullary int//min)) (install "max" (nullary int//max)) - (install "to-nat" (unary int//to-nat)) - (install "to-frac" (unary int//to-frac))))) + (install "to-frac" (unary int//to-frac)) + (install "char" (unary int//char))))) (def: deg-procs Bundle @@ -638,7 +602,6 @@ (<| (prefix "lux") (|> lux-procs (dict.merge bit-procs) - (dict.merge nat-procs) (dict.merge int-procs) (dict.merge deg-procs) (dict.merge frac-procs) 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 afb3cd538..5fab92941 100644 --- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux @@ -584,99 +584,6 @@ __int/// __int//%)) -(runtime: nat//< "ltN64" - (let [high (function (_ i64) (format "(" i64 "." //.int-high-field ")")) - low (function (_ i64) (format "(" i64 "." //.int-low-field ")")) - i32 (function (_ word) (format "(" word " >>> 0)"))] - (js.function @ (list "subject" "parameter") - (list (js.return! (js.or (js.> (i32 (high "subject")) - (i32 (high "parameter"))) - (js.and (js.= (high "subject") - (high "parameter")) - (js.> (i32 (low "subject")) - (i32 (low "parameter")))))))))) - -(def: (<N param subject) - (-> Expression Expression Expression) - (js.apply nat//< (list subject param))) - -(def: (<=N param subject) - (-> Expression Expression Expression) - (js.or (js.apply nat//< (list subject param)) - (js.apply int//= (list subject param)))) - -(def: (>N param subject) - (-> Expression Expression Expression) - (js.apply nat//< (list param subject))) - -(def: (>=N param subject) - (-> Expression Expression Expression) - (js.or (js.apply nat//< (list param subject)) - (js.apply int//= (list subject param)))) - -(runtime: nat/// "divN64" - (let [negative? (function (_ value) - (js.apply int//< (list value int//zero))) - valid-division-check [(=I int//zero "parameter") - (js.throw! (js.string "Cannot divide by zero!"))] - short-circuit-check [(=I int//zero "subject") - (js.return! int//zero)]] - (js.function @ (list "subject" "parameter") - (list (js.cond! (list valid-division-check - short-circuit-check - - [(>N "subject" "parameter") - (js.return! int//zero)] - - [(>N (js.apply bit//logical-right-shift - (list "subject" (js.number 1.0))) - "parameter") - (js.return! int//one)]) - (js.block! (list (js.var! "result" (#.Some int//zero)) - (js.var! "remainder" (#.Some "subject")) - (js.while! (>=N "parameter" "remainder") - (let [rough-estimate (js.apply "Math.floor" (list (js./ (js.apply int//to-number (list "parameter")) - (js.apply int//to-number (list "remainder"))))) - log2 (js./ "Math.LN2" - (js.apply "Math.log" (list "approximate"))) - approx-result (js.apply int//from-number (list "approximate")) - approx-remainder (js.apply int//* (list "approximate_result" "parameter"))] - (list (js.var! "approximate" (#.Some (js.apply "Math.max" (list (js.number 1.0) - rough-estimate)))) - (js.var! "log2" (#.Some (js.apply "Math.ceil" (list log2)))) - (js.var! "delta" (#.Some (js.? (js.<= (js.number 48.0) "log2") - (js.number 1.0) - (js.apply "Math.pow" (list (js.number 2.0) - (js.- (js.number 48.0) - "log2")))))) - (js.var! "approximate_result" (#.Some approx-result)) - (js.var! "approximate_remainder" (#.Some approx-remainder)) - (js.while! (js.or (negative? "approximate_remainder") - (>N "remainder" - "approximate_remainder")) - (list (js.set! "approximate" (js.- "delta" "approximate")) - (js.set! "approximate_result" approx-result) - (js.set! "approximate_remainder" approx-remainder))) - (js.block! (list (js.set! "result" (js.apply int//+ (list "result" - (js.? (=I int//zero "approximate_result") - int//one - "approximate_result")))) - (js.set! "remainder" (js.apply int//- (list "remainder" "approximate_remainder")))))))) - (js.return! "result"))) - ))))) - -(runtime: nat//% "remN64" - (js.function @ (list "subject" "parameter") - (list (let [flat (js.apply int//* (list (js.apply nat/// (list "subject" "parameter")) - "parameter"))] - (js.return! (js.apply int//- (list "subject" flat))))))) - -(def: runtime//nat - Runtime - (format __nat//< - __nat/// - __nat//%)) - (runtime: deg//* "mulD64" (format "(function " @ "(l,r) {" "var lL = " int//from-number "(l.L);" @@ -900,7 +807,6 @@ runtime//adt runtime//bit runtime//int - runtime//nat runtime//deg runtime//text runtime//array 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 index 3a5cc9b70..05a38eb2f 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -267,18 +267,11 @@ (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] @@ -307,12 +300,6 @@ [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] @@ -340,10 +327,9 @@ [<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)] + [deg//eq deg//lt ($i.unwrap #$.Long) $i.LCMP] ) (do-template [<name> <prepare> <transform>] @@ -351,12 +337,9 @@ 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)] + [int//char ($i.unwrap #$.Long) + ((|>> $i.L2I $i.I2C ($i.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) false)))] [frac//to-int ($i.unwrap #$.Double) (<| ($i.wrap #$.Long) $i.D2L)] [frac//to-deg ($i.unwrap #$.Double) @@ -623,22 +606,6 @@ (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift)) ))) -(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") @@ -652,8 +619,8 @@ (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))))) + (install "to-frac" (unary int//to-frac)) + (install "char" (unary int//char))))) (def: deg-procs Bundle @@ -782,7 +749,6 @@ (<| (prefix "lux") (|> lux-procs (dict.merge bit-procs) - (dict.merge nat-procs) (dict.merge int-procs) (dict.merge deg-procs) (dict.merge frac-procs) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux index b394a7f53..58ed736ab 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -167,94 +167,6 @@ $.Inst ($i.INVOKESTATIC hostL.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) false)) -(def: nat-methods - $.Def - (let [compare-nat-method ($t.method (list $t.long $t.long) (#.Some $t.int) (list)) - less-thanI (function (_ @where) (|>> ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false) ($i.IFLT @where))) - $BigInteger ($t.class "java.math.BigInteger" (list)) - upcast-method ($t.method (list $t.long) (#.Some $BigInteger) (list)) - div-method ($t.method (list $t.long $t.long) (#.Some $t.long) (list)) - upcastI ($i.INVOKESTATIC hostL.runtime-class "_toUnsignedBigInteger" upcast-method false) - downcastI ($i.INVOKEVIRTUAL "java.math.BigInteger" "longValue" ($t.method (list) (#.Some $t.long) (list)) false)] - (|>> ($d.method #$.Public $.staticM "_toUnsignedBigInteger" upcast-method - (let [upcastI ($i.INVOKESTATIC "java.math.BigInteger" "valueOf" upcast-method false) - discernI (function (_ @where) (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGE @where))) - prepare-upperI (|>> ($i.LLOAD +0) ($i.int 32) $i.LUSHR - upcastI - ($i.int 32) ($i.INVOKEVIRTUAL "java.math.BigInteger" "shiftLeft" ($t.method (list $t.int) (#.Some $BigInteger) (list)) false)) - prepare-lowerI (|>> ($i.LLOAD +0) ($i.int 32) $i.LSHL - ($i.int 32) $i.LUSHR - upcastI)] - (<| $i.with-label (function (_ @simple)) - (|>> (discernI @simple) - ## else - prepare-upperI - prepare-lowerI - ($i.INVOKEVIRTUAL "java.math.BigInteger" "add" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false) - $i.ARETURN - ## then - ($i.label @simple) - ($i.LLOAD +0) - upcastI - $i.ARETURN)))) - ($d.method #$.Public $.staticM "compare_nat" compare-nat-method - (let [shiftI (|>> ($i.GETSTATIC "java.lang.Long" "MIN_VALUE" $t.long) $i.LADD)] - (|>> ($i.LLOAD +0) shiftI - ($i.LLOAD +2) shiftI - $i.LCMP - $i.IRETURN))) - ($d.method #$.Public $.staticM "div_nat" div-method - (let [is-param-largeI (function (_ @where) (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLT @where))) - is-subject-smallI (function (_ @where) (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGT @where))) - small-division (|>> ($i.LLOAD +0) ($i.LLOAD +2) $i.LDIV $i.LRETURN) - big-divisionI ($i.INVOKEVIRTUAL "java.math.BigInteger" "divide" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)] - (<| $i.with-label (function (_ @is-zero)) - $i.with-label (function (_ @param-is-large)) - $i.with-label (function (_ @subject-is-small)) - (|>> (is-param-largeI @param-is-large) - ## Param is not too large - (is-subject-smallI @subject-is-small) - ## Param is small, but subject is large - ($i.LLOAD +0) upcastI - ($i.LLOAD +2) upcastI - big-divisionI downcastI $i.LRETURN - ## Both param and subject are small, - ## and can thus be divided normally. - ($i.label @subject-is-small) - small-division - ## Param is too large. Cannot simply divide. - ## Depending on the result of the - ## comparison, a result will be determined. - ($i.label @param-is-large) - ($i.LLOAD +0) ($i.LLOAD +2) (less-thanI @is-zero) - ## Greater-than or equals - ($i.long 1) $i.LRETURN - ## Less than - ($i.label @is-zero) - ($i.long 0) $i.LRETURN)))) - ($d.method #$.Public $.staticM "rem_nat" div-method - (let [is-subject-largeI (function (_ @where) (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFLE @where))) - is-param-largeI (function (_ @where) (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLE @where))) - small-remainderI (|>> ($i.LLOAD +0) ($i.LLOAD +2) $i.LREM $i.LRETURN) - big-remainderI ($i.INVOKEVIRTUAL "java.math.BigInteger" "remainder" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)] - (<| $i.with-label (function (_ @large-number)) - $i.with-label (function (_ @subject-is-smaller-than-param)) - (|>> (is-subject-largeI @large-number) - (is-param-largeI @large-number) - small-remainderI - - ($i.label @large-number) - ($i.LLOAD +0) ($i.LLOAD +2) (less-thanI @subject-is-smaller-than-param) - - ($i.LLOAD +0) upcastI - ($i.LLOAD +2) upcastI - big-remainderI downcastI $i.LRETURN - - ($i.label @subject-is-smaller-than-param) - ($i.LLOAD +0) - $i.LRETURN)))) - ))) - (def: frac-shiftI $.Inst ($i.double (math.pow 32.0 2.0))) (def: frac-methods @@ -620,7 +532,6 @@ [_ (wrap []) #let [bytecode ($d.class #$.V1_6 #$.Public $.finalC hostL.runtime-class (list) ["java.lang.Object" (list)] (list) (|>> adt-methods - nat-methods frac-methods deg-methods text-methods diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux index bdba05a9d..a9849b557 100644 --- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux @@ -197,9 +197,6 @@ Nullary (<encode> <const>))] - [nat//min 0 lua.int] - [nat//max -1 lua.int] - [frac//smallest Double::MIN_VALUE lua.float] [frac//min (f/* -1.0 Double::MAX_VALUE) lua.float] [frac//max Double::MAX_VALUE lua.float] @@ -238,12 +235,6 @@ [int//div lua.//] [int//rem lua.%] - [nat//add lua.+] - [nat//sub lua.-] - [nat//mul lua.*] - [nat//div runtimeT.nat///] - [nat//rem runtimeT.nat//%] - [deg//add lua.+] [deg//sub lua.-] [deg//mul runtimeT.deg//*] @@ -275,21 +266,10 @@ Binary (<cmp> paramO subjectO))] - [nat//= lua.=] - [nat//< runtimeT.nat//<] [int//= lua.=] [int//< lua.<] [deg//= lua.=] - [deg//< runtimeT.nat//<] - ) - -(do-template [<name>] - [(def: (<name> inputO) - Unary - inputO)] - - [nat//to-int] - [int//to-nat] + [deg//< lua.<] ) (def: frac//encode @@ -320,7 +300,7 @@ [text//hash runtimeT.text//hash] ) -(def: nat//char +(def: int//char Unary (|>> (list) (lua.apply "string.char"))) @@ -466,22 +446,6 @@ (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift)) ))) -(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//=)) - (install "<" (binary nat//<)) - (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") @@ -495,8 +459,8 @@ (install "<" (binary int//<)) (install "min" (nullary int//min)) (install "max" (nullary int//max)) - (install "to-nat" (unary int//to-nat)) - (install "to-frac" (unary int//to-frac))))) + (install "to-frac" (unary int//to-frac)) + (install "char" (unary int//char))))) (def: deg-procs Bundle @@ -620,7 +584,6 @@ (<| (prefix "lux") (|> lux-procs (dict.merge bit-procs) - (dict.merge nat-procs) (dict.merge int-procs) (dict.merge deg-procs) (dict.merge frac-procs) diff --git a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux index 64253b1c3..cd5d0c090 100644 --- a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux @@ -197,36 +197,6 @@ (format @@bit//count @@bit//logical-right-shift)) -(runtime: (nat//< param subject) - (lua.return! (lua.apply "math.ult" (list subject param)))) - -(runtime: (nat/// param subject) - (lua.if! (lua.< (lua.int 0) param) - (lua.if! (nat//< param subject) - (lua.return! (lua.int 0)) - (lua.return! (lua.int 1))) - (lua.block! (list (lua.local! "quotient" (#.Some (|> subject - (lua.bit-shr (lua.int 1)) - (lua.// param) - (lua.bit-shl (lua.int 1))))) - (lua.local! "remainder" (#.Some (lua.- (lua.* param "quotient") - subject))) - (lua.if! (lua.not (nat//< param "remainder")) - (lua.return! (lua.+ (lua.int 1) "quotient")) - (lua.return! "quotient")))))) - -(runtime: (nat//% param subject) - (let [flat (|> subject - (nat/// param) - (lua.* param))] - (lua.return! (lua.- flat subject)))) - -(def: runtime//nat - Runtime - (format @@nat//< - @@nat/// - @@nat//%)) - (runtime: deg//low-mask (|> (lua.int 1) (lua.bit-shl (lua.int 32)) @@ -477,7 +447,6 @@ (format runtime//lux runtime//adt runtime//bit - runtime//nat runtime//deg runtime//text runtime//array diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux index c201c417c..69b4aede4 100644 --- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux @@ -228,9 +228,6 @@ Nullary (<encode> <const>))] - [nat//min 0 python.int] - [nat//max -1 python.int] - [frac//smallest Double::MIN_VALUE python.float] [frac//min (f/* -1.0 Double::MAX_VALUE) python.float] [frac//max Double::MAX_VALUE python.float] @@ -269,10 +266,6 @@ [int//sub python.-] [int//mul python.*] - [nat//add python.+] - [nat//sub python.-] - [nat//mul python.*] - [deg//add python.+] [deg//sub python.-] [deg//rem python.-] @@ -288,9 +281,6 @@ [int//div python./] [int//rem python.%] - [nat//div runtimeT.nat///] - [nat//rem runtimeT.nat//%] - [deg//mul runtimeT.deg//*] [deg//div runtimeT.deg///] [deg//reciprocal python./] @@ -318,14 +308,11 @@ Binary (<cmp> paramO subjectO))] - [nat//= python.=] - [nat//< runtimeT.nat//<] - [int//= python.=] [int//< python.<] [deg//= python.=] - [deg//< runtimeT.nat//<] + [deg//< python.<] ) (def: (apply1 func) @@ -347,22 +334,6 @@ (python.global "float"))] ) -(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//=)) - (install "<" (binary nat//<)) - (install "min" (nullary nat//min)) - (install "max" (nullary nat//max)) - (install "to-int" (unary id)) - (install "char" (unary (apply1 (python.global "chr"))))))) - (def: int-procs Bundle (<| (prefix "int") @@ -376,8 +347,8 @@ (install "<" (binary int//<)) (install "min" (nullary int//min)) (install "max" (nullary int//max)) - (install "to-nat" (unary id)) - (install "to-frac" (unary (apply1 (python.global "float"))))))) + (install "to-frac" (unary (apply1 (python.global "float")))) + (install "char" (unary (apply1 (python.global "chr"))))))) (def: deg-procs Bundle @@ -558,7 +529,6 @@ (<| (prefix "lux") (|> lux-procs (dict.merge bit-procs) - (dict.merge nat-procs) (dict.merge int-procs) (dict.merge deg-procs) (dict.merge frac-procs) diff --git a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux index 65e864d91..3457cc49b 100644 --- a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux @@ -285,45 +285,6 @@ (def: high (-> Expression Expression) (bit//logical-right-shift (python.int 32))) (def: low (-> Expression Expression) (python.bit-and full-32-bits)) -(runtime: (nat//< param subject) - (with-vars [ph sh] - ($_ python.then! - (python.set! (list ph) (..high param)) - (python.set! (list sh) (..high subject)) - (python.return! (python.or (python.< (@@ ph) (@@ sh)) - (python.and (python.= (@@ ph) (@@ sh)) - (python.< (low param) (low subject)))))))) - -(runtime: (nat/// param subject) - (with-vars [quotient remainder] - (python.if! (python.< (python.int 0) param) - (python.if! (nat//< param subject) - (python.return! (python.int 0)) - (python.return! (python.int 1))) - ($_ python.then! - (python.set! (list quotient) (|> subject - (python.bit-shr (python.int 1)) - (python./ param) - (python.bit-shl (python.int 1)))) - (let [remainder (python.- (python.* param (@@ quotient)) - subject)] - (python.if! (python.not (nat//< param remainder)) - (python.return! (python.+ (python.int 1) (@@ quotient))) - (python.return! (@@ quotient)))))))) - -(runtime: (nat//% param subject) - (let [flat (|> subject - (nat/// param) - (python.* param))] - (python.return! (|> subject (python.- flat))))) - -(def: runtime//nat - Runtime - ($_ python.then! - @@nat//< - @@nat/// - @@nat//%)) - (runtime: (deg//* param subject) (with-vars [$sL $sH $pL $pH $bottom $middle $top] ($_ python.then! @@ -561,7 +522,6 @@ runtime//lux runtime//adt runtime//bit - runtime//nat runtime//deg runtime//frac runtime//text diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux index a9e661130..9554abc86 100644 --- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux @@ -229,9 +229,6 @@ Nullary <expression>)] - [nat//min runtimeT.int//zero] - [nat//max runtimeT.int//-one] - [int//min runtimeT.int//min] [int//max runtimeT.int//max] @@ -260,12 +257,6 @@ [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//rem runtimeT.int//-] @@ -297,14 +288,11 @@ Binary (<cmp> paramO subjectO))] - [nat//= runtimeT.int//=] - [nat//< runtimeT.nat//<] - [int//= runtimeT.int//=] [int//< runtimeT.int//<] [deg//= runtimeT.int//=] - [deg//< runtimeT.nat//<] + [deg//< runtimeT.int//<] ) (def: (apply1 func) @@ -312,23 +300,7 @@ (function (_ value) (r.apply (list value) func))) -(def: nat//char (|>> runtimeT.int64-low (apply1 (r.global "intToUtf8")))) - -(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//=)) - (install "<" (binary nat//<)) - (install "min" (nullary nat//min)) - (install "max" (nullary nat//max)) - (install "to-int" (unary id)) - (install "char" (unary nat//char))))) +(def: int//char (|>> runtimeT.int64-low (apply1 (r.global "intToUtf8")))) (def: int-procs Bundle @@ -343,8 +315,8 @@ (install "<" (binary int//<)) (install "min" (nullary int//min)) (install "max" (nullary int//max)) - (install "to-nat" (unary id)) - (install "to-frac" (unary runtimeT.int//to-float))))) + (install "to-frac" (unary runtimeT.int//to-float)) + (install "char" (unary int//char))))) (def: deg-procs Bundle @@ -544,7 +516,6 @@ (<| (prefix "lux") (|> lux-procs (dict.merge bit-procs) - (dict.merge nat-procs) (dict.merge int-procs) (dict.merge deg-procs) (dict.merge frac-procs) diff --git a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux index 88b40bcca..70a9f62df 100644 --- a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux @@ -664,83 +664,6 @@ @@bit//logical-right-shift )) -(runtime: (nat//< param subject) - (with-vars [pH sH] - ($_ r.then - (r.set! pH (..int64-high (@@ param))) - (r.set! sH (..int64-high (@@ subject))) - (let [lesser-high? (|> (@@ sH) (r.< (@@ pH))) - equal-high? (|> (@@ sH) (r.= (@@ pH))) - lesser-low? (|> (..int64-low (@@ subject)) (r.< (..int64-low (@@ param))))] - (|> lesser-high? - (r.or (|> equal-high? - (r.and lesser-low?)))))))) - -(runtime: (nat/// parameter subject) - (let [negative? (int//< int//zero) - valid-division-check [(|> (@@ parameter) (int//= int//zero)) - (r.stop (r.string "Cannot divide by zero!"))] - short-circuit-check [(|> (@@ subject) (nat//< (@@ parameter))) - int//zero]] - (r.cond (list valid-division-check - short-circuit-check - - [(|> (@@ parameter) - (nat//< (|> (@@ subject) (bit//logical-right-shift (r.int 1))))) - int//one]) - (with-vars [result remainder approximate log2 approximate-result approximate-remainder delta] - ($_ r.then - (r.set! result int//zero) - (r.set! remainder (@@ subject)) - (r.while (|> (|> (@@ remainder) (nat//< (@@ parameter))) - (r.or (|> (@@ remainder) (int//= (@@ parameter))))) - (let [rough-estimate (r.apply (list (|> (int//to-float (@@ parameter)) (r./ (int//to-float (@@ remainder))))) - (r.global "floor")) - calculate-approximate-result (int//from-float (@@ approximate)) - calculate-approximate-remainder (int//* (@@ parameter) (@@ approximate-result)) - delta (r.if (|> (r.float 48.0) (r.<= (@@ log2))) - (r.float 1.0) - (r.** (|> (r.float 48.0) (r.- (@@ log2))) - (r.float 2.0))) - update-approximates! ($_ r.then - (r.set! approximate-result calculate-approximate-result) - (r.set! approximate-remainder calculate-approximate-remainder))] - ($_ r.then - (r.set! approximate (r.apply (list (r.float 1.0) rough-estimate) - (r.global "max"))) - (r.set! log2 (let [log (function (_ input) - (r.apply (list input) (r.global "log")))] - (r.apply (list (|> (log (r.int 2)) - (r./ (log (@@ approximate))))) - (r.global "ceil")))) - update-approximates! - (r.while (|> (negative? (@@ approximate-remainder)) - (r.or (|> (@@ approximate-remainder) (int//< (@@ remainder))))) - ($_ r.then - (r.set! approximate (|> delta (r.- (@@ approximate)))) - update-approximates!)) - ($_ r.then - (r.set! result (|> (@@ result) - (int//+ (r.if (|> (@@ approximate-result) (int//= int//zero)) - int//one - (@@ approximate-result))))) - (r.set! remainder (|> (@@ remainder) (int//- (@@ approximate-remainder)))))))) - (@@ result))) - ))) - -(runtime: (nat//% param subject) - (let [flat (|> (@@ subject) - (nat/// (@@ param)) - (int//* (@@ param)))] - (|> (@@ subject) (int//- flat)))) - -(def: runtime//nat - Runtime - ($_ r.then - @@nat//< - @@nat/// - @@nat//%)) - (runtime: (deg//* param subject) (with-vars [sL sH pL pH bottom middle top] ($_ r.then @@ -1035,7 +958,6 @@ runtime//bit runtime//int runtime//adt - runtime//nat runtime//deg runtime//frac runtime//text diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux index a13dae50b..e38dfff28 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux @@ -233,9 +233,6 @@ Nullary (<encode> <const>))] - [nat//min 0 ruby.int] - [nat//max -1 ruby.int] - [frac//smallest Double::MIN_VALUE ruby.float] [frac//min (f/* -1.0 Double::MAX_VALUE) ruby.float] [frac//max Double::MAX_VALUE ruby.float] @@ -282,12 +279,6 @@ [int//div ruby./] [int//rem ruby.%] - [nat//add ruby.+] - [nat//sub ruby.-] - [nat//mul ruby.*] - [nat//div runtimeT.nat///] - [nat//rem runtimeT.nat//%] - [deg//add ruby.+] [deg//sub ruby.-] [deg//mul runtimeT.deg//*] @@ -319,21 +310,10 @@ Binary (<cmp> paramO subjectO))] - [nat//= ruby.=] - [nat//< runtimeT.nat//<] [int//= ruby.=] [int//< ruby.<] [deg//= ruby.=] - [deg//< runtimeT.nat//<]) - -(do-template [<name>] - [(def: (<name> inputO) - Unary - inputO)] - - [nat//to-int] - [int//to-nat] - ) + [deg//< ruby.<]) (def: frac//encode Unary @@ -370,26 +350,6 @@ [frac//to-deg runtimeT.deg//from-frac] ) -(def: nat//char - Unary - (ruby.send "chr" (list))) - -(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//=)) - (install "<" (binary nat//<)) - (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") @@ -403,8 +363,8 @@ (install "<" (binary int//<)) (install "min" (nullary int//min)) (install "max" (nullary int//max)) - (install "to-nat" (unary int//to-nat)) - (install "to-frac" (unary int//to-frac))))) + (install "to-frac" (unary int//to-frac)) + (install "char" (unary (ruby.send "chr" (list))))))) (def: deg-procs Bundle @@ -647,7 +607,6 @@ (<| (prefix "lux") (|> lux-procs (dict.merge bit-procs) - (dict.merge nat-procs) (dict.merge int-procs) (dict.merge deg-procs) (dict.merge frac-procs) diff --git a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux index c3f2981e1..7f66b0cd5 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux @@ -181,40 +181,6 @@ (def: high (-> Expression Expression) (bit//logical-right-shift (ruby.int 32))) (def: low (-> Expression Expression) (ruby.bit-and "0xFFFFFFFF")) -(runtime: (nat//< param subject) - (ruby.block! (list (ruby.set! (list "ph") (high param)) - (ruby.set! (list "sh") (high subject)) - (ruby.return! (ruby.or (ruby.< "ph" "sh") - (ruby.and (ruby.= "ph" "sh") - (ruby.< (low param) (low subject)))))))) - -(runtime: (nat/// param subject) - (ruby.if! (ruby.< (ruby.int 0) param) - (ruby.if! (nat//< param subject) - (ruby.return! (ruby.int 0)) - (ruby.return! (ruby.int 1))) - (ruby.block! (list (ruby.set! (list "quotient") (|> subject - (ruby.bit-shr (ruby.int 1)) - (ruby./ param) - (ruby.bit-shl (ruby.int 1)))) - (ruby.set! (list "remainder") (ruby.- (ruby.* param "quotient") - subject)) - (ruby.if! (ruby.not (nat//< param "remainder")) - (ruby.return! (ruby.+ (ruby.int 1) "quotient")) - (ruby.return! "quotient")))))) - -(runtime: (nat//% param subject) - (let [flat (|> subject - (nat/// param) - (ruby.* param))] - (ruby.return! (ruby.- flat subject)))) - -(def: runtime//nat - Runtime - (format @@nat//< - @@nat/// - @@nat//%)) - (runtime: (deg//* param subject) (ruby.block! (list (ruby.set! (list "sL") (low subject)) (ruby.set! (list "sH") (high subject)) @@ -366,7 +332,6 @@ (format runtime//lux "\n" runtime//adt "\n" runtime//bit "\n" - runtime//nat "\n" runtime//deg "\n" runtime//text "\n" runtime//array "\n" diff --git a/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux index cd828e082..67ec0e95c 100644 --- a/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux @@ -235,9 +235,6 @@ Nullary (_.int <expression>))] - [nat//min 0] - [nat//max -1] - [int//min ("lux int min")] [int//max ("lux int max")] @@ -266,12 +263,6 @@ [int//div _.quotient] [int//rem _.remainder] - [nat//add _.+] - [nat//sub _.-] - [nat//mul _.*] - [nat//div runtimeT.nat///] - [nat//rem runtimeT.nat//%] - [deg//add _.+] [deg//sub _.-] [deg//rem _.-] @@ -303,14 +294,11 @@ Binary (<cmp> paramO subjectO))] - [nat//= _.=] - [nat//< runtimeT.nat//<] - [int//= _.=] [int//< _.<] [deg//= _.=] - [deg//< runtimeT.nat//<] + [deg//< _.<] ) (def: deg//to-frac @@ -321,25 +309,9 @@ (_./ f2^32) (_./ (_.float 1.0))))) -(def: nat//char (|>> (_.apply1 (_.global "integer->char")) +(def: int//char (|>> (_.apply1 (_.global "integer->char")) (_.apply1 (_.global "string")))) -(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//=)) - (install "<" (binary nat//<)) - (install "min" (nullary nat//min)) - (install "max" (nullary nat//max)) - (install "to-int" (unary id)) - (install "char" (unary nat//char))))) - (def: int-procs Bundle (<| (prefix "int") @@ -353,8 +325,8 @@ (install "<" (binary int//<)) (install "min" (nullary int//min)) (install "max" (nullary int//max)) - (install "to-nat" (unary id)) - (install "to-frac" (unary (|>> (_./ (_.float 1.0)))))))) + (install "to-frac" (unary (|>> (_./ (_.float 1.0))))) + (install "char" (unary int//char))))) (def: deg-procs Bundle @@ -519,7 +491,6 @@ (<| (prefix "lux") (|> lux-procs (dict.merge bit-procs) - (dict.merge nat-procs) (dict.merge int-procs) (dict.merge deg-procs) (dict.merge frac-procs) diff --git a/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux index 09259c2b9..e8016eb0a 100644 --- a/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux @@ -239,43 +239,6 @@ (def: int-high (bit//logical-right-shift (_.int 32))) (def: int-low (_.bit-and (_.int (hex "FFFFFFFF")))) -(runtime: (nat//< param subject) - (with-vars [pH sH] - (_.let (list [pH (int-high (@@ param))] - [sH (int-high (@@ subject))]) - (_.or (list (_.< (@@ pH) (@@ sH)) - (_.and (list (_.= (@@ pH) (@@ sH)) - (_.< (int-low (@@ param)) (int-low (@@ subject)))))))))) - -(runtime: (nat/// param subject) - (_.if (_.< (_.int 0) (@@ param)) - (_.if (nat//< (@@ param) (@@ subject)) - (_.int 0) - (_.int 1)) - (with-vars [quotient] - (_.let (list [quotient (|> (@@ subject) - (bit//logical-right-shift (_.int 1)) - (_.quotient (@@ param)) - (_.arithmetic-shift (_.int 1)))]) - (let [remainder (_.- (_.* (@@ param) (@@ quotient)) - (@@ subject))] - (_.if (_.not (nat//< (@@ param) remainder)) - (_.+ (_.int 1) (@@ quotient)) - (@@ quotient))))))) - -(runtime: (nat//% param subject) - (let [flat (|> (@@ subject) - (nat/// (@@ param)) - (_.* (@@ param)))] - (|> (@@ subject) (_.- flat)))) - -(def: runtime//nat - Runtime - (_.begin - (list @@nat//< - @@nat/// - @@nat//%))) - (runtime: (frac//to-deg input) (with-vars [two32 shifted] (_.let* (list [two32 (|> (_.float 2.0) (_.expt (_.float 32.0)))] @@ -405,7 +368,6 @@ runtime//lux runtime//bit runtime//adt - runtime//nat runtime//frac ## runtime//text runtime//array |