Made some new-luxc modules "old".

1 files changed, 327 insertions, 0 deletions

diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
new file mode 100644
index 000000000..aeaa1d664
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
@@ -0,0 +1,327 @@
+(.module:
+  [lux #*
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["p" parser]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." text
+     format]
+    [collection
+     ["." dictionary]]]
+   [tool
+    [compiler
+     ["." synthesis (#+ Synthesis)]
+     ["." phase
+      [generation
+       [extension (#+ Nullary Unary Binary Trinary Variadic
+                      nullary unary binary trinary variadic)]]
+      ["." extension
+       ["." bundle]]]]]
+   [host (#+ import:)]]
+  [luxc
+   [lang
+    [host
+     ["$" jvm (#+ Label Inst Method Bundle)
+      ["_t" type]
+      ["_" inst]]]]]
+  ["." ///
+   ["." runtime]])
+
+(import: java/lang/Double
+  (#static MIN_VALUE Double)
+  (#static MAX_VALUE Double))
+
+(def: $Object-Array $.Type (_t.array 1 ///.$Object))
+(def: $String $.Type (_t.class "java.lang.String" (list)))
+(def: $CharSequence $.Type (_t.class "java.lang.CharSequence" (list)))
+
+(def: lux-intI Inst (|>> _.I2L (_.wrap #$.Long)))
+(def: jvm-intI Inst (|>> (_.unwrap #$.Long) _.L2I))
+(def: check-stringI Inst (_.CHECKCAST "java.lang.String"))
+
+(def: (predicateI tester)
+  (-> (-> Label Inst)
+      Inst)
+  (<| _.with-label (function (_ @then))
+      _.with-label (function (_ @end))
+      (|>> (tester @then)
+           (_.GETSTATIC "java.lang.Boolean" "FALSE" (_t.class "java.lang.Boolean" (list)))
+           (_.GOTO @end)
+           (_.label @then)
+           (_.GETSTATIC "java.lang.Boolean" "TRUE" (_t.class "java.lang.Boolean" (list)))
+           (_.label @end)
+           )))
+
+(def: unitI Inst (_.string synthesis.unit))
+
+(def: (lux::is [referenceI sampleI])
+  (Binary Inst)
+  (|>> referenceI
+       sampleI
+       (predicateI _.IF_ACMPEQ)))
+
+(def: (lux::try riskyI)
+  (Unary Inst)
+  (|>> riskyI
+       (_.CHECKCAST ///.function-class)
+       (_.INVOKESTATIC ///.runtime-class "try"
+                       (_t.method (list ///.$Function) (#.Some $Object-Array) (list))
+                       #0)))
+
+(template [<name> <op>]
+  [(def: (<name> [maskI inputI])
+     (Binary Inst)
+     (|>> inputI (_.unwrap #$.Long)
+          maskI (_.unwrap #$.Long)
+          <op> (_.wrap #$.Long)))]
+
+  [bit::and _.LAND]
+  [bit::or  _.LOR]
+  [bit::xor _.LXOR]
+  )
+
+(template [<name> <op>]
+  [(def: (<name> [shiftI inputI])
+     (Binary Inst)
+     (|>> inputI (_.unwrap #$.Long)
+          shiftI jvm-intI
+          <op>
+          (_.wrap #$.Long)))]
+
+  [bit::left-shift             _.LSHL]
+  [bit::arithmetic-right-shift _.LSHR]
+  [bit::logical-right-shift    _.LUSHR]
+  )
+
+(template [<name> <const> <type>]
+  [(def: (<name> _)
+     (Nullary Inst)
+     (|>> <const> (_.wrap <type>)))]
+
+  [frac::smallest (_.double (Double::MIN_VALUE))            #$.Double]
+  [frac::min      (_.double (f/* -1.0 (Double::MAX_VALUE))) #$.Double]
+  [frac::max      (_.double (Double::MAX_VALUE))            #$.Double]
+  )
+
+(template [<name> <type> <op>]
+  [(def: (<name> [paramI subjectI])
+     (Binary Inst)
+     (|>> subjectI (_.unwrap <type>)
+          paramI (_.unwrap <type>)
+          <op>
+          (_.wrap <type>)))]
+
+  [i64::+  #$.Long   _.LADD]
+  [i64::-  #$.Long   _.LSUB]
+  [int::*  #$.Long   _.LMUL]
+  [int::/  #$.Long   _.LDIV]
+  [int::%  #$.Long   _.LREM]
+  
+  [frac::+ #$.Double _.DADD]
+  [frac::- #$.Double _.DSUB]
+  [frac::* #$.Double _.DMUL]
+  [frac::/ #$.Double _.DDIV]
+  [frac::% #$.Double _.DREM]
+  )
+
+(template [<eq> <lt> <unwrap> <cmp>]
+  [(template [<name> <reference>]
+     [(def: (<name> [paramI subjectI])
+        (Binary Inst)
+        (|>> subjectI <unwrap>
+             paramI <unwrap>
+             <cmp>
+             (_.int <reference>)
+             (predicateI _.IF_ICMPEQ)))]
+     
+     [<eq> +0]
+     [<lt> -1])]
+
+  [i64::= int::< (_.unwrap #$.Long)   _.LCMP]
+  [frac::= frac::< (_.unwrap #$.Double) _.DCMPG]
+  )
+
+(template [<name> <prepare> <transform>]
+  [(def: (<name> inputI)
+     (Unary Inst)
+     (|>> inputI <prepare> <transform>))]
+
+  [int::frac (_.unwrap #$.Long) (<| (_.wrap #$.Double) _.L2D)]
+  [int::char (_.unwrap #$.Long)
+   ((|>> _.L2I _.I2C (_.INVOKESTATIC "java.lang.Character" "toString" (_t.method (list _t.char) (#.Some $String) (list)) #0)))]
+
+  [frac::int (_.unwrap #$.Double) (<| (_.wrap #$.Long) _.D2L)]
+  [frac::encode (_.unwrap #$.Double)
+   (_.INVOKESTATIC "java.lang.Double" "toString" (_t.method (list _t.double) (#.Some $String) (list)) #0)]
+  [frac::decode ..check-stringI
+   (_.INVOKESTATIC ///.runtime-class "decode_frac" (_t.method (list $String) (#.Some $Object-Array) (list)) #0)]
+  )
+
+(def: (text::size inputI)
+  (Unary Inst)
+  (|>> inputI
+       ..check-stringI
+       (_.INVOKEVIRTUAL "java.lang.String" "length" (_t.method (list) (#.Some _t.int) (list)) #0)
+       lux-intI))
+
+(template [<name> <pre-subject> <pre-param> <op> <post>]
+  [(def: (<name> [paramI subjectI])
+     (Binary Inst)
+     (|>> subjectI <pre-subject>
+          paramI <pre-param>
+          <op> <post>))]
+
+  [text::= (<|) (<|)
+   (_.INVOKEVIRTUAL "java.lang.Object" "equals" (_t.method (list ///.$Object) (#.Some _t.boolean) (list)) #0)
+   (_.wrap #$.Boolean)]
+  [text::< ..check-stringI ..check-stringI
+   (_.INVOKEVIRTUAL "java.lang.String" "compareTo" (_t.method (list $String) (#.Some _t.int) (list)) #0)
+   (predicateI _.IFLT)]
+  [text::char ..check-stringI jvm-intI
+   (_.INVOKEVIRTUAL "java.lang.String" "charAt" (_t.method (list _t.int) (#.Some _t.char) (list)) #0)
+   lux-intI]
+  )
+
+(def: (text::concat [leftI rightI])
+  (Binary Inst)
+  (|>> leftI ..check-stringI
+       rightI ..check-stringI
+       (_.INVOKEVIRTUAL "java.lang.String" "concat" (_t.method (list $String) (#.Some $String) (list)) #0)))
+
+(def: (text::clip [startI endI subjectI])
+  (Trinary Inst)
+  (|>> subjectI ..check-stringI
+       startI jvm-intI
+       endI jvm-intI
+       (_.INVOKEVIRTUAL "java.lang.String" "substring" (_t.method (list _t.int _t.int) (#.Some $String) (list)) #0)))
+
+(def: index-method Method (_t.method (list $String _t.int) (#.Some _t.int) (list)))
+(def: (text::index [startI partI textI])
+  (Trinary Inst)
+  (<| _.with-label (function (_ @not-found))
+      _.with-label (function (_ @end))
+      (|>> textI ..check-stringI
+           partI ..check-stringI
+           startI jvm-intI
+           (_.INVOKEVIRTUAL "java.lang.String" "indexOf" index-method #0)
+           _.DUP
+           (_.int -1)
+           (_.IF_ICMPEQ @not-found)
+           lux-intI
+           runtime.someI
+           (_.GOTO @end)
+           (_.label @not-found)
+           _.POP
+           runtime.noneI
+           (_.label @end))))
+
+(def: string-method Method (_t.method (list $String) #.None (list)))
+(def: (io::log messageI)
+  (Unary Inst)
+  (|>> (_.GETSTATIC "java.lang.System" "out" (_t.class "java.io.PrintStream" (list)))
+       messageI
+       ..check-stringI
+       (_.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method #0)
+       unitI))
+
+(def: (io::error messageI)
+  (Unary Inst)
+  (|>> (_.NEW "java.lang.Error")
+       _.DUP
+       messageI
+       ..check-stringI
+       (_.INVOKESPECIAL "java.lang.Error" "<init>" string-method #0)
+       _.ATHROW))
+
+(def: (io::exit codeI)
+  (Unary Inst)
+  (|>> codeI jvm-intI
+       (_.INVOKESTATIC "java.lang.System" "exit" (_t.method (list _t.int) #.None (list)) #0)
+       _.NULL))
+
+(def: (io::current-time _)
+  (Nullary Inst)
+  (|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" (_t.method (list) (#.Some _t.long) (list)) #0)
+       (_.wrap #$.Long)))
+
+(def: bundle::lux
+  Bundle
+  (|> (: Bundle bundle.empty)
+      (bundle.install "is" (binary lux::is))
+      (bundle.install "try" (unary lux::try))))
+
+(def: bundle::i64
+  Bundle
+  (<| (bundle.prefix "i64")
+      (|> (: Bundle bundle.empty)
+          (bundle.install "and" (binary bit::and))
+          (bundle.install "or" (binary bit::or))
+          (bundle.install "xor" (binary bit::xor))
+          (bundle.install "left-shift" (binary bit::left-shift))
+          (bundle.install "logical-right-shift" (binary bit::logical-right-shift))
+          (bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift))
+          (bundle.install "+" (binary i64::+))
+          (bundle.install "-" (binary i64::-))
+          (bundle.install "=" (binary i64::=)))))
+
+(def: bundle::int
+  Bundle
+  (<| (bundle.prefix "int")
+      (|> (: Bundle bundle.empty)
+          (bundle.install "*" (binary int::*))
+          (bundle.install "/" (binary int::/))
+          (bundle.install "%" (binary int::%))
+          (bundle.install "<" (binary int::<))
+          (bundle.install "frac" (unary int::frac))
+          (bundle.install "char" (unary int::char)))))
+
+(def: bundle::frac
+  Bundle
+  (<| (bundle.prefix "frac")
+      (|> (: Bundle bundle.empty)
+          (bundle.install "+" (binary frac::+))
+          (bundle.install "-" (binary frac::-))
+          (bundle.install "*" (binary frac::*))
+          (bundle.install "/" (binary frac::/))
+          (bundle.install "%" (binary frac::%))
+          (bundle.install "=" (binary frac::=))
+          (bundle.install "<" (binary frac::<))
+          (bundle.install "smallest" (nullary frac::smallest))
+          (bundle.install "min" (nullary frac::min))
+          (bundle.install "max" (nullary frac::max))
+          (bundle.install "int" (unary frac::int))
+          (bundle.install "encode" (unary frac::encode))
+          (bundle.install "decode" (unary frac::decode)))))
+
+(def: bundle::text
+  Bundle
+  (<| (bundle.prefix "text")
+      (|> (: Bundle bundle.empty)
+          (bundle.install "=" (binary text::=))
+          (bundle.install "<" (binary text::<))
+          (bundle.install "concat" (binary text::concat))
+          (bundle.install "index" (trinary text::index))
+          (bundle.install "size" (unary text::size))
+          (bundle.install "char" (binary text::char))
+          (bundle.install "clip" (trinary text::clip)))))
+
+(def: bundle::io
+  Bundle
+  (<| (bundle.prefix "io")
+      (|> (: Bundle bundle.empty)
+          (bundle.install "log" (unary io::log))
+          (bundle.install "error" (unary io::error))
+          (bundle.install "exit" (unary io::exit))
+          (bundle.install "current-time" (nullary io::current-time)))))
+
+(def: #export bundle
+  Bundle
+  (<| (bundle.prefix "lux")
+      (|> bundle::lux
+          (dictionary.merge bundle::i64)
+          (dictionary.merge bundle::int)
+          (dictionary.merge bundle::frac)
+          (dictionary.merge bundle::text)
+          (dictionary.merge bundle::io))))