Activate test25b, which is passing. Add more test25 tests.

gibbon-compiler/examples/Makefile

@@ -32,9 +32,14 @@ test: prebuild build
 benchtest: test24_input.bin
 	@echo "\n Testing Gibbon's benchmarking mode."
 	@echo "--------------------------------------------------"
-	DEBUG=1 $(GIBBON) --bench pass test24_defs.sexp
+	$(GIBBON) --bench pass test24_defs.sexp
 	./test24_defs.exe -bench 10 10 -file test24_input.bin 
-	DEBUG=1 $(GIBBON) -b pass --bench-input test24_input.bin  test24_defs.sexp
+	$(GIBBON) -b pass --bench-input test24_input.bin  test24_defs.sexp
+
+# Next is this:
+#	@echo "\nNow in packed mode:"
+#	$(GIBBON) --packed --bench pass --bench-input test24_input.bin test24_defs.sexp
+
 
 # Assumes answers and build already available:
 core_tests:
@@ -98,7 +103,7 @@ FAILING_TESTS ?= \
   test13_build.sexp test13b_build.sexp \
   test20_bintree.sexp test20b_bintree.sexp test20c_bintree.sexp  test20d_bintree.sexp test20e_bintree.sexp test20f_bintree.sexp \
   test11_fundata.sexp test11c_funrec.sexp test11e_funrec.sexp test12c_traverse.sexp \
-  test25b_racketcore.sexp  \
+  test25c_racketcore.sexp test25d_racketcore.sexp \
   test16_forlist.sexp test17_forfold.sexp 
 # Last Line - added because they are failing under valgrind [2016.11.11]
 
@@ -143,7 +148,7 @@ build_tests: $(EXE_FILES)
 
 
 PACKED_FAILING ?=  test12_skip.sexp  test16_forlist.sexp test17_forfold.sexp \
-test20b_bintree.sexp test20f_bintree.sexp test24_defs.sexp test25b_racketcore.sexp 
+test20b_bintree.sexp test20f_bintree.sexp test24_defs.sexp test25c_racketcore.sexp test25d_racketcore.sexp
 
 # test20f - wip
 # test20b_bintree.sexp   -- requires copy insertion
@@ -162,15 +167,15 @@ run_tests_packed: answers
 
 INTERP2_FAILING = test00b_printBool.sexp test06a_two_cases.sexp test06b_case.sexp test06_case.sexp test06c_nested.sexp \
      test06d_rec.sexp test06e_rec.sexp test06f_rec.sexp test06g_rec.sexp \
-  test06h_rec.sexp test06i_casecase.sexp test11b_fundata.sexp test11c_funrec.sexp \
+  test06h_rec.sexp test06i_casecase.sexp test07b_iterate.sexp test11b_fundata.sexp test11c_funrec.sexp \
   test11d_funrec.sexp test11e_funrec.sexp test11f_funrec.sexp  \
   test12b_traverse.sexp test12c_traverse.sexp test12_skip.sexp \
   test16_forlist.sexp test17_forfold.sexp test20_bintree.sexp \
   text08_dict.sexp test08b_dict.sexp test08c_dict.sexp test08d_sharedict.sexp \
   test13_build.sexp test13b_build.sexp  \
   test20b_bintree.sexp test20c_bintree.sexp test20d_bintree.sexp test20e_bintree.sexp test20f_bintree.sexp \
   test25b_racketcore.sexp test25_rackcore.sexp \
-  test07b_iterate.sexp test25b_racketcore.sexp \
+  test25c_racketcore.sexp test25d_racketcore.sexp \
   test11_fundata.sexp test10_desugar.sexp test10b_desugar.sexp test24_defs.sexp \
   test09_recur.sexp test08_dict.sexp test02b_datacon.sexp test02c_case.sexp 
 # Last line are new regressions...

gibbon-compiler/examples/test25b_racketcore.sexp

@@ -2,25 +2,15 @@
 
 (require "../../ASTBenchmarks/grammar_racket.sexp")
 
