Merge pull request #88 from TroupeLang/revert-84-fork/dev/lib-cleanup

Revert "lib/ cleanup"

Author: aslanix

compiler/src/AddAmbientMethods.hs

@@ -1,61 +1,47 @@
 -- 2020-05-17, AA
 
 -- HACK
---
--- This module add a number of standard ambient methods such as `print` to the beginning of the
--- file. This provides some backward compatibility with prior test cases as well as minimizes some
--- clutter.
---
--- If these methods are unused they are eliminated by the optimization passes in the further passes.
-
--- TODO
---
--- Move this into a '.trp' file of the form
---
--- ```
---     let fun print x = fwrite (stdout authority, (toString x) ^"\n")
---         ...
---     in () end
--- ```
---
--- Which, similar to below, after parsing has the `dummy` value replaced by the actual program. This
--- preamble can then be specified at compile-time.
-
-module AddAmbientMethods(addAmbientMethods) where
+-- This module add a number of standard 
+-- ambient methods such as `print` to the 
+-- beginning of the file. This provides some
+-- backward compatibility with prior test cases
+-- as well as minimizes some clutter
+
+-- If these methods are unused they are 
+-- eliminated by the optimization passes in 
+-- the further passes.
+
+module AddAmbientMethods(addAmbientMethods) where 
 
 import Basics
-import Direct
+import Direct  
 import TroupePositionInfo
 
-printStringDecl :: FunDecl
-printStringDecl = FunDecl "printString"
+printDecl :: FunDecl 
+printDecl = FunDecl "print"  
     [Lambda [VarPattern "x"] $
-        Let [ ValDecl (VarPattern "fd") (App (Var "stdout") [Var "authority"]) NoPos
-            , ValDecl (VarPattern "x'") (Bin Concat (Var "x") (Lit $ LString "\\n")) NoPos
-            ]
-            (App (Var "fwrite") [Tuple [Var "fd", Var "x'"]])
+        Let [ValDecl (VarPattern "out") (App (Var "getStdout") [Var "authority"]) NoPos]
+            (App (Var "fprintln") [Tuple [Var "out", Var "x"]])
     ] NoPos
 
