From ce4ffdcecd271b9cebf62d71977a2d5cb5a1a0ee Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 16 Nov 2021 03:15:39 -0400
Subject: 64-bit integers that work in both normal Ruby & DragonRuby.

---
 stdlib/source/library/lux/target/js.lux            |   8 +-
 stdlib/source/library/lux/target/ruby.lux          |  42 ++-
 .../lux/phase/extension/generation/ruby/common.lux |  23 +-
 .../language/lux/phase/generation/ruby/runtime.lux | 293 ++++++++++++++++-----
 stdlib/source/test/lux.lux                         |  10 +-
 stdlib/source/test/lux/math/number/frac.lux        |  48 ++--
 6 files changed, 308 insertions(+), 116 deletions(-)

(limited to 'stdlib')

diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux
index 88ad9ff5e..6ee7a793c 100644
--- a/stdlib/source/library/lux/target/js.lux
+++ b/stdlib/source/library/lux/target/js.lux
@@ -243,14 +243,14 @@
     [bit_and "&"]
     )
 
-  (template [<name> <prefix>]
+  (template [<prefix> <name>]
     [(def: .public <name>
        (-> Expression Computation)
        (|>> :representation (text.prefix <prefix>) ..expression :abstraction))]
 
-    [not "!"]
-    [bit_not "~"]
-    [opposite "-"]
+    ["!" not]
+    ["~" bit_not]
+    ["-" opposite]
     )
 
   (template [<name> <input> <format>]
diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux
index eb0f542ac..3280ac134 100644
--- a/stdlib/source/library/lux/target/ruby.lux
+++ b/stdlib/source/library/lux/target/ruby.lux
@@ -221,18 +221,30 @@
     (format content
             \n+ "end" ..statement_suffix))
 
-  (def: .public (apply/* arguments block_lambda func)
-    (-> (List Expression) (Maybe Expression) Expression Computation)
+  (type: .public Block
+    [(List LVar)
+     Statement])
+
+  (def: .public (apply/* arguments block func)
+    (-> (List Expression) (Maybe Block) Expression Computation)
     (let [arguments (|> arguments
                         (list#each (|>> :representation))
                         (text.interposed ..input_separator)
                         (text.enclosed ["(" ")"]))
-          block (case block_lambda
+          block (case block
                   {.#None}
                   ""
                   
-                  {.#Some lambda}
-                  (format " &" (:representation lambda)))]
+                  {.#Some [inputs block]}
+                  (|> block
+                      :representation
+                      nested
+                      control_structure
+                      (format " do "
+                              (|> inputs
+                                  (list#each (|>> :representation))
+                                  (text.interposed ..input_separator)
+                                  (text.enclosed' "|")))))]
       (:abstraction (format (:representation func) arguments block))))
 
   (def: .public (the field object)
@@ -413,6 +425,7 @@
        (:abstraction (format "(" <unary> (:representation subject) ")")))]
 
     ["!" not]
+    ["~" bit_not]
     ["-" opposite]
     )
 
@@ -420,11 +433,24 @@
     (All (_ brand) (-> Text (Code brand) (Code brand)))
     (:abstraction (format "# "  (..safe commentary) \n+
                           (:representation on))))
+
+  (def: .public (class name definition)
+    (-> LVar Statement Statement)
+    (:abstraction
+     (format "class " (:representation name)
+             (control_structure
+              (nested
+               (:representation definition))))))
+
+  (def: .public (attribute_readers attributes)
+    (-> (List Text) Statement)
+    (..statement
+     (..apply/* (list#each ..string attributes) {.#None} (..local "attr_reader"))))
   )
 
-(def: .public (do method arguments block_lambda object)
-  (-> Text (List Expression) (Maybe Expression) Expression Computation)
-  (|> object (..the method) (..apply/* arguments block_lambda)))
+(def: .public (do method arguments block object)
+  (-> Text (List Expression) (Maybe Block) Expression Computation)
+  (|> object (..the method) (..apply/* arguments block)))
 
 (def: .public (apply_lambda/* args lambda)
   (-> (List Expression) Expression Computation)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux
index 9ea3621e3..c9136a9dd 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux
@@ -147,27 +147,22 @@
                                 (_.do "equal?" (list reference) {.#None} subject))))
       (/.install "try" (unary //runtime.lux//try))))
 
-(def: (capped operation parameter subject)
-  (-> (-> Expression Expression Expression)
-      (-> Expression Expression Expression))
-  (//runtime.i64//64 (operation parameter subject)))
-
 (def: i64_procs
   Bundle
   (<| (/.prefix "i64")
       (|> /.empty
-          (/.install "and" (binary (product.uncurried //runtime.i64//and)))
-          (/.install "or" (binary (product.uncurried //runtime.i64//or)))
-          (/.install "xor" (binary (product.uncurried //runtime.i64//xor)))
-          (/.install "left-shift" (binary (product.uncurried //runtime.i64//left_shifted)))
-          (/.install "right-shift" (binary (product.uncurried //runtime.i64//right_shifted)))
+          (/.install "and" (binary (product.uncurried //runtime.i64##and)))
+          (/.install "or" (binary (product.uncurried //runtime.i64##or)))
+          (/.install "xor" (binary (product.uncurried //runtime.i64##xor)))
+          (/.install "left-shift" (binary (product.uncurried //runtime.i64##left_shifted)))
+          (/.install "right-shift" (binary (product.uncurried //runtime.i64##right_shifted)))
           
           (/.install "<" (binary (product.uncurried _.<)))
           (/.install "=" (binary (product.uncurried _.=)))
-          (/.install "+" (binary (product.uncurried (..capped _.+))))
-          (/.install "-" (binary (product.uncurried (..capped _.-))))
-          (/.install "*" (binary (product.uncurried (..capped _.*))))
-          (/.install "/" (binary (product.uncurried //runtime.i64//division)))
+          (/.install "+" (binary (product.uncurried //runtime.i64##+)))
+          (/.install "-" (binary (product.uncurried //runtime.i64##-)))
+          (/.install "*" (binary (product.uncurried //runtime.i64##*)))
+          (/.install "/" (binary (product.uncurried //runtime.i64##/)))
           (/.install "%" (binary (function (_ [parameter subject])
                                    (_.do "remainder" (list parameter) {.#None} subject))))
           
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
index e3d1e8dff..19ef21fbf 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
@@ -1,6 +1,6 @@
 (.using
   [library
-   [lux "*"
+   [lux {"-" i64}
     ["[0]" meta]
     [abstract
      ["[0]" monad {"+" do}]]
@@ -250,76 +250,245 @@
       @lux//program_args
       ))
 
-(def: i64//+limit (_.manual "+0x7FFFFFFFFFFFFFFF"))
-(def: i64//-limit (_.manual "-0x8000000000000000"))
-(def: i64//+iteration (_.manual "+0x10000000000000000"))
-(def: i64//-iteration (_.manual "-0x10000000000000000"))
-(def: i64//+cap (_.manual "+0x8000000000000000"))
-(def: i64//-cap (_.manual "-0x8000000000000001"))
-
-(runtime: (i64//64 input)
-  (with_vars [temp]
-    (`` (<| (~~ (template [<scenario> <iteration> <cap> <entrance>]
-                  [(_.if (|> input <scenario>)
-                     ($_ _.then
-                         (_.set (list temp) (_.% <iteration> input))
-                         (_.return (_.? (|> temp <scenario>)
-                                        (|> temp (_.- <cap>) (_.+ <entrance>))
-                                        temp))))]
-
-                  [(_.> ..i64//+limit) ..i64//+iteration ..i64//+cap ..i64//-limit]
-                  [(_.< ..i64//-limit) ..i64//-iteration ..i64//-cap ..i64//+limit]
-                  ))
-            (_.return input)))))
-
-(runtime: i64//nat_top
-  (|> (_.int +1)
-      (_.bit_shl (_.int +64))
-      (_.- (_.int +1))))
-
-(def: as_nat
-  (_.% (_.manual "0x10000000000000000")))
-
-(runtime: (i64//left_shifted param subject)
-  (_.return (|> subject
-                (_.bit_shl (_.% (_.int +64) param))
-                ..i64//64)))
-
-(runtime: (i64//right_shifted param subject)
-  ($_ _.then
-      (_.set (list param) (_.% (_.int +64) param))
-      (_.return (_.? (_.= (_.int +0) param)
-                     subject
-                     (|> subject
-                         ..as_nat
-                         (_.bit_shr param))))))
+... (def: i64##+limit (_.manual "+0x7FFFFFFFFFFFFFFF"))
+... (def: i64##-limit (_.manual "-0x8000000000000000"))
+... (def: i64##+iteration (_.manual "+0x10000000000000000"))
+... (def: i64##-iteration (_.manual "-0x10000000000000000"))
+... (def: i64##+cap (_.manual "+0x8000000000000000"))
+... (def: i64##-cap (_.manual "-0x8000000000000001"))
+
+... (runtime: (i64##64 input)
+...   (with_vars [temp]
+...     (`` (<| (~~ (template [<scenario> <iteration> <cap> <entrance>]
+...                   [(_.if (|> input <scenario>)
+...                      ($_ _.then
+...                          (_.set (list temp) (_.% <iteration> input))
+...                          (_.return (_.? (|> temp <scenario>)
+...                                         (|> temp (_.- <cap>) (_.+ <entrance>))
+...                                         temp))))]
+
+...                   [(_.> ..i64##+limit) ..i64##+iteration ..i64##+cap ..i64##-limit]
+...                   [(_.< ..i64##-limit) ..i64##-iteration ..i64##-cap ..i64##+limit]
+...                   ))
+...             (_.return input)))))
+
+(def: i32##low
+  (|>> (_.bit_and (_.manual "+0xFFFFFFFF"))))
+
+(def: i32##high
+  (|>> (_.bit_shr (_.int +32))
+       ..i32##low))
+
+(def: i32##positive?
+  (|>> (_.bit_and (_.manual "+0x80000000"))
+       (_.= (_.int +0))))
+
+(template: (i64 @high @low)
+  [(|> (_.? (i32##positive? @high)
+            @high
+            (|> (_.manual "+0xFFFFFFFF")
+                (_.- @high)
+                _.bit_not))
+       (_.bit_shl (_.int +32))
+       (_.bit_or @low))])
 
 (template [<runtime> <host>]
   [(runtime: (<runtime> left right)
-     (_.return (..i64//64 (<host> (..as_nat left) (..as_nat right)))))]
-
-  [i64//and _.bit_and]
-  [i64//or _.bit_or]
-  [i64//xor _.bit_xor]
+     (with_vars [high low]
+       ($_ _.then
+           (_.set (list high) (<host> (i32##high left) (..i32##high right)))
+           (_.set (list low) (<host> (i32##low left) (..i32##low right)))
+           (_.return (..i64 high low)))))]
+
+  [i64##and _.bit_and]
+  [i64##or _.bit_or]
+  [i64##xor _.bit_xor]
   )
 
-(runtime: (i64//division parameter subject)
+(def: (cap_shift! shift)
+  (-> LVar Statement)
+  (_.set (list shift) (|> shift (_.bit_and (_.int +63)))))
+
+(def: (handle_no_shift! shift input)
+  (-> LVar LVar (-> Statement Statement))
+  (_.if (|> shift (_.= (_.int +0)))
+    (_.return input)))
+
+(def: small_shift?
+  (-> LVar Expression)
+  (|>> (_.< (_.int +32))))
+
+(runtime: (i64##left_shifted shift input)
+  (with_vars [high low]
+    ($_ _.then
+        (..cap_shift! shift)
+        (<| (..handle_no_shift! shift input)
+            (_.if (..small_shift? shift)
+              ($_ _.then
+                  (_.set (list high) (_.bit_or (|> input i32##high (_.bit_shl shift))
+                                               (|> input i32##low (_.bit_shr (_.- shift (_.int +32))))))
+                  (_.set (list low) (|> input i32##low (_.bit_shl shift)))
+                  (_.return (..i64 (i32##low high)
+                                   (i32##low low)))))
+            ($_ _.then
+                (_.set (list high) (|> input i32##low (_.bit_shl (_.- (_.int +32) shift))))
+                (_.return (..i64 (i32##low high)
+                                 (_.int +0)))))
+        )))
+
+(runtime: (i64##right_shifted shift input)
+  (with_vars [high low]
+    ($_ _.then
+        (..cap_shift! shift)
+        (<| (..handle_no_shift! shift input)
+            (_.if (..small_shift? shift)
+              ($_ _.then
+                  (_.set (list high) (|> input i32##high (_.bit_shr shift)))
+                  (_.set (list low) (|> input i32##low (_.bit_shr shift)
+                                        (_.bit_or (|> input i32##high (_.bit_shl (_.- shift (_.int +32)))))))
+                  (_.return (..i64 high low))))
+            ($_ _.then
+                (_.set (list low) (_.? (|> shift (_.= (_.int +32)))
+                                       (i32##high input)
+                                       (|> input i32##high (_.bit_shr (_.- (_.int +32) shift)))))
+                (_.return (..i64 (_.int +0) low)))))))
+
+(runtime: (i64##/ parameter subject)
   (let [extra (_.do "remainder" (list parameter) {.#None} subject)]
     (_.return (|> subject
                   (_.- extra)
                   (_./ parameter)))))
 
+(def: i16##high
+  (_.bit_shr (_.int +16)))
+
+(def: i16##low
+  (_.bit_and (_.manual "+0xFFFF")))
+
+(def: i16##up
+  (_.bit_shl (_.int +16)))
+
+(runtime: (i64##+ parameter subject)
+  ... (_.return (i64##64 (_.+ parameter subject)))
+  (let [hh (|>> i32##high i16##high)
+        hl (|>> i32##high i16##low)
+        lh (|>> i32##low i16##high)
+        ll (|>> i32##low i16##low)]
+    (with_vars [l48 l32 l16 l00
+                r48 r32 r16 r00
+                x48 x32 x16 x00
+                high low]
+      ($_ _.then
+          (_.set (list l48) (hh subject))
+          (_.set (list l32) (hl subject))
+          (_.set (list l16) (lh subject))
+          (_.set (list l00) (ll subject))
+
+          (_.set (list r48) (hh parameter))
+          (_.set (list r32) (hl parameter))
+          (_.set (list r16) (lh parameter))
+          (_.set (list r00) (ll parameter))
+
+          (_.set (list x00) (_.+ l00 r00))
+          
+          (_.set (list x16) (|> (i16##high x00)
+                                (_.+ l16)
+                                (_.+ r16)))
+          (_.set (list x00) (i16##low x00))
+          
+          (_.set (list x32) (|> (i16##high x16)
+                                (_.+ l32)
+                                (_.+ r32)))
+          (_.set (list x16) (i16##low x16))
+          
+          (_.set (list x48) (|> (i16##high x32)
+                                (_.+ l48)
+                                (_.+ r48)
+                                i16##low))
+          (_.set (list x32) (i16##low x32))
+
+          (_.set (list high) (_.bit_or (i16##up x48) x32))
+          (_.set (list low) (_.bit_or (i16##up x16) x00))
+          (_.return (..i64 high low))
+          )))
+  )
+
+(def: i64##min
+  (_.manual "-0x8000000000000000"))
+
+(def: (i64##opposite value)
+  (_.? (_.= i64##min value)
+       i64##min
+       (i64##+ (_.int +1) (_.bit_not value))))
+
+(runtime: (i64##- parameter subject)
+  ... (_.return (i64##64 (_.- parameter subject)))
+  (_.return (i64##+ (i64##opposite parameter) subject))
+  )
+
+(runtime: (i64##* parameter subject)
+  ... (_.return (i64##64 (_.* parameter subject)))
+  (let [hh (|>> i32##high i16##high)
+        hl (|>> i32##high i16##low)
+        lh (|>> i32##low i16##high)
+        ll (|>> i32##low i16##low)]
+    (with_vars [l48 l32 l16 l00
+                r48 r32 r16 r00
+                x48 x32 x16 x00
+                high low]
+      ($_ _.then
+          (_.set (list l48) (hh subject))
+          (_.set (list l32) (hl subject))
+          (_.set (list l16) (lh subject))
+          (_.set (list l00) (ll subject))
+
+          (_.set (list r48) (hh parameter))
+          (_.set (list r32) (hl parameter))
+          (_.set (list r16) (lh parameter))
+          (_.set (list r00) (ll parameter))
+
+          (_.set (list x00) (_.* l00 r00))
+          (_.set (list x16) (i16##high x00))
+          (_.set (list x00) (i16##low x00))
+          
+          (_.set (list x16) (|> x16 (_.+ (_.* l16 r00))))
+          (_.set (list x32) (i16##high x16)) (_.set (list x16) (i16##low x16))
+          (_.set (list x16) (|> x16 (_.+ (_.* l00 r16))))
+          (_.set (list x32) (|> x32 (_.+ (i16##high x16)))) (_.set (list x16) (i16##low x16))
+
+          (_.set (list x32) (|> x32 (_.+ (_.* l32 r00))))
+          (_.set (list x48) (i16##high x32)) (_.set (list x32) (i16##low x32))
+          (_.set (list x32) (|> x32 (_.+ (_.* l16 r16))))
+          (_.set (list x48) (|> x48 (_.+ (i16##high x32)))) (_.set (list x32) (i16##low x32))
+          (_.set (list x32) (|> x32 (_.+ (_.* l00 r32))))
+          (_.set (list x48) (|> x48 (_.+ (i16##high x32)))) (_.set (list x32) (i16##low x32))
+          
+          (_.set (list x48) (|> x48
+                                (_.+ (_.* l48 r00))
+                                (_.+ (_.* l32 r16))
+                                (_.+ (_.* l16 r32))
+                                (_.+ (_.* l00 r48))
+                                i16##low))
+
+          (_.set (list high) (_.bit_or (i16##up x48) x32))
+          (_.set (list low) (_.bit_or (i16##up x16) x00))
+          (_.return (..i64 high low))
+          )))
+  )
+
 (def: runtime//i64
   Statement
   ($_ _.then
-      @i64//64
-      @i64//nat_top
-      @i64//left_shifted
-      @i64//right_shifted
-      @i64//and
-      @i64//or
-      @i64//xor
-      @i64//division
+      ... @i64##64
+      @i64##left_shifted
+      @i64##right_shifted
+      @i64##and
+      @i64##or
+      @i64##xor
+      @i64##+
+      @i64##-
+      @i64##*
+      @i64##/
       ))
 
 (runtime: (f64//decode inputG)
@@ -392,10 +561,10 @@
                        (_.local "Numeric")))
               ... We're in DragonRuby territory.
               (_.statement
-               (_.do "class_eval" (list) {.#Some (_.lambda {.#None} (list (_.local "_"))
-                                                           (_.statement
-                                                            (_.alias_method/2 (_.string "remainder")
-                                                                              (_.string "remainder_of_divide"))))}
+               (_.do "class_eval" (list) {.#Some [(list (_.local "_"))
+                                                  (_.statement
+                                                   (_.alias_method/2 (_.string "remainder")
+                                                                     (_.string "remainder_of_divide")))]}
                  (_.local "Numeric"))))
       runtime//adt
       runtime//lux
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 84353e082..7026c0a48 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -865,10 +865,12 @@
                                    (hide left))
                                 true)))))
         (_.cover [/.same?]
-                 (let [not_left (|> left ++ --)]
-                   (and (/.same? left left)
-                        (and (n.= not_left left)
-                             (not (/.same? not_left left))))))
+                 (let [not_left (|> left ++ -- %.nat)
+                       left (%.nat left)]
+                   (and (and (/.same? left left)
+                             (/.same? not_left not_left))
+                        (and (text#= left not_left)
+                             (not (/.same? left not_left))))))
         (_.cover [/.Rec]
                  (let [list (: (/.Rec NList
                                  (Maybe [Nat NList]))
diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux
index 2b960b43e..bc77f1f32 100644
--- a/stdlib/source/test/lux/math/number/frac.lux
+++ b/stdlib/source/test/lux/math/number/frac.lux
@@ -1,28 +1,28 @@
 (.using
-  [library
-   [lux "*"
-    ["_" test {"+" Test}]
-    ["@" target]
-    ["[0]" ffi]
-    [abstract
-     [monad {"+" do}]
-     [\\specification
-      ["$[0]" equivalence]
-      ["$[0]" hash]
-      ["$[0]" order]
-      ["$[0]" monoid]
-      ["$[0]" codec]]]
-    [data
-     ["[0]" bit ("[1]#[0]" equivalence)]]
-    [math
-     ["[0]" random {"+" Random}]]]]
-  [\\library
-   ["[0]" /
-    [// "*"
-     ["n" nat]
-     ["i" int]
-     ["r" rev]
-     ["[0]" i64]]]])
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   ["@" target]
+   ["[0]" ffi]
+   [abstract
+    [monad {"+" do}]
+    [\\specification
+     ["$[0]" equivalence]
+     ["$[0]" hash]
+     ["$[0]" order]
+     ["$[0]" monoid]
+     ["$[0]" codec]]]
+   [data
+    ["[0]" bit ("[1]#[0]" equivalence)]]
+   [math
+    ["[0]" random {"+" Random}]]]]
+ [\\library
+  ["[0]" /
+   [// "*"
+    ["n" nat]
+    ["i" int]
+    ["r" rev]
+    ["[0]" i64]]]])
 
 (def: random
   (Random Frac)
-- 
cgit v1.2.3