HAMT Performance Improvements

.github/workflows/run_tests.yml

@@ -106,8 +106,8 @@ jobs:
             exit 1
           fi
           echo "Runtime built successfully, troupe.mjs found"
-      - name: compile libs
-        run: make libs
+      - name: compile lib
+        run: make lib
       - name: compile service
         run: make service      
       - name: run basic test
@@ -137,4 +137,4 @@ jobs:
           path: |
             /tmp/troupe-multinode-*/
             /tmp/tmp.*/
-          retention-days: 7
+          retention-days: 7

.gitignore

@@ -32,3 +32,4 @@ yarn-error.log
 bin/troupe
 bin/understudy
 trp-rt/out/
+*.#*

Makefile

@@ -1,7 +1,7 @@
-.PHONY: rt compiler p2p-tools
+.PHONY: rt compiler lib p2p-tools
 
 # TODO: Rename to 'build/*' ?
-all: npm rt compiler p2p-tools libs service
+all: npm rt compiler p2p-tools lib service
 
 npm:
 	npm install
@@ -17,33 +17,23 @@ compiler:
 p2p-tools:
 	cd p2p-tools; tsc
 
-libs:
-	$(COMPILER) ./lib/nsuref.trp -l
-	$(COMPILER) ./lib/string.trp -l
-	$(COMPILER) ./lib/printService.trp -l
-	$(COMPILER) ./lib/lists.trp -l
-	$(COMPILER) ./lib/NetHealth.trp -l
-	$(COMPILER) ./lib/declassifyutil.trp -l
-	$(COMPILER) ./lib/stdio.trp -l
-	$(COMPILER) ./lib/timeout.trp -l
-	$(COMPILER) ./lib/raft.trp -l
-	$(COMPILER) ./lib/raft_debug.trp -l
-	$(COMPILER) ./lib/bst.trp -l
-	$(COMPILER) ./lib/localregistry.trp -l
-	$(COMPILER) ./lib/hamt.trp -l
+lib:
+	cd lib; $(MAKE) build
 
 service:
 	mkdir -p ./trp-rt/out
 	$(COMPILER) ./trp-rt/service.trp -l
 
 # TODO: Rename to 'clean/*' ?
-clear: clear/stack clear/rt
-clear/compiler:
-	cd compiler; $(MAKE) clear
-clear/rt:
-	cd rt; $(MAKE) clear
-clear/p2p-tools:
-	cd p2p-tools; $(MAKE) clear
+clean: clean/compiler clean/rt clean/lib
+clean/compiler:
+	cd compiler; $(MAKE) clean
+clean/rt:
+	cd rt; $(MAKE) clean
+clean/p2p-tools:
+	cd p2p-tools; $(MAKE) clean
+clean/lib:
+	cd lib; $(MAKE) clean
 
 ci-test-golden-no-color:
 	mkdir -p out 
@@ -66,7 +56,7 @@ test/ci-relay: p2p-tools
 	@echo "Running CI relay test..."
 	./tests/ci-relay-test.sh
 
-dist: stack npm rt p2p-tools libs
+dist: stack npm rt p2p-tools lib
 	rm -rf ./build/
 	mkdir -p ./build/Troupe/rt/built
 	mkdir -p ./build/Troupe/p2p-tools/built

compiler/Makefile

@@ -5,7 +5,7 @@ all:
 	mkdir  -p ./../bin
 	stack -v install $(STACK_OPTS) --local-bin-path ./../bin/
 
-clear:
+clean:
 	rm *.cabal
 	stack clean --full
 	rm -rf ../bin

compiler/test/Golden.hs

@@ -135,12 +135,14 @@ goldenTests tc = do
     warningTestsForRuntime   <- findByExtension extensions "tests/rt/warn"
     timeoutTestsForRuntime   <- findByExtension extensions "tests/rt/timeout/blocking"
     divergingTestsForRuntime <- findByExtension extensions "tests/rt/timeout/diverging"
+    testsForLib              <- findByExtension extensions "tests/lib"
 
     return $ (testGroup ("Troupe golden tests (" ++ ppTestConfig tc ++ ")") $ map ($ tc)
                                 [ compilerTests negativeTestsForCompiler
                                 , runtimeTests $ concat [positiveTestsForRuntime, negativeTestsForRuntime, warningTestsForRuntime]
                                 , timeoutTests timeoutTestsForRuntime
-                                , divergingTests divergingTestsForRuntime ] )
+                                , divergingTests divergingTestsForRuntime
+                                , libTests testsForLib] )
 
 
 compilerTests testFiles tc =
@@ -196,3 +198,13 @@ divergingTests testFiles tc =
         | troupeFile <- testFiles 
         ]
 
