Some refactoring.

1 files changed, 0 insertions, 385 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
deleted file mode 100644
index a46813232..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
+++ /dev/null
@@ -1,385 +0,0 @@
-(.module:
-  [lux (#- Type)
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    ["." try]
-    ["<>" parser
-     ["<s>" synthesis (#+ Parser)]]
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["." product]
-    [number
-     ["f" frac]]
-    [collection
-     ["." list ("#@." monad)]
-     ["." dictionary]]]
-   [target
-    [jvm
-     ["." type
-      ["." signature]]]]
-   [tool
-    [compiler
-     ["." synthesis (#+ 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 Def Handler Bundle Operation Phase)
-      ["_" inst]]]]]
-  ["." ///
-   ["." runtime]])
-
-(def: #export (custom [parser handler])
-  (All [s]
-    (-> [(Parser s)
-         (-> Text Phase s (Operation Inst))]
-        Handler))
-  (function (_ extension-name phase input)
-    (case (<s>.run input parser)
-      (#try.Success input')
-      (handler extension-name phase input')
-
-      (#try.Failure error)
-      (phase.throw extension.invalid-syntax [extension-name %synthesis input]))))
-
-(import: java/lang/Double
-  (#static MIN_VALUE Double)
-  (#static MAX_VALUE Double))
-
-(def: $String (type.class "java.lang.String" (list)))
-(def: $CharSequence (type.class "java.lang.CharSequence" (list)))
-(def: $System (type.class "java.lang.System" (list)))
-(def: $Object (type.class "java.lang.Object" (list)))
-
-(def: lux-intI Inst (|>> _.I2L (_.wrap type.long)))
-(def: jvm-intI Inst (|>> (_.unwrap type.long) _.L2I))
-(def: check-stringI Inst (_.CHECKCAST $String))
-
-(def: (predicateI tester)
-  (-> (-> Label Inst)
-      Inst)
-  (let [$Boolean (type.class "java.lang.Boolean" (list))]
-    (<| _.with-label (function (_ @then))
-        _.with-label (function (_ @end))
-        (|>> (tester @then)
-             (_.GETSTATIC $Boolean "FALSE" $Boolean)
-             (_.GOTO @end)
-             (_.label @then)
-             (_.GETSTATIC $Boolean "TRUE" $Boolean)
-             (_.label @end)
-             ))))
-
-(def: unitI Inst (_.string synthesis.unit))
-
-## TODO: Get rid of this ASAP
-(def: lux::syntax-char-case!
-  (..custom [($_ <>.and
-                 <s>.any
-                 <s>.any
-                 (<>.some (<s>.tuple ($_ <>.and
-                                         (<s>.tuple (<>.many <s>.i64))
-                                         <s>.any))))
-             (function (_ extension-name phase [input else conditionals])
-               (<| _.with-label (function (_ @end))
-                   _.with-label (function (_ @else))
-                   (do phase.monad
-                     [inputG (phase input)
-                      elseG (phase else)
-                      conditionalsG+ (: (Operation (List [(List [Int Label])
-                                                          Inst]))
-                                        (monad.map @ (function (_ [chars branch])
-                                                       (do @
-                                                         [branchG (phase branch)]
-                                                         (wrap (<| _.with-label (function (_ @branch))
-                                                                   [(list@map (function (_ char)
-                                                                                [(.int char) @branch])
-                                                                              chars)
-                                                                    (|>> (_.label @branch)
-                                                                         branchG
-                                                                         (_.GOTO @end))]))))
-                                                   conditionals))
-                      #let [table (|> conditionalsG+
-                                      (list@map product.left)
-                                      list@join)
-                            conditionalsG (|> conditionalsG+
-                                              (list@map product.right)
-                                              _.fuse)]]
-                     (wrap (|>> inputG (_.unwrap type.long) _.L2I
-                                (_.LOOKUPSWITCH @else table)
-                                conditionalsG
-                                (_.label @else)
-                                elseG
-                                (_.label @end)
-                                )))))]))
-
-(def: (lux::is [referenceI sampleI])
-  (Binary Inst)
-  (|>> referenceI
-       sampleI
-       (predicateI _.IF_ACMPEQ)))
-
-(def: (lux::try riskyI)
-  (Unary Inst)
-  (|>> riskyI
-       (_.CHECKCAST ///.$Function)
-       (_.INVOKESTATIC ///.$Runtime "try" runtime.try)))
-
-(template [<name> <op>]
-  [(def: (<name> [maskI inputI])
-     (Binary Inst)
-     (|>> inputI (_.unwrap type.long)
-          maskI (_.unwrap type.long)
-          <op> (_.wrap type.long)))]
-
-  [i64::and _.LAND]
-  [i64::or  _.LOR]
-  [i64::xor _.LXOR]
-  )
-
-(template [<name> <op>]
-  [(def: (<name> [shiftI inputI])
-     (Binary Inst)
-     (|>> inputI (_.unwrap type.long)
-          shiftI jvm-intI
-          <op>
-          (_.wrap type.long)))]
-
-  [i64::left-shift             _.LSHL]
-  [i64::arithmetic-right-shift _.LSHR]
-  [i64::logical-right-shift    _.LUSHR]
-  )
-
-(template [<name> <const> <type>]
-  [(def: (<name> _)
-     (Nullary Inst)
-     (|>> <const> (_.wrap <type>)))]
-
-  [f64::smallest (_.double (Double::MIN_VALUE))            type.double]
-  [f64::min      (_.double (f.* -1.0 (Double::MAX_VALUE))) type.double]
-  [f64::max      (_.double (Double::MAX_VALUE))            type.double]
-  )
-
-(template [<name> <type> <op>]
-  [(def: (<name> [paramI subjectI])
-     (Binary Inst)
-     (|>> subjectI (_.unwrap <type>)
-          paramI (_.unwrap <type>)
-          <op>
-          (_.wrap <type>)))]
-
-  [i64::+ type.long   _.LADD]
-  [i64::- type.long   _.LSUB]
-  [i64::* type.long   _.LMUL]
-  [i64::/ type.long   _.LDIV]
-  [i64::% type.long   _.LREM]
-  
-  [f64::+ type.double _.DADD]
-  [f64::- type.double _.DSUB]
-  [f64::* type.double _.DMUL]
-  [f64::/ type.double _.DDIV]
-  [f64::% type.double _.DREM]
-  )
-
-(template [<eq> <lt> <type> <cmp>]
-  [(template [<name> <reference>]
-     [(def: (<name> [paramI subjectI])
-        (Binary Inst)
-        (|>> subjectI (_.unwrap <type>)
-             paramI (_.unwrap <type>)
-             <cmp>
-             (_.int <reference>)
-             (predicateI _.IF_ICMPEQ)))]
-     
-     [<eq> +0]
-     [<lt> -1])]
-
-  [i64::= i64::< type.long   _.LCMP]
-  [f64::= f64::< type.double _.DCMPG]
-  )
-
-(template [<name> <prepare> <transform>]
-  [(def: (<name> inputI)
-     (Unary Inst)
-     (|>> inputI <prepare> <transform>))]
-
-  [i64::f64 (_.unwrap type.long) (<| (_.wrap type.double) _.L2D)]
-  [i64::char (_.unwrap type.long)
-   ((|>> _.L2I _.I2C (_.INVOKESTATIC (type.class "java.lang.Character" (list)) "toString" (type.method [(list type.char) $String (list)]))))]
-
-  [f64::i64 (_.unwrap type.double) (<| (_.wrap type.long) _.D2L)]
-  [f64::encode (_.unwrap type.double)
-   (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "toString" (type.method [(list type.double) $String (list)]))]
-  [f64::decode ..check-stringI
-   (_.INVOKESTATIC ///.$Runtime "decode_frac" (type.method [(list $String) ///.$Variant (list)]))]
-  )
-
-(def: (text::size inputI)
-  (Unary Inst)
-  (|>> inputI
-       ..check-stringI
-       (_.INVOKEVIRTUAL $String "length" (type.method [(list) type.int (list)]))
-       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 $Object "equals" (type.method [(list $Object) type.boolean (list)]))
-   (_.wrap type.boolean)]
-  [text::< ..check-stringI ..check-stringI
-   (_.INVOKEVIRTUAL $String "compareTo" (type.method [(list $String) type.int (list)]))
-   (predicateI _.IFLT)]
-  [text::char ..check-stringI jvm-intI
-   (_.INVOKEVIRTUAL $String "charAt" (type.method [(list type.int) type.char (list)]))
-   lux-intI]
-  )
-
-(def: (text::concat [leftI rightI])
-  (Binary Inst)
-  (|>> leftI ..check-stringI
-       rightI ..check-stringI
-       (_.INVOKEVIRTUAL $String "concat" (type.method [(list $String) $String (list)]))))
-
-(def: (text::clip [startI endI subjectI])
-  (Trinary Inst)
-  (|>> subjectI ..check-stringI
-       startI jvm-intI
-       endI jvm-intI
-       (_.INVOKEVIRTUAL $String "substring" (type.method [(list type.int type.int) $String (list)]))))
-
-(def: index-method (type.method [(list $String type.int) type.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 $String "indexOf" index-method)
-           _.DUP
-           (_.int -1)
-           (_.IF_ICMPEQ @not-found)
-           lux-intI
-           runtime.someI
-           (_.GOTO @end)
-           (_.label @not-found)
-           _.POP
-           runtime.noneI
-           (_.label @end))))
-
-(def: string-method (type.method [(list $String) type.void (list)]))
-(def: (io::log messageI)
-  (Unary Inst)
-  (let [$PrintStream (type.class "java.io.PrintStream" (list))]
-    (|>> (_.GETSTATIC $System "out" $PrintStream)
-         messageI
-         ..check-stringI
-         (_.INVOKEVIRTUAL $PrintStream "println" string-method)
-         unitI)))
-
-(def: (io::error messageI)
-  (Unary Inst)
-  (let [$Error (type.class "java.lang.Error" (list))]
-    (|>> (_.NEW $Error)
-         _.DUP
-         messageI
-         ..check-stringI
-         (_.INVOKESPECIAL $Error "<init>" string-method)
-         _.ATHROW)))
-
-(def: (io::exit codeI)
-  (Unary Inst)
-  (|>> codeI jvm-intI
-       (_.INVOKESTATIC $System "exit" (type.method [(list type.int) type.void (list)]))
-       _.NULL))
-
-(def: (io::current-time _)
-  (Nullary Inst)
-  (|>> (_.INVOKESTATIC $System "currentTimeMillis" (type.method [(list) type.long (list)]))
-       (_.wrap type.long)))
-
-(def: bundle::lux
-  Bundle
-  (|> (: Bundle bundle.empty)
-      (bundle.install "syntax char case!" lux::syntax-char-case!)
-      (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 i64::and))
-          (bundle.install "or" (binary i64::or))
-          (bundle.install "xor" (binary i64::xor))
-          (bundle.install "left-shift" (binary i64::left-shift))
-          (bundle.install "logical-right-shift" (binary i64::logical-right-shift))
-          (bundle.install "arithmetic-right-shift" (binary i64::arithmetic-right-shift))
-          (bundle.install "=" (binary i64::=))
-          (bundle.install "<" (binary i64::<))
-          (bundle.install "+" (binary i64::+))
-          (bundle.install "-" (binary i64::-))
-          (bundle.install "*" (binary i64::*))
-          (bundle.install "/" (binary i64::/))
-          (bundle.install "%" (binary i64::%))
-          (bundle.install "f64" (unary i64::f64))
-          (bundle.install "char" (unary i64::char)))))
-
-(def: bundle::f64
-  Bundle
-  (<| (bundle.prefix "f64")
-      (|> (: Bundle bundle.empty)
-          (bundle.install "+" (binary f64::+))
-          (bundle.install "-" (binary f64::-))
-          (bundle.install "*" (binary f64::*))
-          (bundle.install "/" (binary f64::/))
-          (bundle.install "%" (binary f64::%))
-          (bundle.install "=" (binary f64::=))
-          (bundle.install "<" (binary f64::<))
-          (bundle.install "smallest" (nullary f64::smallest))
-          (bundle.install "min" (nullary f64::min))
-          (bundle.install "max" (nullary f64::max))
-          (bundle.install "i64" (unary f64::i64))
-          (bundle.install "encode" (unary f64::encode))
-          (bundle.install "decode" (unary f64::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::f64)
-          (dictionary.merge bundle::text)
-          (dictionary.merge bundle::io))))