From 3f95779bf61165e5738964476cc52a39071c7bdc Mon Sep 17 00:00:00 2001 From: Ryan Newton Date: Tue, 3 Jan 2017 16:25:27 -0500 Subject: [PATCH] Activate test25b, which is passing. Add more test25 tests. --- gibbon-compiler/examples/Makefile | 17 +++++++---- .../examples/test25b_racketcore.sexp | 30 +++++++------------ .../examples/test25c_racketcore.sexp | 16 ++++++++++ .../examples/test25d_racketcore.sexp | 30 +++++++++++++++++++ .../src/Packed/FirstOrder/Passes/Codegen.hs | 2 +- .../Packed/FirstOrder/Passes/InlinePacked.hs | 17 ++++++----- .../src/Packed/FirstOrder/Passes/Typecheck.hs | 6 ++-- 7 files changed, 81 insertions(+), 37 deletions(-) create mode 100644 gibbon-compiler/examples/test25c_racketcore.sexp create mode 100644 gibbon-compiler/examples/test25d_racketcore.sexp diff --git a/gibbon-compiler/examples/Makefile b/gibbon-compiler/examples/Makefile index 6d7e4b2da..9886f59b9 100644 --- a/gibbon-compiler/examples/Makefile +++ b/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,7 +167,7 @@ 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 \ @@ -170,7 +175,7 @@ INTERP2_FAILING = test00b_printBool.sexp test06a_two_cases.sexp test06b_case.sex 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... diff --git a/gibbon-compiler/examples/test25b_racketcore.sexp b/gibbon-compiler/examples/test25b_racketcore.sexp index e692fb90b..b5acc987b 100644 --- a/gibbon-compiler/examples/test25b_racketcore.sexp +++ b/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])])) \ No newline at end of file + ;; 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)))) diff --git a/gibbon-compiler/examples/test25c_racketcore.sexp b/gibbon-compiler/examples/test25c_racketcore.sexp new file mode 100644 index 000000000..ec87fa2c3 --- /dev/null +++ b/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)))) diff --git a/gibbon-compiler/examples/test25d_racketcore.sexp b/gibbon-compiler/examples/test25d_racketcore.sexp new file mode 100644 index 000000000..7cead8232 --- /dev/null +++ b/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)))) diff --git a/gibbon-compiler/src/Packed/FirstOrder/Passes/Codegen.hs b/gibbon-compiler/src/Packed/FirstOrder/Passes/Codegen.hs index d146c0417..7910ddda3 100644 --- a/gibbon-compiler/src/Packed/FirstOrder/Passes/Codegen.hs +++ b/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 diff --git a/gibbon-compiler/src/Packed/FirstOrder/Passes/InlinePacked.hs b/gibbon-compiler/src/Packed/FirstOrder/Passes/InlinePacked.hs index 64a9616ca..547826e49 100644 --- a/gibbon-compiler/src/Packed/FirstOrder/Passes/InlinePacked.hs +++ b/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 diff --git a/gibbon-compiler/src/Packed/FirstOrder/Passes/Typecheck.hs b/gibbon-compiler/src/Packed/FirstOrder/Passes/Typecheck.hs index 34ef9e652..dde9cd80b 100644 --- a/gibbon-compiler/src/Packed/FirstOrder/Passes/Typecheck.hs +++ b/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