+;; This can be run on any file from disk:
 (define (foo [e : Toplvl]) : Int
   (case e
-    [(Expression x)
-      (case x
-        [(VARREF s) 1]
-        [(Top s) 2]
-        [(VariableReference s) 3] 
-        [(VariableReferenceTop s) 4]
-        [(VariableReferenceNull) 5]
-    	[(Quote d) 6]
-	[(QuoteSyntax d) 7]
-	[(QuoteSyntaxLocal d) 8]
-	[(Lambda formals lse) 9]
-        [(CaseLambda cases) 10]
-        [(LetValues binds body) 11]
-        [(LetrecValues binds body) 12]
-        [(If cond then else) 13]
-        [(Begin exprs) 14]
-        [(Begin0 e1 exprs) 15]
-        [(App rator rands) 16]
-        [(SetBang s e) 17]
-        [(WithContinuationMark e1 e2 e3) 18])]))
+    ;; In the same order as the data def:
+    [(DefineValues   listSym expr) 101]
+    [(DefineSyntaxes listSym expr) 102]
+    [(BeginTop listToplvl)         103]
+    [(Expression x)                104]
+    ))
+    ;[Expression Expr]
+
+(foo (Expression (VARREF (quote hi))))

gibbon-compiler/examples/test25c_racketcore.sexp

@@ -0,0 +1,16 @@
+#lang gibbon
+
+(require "../../ASTBenchmarks/grammar_racket.sexp")
+
+;; This can be run on any file from disk:
+(define (foo [e : Toplvl]) : Int
+  (case e
+    ;; In a DIFFERENT order from the datadef:
+    [(Expression x)                104]
+    [(DefineValues   listSym expr) 101]
+    [(DefineSyntaxes listSym expr) 102]
+    [(BeginTop listToplvl)         103]
+    ))
+    ;[Expression Expr]
+
+(foo (Expression (VARREF (quote hi))))

gibbon-compiler/examples/test25d_racketcore.sexp

@@ -0,0 +1,30 @@
+#lang gibbon
+
+(require "../../ASTBenchmarks/grammar_racket.sexp")
+
+;; Non-exhaustive pattern match
+(define (foo [e : Toplvl]) : Int
+  (case e
+    [(Expression x)
+      (case x
+        [(VARREF s) 1]
+        [(Top s) 2]
+        [(VariableReference s) 3] 
+        [(VariableReferenceTop s) 4]
+        [(VariableReferenceNull) 5]
+    	[(Quote d) 6]
+	[(QuoteSyntax d) 7]
+	[(QuoteSyntaxLocal d) 8]
+	[(Lambda formals lse) 9]
+        [(CaseLambda cases) 10]
+        [(LetValues binds body) 11]
+        [(LetrecValues binds body) 12]
+        [(If cond then else) 13]
+        [(Begin exprs) 14]
+        [(Begin0 e1 exprs) 15]
+        [(App rator rands) 16]
+        [(SetBang s e) 17]
+        [(WithContinuationMark e1 e2 e3) 18])]))
+;; TODO: Need to fill these out with error cases.
+
+; (foo (Expression (VARREF (quote hi))))

gibbon-compiler/src/Packed/FirstOrder/Passes/Codegen.hs

