Cyclic equal (alpha)

stdlib/Array.lama

@@ -18,7 +18,7 @@ public fun initArray (n, f) {
 }
 
 public fun mapArray (f, a) {
-  initArray (a.length, fun (i) {a[i]})
+  initArray (a.length, fun (i) {f (a[i])})
 }
 
 public fun arrayList (a) {

stdlib/Collection.lama

@@ -48,13 +48,16 @@ public fun validateColl (t) {
 }
 
 fun makeCompare (sort) {
+  fun c (x, y) {
+    if   x == y then 0
+    elif x < y  then -1
+    else 1
+    fi  
+  }
+  
   case sort of
-    Hash -> fun (x, y) {
-              if   x == y then 0
-              elif x < y  then -1
-              else 1
-              fi
-            }
+    Hash -> c
+  | Ptr  -> c
   | _    -> compare
   esac
 }
@@ -66,6 +69,7 @@ fun insertColl (m, pk, v, sort) {
   fun append (v, vs) {
     case sort of
       Map  -> v : vs
+    | Ptr  -> v : vs
     | Set  -> v
     | Hash ->
        case find (fun (x) {compare (x, [pk, v]) == 0}, vs) of
@@ -159,6 +163,7 @@ fun findColl (m, pk, sort) {
   fun extract (vv) {
     case sort of
       Map  -> case vv of v : _ -> Some (v) | _ -> None esac
+    | Ptr  -> case vv of v : _ -> Some (v) | _ -> None esac
     | Set  -> Some (vv)
     | Hash -> case find (fun (x) {compare (x.fst, pk) == 0}, vv) of
                 Some (p) -> Some (p.snd)
@@ -189,6 +194,7 @@ fun removeColl (m, pk, sort) {
   fun delete (vs) {
     case sort of
       Map  -> case vs of {} -> {} | _ : vv -> vv esac
+    | Ptr  -> case vs of {} -> {} | _ : vv -> vv esac
     | Set  -> false
     | Hash -> remove (fun (x) {x.fst == pk}, vs)
     esac
@@ -216,6 +222,7 @@ fun contents (m, sort) {
   fun append (k, vs, acc) {
     case sort of
       Map -> case vs of {} -> acc | v : _ -> [k, v] : acc esac
+    | Ptr -> case vs of {} -> acc | v : _ -> [k, v] : acc esac
     | Set -> if vs then k : acc else acc fi
     esac
   }
@@ -230,6 +237,19 @@ fun contents (m, sort) {
   inner (m, {})
 }
 
+-- Map on raw pointers (experimental)
+public fun emptyPtrMap () {
+  {}
+}
+
+public fun addPtrMap (m, k, v) {
+  insertColl (m, k, v, Ptr)
+}
+
+public fun findPtrMap (m, k) {
+  findColl (m, k, Ptr)
+}
+
 -- Map structure
 public fun emptyMap () {
   {}

stdlib/Random.lama

@@ -0,0 +1,51 @@
+-- Random data structures generator.
+-- (C) Dmitry Boulytchev, JetBrains Research, St. Petersburg State University, 2020
+--
+-- This unit provides an implementation for random data structures generator
+
+import Array;
+
+-- Generates a random signed 31-bit integer
+public fun randomInt () {
+  if random (2)
+  then random (1073741823) 
+  else 0 - random (1073741823)
+  fi
+}
+
+-- Generates a printable ASCII string of given length
+public fun randomString (len) {
+  local s = makeString (len);
+
+  for local i = 0;, i < len, i := i+1
+  do
+    s [i] := 32 + random (94) -- printable ASCII set
+  od;
+
+  s
+}
+
+-- Generates a random array of (deep) size n. f is element-generation
+-- function which takes the size of the element
+public fun randomArray (f, n) {
+  mapArray (f, split (n))  
+}
+
+-- Splits a number in a random sequence of summands
+public fun split (n) {
+  local k = random (n) + 1,
+        a = makeArray (k),
+        m = n;
+
+  for local i = 0;, i < k, i := i + 1
+  do
+    if i == k - 1
+    then a[i] := m
+    else 
+      a [i] := random (m - k + i + 1) + 1;
+      m := m - a [i]
+    fi
+  od;
+
+  a
+}

stdlib/Timer.lama

@@ -0,0 +1,14 @@
+-- Timer.
+-- (C) Dmitry Boulytchev, JetBrains Research, St. Petersburg State University, 2020
+--
+-- This unit provides an implementation for simple timer. A timer is a function which
+-- measures an elapsed time (in microseconds) since its creation.
+
+-- Creates a new timer
+public fun timer () {
+  local t = time ();
+
+  fun () {
+    time () - t
+  }
+}

stdlib/regression/orig/test30.log

@@ -0,0 +1,100 @@
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1

stdlib/regression/test30.lama

@@ -0,0 +1,147 @@
+import Collection;
+import Ref;
+import Random;
+import Array;
+import Fun;
+
+local m = emptyPtrMap ();
+
+fun eq (x, y) {
+  local m = ref (emptyPtrMap ());
+
+  fun alreadyEq (x, y) {
+    fun find (x) {
+      fun walk (r) {
+        case r of
+          [#unboxed] -> r
+        | [x]        -> walk (x)
+        esac
+      }
+      
+      case findPtrMap (deref (m), x) of
+        Some (r) -> Some (walk (r))
+      | x        -> x
+      esac
+    }
+
+    case [find (x), find (y)] of
+      [None, None] ->
+        local v = [1];
+        m ::= addPtrMap (addPtrMap (deref (m), x, v), y, v);
+        false
+         
+    | [None, Some (ry)] ->
+        m ::= addPtrMap (deref (m), x, ry);
+        false
+         
+    | [Some (rx), None] ->
+        m ::= addPtrMap (deref (m), y, rx);
+        false
+        
+    | [Some (rx), Some (ry)] ->
+        if rx == ry
+        then true
+        else
+          rx [0] := ry;
+          false
+        fi
+    esac    
+  }
+  
+  fun eqrec (x, y) {
+    if alreadyEq (x, y)
+    then true
+    else
+      case [x, y] of
+        [#array, #array] ->
+          if x.length == y.length
+          then
+            local continue = true;
+            
+            for local i = 0;, i<x.length && continue, i := i + 1 do
+              continue := eqrec (x[i], y[i]) 
+            od;            
+            continue
+          else false
+          fi
+      | [#unboxed, #unboxed] -> x == y
+      | [#string, #string]   -> compare (x, y) == 0
+      | [#unboxed, #array] -> false
+      | [#array, #unboxed] -> false
+      | _ -> failure ("eq not supported: %s, %s", x.string, y.string)
+      esac
+    fi
+  }
+
+  eqrec (x, y)  
+}
+
+fun genCyclicArrays (n) {
+  fun genrec (n, stacka, stackb, depth) {
+    fun peek (k, stack) {
+      case stack of
+        [x, prev] -> if k == 0 then x else peek (k-1, prev) fi
+      esac
+    }
+    
+    if n == 1
+    then
+      case if random (2)
+           then randomString (16)
+           else randomInt ()
+           fi of
+        x -> [x, clone (x)]
+      esac           
+    else
+      local a     = split (n),
+            b     = mapArray (id, a),
+            index = initArray (random (a.length + 1), fun (_) {random (a.length)});
+      
+      fun shared (i)  {
+        local found = false;
+        
+        for local j=0;, j < index.length && 1 - found, j := j + 1
+        do
+          found := i == index[j]
+        od;
+
+        found
+      }
+      
+      for local i=0;, i < a.length, i := i + 1
+      do
+        if shared (i)
+        then
+          if depth == 0
+          then
+            a[i] := a;
+            b[i] := b
+          else
+            case random (depth) of
+              r -> a [i] := peek (r, stacka);
+                   b [i] := peek (r, stackb)
+            esac
+          fi
+        else
+          case genrec (a[i], [a, stacka], [b, stackb], depth + 1) of
+            [ai, bi] -> a [i] := ai;
+                        b [i] := bi
+          esac
+        fi
+      od;
+
+      [a, b]
+    fi
+  }
+
+  genrec (n, [], [], 0)
+}
+
+disableGC ();
+
+for local i=0;, i<100, i:=i+1
+do
+  case genCyclicArrays (1000) of
+    [a, b] -> printf ("%d\n", eq (a, b))
+  esac
+od