lib/ cleanup

.github/dependabot.yml

@@ -0,0 +1,6 @@
+version: 2
+updates:
+  - package-ecosystem: "github-actions"
+    directory: "/"
+    schedule:
+      interval: "weekly"

compiler/Makefile

@@ -1,24 +1,35 @@
 .PHONY: test
 
-all:
-	stack -v build $(STACK_OPTS)
+all: build install
+
+build: VERBOSITY_FLAG =
+build:
+	stack $(VERBOSITY_FLAG) build $(STACK_OPTS)
+build/verbose:
+	$(MAKE) $(MAKE_FLAGS) build VERBOSITY_FLAG="-v"
+
+install: VERBOSITY_FLAG =
+install:
+	$(MAKE) $(MAKE_FLAGS) build
 	mkdir  -p ./../bin
-	stack -v install $(STACK_OPTS) --local-bin-path ./../bin/
+	stack $(VERBOSITY_FLAG) install $(STACK_OPTS) --local-bin-path ./../bin/
+install/verbose:
+	$(MAKE) $(MAKE_FLAGS) install VERBOSITY_FLAG="-v"
 
 clean:
 	rm *.cabal
 	stack clean --full
 	rm -rf ../bin
 # If problems still persist after this, remove all GHC compilers in ~/.stack/programs/**/
 
-ghci-irtester:
-	stack ghci --main-is Troupe-compiler:exe:irtester --no-load
-
-ghci-troupec:
-	stack ghci --main-is Troupe-compiler:exe:troupec --no-load
-
 test:
 	stack test $(STACK_OPTS)
 
 parser-info:
 	stack exec happy -- -i src/Parser.y
+
+ghci/irtester:
+	stack ghci --main-is Troupe-compiler:exe:irtester --no-load
+
+ghci/troupec:
+	stack ghci --main-is Troupe-compiler:exe:troupec --no-load

compiler/app/Main.hs

@@ -21,9 +21,8 @@ import qualified Raw2Stack
 import qualified Stack2JS
 import qualified RawOpt
 -- import System.IO (isEOF)
-import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS
 import Data.ByteString.Base64 (decode)
-import qualified Data.ByteString.Char8  as BSChar8
 import qualified Data.ByteString.Lazy.Char8 as BSLazyChar8
 import System.IO
 import System.Exit
@@ -220,7 +219,7 @@ fromStdinIR = do
     input <- BS.getLine
     if BS.isPrefixOf "!ECHO " input
     then let response = BS.drop 6 input
-          in do BSChar8.putStrLn response
+          in do BS.putStrLn response
 --                  debugOut "echo"
     else
       case decode input of
@@ -244,7 +243,7 @@ fromStdinIRJson = do
     input <- BS.getLine
     if BS.isPrefixOf "!ECHO " input
     then let response = BS.drop 6 input
-          in BSChar8.putStrLn response
+          in BS.putStrLn response
     else
       case decode input of
         Right bs ->

compiler/src/AddAmbientMethods.hs

@@ -1,47 +1,61 @@
 -- 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.
-
-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.
+
+-- 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
 
 import Basics
-import Direct  
+import Direct
 import TroupePositionInfo
 
-printDecl :: FunDecl 
-printDecl = FunDecl "print"  
+printStringDecl :: FunDecl
+printStringDecl = FunDecl "printString"
     [Lambda [VarPattern "x"] $
-        Let [ValDecl (VarPattern "out") (App (Var "getStdout") [Var "authority"]) NoPos]
-            (App (Var "fprintln") [Tuple [Var "out", Var "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'"]])
     ] NoPos
 
-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"]])
+printDecl :: FunDecl
+printDecl = FunDecl "print"
+    [Lambda [ VarPattern "x" ] $
+      (App (Var "printString") [App (Var "toString") [Var "x"]])
     ] NoPos
 
-
-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"))]])
+printWithLabelsDecl :: FunDecl
+printWithLabelsDecl = FunDecl "printWithLabels"
+    [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"]])
+    ] NoPos
 
-
-addAmbientMethods :: Prog -> Prog 
-addAmbientMethods (Prog imports atoms t) = 
-    let t' = Let [FunDecs [printDecl,printWithLabelsDecl,printStringDecl]] t
-    in Prog imports atoms t'
+addAmbientMethods :: Prog -> Prog
+addAmbientMethods (Prog imports atoms t) =
+    let t' = Let [FunDecs [printStringDecl,printDecl,printWithLabelsDecl,inputLineDecl]] t
+    in Prog imports atoms t'

