Made some new-luxc modules "old".

1 files changed, 0 insertions, 361 deletions

diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
deleted file mode 100644
index d21729d0e..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ /dev/null
@@ -1,361 +0,0 @@
-(.module:
-  [lux #*
-   [abstract
-    [monad (#+ do)]]
-   [data
-    [text
-     format]
-    [collection
-     ["." list ("#/." functor)]]]
-   ["." math]
-   [tool
-    [compiler
-     [analysis (#+ Arity)]
-     ["." synthesis]
-     ["." phase
-      ["." generation]]]]]
-  [luxc
-   [lang
-    [host
-     ["$" jvm (#+ Label Inst Method Def Operation)
-      ["$t" type]
-      ["$d" def]
-      ["_" inst]]]]]
-  ["." // (#+ ByteCode)])
-
-(def: $Object $.Type ($t.class "java.lang.Object" (list)))
-(def: $Object-Array $.Type ($t.array 1 $Object))
-(def: $String $.Type ($t.class "java.lang.String" (list)))
-(def: #export $Stack $.Type ($t.array 1 $Object))
-(def: #export $Tuple $.Type $Object-Array)
-(def: #export $Variant $.Type $Object-Array)
-(def: #export $Tag $.Type $t.int)
-(def: #export $Flag $.Type $Object)
-(def: #export $Datum $.Type $Object)
-(def: #export $Function $.Type ($t.class //.function-class (list)))
-(def: $Throwable $.Type ($t.class "java.lang.Throwable" (list)))
-(def: $Runtime $.Type ($t.class "java.lang.Runtime" (list)))
-
-(def: #export logI
-  Inst
-  (let [outI (_.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list)))
-        printI (function (_ method) (_.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) #0))]
-    (|>> outI (_.string "LOG: ") (printI "print")
-         outI _.SWAP (printI "println"))))
-
-(def: variant-method
-  Method
-  ($t.method (list $t.int $Object $Object) (#.Some $Object-Array) (list)))
-
-(def: #export variantI
-  Inst
-  (_.INVOKESTATIC //.runtime-class "variant_make" variant-method #0))
-
-(def: #export leftI
-  Inst
-  (|>> (_.int +0)
-       _.NULL
-       _.DUP2_X1
-       _.POP2
-       variantI))
-
-(def: #export rightI
-  Inst
-  (|>> (_.int +1)
-       (_.string "")
-       _.DUP2_X1
-       _.POP2
-       variantI))
-
-(def: #export someI Inst rightI)
-
-(def: #export noneI
-  Inst
-  (|>> (_.int +0)
-       _.NULL
-       (_.string synthesis.unit)
-       variantI))
-
-(def: (try-methodI unsafeI)
-  (-> Inst Inst)
-  (<| _.with-label (function (_ @from))
-      _.with-label (function (_ @to))
-      _.with-label (function (_ @handler))
-      (|>> (_.try @from @to @handler "java.lang.Exception")
-           (_.label @from)
-           unsafeI
-           someI
-           _.ARETURN
-           (_.label @to)
-           (_.label @handler)
-           noneI
-           _.ARETURN)))
-
-(def: #export string-concatI
-  Inst
-  (_.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0))
-
-(def: #export partials-field Text "partials")
-(def: #export apply-method Text "apply")
-(def: #export num-apply-variants Nat 8)
-
-(def: #export (apply-signature arity)
-  (-> Arity Method)
-  ($t.method (list.repeat arity $Object) (#.Some $Object) (list)))
-
-(def: adt-methods
-  Def
-  (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap #$.Int) _.AASTORE)
-        store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE)
-        store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)]
-    (|>> ($d.method #$.Public $.staticM "variant_make"
-                    ($t.method (list $t.int $Object $Object)
-                               (#.Some $Variant)
-                               (list))
-                    (|>> (_.int +3)
-                         (_.array $Object)
-                         store-tagI
-                         store-flagI
-                         store-valueI
-                         _.ARETURN)))))
-
-(def: frac-shiftI Inst (_.double (math.pow +32.0 +2.0)))
-
-(def: frac-methods
-  Def
-  (|>> ($d.method #$.Public $.staticM "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list))
-                  (try-methodI
-                   (|>> (_.ALOAD 0)
-                        (_.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) #0)
-                        (_.wrap #$.Double))))
-       ))
-
-(def: pm-methods
-  Def
-  (let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH)
-        last-rightI (|>> tuple-sizeI (_.int +1) _.ISUB)
-        leftsI (_.ILOAD 1)
-        left-indexI leftsI
-        sub-leftsI (|>> leftsI
-                        last-rightI
-                        _.ISUB)
-        sub-tupleI (|>> (_.ALOAD 0) last-rightI _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple)))
-        recurI (: (-> Label Inst)
-                  (function (_ @loop)
-                    (|>> sub-leftsI (_.ISTORE 1)
-                         sub-tupleI (_.ASTORE 0)
-                         (_.GOTO @loop))))]
-    (|>> ($d.method #$.Public $.staticM "pm_fail" ($t.method (list) #.None (list))
-                    (|>> (_.NEW "java.lang.IllegalStateException")
-                         _.DUP
-                         (_.string "Invalid expression for pattern-matching.")
-                         (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0)
-                         _.ATHROW))
-         ($d.method #$.Public $.staticM "apply_fail" ($t.method (list) #.None (list))
-                    (|>> (_.NEW "java.lang.IllegalStateException")
-                         _.DUP
-                         (_.string "Error while applying function.")
-                         (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0)
-                         _.ATHROW))
-         ($d.method #$.Public $.staticM "pm_push" ($t.method (list $Stack $Object) (#.Some $Stack) (list))
-                    (|>> (_.int +2)
-                         (_.ANEWARRAY "java.lang.Object")
-                         _.DUP
-                         (_.int +0)
-                         (_.ALOAD 0)
-                         _.AASTORE
-                         _.DUP
-                         (_.int +1)
-                         (_.ALOAD 1)
-                         _.AASTORE
-                         _.ARETURN))
-         ($d.method #$.Public $.staticM "pm_pop" ($t.method (list $Stack) (#.Some $Stack) (list))
-                    (|>> (_.ALOAD 0)
-                         (_.int +0)
-                         _.AALOAD
-                         (_.CHECKCAST ($t.descriptor $Stack))
-                         _.ARETURN))
-         ($d.method #$.Public $.staticM "pm_peek" ($t.method (list $Stack) (#.Some $Object) (list))
-                    (|>> (_.ALOAD 0)
-                         (_.int +1)
-                         _.AALOAD
-                         _.ARETURN))
-         ($d.method #$.Public $.staticM "pm_variant" ($t.method (list $Variant $Tag $Flag) (#.Some $Object) (list))
-                    (<| _.with-label (function (_ @loop))
-                        _.with-label (function (_ @just-return))
-                        _.with-label (function (_ @then))
-                        _.with-label (function (_ @further))
-                        _.with-label (function (_ @shorten))
-                        _.with-label (function (_ @wrong))
-                        (let [variant-partI (: (-> Nat Inst)
-                                               (function (_ idx)
-                                                 (|>> (_.int (.int idx)) _.AALOAD)))
-                              tagI (: Inst
-                                      (|>> (variant-partI 0) (_.unwrap #$.Int)))
-                              flagI (variant-partI 1)
-                              datumI (variant-partI 2)
-                              shortenI (|>> (_.ALOAD 0) tagI ## Get tag
-                                            (_.ILOAD 1) _.ISUB ## Shorten tag
-                                            (_.ALOAD 0) flagI ## Get flag
-                                            (_.ALOAD 0) datumI ## Get value
-                                            variantI ## Build sum
-                                            _.ARETURN)
-                              update-tagI (|>> _.ISUB (_.ISTORE 1))
-                              update-variantI (|>> (_.ALOAD 0) datumI (_.CHECKCAST ($t.descriptor $Variant)) (_.ASTORE 0))
-                              failureI (|>> _.NULL _.ARETURN)
-                              return-datumI (|>> (_.ALOAD 0) datumI _.ARETURN)])
-                        (|>> (_.label @loop)
-                             (_.ILOAD 1) ## tag
-                             (_.ALOAD 0) tagI ## tag, sumT
-                             _.DUP2 (_.IF_ICMPEQ @then)
-                             _.DUP2 (_.IF_ICMPGT @further)
-                             _.DUP2 (_.IF_ICMPLT @shorten)
-                             ## _.POP2
-                             failureI
-                             (_.label @then) ## tag, sumT
-                             (_.ALOAD 2) ## tag, sumT, wants-last?
-                             (_.ALOAD 0) flagI ## tag, sumT, wants-last?, is-last?
-                             (_.IF_ACMPEQ @just-return) ## tag, sumT
-                             (_.label @further) ## tag, sumT
-                             (_.ALOAD 0) flagI ## tag, sumT, last?
-                             (_.IFNULL @wrong) ## tag, sumT
-                             update-tagI
-                             update-variantI
-                             (_.GOTO @loop)
-                             (_.label @just-return) ## tag, sumT
-                             ## _.POP2
-                             return-datumI
-                             (_.label @shorten) ## tag, sumT
-                             (_.ALOAD 2) (_.IFNULL @wrong)
-                             ## _.POP2
-                             shortenI
-                             (_.label @wrong) ## tag, sumT
-                             ## _.POP2
-                             failureI)))
-         ($d.method #$.Public $.staticM "tuple_left" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
-                    (<| _.with-label (function (_ @loop))
-                        _.with-label (function (_ @recursive))
-                        (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)])
-                        (|>> (_.label @loop)
-                             leftsI last-rightI (_.IF_ICMPGE @recursive)
-                             left-accessI
-                             _.ARETURN
-                             (_.label @recursive)
-                             ## Recursive
-                             (recurI @loop))))
-         ($d.method #$.Public $.staticM "tuple_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
-                    (<| _.with-label (function (_ @loop))
-                        _.with-label (function (_ @not-tail))
-                        _.with-label (function (_ @slice))
-                        (let [right-indexI (|>> leftsI
-                                                (_.int +1)
-                                                _.IADD)
-                              right-accessI (|>> (_.ALOAD 0)
-                                                 _.SWAP
-                                                 _.AALOAD)
-                              sub-rightI (|>> (_.ALOAD 0)
-                                              right-indexI
-                                              tuple-sizeI
-                                              (_.INVOKESTATIC "java.util.Arrays" "copyOfRange"
-                                                              ($t.method (list $Object-Array $t.int $t.int)
-                                                                         (#.Some $Object-Array)
-                                                                         (list))
-                                                              #0))])
-                        (|>> (_.label @loop)
-                             last-rightI right-indexI
-                             _.DUP2 (_.IF_ICMPNE @not-tail)
-                             ## _.POP
-                             right-accessI
-                             _.ARETURN
-                             (_.label @not-tail)
-                             (_.IF_ICMPGT @slice)
-                             ## Must recurse
-                             (recurI @loop)
-                             (_.label @slice)
-                             sub-rightI
-                             _.ARETURN
-                             )))
-         )))
-
-(def: io-methods
-  Def
-  (let [string-writerI (|>> (_.NEW "java.io.StringWriter")
-                            _.DUP
-                            (_.INVOKESPECIAL "java.io.StringWriter" "<init>" ($t.method (list) #.None (list)) #0))
-        print-writerI (|>> (_.NEW "java.io.PrintWriter")
-                           _.SWAP
-                           _.DUP2
-                           _.POP
-                           _.SWAP
-                           (_.boolean #1)
-                           (_.INVOKESPECIAL "java.io.PrintWriter" "<init>" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) #0)
-                           )]
-    (|>> ($d.method #$.Public $.staticM "try" ($t.method (list $Function) (#.Some $Variant) (list))
-                    (<| _.with-label (function (_ @from))
-                        _.with-label (function (_ @to))
-                        _.with-label (function (_ @handler))
-                        (|>> (_.try @from @to @handler "java.lang.Throwable")
-                             (_.label @from)
-                             (_.ALOAD 0)
-                             _.NULL
-                             (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature 1) #0)
-                             rightI
-                             _.ARETURN
-                             (_.label @to)
-                             (_.label @handler)
-                             string-writerI ## TW
-                             _.DUP2 ## TWTW
-                             print-writerI ## TWTP
-                             (_.INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t.method (list ($t.class "java.io.PrintWriter" (list))) #.None (list)) #0) ## TW
-                             (_.INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t.method (list) (#.Some $String) (list)) #0) ## TS
-                             _.SWAP _.POP leftI
-                             _.ARETURN)))
-         )))
-
-(def: translate-runtime
-  (Operation ByteCode)
-  (let [bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runtime-class (list) ["java.lang.Object" (list)] (list)
-                           (|>> adt-methods
-                                frac-methods
-                                pm-methods
-                                io-methods))]
-    (do phase.monad
-      [_ (generation.execute! //.runtime-class [//.runtime-class bytecode])]
-      (wrap bytecode))))
-
-(def: translate-function
-  (Operation ByteCode)
-  (let [applyI (|> (list.n/range 2 num-apply-variants)
-                   (list/map (function (_ arity)
-                               ($d.method #$.Public $.noneM apply-method (apply-signature arity)
-                                          (let [preI (|> (list.n/range 0 (dec arity))
-                                                         (list/map _.ALOAD)
-                                                         _.fuse)]
-                                            (|>> preI
-                                                 (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0)
-                                                 (_.CHECKCAST //.function-class)
-                                                 (_.ALOAD arity)
-                                                 (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature 1) #0)
-                                                 _.ARETURN)))))
-                   (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature 1)))
-                   $d.fuse)
-        bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) ["java.lang.Object" (list)] (list)
-                              (|>> ($d.field #$.Public $.finalF partials-field $t.int)
-                                   ($d.method #$.Public $.noneM "<init>" ($t.method (list $t.int) #.None (list))
-                                              (|>> (_.ALOAD 0)
-                                                   (_.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0)
-                                                   (_.ALOAD 0)
-                                                   (_.ILOAD 1)
-                                                   (_.PUTFIELD //.function-class partials-field $t.int)
-                                                   _.RETURN))
-                                   applyI))]
-    (do phase.monad
-      [_ (generation.execute! //.function-class [//.function-class bytecode])]
-      (wrap bytecode))))
-
-(def: #export translate
-  (Operation Any)
-  (do phase.monad
-    [runtime-bc translate-runtime
-     function-bc translate-function]
-    (wrap [])))