-printDecl :: FunDecl
-printDecl = FunDecl "print"
-    [Lambda [ VarPattern "x" ] $
-      (App (Var "printString") [App (Var "toString") [Var "x"]])
+printWithLabelsDecl :: FunDecl 
+printWithLabelsDecl = FunDecl "printWithLabels" 
+    [Lambda [VarPattern "x"] $
+        Let [ValDecl (VarPattern "out") (App (Var "getStdout") [Var "authority"]) NoPos]
+            (App (Var "fprintlnWithLabels") [Tuple [Var "out", Var "x"]])
     ] NoPos
 
-printLDecl :: FunDecl
-printLDecl = FunDecl "printL"
-    [Lambda [ VarPattern "x" ] $
-      (App (Var "printString") [App (Var "toStringL") [Var "x"]])
-    ] NoPos
 
-inputLineDecl :: FunDecl
-inputLineDecl = FunDecl "inputLine"
-    [Lambda [ VarPattern "_" ] $
-        Let [ValDecl (VarPattern "fd") (App (Var "stdin") [Var "authority"]) NoPos]
-            (App (Var "freadln") [App (Var "stdin") [Var "authority"]])
+printStringDecl :: FunDecl 
+printStringDecl = FunDecl "printString"
+    [Lambda [VarPattern "x"] $
+        Let [ValDecl (VarPattern "out") (App (Var "getStdout") [Var "authority"]) NoPos]
+            (App (Var "fwrite") [Tuple [Var "out", Bin Concat (Var "x") (Lit (LString "\\n"))]])
     ] NoPos
 
-addAmbientMethods :: Prog -> Prog
-addAmbientMethods (Prog imports atoms t) =
-    let t' = Let [FunDecs [printStringDecl,printDecl,printLDecl,inputLineDecl]] t
-    in Prog imports atoms t'
+
+
+addAmbientMethods :: Prog -> Prog 
+addAmbientMethods (Prog imports atoms t) = 
+    let t' = Let [FunDecs [printDecl,printWithLabelsDecl,printStringDecl]] t
+    in Prog imports atoms t'

compiler/src/IR.hs

@@ -261,7 +261,7 @@ instance WellFormedIRCheck IRExpr where
     -- code over wire. Such malformed code would result
     -- in a JS output returning a runtime error (which should
     -- generally be avoided)
-     if  fname `elem`[
+     if  fname `elem`[ 
                        "$$authorityarg"
                      , "adv"
                      , "ladv"
@@ -285,13 +285,16 @@ instance WellFormedIRCheck IRExpr where
                      , "endorse"
                      , "floor"
                      , "flowsTo"                     
-                     , "freadln"
-                     , "fwrite"
+                     , "fprintln"
+                     , "fprintlnWithLabels"
+                     , "fwrite"                     
                      , "getTime"
                      , "getType"
                      , "getNanoTime"
+                     , "getStdout"
                      , "_getSystemProcess"
                      , "guard"
+                     , "inputLine"
                      , "intToString"                     
                      , "listToTuple"
                      , "lowermbox"                    
@@ -302,13 +305,13 @@ instance WellFormedIRCheck IRExpr where
                      , "newlabel"                     
                      , "node"
                      , "_pc"
-                     , "_bl"
                      , "pcpop"
                      , "peek"
                      , "pinipush"
                      , "pinipushto"
                      , "pinipop"
                      , "pcpush"                      
+                     , "question"
                      , "raisembox"
                      , "raiseTrust"
                      , "random"
@@ -330,9 +333,6 @@ instance WellFormedIRCheck IRExpr where
                      , "spawn"
                      , "sqrt"
                      , "substring"
-                     , "stdin"
-                     , "stdout"
-                     , "stderr"
                      , "stringToInt"
                      , "strlen"
                      , "restore"

examples/fromuserguide/basic_lib.trp

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

examples/fromuserguide/basic_receive.trp

@@ -1,5 +1,5 @@
 let fun foo () =
-      receive [hn x => printL ("foo received", x)]
+      receive [hn x => printWithLabels ("foo received", x)]
     val p = spawn foo
 in send (p, "hello")
 end

examples/fromuserguide/basic_spawn.trp

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

examples/fromuserguide/basic_updateableserver.trp

@@ -1,5 +1,4 @@
-import ThreadUtil
-
+import timeout
 let fun v_one n =
          receive [ hn ("REQUEST", senderid) => 
                         let val _ = send (senderid, n) 
@@ -27,8 +26,7 @@ let fun v_one n =
     val _ = send (service, ("UPDATE", v_two))
     val _ = send (service, ("COMPUTE", self(), fn x => x * x, 42))
     val _ = receive [ hn x => print x]
-in ThreadUtil.spawnTimeout (fn () => print "force terminating the server example after 1s";
-                                     exit (authority, 0))
-                           1000
+in exitAfterTimeout 
+        authority 1000 0 "force terminating the server example after 1s"
 end    
 

examples/fromuserguide/ifc_type_labels.trp

@@ -5,10 +5,10 @@ let val x = 100 raisedTo `{alice}`
                 val a = if y > 10 then z else "not an integer"
             in a 
             end
-    val _ = printL a
+    val _ = printWithLabels a
     val _ = debugpc()
     val w = a + x
-    val _ = printL w
+    val _ = printWithLabels w
 in debugpc()
 end
 

lib/DeclassifyUtil.trp

@@ -10,15 +10,15 @@ let
      *)
     fun hashString s =
         (* String hash with fast paths for small strings *)
-        let val len    = String.size s
-            val radix  = 127
-            val codeAt = String.sub' s
+        let val len = strlen s
+            val radix = 127
+            fun charCodeAt i = String.subCode (s,i)
         in case len of 0 => 0
-                     | 1 => codeAt 0
-                     | 2 => (radix * codeAt 0 + codeAt 1) andb Number.maxInt32
+                     | 1 => charCodeAt 0
+                     | 2 => (radix * charCodeAt 0 + charCodeAt 1) andb Number.maxInt32
                      | _ => let fun go idx acc =
                                     if len <= idx then acc
-                                    else go (idx + 1) ((acc * radix + codeAt idx) andb Number.maxInt32)
+                                    else go (idx + 1) ((acc * radix + charCodeAt idx) andb Number.maxInt32)
                             in go 0 0
                             end
         end

lib/Hash.trp

@@ -72,9 +72,9 @@ let (* -- List Access -- *)
     (** Same as `List.map` but `f` is applied to the index of the element as first argument
         (counting from 0), and the element itself as second argument. Not tail-recursive. *)
     fun mapi f list =
-        let fun mapi_aux j []    = []
-              | mapi_aux j x::xs = (f (j,x)) :: (mapi_aux (j+1) xs)
-        in mapi_aux 0 list
+        let fun mapj j []    = []
+              | mapj j x::xs = (f (j,x)) :: (mapj (j+1) xs)
+        in mapj 0 list
         end
 
     (* TODO: revMap *)
@@ -83,9 +83,6 @@ let (* -- List Access -- *)
     fun foldl f y []    = y
       | foldl f y x::xs = foldl f (f (x,y)) xs
 
-    (** Left-fold of `f` on a non-empty list using the head as the initial value. *)
-    fun foldl1 f x::xs = foldl f x xs
-
     (* TODO: foldr *)
 
     (** Returns the sublist of elements that satisfy `f`. Not tail-recursive. *)
@@ -186,7 +183,6 @@ let (* -- List Access -- *)
         map,
         mapi,
         foldl,
-        foldl1,
         filter,
         filteri,
         partition,