compiler/src/ClosureConv.hs

@@ -201,7 +201,7 @@ cpsToIR (CPS.LetSimple vname@(VN ident) st kt) = do
 cpsToIR (CPS.LetRet (CPS.Cont arg kt') kt) = do
     t  <- cpsToIR kt
     t' <- local (insVar arg) (cpsToIR kt')
-    return $ CCIR.BB [] $ Call arg t t'
+    return $ CCIR.BB [] $ StackExpand arg t t'
 cpsToIR (CPS.LetFun fdefs kt) = do 
     let vnames_orig = map (\(CPS.Fun fname _) -> fname) fdefs
     let localExt = local (insVars vnames_orig)

compiler/src/IR.hs

@@ -91,7 +91,7 @@ data IRTerminator
   -- and then execute the second BB, which can refer to this variable and
   -- where PC is reset to the level before entering the first BB.
   -- Represents a "let x = ... in ..." format.
-  | Call VarName IRBBTree IRBBTree
+  | StackExpand VarName IRBBTree IRBBTree
   deriving (Eq,Show,Generic)
 
 
@@ -147,7 +147,7 @@ instance ComputesDependencies IRBBTree where
 instance ComputesDependencies IRTerminator where 
     dependencies (If _ bb1 bb2) = mapM_ dependencies [bb1, bb2]
     dependencies (AssertElseError _ bb1 _ _) = dependencies bb1
-    dependencies (Call _ t1 t2) = dependencies t1  >> dependencies t2
+    dependencies (StackExpand _ t1 t2) = dependencies t1  >> dependencies t2
 
     dependencies _              = return ()
 instance ComputesDependencies FunDef where
@@ -231,15 +231,15 @@ instance WellFormedIRCheck IRInst where
  wfir (Assign (VN x) e) = do checkId x
                              wfir e
  wfir (MkFunClosures _ fdefs) = mapM_ (\((VN x), _) -> checkId x) fdefs
- 
+
 
 instance WellFormedIRCheck IRTerminator where
   wfir (If _ bb1 bb2) = do
     wfir bb1
     wfir bb2
   wfir (AssertElseError _ bb _ _) = wfir bb
-  wfir (Call (VN x) bb1 bb2 ) = do 
-    checkId x 
+  wfir (StackExpand (VN x) bb1 bb2 ) = do
+    checkId x
     wfir bb1
     wfir bb2
 
@@ -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,16 +285,13 @@ instance WellFormedIRCheck IRExpr where
                      , "endorse"
                      , "floor"
                      , "flowsTo"                     
-                     , "fprintln"
-                     , "fprintlnWithLabels"
-                     , "fwrite"                     
+                     , "freadln"
+                     , "fwrite"
                      , "getTime"
                      , "getType"
                      , "getNanoTime"
-                     , "getStdout"
                      , "_getSystemProcess"
                      , "guard"
-                     , "inputLine"
                      , "intToString"                     
                      , "listToTuple"
                      , "lowermbox"                    
@@ -305,13 +302,13 @@ instance WellFormedIRCheck IRExpr where
                      , "newlabel"                     
                      , "node"
                      , "_pc"
+                     , "_bl"
                      , "pcpop"
                      , "peek"
                      , "pinipush"
                      , "pinipushto"
                      , "pinipop"
                      , "pcpush"                      
-                     , "question"
                      , "raisembox"
                      , "raiseTrust"
                      , "random"
@@ -333,6 +330,9 @@ instance WellFormedIRCheck IRExpr where
                      , "spawn"
                      , "sqrt"
                      , "substring"
+                     , "stdin"
+                     , "stdout"
+                     , "stderr"
                      , "stringToInt"
                      , "strlen"
                      , "restore"
@@ -442,7 +442,8 @@ ppIR (MkFunClosures varmap fdefs) =
 
 
 
-ppTr (Call vn bb1 bb2) = (ppId vn <+> text "= call" $$ nest 2 (ppBB bb1)) $$ (ppBB bb2)
+
+ppTr (StackExpand vn bb1 bb2) = (ppId vn <+> text "= call" $$ nest 2 (ppBB bb1)) $$ (ppBB bb2)
 
 
 ppTr (AssertElseError va ir va2 _) 

compiler/src/IR2Raw.hs

@@ -699,7 +699,7 @@ tr2raw = \case
     return $ If r bb1' bb2'
 
   -- Revision 2023-08: Equivalent, only way of modifying bb2 changed.
-  IR.Call v irBB1 irBB2 -> do
+  IR.StackExpand v irBB1 irBB2 -> do
     bb1 <- tree2raw irBB1
     BB insts2 tr2 <- tree2raw irBB2
     -- Prepend before insts2 instructions to store in variable v the result
@@ -711,7 +711,7 @@ tr2raw = \case
                                   -- generally using Sequence (faster concatenation) for instructions
                                   -- might improve performance
     let bb2 = BB insts2' tr2
-    return $ Call bb1 bb2
+    return $ StackExpand bb1 bb2
 
   -- Note: This is translated into branching and Error for throwing RT exception
   -- Revision 2023-08: More fine-grained raising of blocking label, see below.

compiler/src/IROpt.hs

@@ -67,7 +67,7 @@ instance Substitutable IRTerminator where
                 AssertElseError (apply subst x) (apply subst bb) (apply subst y) pos 
             LibExport x -> LibExport (apply subst x)
             Error x pos -> Error (apply subst x) pos 
-            Call decVar bb1 bb2 -> Call decVar (apply subst bb1) (apply subst bb2)
+            StackExpand decVar bb1 bb2 -> StackExpand decVar (apply subst bb1) (apply subst bb2)
 
 instance Substitutable IRBBTree where 
     apply subst (BB insts tr) = 
@@ -462,7 +462,7 @@ trPeval (AssertElseError x bb y_err pos) = do
                 return $ BB [] (AssertElseError x bb' y_err pos)     
 
 
-trPeval (Call x bb1 bb2) = do 
+trPeval (StackExpand x bb1 bb2) = do 
     bb1' <- peval bb1 
     bb2' <- peval bb2
 
@@ -473,7 +473,7 @@ trPeval (Call x bb1 bb2) = do
             setChangeFlag           
             return $ BB (insts1 ++ insts2) tr2
         _ -> 
-            return $ BB [] (Call x bb1' bb2')
+            return $ BB [] (StackExpand x bb1' bb2')
 
 trPeval tr@(Ret x) = do 
     markUsed' x 

compiler/src/Raw.hs

@@ -158,7 +158,7 @@ data RawTerminator
   | Error RawVar PosInf
   -- | Execute the first BB and then execute the second BB where
   -- PC is reset to the level before entering the first BB.
-  | Call RawBBTree RawBBTree
+  | StackExpand RawBBTree RawBBTree
   deriving (Eq, Show)
 
 
@@ -341,7 +341,7 @@ ppIR (MkFunClosures varmap fdefs) =
 -- ppIR (LevelOperations _ insts) = 
 --  text "level operation" $$ nest 2 (vcat (map ppIR insts))
 
-ppTr (Call bb1 bb2) = (text "call" $$ nest 4 (ppBB bb1)) $$ (ppBB bb2)
+ppTr (StackExpand bb1 bb2) = (text "call" $$ nest 4 (ppBB bb1)) $$ (ppBB bb2)
 
 
 -- ppTr (AssertElseError va ir va2 _) 

compiler/src/Raw2Stack.hs

@@ -188,7 +188,7 @@ trTr (Raw.LibExport v) = do
      return $ Stack.LibExport v 
 trTr (Raw.Error r1 p) = do 
      return $ Stack.Error r1 p 
-trTr (Raw.Call bb1 bb2) = do 
+trTr (Raw.StackExpand bb1 bb2) = do 
    __callDepth <- localCallDepth <$> ask 
    bb1' <- local (\tenv -> tenv { localCallDepth = __callDepth + 1 } ) $ trBB bb1 
    n <- getBlockNumber
@@ -205,7 +205,7 @@ trTr (Raw.Call bb1 bb2) = do
                     | x <-  filter filterConsts (Set.elems varsToLoad) ]   
    bb2'@(Stack.BB inst_2 tr_2) <- trBB bb2
 
-   return $ Stack.Call bb1' (Stack.BB (loads ++ inst_2) tr_2)
+   return $ Stack.StackExpand bb1' (Stack.BB (loads ++ inst_2) tr_2)
 
 
 trBB :: Raw.RawBBTree -> Tr Stack.StackBBTree 

compiler/src/RawDefUse.hs

@@ -233,7 +233,7 @@ instance Trav RawTerminator where
          trav bb2
        LibExport v -> use v 
        Error r _ -> use r 
-       Call bb1 bb2 -> do
+       StackExpand bb1 bb2 -> do
          trav bb1
          modify (\s -> 
                      let (c, _) = locInfo s