- Updated new compiler's code to the recent changes in the language.

- WIP: Some other changes/additions to the new compiler.

1 files changed, 144 insertions, 3 deletions

diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux
index e6a12d6fa..fe7a4b2cb 100644
--- a/new-luxc/source/luxc/generator/runtime.jvm.lux
+++ b/new-luxc/source/luxc/generator/runtime.jvm.lux
@@ -3,6 +3,7 @@
   (lux (control monad)
        (data ["R" result]
              text/format)
+       [math]
        [macro #+ Monad<Lux> "Lux/" Monad<Lux>]
        [host #+ jvm-import do-to])
   (luxc ["&" base]
@@ -44,6 +45,8 @@
 (def: #export unit Text "\u0000")
 
 (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: logI
   $;Inst
@@ -52,9 +55,28 @@
     (|>. outI ($i;string "LOG: ") (printI "print")
          outI $i;SWAP (printI "println"))))
 
+(def: sum-method
+  $;Method
+  ($t;method (list $t;int $Object $Object) (#;Some $Object-Array) (list)))
+
+(def: #export someI
+  $;Inst
+  (|>. ($i;int 1)
+       ($i;string "")
+       $i;DUP2_X1
+       $i;POP2
+       ($i;INVOKESTATIC runtime-name "sum_make" sum-method false)))
+
+(def: #export noneI
+  $;Inst
+  (|>. ($i;int 0)
+       $i;NULL
+       ($i;string unit)
+       ($i;INVOKESTATIC runtime-name "sum_make" sum-method false)))
+
 (def: add-adt-methods
   $;Def
-  (let [store-tag (|>. $i;DUP ($i;int 0) ($i;ILOAD +0) $i;wrap-int $i;AASTORE)
+  (let [store-tag (|>. $i;DUP ($i;int 0) ($i;ILOAD +0) ($i;wrap #$;Int) $i;AASTORE)
         store-flag (|>. $i;DUP ($i;int 1) ($i;ALOAD +1) $i;AASTORE)
         store-value (|>. $i;DUP ($i;int 2) ($i;ALOAD +2) $i;AASTORE)]
     (|>. ($d;method #$;Public $;staticM "sum_make"
@@ -159,7 +181,125 @@
                                $i;LRETURN))))
          )))
 
-(def: init-method $;Method ($t;method (list) #;None (list)))
+(def: frac-shiftI $;Inst ($i;double (math;pow 32.0 2.0)))
+
+(def: add-frac-methods
+  $;Def
+  (|>. ($d;method #$;Public $;staticM "decode_frac" ($t;method (list $String) (#;Some $Object-Array) (list))
+                  (<| $i;with-label (function [@from])
+                      $i;with-label (function [@to])
+                      $i;with-label (function [@handler])
+                      (|>. ($i;try @from @to @handler "java.lang.Exception")
+                           ($i;label @from)
+                           ($i;ALOAD +0)
+                           ($i;INVOKESTATIC "java.lang.Double" "parseDouble" ($t;method (list $String) (#;Some $t;double) (list)) false)
+                           ($i;wrap #$;Double)
+                           someI
+                           $i;ARETURN
+                           ($i;label @to)
+                           ($i;label @handler)
+                           noneI
+                           $i;ARETURN)))
+       ($d;method #$;Public $;staticM "frac_to_deg" ($t;method (list $t;double) (#;Some $t;long) (list))
+                  (let [swap2 (|>. $i;DUP2_X2 $i;POP2)
+                        drop-excessI (|>. ($i;double 1.0) $i;DREM)
+                        shiftI (|>. frac-shiftI $i;DMUL)]
+                    (|>. ($i;DLOAD +0)
+                         ## Get upper half
+                         drop-excessI
+                         shiftI
+                         ## Make a copy, so the lower half can be extracted
+                         $i;DUP2
+                         ## Get lower half
+                         drop-excessI
+                         shiftI
+                         ## Turn it into a deg
+                         $i;D2L
+                         ## Turn the upper half into deg too
+                         swap2
+                         $i;D2L
+                         ## Combine both pieces
+                         $i;LADD
+                         ## FINISH
+                         $i;LRETURN
+                         )))
+       ))
+
+(def: deg-bits Nat +64)
+(def: deg-method $;Method ($t;method (list $t;long $t;long) (#;Some $t;long) (list)))
+(def: clz-method $;Method ($t;method (list $t;long) (#;Some $t;int) (list)))
+
+(def: add-deg-methods
+  $;Def
+  (let [## "And" mask corresponding to -1 (FFFF...), on the low 32 bits.
+        low-half (|>. ($i;int -1) $i;I2L $i;LAND)
+        high-half (|>. ($i;int 32) $i;LUSHR)]
+    (|>. ($d;method #$;Public $;staticM "mul_deg" deg-method
+                    ## Based on: http://stackoverflow.com/a/31629280/6823464
+                    (let [shift-downI (|>. ($i;int 32) $i;LUSHR)
+                          low-leftI (|>. ($i;LLOAD +0) low-half)
+                          high-leftI (|>. ($i;LLOAD +0) high-half)
+                          low-rightI (|>. ($i;LLOAD +2) low-half)
+                          high-rightI (|>. ($i;LLOAD +2) high-half)
+                          bottomI (|>. low-leftI low-rightI $i;LMUL)
+                          middleLI (|>. high-leftI low-rightI $i;LMUL)
+                          middleRI (|>. low-leftI high-rightI $i;LMUL)
+                          middleI (|>. middleLI middleRI $i;LADD)
+                          topI (|>. high-leftI high-rightI $i;LMUL)]
+                      (|>. bottomI shift-downI
+                           middleI $i;LADD shift-downI
+                           topI $i;LADD
+                           $i;LRETURN)))
+         ($d;method #$;Public $;staticM "count_leading_zeros" clz-method
+                    (let [when-zeroI (function [@where] (|>. ($i;long 0) $i;LCMP ($i;IFEQ @where)))
+                          shift-rightI (function [amount] (|>. ($i;int amount) $i;LUSHR))
+                          decI (|>. ($i;int 1) $i;ISUB)]
+                      (<| $i;with-label (function [@start])
+                          $i;with-label (function [@done])
+                          (|>. ($i;int 64)
+                               ($i;label @start)
+                               ($i;LLOAD +0) (when-zeroI @done)
+                               ($i;LLOAD +0) (shift-rightI 1) ($i;LSTORE +0)
+                               decI
+                               ($i;GOTO @start)
+                               ($i;label @done)
+                               $i;IRETURN))))
+         ($d;method #$;Public $;staticM "div_deg" deg-method
+                    (<| $i;with-label (function [@same])
+                        (let [subjectI ($i;LLOAD +0)
+                              paramI ($i;LLOAD +2)
+                              equal?I (function [@where] (|>. $i;LCMP ($i;IFEQ @where)))
+                              count-leading-zerosI ($i;INVOKESTATIC runtime-name "count_leading_zeros" clz-method false)
+                              calc-max-shiftI (|>. subjectI count-leading-zerosI
+                                                   paramI count-leading-zerosI
+                                                   ($i;INVOKESTATIC "java.lang.Math" "min" ($t;method (list $t;int $t;int) (#;Some $t;int) (list)) false)
+                                                   ($i;ISTORE +4))
+                              shiftI (|>. ($i;ILOAD +4) $i;LSHL)
+                              imprecise-divisionI (|>. subjectI shiftI
+                                                       paramI shiftI high-half
+                                                       $i;LDIV)
+                              scale-downI (|>. ($i;int 32) $i;LSHL)]
+                          (|>. subjectI paramI
+                               (equal?I @same)
+                               ## Based on: http://stackoverflow.com/a/8510587/6823464
+                               ## Shifting the operands as much as possible can help
+                               ## avoid some loss of precision later.
+                               calc-max-shiftI
+                               imprecise-divisionI
+                               scale-downI
+                               $i;LRETURN
+                               ($i;label @same)
+                               ($i;long -1) ## ~= 1.0 Degrees
+                               $i;LRETURN))))
+         ($d;method #$;Public $;staticM "deg_to_frac" ($t;method (list $t;long) (#;Some $t;double) (list))
+                    (let [highI (|>. ($i;LLOAD +0) high-half $i;L2D)
+                          lowI (|>. ($i;LLOAD +0) low-half $i;L2D)
+                          scaleI (|>. frac-shiftI $i;DDIV)]
+                      (|>. highI scaleI
+                           lowI scaleI scaleI
+                           $i;DADD
+                           $i;DRETURN)))
+         )))
 
 (def: #export generate
   (Lux &common;Bytecode)
@@ -168,6 +308,7 @@
      #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC runtime-name (list) ["java.lang.Object" (list)] (list)
                               (|>. add-adt-methods
                                    add-nat-methods
-                                   ))]
+                                   add-frac-methods
+                                   add-deg-methods))]
      _ (&common;store-class runtime-name bytecode)]
     (wrap bytecode)))