Hash table

runtime/Std.i

@@ -1,3 +1,4 @@
+F,makeArray;
 F,clone;
 F,hash;
 F,fst;

runtime/runtime.c

@@ -650,6 +650,24 @@ extern void* Belem (void *p, int i) {
   return (void*) ((int*) a->contents)[i];
 }
 
+extern void* LmakeArray (int length) {
+  data *r;
+  int n;
+
+  ASSERT_UNBOXED("makeArray:1", length);
+  
+  __pre_gc ();
+
+  n = UNBOX(length);
+  r = (data*) alloc (sizeof(int) * (n+1));
+
+  r->tag = ARRAY_TAG | (n << 3);
+
+  __post_gc ();
+
+  return r->contents;
+}
+
 extern void* LmakeString (int length) {
   int   n = UNBOX(length);
   data *r;

src/Language.ml

@@ -916,9 +916,9 @@ module Definition =
         | `Extern, Some _ -> report_error ~loc:(Some l#coord) (Printf.sprintf "initial value for an external variable \"%s\" can not be specified" name)
         | _               -> name, (m,`Variable value)
       };
-      parse[infix][expr][def]:        
+      parse[infix][expr][expr'][def]:
         m:(%"local" {`Local} | %"public" e:(%"external")? {match e with None -> `Public | Some _ -> `PublicExtern} | %"external" {`Extern})
-        locs:!(Util.list (local_var m infix expr def)) ";" {locs, infix}
+        locs:!(Util.list (local_var m infix expr' def)) ";" {locs, infix}
       | - <(m, orig_name, name, infix', flag)> : head[infix] -"(" -args:!(Util.list0 arg) -")"
           (l:$ "{" body:expr[def][infix'][Expr.Weak] "}" {
             if flag && List.length args != 2 then report_error ~loc:(Some l#coord) "infix operator should accept two arguments";
@@ -1056,7 +1056,9 @@ ostap (
     (is, Infix.extract_exports infix'), Expr.Scope (d, match expr with None -> Expr.Skip | Some e -> e)
     };
   definitions[infix]:
-    <(def, infix')> : !(Definition.parse infix (fun def infix atr -> Expr.scope def infix atr (Expr.parse def)) definitions) <(defs, infix'')> : definitions[infix'] {
+    <(def, infix')> : !(Definition.parse infix (fun def infix atr -> Expr.scope def infix atr (Expr.parse def))
+                                               (fun def infix atr -> Expr.basic def infix atr)
+                          definitions) <(defs, infix'')> : definitions[infix'] {
       def @ defs, infix''
      }
   | empty {[], infix}

stdlib/Array.expr

@@ -0,0 +1,73 @@
+import List;
+
+public fun initArray (n, f) {
+  local a = makeArray (n), i;
+
+  for i := 0, i < n, i := i + 1 do
+    a [i] := f (i)
+  od;
+
+  a
+}
+
+public fun mapArray (f, a) {
+  initArray (a.length, fun (i) {a[i]})
+}
+
+public fun arrayList (a) {
+  local i = 0, res = [0, {}], curr = res;
+
+  for skip, i < a.length, i := i + 1 do
+    curr [1] := a [i] : curr [1];
+    curr := curr [1]
+  od;
+
+  res [1]
+}
+
+public fun listArray (l) {
+  local a = makeArray (l.size);
+
+  fun inner (i, l) {
+    case l of {} -> skip | h : t -> a[i] := h; inner (i+1, t) esac   
+  }
+
+  inner (0, l);
+  a
+}
+
+public fun foldlArray (f, acc, a) {
+  local i = 0;
+  
+  for skip, i < a.length, i := i+1 do
+    acc := f (acc, a[i])
+  od;
+
+  acc
+}
+
+public fun foldrArray (f, acc, a) {
+  local i = a.length - 1;
+ 
+  for skip, i >= 0, i := i-1 do
+    acc := f (acc, a[i])
+  od;
+
+  acc
+}
+
+public fun iterArray (f, a) {
+  local i = 0;
+  
+  for skip, i < a.length, i := i+1 do
+    f (a [i])
+  od
+}
+
+public fun iteriArray (f, a) {
+  local i = 0;
+  
+  for skip, i < a.length, i := i+1 do
+    f (i, a [i])
+  od
+}

stdlib/Collection.expr

@@ -6,15 +6,14 @@
 
 import List;
 
-fun insertColl (m, k, v, sort) {
+fun insertColl (m, pk, v, sort) {
+  local k = case sort of Hash -> hash (pk) | _ -> pk esac;
+  
   fun append (v, vs) {
     case sort of
       Map  -> v : vs
     | Set  -> v
-    | Hash -> case find (fun (x) {x == v}, vs) of
-                None -> v : vs
-              | _    -> vs
-	      esac
+    | Hash -> [pk, v] : vs
     esac
   }
   
@@ -75,11 +74,17 @@ fun insertColl (m, k, v, sort) {
   inner (m).snd
 } 
 
-fun findColl (m, k, sort) {
+fun findColl (m, pk, sort) {
+  local k = case sort of Hash -> hash (pk) | _ -> pk esac;
+  
   fun extract (vv) {
     case sort of
-      Map -> case vv of v : _ -> Some (v) | _ -> None esac
-    | Set -> Some (vv)
+      Map  -> case vv of v : _ -> Some (v) | _ -> None esac
+    | Set  -> Some (vv)
+    | Hash -> case find (fun (x) {x.fst == pk}, vv) of
+                Some (p) -> Some (p.snd)
+              | None     -> None
+              esac
     esac
   }
   
@@ -98,11 +103,14 @@ fun findColl (m, k, sort) {
   inner (m)
 }
 
-fun removeColl (m, k, sort) {
+fun removeColl (m, pk, sort) {
+  local k = case sort of Hash -> hash (pk) | _ -> pk esac;
+  
   fun delete (vs) {
     case sort of
-      Map -> case vs of {} -> {} | _ : vv -> vv esac
-    | Set -> false
+      Map  -> case vs of {} -> {} | _ : vv -> vv esac
+    | Set  -> false
+    | Hash -> remove (fun (x) {x.fst == pk}, vs)
     esac
   }
   
@@ -249,11 +257,45 @@ public fun foldSet (f, acc, s) {
   foldl (f, acc, elements (s))
 }
 
--- Hash structure
+-- Hash consing
 public fun emptyMemo () {
   [{}]
 }
 
 public fun lookupMemo (m, v) {
-  skip  
+  case v of
+    #unboxed -> v
+  | _ ->
+     case findMap (m[0], v) of
+       Some (w) -> w
+     | None ->
+        case v of
+          #string -> m[0] := addMap (m[0], v, v); v        
+        | _ ->
+          local vc = clone (v), i = case vc of #fun -> 1 | _ -> 0 esac;
+          for skip, i < v.length, i := i + 1 do
+            vc [i] := lookupMemo (m, vc [i])
+          od;
+          m[0] := addMap (m[0], vc, vc);
+          vc
+        esac
+     esac
+  esac
+}
+
+-- Maps of hashed pointers
+public fun emptyHashTab () {
+ {}
+}
+
+public fun addHashTab (t, k, v) {
+  insertColl (t, k, v, Hash)
+}
+
+public fun findHashTab (t, k) {
+  findColl (t, k, Hash)
+}
+
+public fun removeHashTab (t, k) {
+  removeColl (t, k, Hash)
 }

stdlib/List.expr

@@ -1,3 +1,10 @@
+public fun size (l) {
+  case l of
+    {}    -> 0
+  | _ : t -> 1 + size (t)
+  esac
+}
+
 public fun foldl (f, acc, l) {
   case l of
     {}     -> acc
@@ -59,13 +66,13 @@ public fun find (f, l) {
 }
 
 public fun flatten (l) {
-  local res = [0, {}];
+  local res = [0, {}], curr = [res];
 
   fun append (x) {
-    local new = {x};
+    local new = x : {};
     
-    res [1] := new;
-    res := new
+    curr [0][1] := new;
+    curr [0] := new    
   }
 
   iter (fun (x) {iter (append, x)}, l);
@@ -88,4 +95,18 @@ public fun unzip (a) {
        [aa, bb] -> [a : aa, b : bb]
      esac
   esac
+}
+
+public fun remove (f, l) {
+  case l of
+    {}    -> {}
+  | h : t -> if f (h) then t else h : remove (f, t) fi
+  esac
+}
+
+public fun filter (f, l) {
+  case l of
+    {}    -> {}
+  | h : t -> if f (h) then h : filter (f, t) else filter (f, t) fi
+  esac
 }

stdlib/Makefile

@@ -8,6 +8,8 @@ all: $(ALL)
 
 Collection.o: List.o
 
+Array.o: List.o
+
 %.o: %.expr
 	$(RC) -I . -c $<
 

stdlib/regression/Makefile

@@ -8,7 +8,7 @@ check: $(TESTS)
 
 $(TESTS): %: %.expr
 	@echo $@
-	RC_RUNTIME=../../runtime $(RC) -I .. $< && ./$@ > $@.log && diff $@.log orig/$@.log
+	RC_RUNTIME=../../runtime $(RC) -I .. -ds -dp $< && ./$@ > $@.log && diff $@.log orig/$@.log
 
 clean:
 	$(RM) test*.log *.s *~ $(TESTS) *.i

stdlib/regression/orig/test05.log

@@ -0,0 +1,9 @@
+Cached: 1
+Cached: 1
+Cached: 1
+Cached: 1
+Cached: 1
+Cached: 1
+Cached: 1
+Cached: 1
+Cached: 1

stdlib/regression/orig/test06.log

@@ -0,0 +1,6 @@
+Flattening: 0
+Flattening: 0
+Flattening: {1, 2, 3}
+Flattening: {1, 2, 3, 4, 5, 6, 7, 8, 9}
+List to array: [1, 2, 3, 4, 5]
+Array to list: {1, 2, 3, 4, 5}

stdlib/regression/orig/test07.log

@@ -0,0 +1,6 @@
+HashTab internal structure: MNode (-624426958, {[{1, 2, 3}, 100]}, 0, 0, 0)
+HashTab internal structure: MNode (-624426958, {[{1, 2, 3}, 200], [{1, 2, 3}, 100]}, 0, 0, 0)
+Searching: Some (100)
+Searching: Some (200)
+Replaced: Some (800)
+Restored: Some (100)

stdlib/regression/test05.expr

@@ -0,0 +1,22 @@
+import Collection;
+
+fun f (x, y) {
+  fun () {x+y}
+}
+
+local t = emptyMemo (),
+      a = lookupMemo (t, "abc"),
+      b = lookupMemo (t, [1, 2, 3, 4, "abc"]),
+      c = lookupMemo (t, f (5, 6));
+
+printf ("Cached: %d\n", lookupMemo (t, "abc") == a);
+printf ("Cached: %d\n", lookupMemo (t, "abc") == a);
+printf ("Cached: %d\n", lookupMemo (t, "abc") == a);
+
+printf ("Cached: %d\n", lookupMemo (t, [1, 2, 3, 4, "abc"]) == b);
+printf ("Cached: %d\n", lookupMemo (t, [1, 2, 3, 4, "abc"]) == b);
+printf ("Cached: %d\n", lookupMemo (t, [1, 2, 3, 4, "abc"]) == b);
+
+printf ("Cached: %d\n", lookupMemo (t, f (5, 6)) == c);
+printf ("Cached: %d\n", lookupMemo (t, f (5, 6)) == c);
+printf ("Cached: %d\n", lookupMemo (t, f (5, 6)) == c)

stdlib/regression/test06.expr

@@ -0,0 +1,9 @@
+import List;
+import Array;
+
+printf ("Flattening: %s\n", flatten ({}).string);
+printf ("Flattening: %s\n", flatten ({{}, {}, {}}).string);
+printf ("Flattening: %s\n", flatten ({1, 2, 3} : {}).string);
+printf ("Flattening: %s\n", flatten ({{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}).string);
+printf ("List to array: %s\n", listArray ({1, 2, 3, 4, 5}).string);
+printf ("Array to list: %s\n", arrayList ([1, 2,3, 4, 5]).string)

stdlib/regression/test07.expr

@@ -0,0 +1,26 @@
+import Collection;
+
+local a = {1, 2, 3}, b = {1, 2, 3}, t = emptyHashTab ();
+
+t := addHashTab (t, a, 100);
+validateColl ();
+printf ("HashTab internal structure: %s\n", t.string);
+
+t := addHashTab (t, b, 200);
+validateColl ();
+printf ("HashTab internal structure: %s\n", t.string);
+
+printf ("Searching: %s\n", findHashTab (t, a).string);
+printf ("Searching: %s\n", findHashTab (t, b).string);
+
+t := addHashTab (t, a, 800);
+validateColl (t);
+
+printf ("Replaced: %s\n", findHashTab (t, a).string);
+
+t := removeHashTab (t, a);
+validateColl (t);
+printf ("Restored: %s\n", findHashTab (t, a).string)
+
+
+