Frustrated with PHP's overflow/underflow logic.

6 files changed, 64 insertions, 47 deletions

diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux
index 560f7618a..dd1cbcc42 100644
--- a/stdlib/source/lux/data/collection/row.lux
+++ b/stdlib/source/lux/data/collection/row.lux
@@ -1,3 +1,6 @@
+## https://hypirion.com/musings/understanding-persistent-vector-pt-1
+## https://hypirion.com/musings/understanding-persistent-vector-pt-2
+## https://hypirion.com/musings/understanding-persistent-vector-pt-3
 (.module:
   [lux #*
    ["@" target]
diff --git a/stdlib/source/lux/math/number/nat.lux b/stdlib/source/lux/math/number/nat.lux
index 7edc60be4..d0fb348fa 100644
--- a/stdlib/source/lux/math/number/nat.lux
+++ b/stdlib/source/lux/math/number/nat.lux
@@ -287,22 +287,15 @@
 (def: (hexadecimal-value digit)
   (-> Nat (Maybe Nat))
   (case digit
-    (^ (char "0")) (#.Some 0)
-    (^ (char "1")) (#.Some 1)
-    (^ (char "2")) (#.Some 2)
-    (^ (char "3")) (#.Some 3)
-    (^ (char "4")) (#.Some 4)
-    (^ (char "5")) (#.Some 5)
-    (^ (char "6")) (#.Some 6)
-    (^ (char "7")) (#.Some 7)
-    (^ (char "8")) (#.Some 8)
-    (^ (char "9")) (#.Some 9)
-    (^or (^ (char "a")) (^ (char "A"))) (#.Some 10)
-    (^or (^ (char "b")) (^ (char "B"))) (#.Some 11)
-    (^or (^ (char "c")) (^ (char "C"))) (#.Some 12)
-    (^or (^ (char "d")) (^ (char "D"))) (#.Some 13)
-    (^or (^ (char "e")) (^ (char "E"))) (#.Some 14)
-    (^or (^ (char "f")) (^ (char "F"))) (#.Some 15)
+    (^template [<character> <number>]
+      [(^ (char <character>)) (#.Some <number>)])
+    (["0" 0] ["1" 1] ["2" 2] ["3" 3] ["4" 4]
+     ["5" 5] ["6" 6] ["7" 7] ["8" 8] ["9" 9])
+
+    (^template [<lower> <upper> <number>]
+      [(^or (^ (char <lower>)) (^ (char <upper>))) (#.Some <number>)])
+    (["a" "A" 10] ["b" "B" 11] ["c" "C" 12]
+     ["d" "D" 13] ["e" "E" 14] ["f" "F" 15])
     _ #.None))
 
 (template [<shift> <struct> <to-character> <to-value> <error>]
diff --git a/stdlib/source/lux/target/php.lux b/stdlib/source/lux/target/php.lux
index b1eb0b553..f76d9cdc0 100644
--- a/stdlib/source/lux/target/php.lux
+++ b/stdlib/source/lux/target/php.lux
@@ -267,7 +267,8 @@
       ["phpversion"]]]
 
     [1
-     [["var_dump"]
+     [["isset"]
+      ["var_dump"]
       ["is_null"]
       ["empty"]
       ["count"]
@@ -284,6 +285,7 @@
 
     [2
      [["intdiv"]
+      ["array_key_exists"]
       ["call_user_func_array"]
       ["array_slice"]
       ["array_push"]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux
index f523f1647..794d4aff2 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux
@@ -36,10 +36,6 @@
   (Unary Expression)
   (//runtime.tuple//make size (_.array_fill/3 [(_.int +0) size _.null])))
 
-(def: array::length
-  (Unary Expression)
-  //runtime.array//length)
-
 (def: (array::read [indexG arrayG])
   (Binary Expression)
   (_.nth indexG arrayG))
@@ -57,7 +53,7 @@
   (<| (/.prefix "array")
       (|> /.empty
           (/.install "new" (unary array::new))
-          (/.install "length" (unary array::length))
+          (/.install "length" (unary //runtime.array//length))
           (/.install "read" (binary array::read))
           (/.install "write" (trinary array::write))
           (/.install "delete" (binary array::delete))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux
index 30e325363..d3e91b925 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux
@@ -8,7 +8,7 @@
      ["%" format (#+ format)]]
     [collection
      ["." list ("#\." functor fold)]
-     ["." set]]]
+     ["." set (#+ Set)]]]
    [math
     [number
      ["n" nat]]]
@@ -81,11 +81,15 @@
                         list.enumeration
                         (list\map (|>> product.left (n.+ start) //case.register _.parameter)))
              @loop (_.constant (///reference.artifact [loop_module loop_artifact]))
+             loop_variables (set.from_list _.hash (list\map product.right locals))
+             referenced_variables (: (-> Synthesis (Set Var))
+                                     (|>> synthesis.path/then
+                                          //case.dependencies
+                                          (set.from_list _.hash)))
              [directive instantiation] (: [Statement Expression]
-                                          (case (|> (synthesis.path/then bodyS)
-                                                    //case.dependencies
-                                                    (set.from_list _.hash)
-                                                    (set.difference (set.from_list _.hash (list\map product.right locals)))
+                                          (case (|> (list\map referenced_variables initsS+)
+                                                    (list\fold set.union (referenced_variables bodyS))
+                                                    (set.difference loop_variables)
                                                     set.to_list)
                                             #.Nil
                                             [(_.define_function @loop (list) scope!)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux
index 5e1c36112..bdf18462a 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux
@@ -149,7 +149,7 @@
 (def: #export tuple_size_field
   "_lux_size")
 
-(def: #export tuple_size
+(def: tuple_size
   (_.nth (_.string ..tuple_size_field)))
 
 (def: jphp?
@@ -158,9 +158,7 @@
 (runtime: (array//length array)
   ## TODO: Get rid of this as soon as JPHP is no longer necessary.
   (_.if ..jphp?
-    (_.if (..tuple_size array)
-      (_.return (..tuple_size array))
-      (_.return (_.count/1 array)))
+    (_.return (..tuple_size array))
     (_.return (_.count/1 array))))
 
 (runtime: (array//write idx value array)
@@ -175,22 +173,34 @@
       @array//write
       ))
 
-(def: last_index
+(def: jphp_last_index
   (|>> ..tuple_size (_.- (_.int +1))))
 
+(def: normal_last_index
+  (|>> _.count/1 (_.- (_.int +1))))
+
 (with_expansions [<recur> (as_is ($_ _.then
                                      (_.; (_.set lefts (_.- last_index_right lefts)))
                                      (_.; (_.set tuple (_.nth last_index_right tuple)))))]
   (runtime: (tuple//make size values)
-    ($_ _.then
-        (_.; (_.set (..tuple_size values) size))
-        (_.return values)))
+    (_.if ..jphp?
+      ($_ _.then
+          (_.; (_.set (..tuple_size values) size))
+          (_.return values))
+      ## https://www.php.net/manual/en/language.operators.assignment.php
+      ## https://www.php.net/manual/en/language.references.php
+      ## https://www.php.net/manual/en/functions.arguments.php
+      ## https://www.php.net/manual/en/language.oop5.references.php
+      ## https://www.php.net/manual/en/class.arrayobject.php
+      (_.return (_.new (_.constant "ArrayObject") (list values)))))
 
   (runtime: (tuple//left lefts tuple)
     (with_vars [last_index_right]
       (<| (_.while (_.bool true))
           ($_ _.then
-              (_.; (_.set last_index_right (..last_index tuple)))
+              (_.if ..jphp?
+                (_.; (_.set last_index_right (..jphp_last_index tuple)))
+                (_.; (_.set last_index_right (..normal_last_index tuple))))
               (_.if (_.> lefts last_index_right)
                 ## No need for recursion
                 (_.return (_.nth lefts tuple))
@@ -216,7 +226,9 @@
     (with_vars [last_index_right right_index]
       (<| (_.while (_.bool true))
           ($_ _.then
-              (_.; (_.set last_index_right (..last_index tuple)))
+              (_.if ..jphp?
+                (_.; (_.set last_index_right (..jphp_last_index tuple)))
+                (_.; (_.set last_index_right (..normal_last_index tuple))))
               (_.; (_.set right_index (_.+ (_.int +1) lefts)))
               (_.cond (list [(_.=== last_index_right right_index)
                              (_.return (_.nth right_index tuple))]
@@ -226,7 +238,7 @@
                       (_.if ..jphp?
                         (_.return (..tuple//make (_.- right_index (..tuple_size tuple))
                                                  (..tuple//slice right_index tuple)))
-                        (_.return (..tuple//make (_.- right_index (..tuple_size tuple))
+                        (_.return (..tuple//make (_.- right_index (_.count/1 tuple))
                                                  (_.array_slice/2 [tuple right_index])))))
               )))))
 
@@ -326,16 +338,23 @@
       ))
 
 (runtime: (i64//right_shift param subject)
-  (let [mask (|> (_.int +1)
-                 (_.bit_shl (_.- param (_.int +64)))
-                 (_.- (_.int +1)))]
+  (let [## The mask has to be calculated this way instead of in a more straightforward way
+        ## because in some languages, 1<<63 = max_negative_value
+        ## and max_negative_value-1 = max_positive_value.
+        ## And bitwise, max_positive_value works out to the mask that is desired when param = 0.
+        ## However, in PHP, max_negative_value-1 underflows and gets cast into a float.
+        ## And this messes up the computation.
+        ## This slightly more convoluted calculation avoids that problem.
+        mask (|> (_.int +1)
+                 (_.bit_shl (_.- param (_.int +63)))
+                 (_.- (_.int +1))
+                 (_.bit_shl (_.int +1))
+                 (_.+ (_.int +1)))]
     ($_ _.then
-        (_.; (_.set param (_.bit_and (_.int +63) param)))
-        (_.if (_.=== (_.int +0) param)
-          (_.return subject)
-          (_.return (|> subject
-                        (_.bit_and mask)
-                        (_.bit_shr param)))))))
+        (_.; (_.set param (_.% (_.int +64) param)))
+        (_.return (|> subject
+                      (_.bit_shr param)
+                      (_.bit_and mask))))))
 
 (runtime: (i64//char code)
   (_.if ..jphp?