+libTests testFiles tc =
+    testGroup "Library tests"
+        [ goldenVsStringDiff
+            troupeFile
+            diff
+            (goldenFileName troupeFile tc)
+            (runPositive troupeFile tc)
+        | troupeFile <- testFiles
+        ]
+

examples/fromuserguide/basic_lib.trp

@@ -1,4 +1,4 @@
-import lists 
-printWithLabels (map ( fn i => i + 1) [1,2,3])
+import List
+printWithLabels (List.map ( fn i => i + 1) [1,2,3])
 
 

examples/fromuserguide/basic_spawn.trp

@@ -1,6 +1,6 @@
-import lists
+import List
 let fun printwait x = let val _ = printWithLabels x in sleep 10 end
-    fun foo () = map printwait [1,2,3]
-    fun bar () = map printwait ["A", "B", "C"]
+    fun foo () = List.map printwait [1,2,3]
+    fun bar () = List.map printwait ["A", "B", "C"]
 in  (spawn foo, spawn bar)
 end

examples/fromuserguide/ifc_labels.trp

@@ -1,5 +1,5 @@
-import lists
-map (fn (x,lev) => x raisedTo lev) [ (1, `{alice}`)
-                                   , (2, `{bob}`)
-                                   , (3, `{charlie}`) ]
+import List
+List.map (fn (x,lev) => x raisedTo lev) [ (1, `{alice}`)
+                                        , (2, `{bob}`)
+                                        , (3, `{charlie}`) ]
 

examples/network/pingpong/p2ppingpong.trp

@@ -1,6 +1,5 @@
-import lists
 let fun pingpong () =
-      let 
+      let
           val {counter, pid=sender} = receive [hn x => x]
           val _ = send (sender, {counter=counter + 1, pid=self()})
           val _ = print counter
@@ -11,7 +10,7 @@ in let val processA = spawn ("@pingpong-listener", pingpong)
         val _ = print processA
         val processB = spawn ("@pingpong-dialer", pingpong)
         val _ = print processB
-        val _ = send (processA,{counter = 1, pid =processB})
+        val _ = send (processA,{counter = 1, pid=processB})
     in ()
     end
 end

lib/Hash.trp