@@ -122,7 +122,7 @@ codegenProg prg@(Prog funs mtal) = do
             t' <- codegenTail t (codegenTy IntTy)
             return $ C.FuncDef [cfun| void __main_expr() { $items:t' } |] noLoc
           _ ->
-            return $ C.FuncDef [cfun| void __main_expr() { return 0; } |] noLoc
+            return $ C.FuncDef [cfun| void __main_expr() { return; } |] noLoc
 
 makeProt :: FunDecl -> SyM C.Definition
 makeProt fd = do fn <- codegenFun' fd  -- This is bad and I apologize

gibbon-compiler/src/Packed/FirstOrder/Passes/InlinePacked.hs

@@ -9,7 +9,7 @@ module Packed.FirstOrder.Passes.InlinePacked
     where
 
 import qualified Data.Map as M    
-import Packed.FirstOrder.Common (SyM, Var, dbgTrace, sdoc, lookupDataCon, DDefs)
+import Packed.FirstOrder.Common (SyM, Var, dbgTrace, ndoc, sdoc, lookupDataCon, DDefs)
 import qualified Packed.FirstOrder.L1_Source as L1
 import Packed.FirstOrder.L2_Traverse as L2
 import Prelude hiding (exp)
@@ -48,7 +48,7 @@ inlinePacked prg@L2.Prog{ddefs,fundefs,mainExp} = return $
 -- | Keep a map of the entire lexical environment, but only part of it
 -- is inlinable. (I.e. function arguments are not.)
 --
--- The policy at the momoent is to inline ONLY `isConstructor`
+-- The policy at the moment is to inline ONLY `isConstructor`
 -- bindings, and not to remove 
 inlinePackedExp :: DDefs L1.Ty -> [(Var,(L1.Ty, Maybe L1.Exp))] -> L1.Exp -> L1.Exp
 inlinePackedExp ddefs = exp True
@@ -76,9 +76,9 @@ inlinePackedExp ddefs = exp True
                   Just (_,Nothing)  -> VarE (var v) -- Bound, but non-inlinable binding.
                   -- Here we either inline just the copies, or we inline up to isConstructor
                   Just (ty,Just rhs)
-                   | VarE v2 <- rhs   -> keepGoing
+                   | VarE _v2 <- rhs   -> keepGoing
                      -- We allow a ProjE-of-AppE idiom:
-                   | ProjE i e <- rhs -> keepGoing
+                   | ProjE _i _e <- rhs -> keepGoing
                     -- IF we're in the RHS of an end-witness, don't duplicate code:
                    | not strong -> VarE v
                     -- Finally, we don't fully inline, but rather leave names visible:
@@ -91,7 +91,7 @@ inlinePackedExp ddefs = exp True
                     keepGoing = exp strong env rhs
 
     (LetE (v,t,rhs) bod)
-       | VarE v2    <- rhs  -> addAndGo  -- ^ We always do copy-prop.
+       | VarE _v2   <- rhs  -> addAndGo  -- ^ We always do copy-prop.
        | not (L2.hasRealPacked t) -> LetE (var v,t, rhs') 
                                      (exp strong ((v,(t,Nothing)):env) bod)
        | TimeIt{}   <- rhs  -> LetE (var v,t, rhs') (exp strong ((v,(t,Nothing)):env) bod)
@@ -103,7 +103,7 @@ inlinePackedExp ddefs = exp True
        -- Otherwise we have a case or an If.  We still inline those.
        | CaseE{} <- rhs  -> addAndGo
        | IfE{}  <- rhs   -> addAndGo
-       | otherwise -> error $ " [inlinePacked] unexpected Let RHS:\n  "++sdoc e0
+       | otherwise -> error $ " [inlinePacked] unexpected Let RHS:  "++ndoc rhs
       where
         -- Don't reduce anything on the RHS yet, just add it:
         addAndGo = exp strong ((v,(t,Just rhs)):env) bod
@@ -140,10 +140,11 @@ pattern NamedVal vr ty e = LetE (vr,ty,e) (VarE "NAMED_VAL_PATTERN_SYN")
 -- pattern NamedVal vr ty e <- LetE (vr,ty,e) (VarE "NAMED_VAL") where
 --   NamedVal vr ty e = LetE (vr,ty,e) (VarE vr)
 
--- | Is it the call that actually allocates output data? 
+-- | Is it a call that actually allocates output data? 
 isConstructor :: Exp -> Bool
 isConstructor ex =
   case ex of
-    AppE{} -> True
+    AppE{}      -> True -- ^ Fixme, shouldn't this depend on the type?
     MkPackedE{} -> True
+    PrimAppE (L1.ReadPackedFile _ _) _ -> True
     _ -> False

gibbon-compiler/src/Packed/FirstOrder/Passes/Typecheck.hs

@@ -98,6 +98,8 @@ typecheck' success prg@(L2.Prog defs _funs _main) = L2.mapMExprs fn prg
                  L1.SizeParam -> return $ Concrete IntTy 
                  L1.MkTrue    -> return $ Concrete BoolTy
                  L1.MkFalse   -> return $ Concrete BoolTy
+
+                 L1.ReadPackedFile _ ty -> return $ Concrete ty
 
                  -- _ -> failFresh $ "Case not handled in typecheck: " ++ (show p)
 
@@ -160,7 +162,7 @@ typecheck' success prg@(L2.Prog defs _funs _main) = L2.mapMExprs fn prg
                                       " but couldn't determine its type."
                           return Nothing
 
-    typecheckCases dd1 cs te1 ex1 = 
+    typecheckCases dd1 cs _te1 ex1 = 
         do tcs <- forM cs $ \(c,args,e) ->
                   do let targs = map Concrete $ lookupDataCon dd c
                          ntcenv = M.fromList (zip args targs) `M.union` tcenv
@@ -169,7 +171,7 @@ typecheck' success prg@(L2.Prog defs _funs _main) = L2.mapMExprs fn prg
            -- FIXME: need to assert that the types in tcs match what's expected from te
            return $ head tcs
 
-    typecheckPacked dd1 c tes =
+    typecheckPacked dd1 c _tes =
         do let te = Concrete $ L1.Packed $ getTyOfDataCon dd1 c
            -- FIXME: need to assert that tes match te
            return te