@@ -0,0 +1,66 @@
+let (** Maximum value available in a 32 bit unsigned integer *)
+    val maxUInt32 = (1 << 32) - 1
+
+    (** A mersenne prime which also happens to be the largest possible value for
+     *  a signed 32 bit integer using two's complement. All hash functions
+     * should map into the range 0..maxInt32. *)
+    val maxInt32 = (1 << 31) - 1
+
+    (** Hash function for strings.
+     *
+     * Uses polynomial rolling hash, i.e. a conversion to a number using a certain
+     * radix; for performance, strings of length 2 or shorter are evaluated
+     * non-recursively.
+     *)
+    fun hashString s =
+        (* String hash with fast paths for small strings *)
+        let val len = strlen s
+            val radix = 127
+            fun charCode idx = charCodeAtWithDefault (s, idx, 0)
+        in case len of 0 => 0
+                     | 1 => charCode 0
+                     | 2 => (radix * charCode 0 + charCode 1) andb maxInt32
+                     | _ => let fun go idx acc =
+                                    if len <= idx then acc
+                                    else go (idx + 1) ((acc * radix + charCode idx) andb maxInt32)
+                            in go 0 0
+                            end
+        end
+
+    (** The Multiply-Shift as proposed by Dietzfelbinger et al. (also known as
+     * Knuth's Multiplicative Hash) of a value `i` into a domain of `0..2^l`
+     * for `l = 0..31`. *)
+    fun hashMultiplyShift i l =
+        if l < 0 then 0
+        else if 31 < l then hashMultiplyShift i 31
+        else let val alpha = 2654435769
+             in (i * alpha andb maxInt32) >> (32 - (floor l))
+             end
+
+    (** Hash function for integers. *)
+    fun hashInt i = hashMultiplyShift i 31
+
+    (** Hash function for numbers, including fractions.
+     *
+     * TODO: Currently float hashing is merely done by string hashing. Much
+     *       better would be just to bitcast it to an integer. *)
+    fun hashNumber i = if floor i = i then hashInt i else hashString (toString i)
+
+    (** Hash function for any type of value. *)
+    fun hash x = case getType x of "number" => hashNumber x
+                                 | "string" => hashString x
+                                 | _ => hashString (toString x)
+
+    (*--- Module ---*)
+    val Hash = {
+        hashString        = hashString,
+        hashMultiplyShift = hashMultiplyShift,
+        hashInt           = hashInt,
+        hashNumber        = hashNumber,
+        hash              = hash
+    }
+
+in [ ("Hash", Hash)
+   , ("hash", hash)
+   ]
+end

lib/lists.trp → lib/List.trp

@@ -1,18 +1,27 @@
-let fun map f list =
+let (* TODO: Sort and document these functions. *)
+
+    (* TODO: isList out of the TCB *)
+
+    fun map f list =
     case list of
        [] => []
       |  (x::xs) => (f x) :: (map f xs)
 
     fun mapi f list =
-    let fun mapj j ls = 
+    let fun mapj j ls =
             case ls of [] => []
             |  (x::xs) => (f (j,x)) :: (mapj (j+1) xs)
     in mapj 0 list
     end
 
+    (* TODO: foldr *)
+
     fun foldl f y [] = y
       | foldl f y (x::xs) = foldl f (f (x,y)) xs
 
+    fun null [] = true
+      | null _  = false
+
     fun length [] = 0
       | length (x::xs) = 1 + length xs
 
@@ -29,32 +38,30 @@ let fun map f list =
       in reverse (rng n)
      end
 
-    fun append l1 l2 =
-        case l1 of
-            [] => l2
-          | x::l => x::(append l l2)
+    fun append []    ys = ys
+      | append x::xs ys = x::(append xs ys)
 
     fun nth (x::l) 1 = x
       | nth (x::l) n = nth l (n - 1)
 
+    (* TODO: Rename this file to 'List' and move this to 'ListPair' together with
+     *       a definition of 'zip' and 'unzip'. *)
     fun lookup list key default =
       case list of [] => default
                  | ((x, v):: xs) =>
                    if x = key then v
                    else lookup xs key default
 
-    fun elem x [] = false 
+    fun elem x [] = false
       | elem x (y::ys) = if x = y then true else elem x ys
 
-    fun partition f ls = 
-      let fun partition_aux  (a,b) [] = (reverse a, reverse b ) 
+    fun partition f ls =
+      let fun partition_aux  (a,b) [] = (reverse a, reverse b )
             | partition_aux  (a,b) (x::xs) =
-                        if f x then partition_aux (x::a, b) xs 
+                        if f x then partition_aux (x::a, b) xs
                                else partition_aux (a, x::b) xs
-
-
-      in  partition_aux ([],[]) ls 
-      end   
+      in  partition_aux ([],[]) ls
+      end
 
     fun filter f l = case l of
     [] => []
@@ -71,28 +78,33 @@ let fun map f list =
     | (m, n, h :: t) => slice (m - 1) (n - 1) t
     | (_, _, _) => []
 
-    fun insert_at_index l appended_l index =
+    fun insertAt l appended_l index =
       let val beg_slice = slice 0 index l
           val end_slice = slice index (length l) l
       in append beg_slice (append appended_l end_slice)
     end
-
-
-in
-    [ ("map",     map)
-    , ("mapi",    mapi)
-    , ("foldl",   foldl)
-    , ("range",   range)
-    , ("reverse", reverse)
-    , ("lookup",  lookup) 
-    , ("elem",    elem)
-    , ("length",  length)
-    , ("append",  append)
-    , ("partition", partition) 
-    , ("nth", nth)
-    , ("filter", filter)
-    , ("first", first)
-    , ("slice", slice)
-    , ("insert_at_index", insert_at_index)
-    ]
+
+    (*--- Module ---*)
+    val List = {
+        map       = map,
+        mapi      = mapi,
+        foldl     = foldl,
+        range     = range,
+        reverse   = reverse,
+        lookup    = lookup,
+        elem      = elem,
+        null      = null,
+        length    = length,
+        append    = append,
+        partition = partition,
+        nth       = nth,
+        filter    = filter,
+        first     = slice,
+        slice     = slice,
+        insertAt  = insertAt
+    }
+
+in [ ("List", List),
+     ("length", length)
+   ]
 end

lib/Makefile

@@ -0,0 +1,22 @@
+COMPILER=../bin/troupec
+
+build:
+	mkdir out
+	$(COMPILER) ./nsuref.trp -l
+	$(COMPILER) ./string.trp -l
+	$(COMPILER) ./printService.trp -l
+	$(COMPILER) ./List.trp -l
+	$(COMPILER) ./timeout.trp -l
+	$(COMPILER) ./NetHealth.trp -l
+	$(COMPILER) ./declassifyutil.trp -l
+	$(COMPILER) ./stdio.trp -l
+	$(COMPILER) ./raft.trp -l
+	$(COMPILER) ./raft_debug.trp -l
+	$(COMPILER) ./bst.trp -l
+	$(COMPILER) ./localregistry.trp -l
+	$(COMPILER) ./Hash.trp -l
+	$(COMPILER) ./Unit.trp -l
+	$(COMPILER) ./StencilVector.trp -l
+
+clean:
+	rm -rf out