1. remove the dependency on mk to run the tests; 2. make Ast an instance of Eq such...
authorNing Wang <email@ningwang.org>
Sat, 25 Apr 2015 04:04:16 +0000 (21:04 -0700)
committerNing Wang <email@ningwang.org>
Sat, 25 Apr 2015 04:04:16 +0000 (21:04 -0700)
25 files changed:
.gitignore
README
hoopl.cabal
src/Compiler/Hoopl.hs
src/Compiler/Hoopl/Fuel.hs
src/Compiler/Hoopl/Graph.hs
src/Compiler/Hoopl/Unique.hs
testing/Ast.hs
testing/Ast2ir.hs
testing/Expr.hs
testing/Ir2ast.hs [new file with mode: 0644]
testing/Main.hs
testing/README
testing/Test.hs
testing/mkfile [deleted file]
testing/tests/ExpectedOutput
testing/tests/if-test.expected [new file with mode: 0644]
testing/tests/if-test2.expected [new file with mode: 0644]
testing/tests/if-test3.expected [new file with mode: 0644]
testing/tests/if-test4.expected [new file with mode: 0644]
testing/tests/test1.expected [new file with mode: 0644]
testing/tests/test2.expected [new file with mode: 0644]
testing/tests/test3.expected [new file with mode: 0644]
testing/tests/test4.expected [new file with mode: 0644]
validate [deleted file]

index 74592d8..392c4de 100644 (file)
@@ -29,4 +29,4 @@ dist
 /dist-install
 /dist-boot
 /ghc.mk
-
+.hpc
diff --git a/README b/README
index 3de87b1..2015598 100644 (file)
--- a/README
+++ b/README
@@ -17,6 +17,10 @@ To build the library, change to the src directory and run
   cabal build
   cabal install --enable-documentation
 
+To run the tests in the folder testing/, change to the top level and run
+  cabal configure --enable-tests
+  cabal test
+
 You'll need a Haskell Platform, which should include appropriate
 versions of Cabal and GHC.
 
index 39e6920..e1bcf8d 100644 (file)
@@ -1,5 +1,5 @@
 Name:                hoopl
-Version:             3.10.1.0
+Version:             3.10.2.1
 -- NOTE: Don't forget to update ./changelog.md
 Description:
   Higher-order optimization library
@@ -10,7 +10,7 @@ Description:
 License:             BSD3
 License-File:        LICENSE
 Author:              Norman Ramsey, Joao Dias, Simon Marlow and Simon Peyton Jones
-Maintainer:          nr@cs.tufts.edu
+Maintainer:          Ning Wang <email@ningwang.org>, Andreas Voellmy <andreas.voellmy@gmail.com>
 Homepage:            http://ghc.cs.tufts.edu/hoopl/
 Bug-Reports:         http://ghc.haskell.org/trac/ghc/newticket?component=libraries/hoopl
 Build-Type:          Simple
@@ -68,3 +68,13 @@ Library
 
   Ghc-Options:       -Wall -fno-warn-name-shadowing
 
+Test-Suite hoopl-test
+  Default-Language:  Haskell2010
+  Type:              exitcode-stdio-1.0
+  Main-Is:           Main.hs
+  Hs-Source-Dirs:    testing src
+  Ghc-Options:       -fhpc -Wall
+  Build-Depends:     base >= 4.3 && < 4.9, 
+                     containers >= 0.4 && < 0.6,
+                     parsec >= 3.1.7,
+                     mtl >= 2.1.3.1
index 7858f42..27a81a2 100644 (file)
@@ -29,7 +29,7 @@ import Compiler.Hoopl.Dataflow hiding ( wrapFR, wrapFR2, wrapBR, wrapBR2
 import Compiler.Hoopl.Debug
 import Compiler.Hoopl.Fuel hiding (withFuel, getFuel, setFuel)
 import Compiler.Hoopl.Block
-import Compiler.Hoopl.Graph hiding (splice, gSplice)
+import Compiler.Hoopl.Graph hiding (splice{-, gSplice-})
 import Compiler.Hoopl.Label hiding (uniqueToLbl, lblToUnique)
 import Compiler.Hoopl.MkGraph
 import Compiler.Hoopl.Pointed
index d6b042e..da6d490 100644 (file)
@@ -21,9 +21,14 @@ where
 import Compiler.Hoopl.Checkpoint
 import Compiler.Hoopl.Unique
 
+#if CABAL
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative (Applicative(..))
 #endif
+#else
+import Control.Applicative (Applicative(..))
+#endif
+
 import Control.Monad (ap,liftM)
 
 class Monad m => FuelMonad m where
index 21ded58..80add5c 100644 (file)
@@ -46,9 +46,13 @@ import Compiler.Hoopl.Collections
 import Compiler.Hoopl.Block
 import Compiler.Hoopl.Label
 
+#if CABAL
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative (Applicative(..))
 #endif
+#else
+import Control.Applicative (Applicative(..))
+#endif
 import Control.Monad (ap,liftM,liftM2)
 
 -- -----------------------------------------------------------------------------
index 42e2b23..0744f3d 100644 (file)
@@ -24,9 +24,14 @@ import Compiler.Hoopl.Collections
 import qualified Data.IntMap as M
 import qualified Data.IntSet as S
 
+#ifdef CABAL
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative
 #endif
+#else
+import Control.Applicative
+#endif
+
 import Control.Monad (ap,liftM)
 
 -----------------------------------------------------------------------------
index 190af83..e7333d2 100644 (file)
@@ -1,21 +1,22 @@
 {-# OPTIONS_GHC -Wall #-}
 {-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, NamedFieldPuns #-}
-module Ast (Proc(..), Block(..), Insn(..), Control(..), Lbl) where
+module Ast (Proc(..), Block(..), Insn(..), Control(..), Lbl, showProc) where
 
 import Expr
+import PP
 
 -- | A procedure has a name, a sequence of arguments, and a body,
 --   which is a sequence of basic blocks. The procedure entry
 --   is the first block in the body.
-data Proc = Proc { name :: String, args :: [Var], body :: [Block] }
+data Proc = Proc { name :: String, args :: [Var], body :: [Block] } deriving Eq
 
 -- | A block consists of a label, a sequence of instructions,
 --   and a control-transfer instruction.
-data Block = Block { first :: Lbl, mids :: [Insn], last :: Control }
+data Block = Block { first :: Lbl, mids :: [Insn], last :: Control } deriving Eq
 
 -- | An instruction is an assignment to a variable or a store to memory.
 data Insn = Assign Var  Expr
-          | Store  Expr Expr
+          | Store  Expr Expr deriving (Eq)
 
 -- | Control transfers are branches (unconditional and conditional),
 --   call, and return.
@@ -26,7 +27,39 @@ data Insn = Assign Var  Expr
 data Control = Branch Lbl
              | Cond   Expr   Lbl    Lbl
              | Call   [Var]  String [Expr] Lbl
-             | Return [Expr]
+             | Return [Expr] deriving (Eq)
 
 -- | Labels are represented as strings in an AST.
 type Lbl = String
+
+
+
+showProc :: Proc -> String
+showProc (Proc { name = n, args = as, body = blks}) 
+  = n ++ tuple as ++ graph
+  where
+    graph  = foldl (\p b -> p ++ "\n" ++ show b) (" {") blks ++ "\n}\n"
+
+instance Show Block where
+  show (Block f m l) = (foldl (\p e -> p ++ "\n" ++ show e) (f++":") m) ++ "\n" ++ show l 
+
+instance Show Insn where
+  show (Assign v e)       = ind $ v ++ " = " ++ show e
+  show (Store addr e)     = ind $ "m[" ++ show addr ++ "] = " ++ show e
+  
+instance Show Control where  
+  show (Branch lbl)       = ind $ "goto " ++ lbl
+  show (Cond e t f)       =
+    ind $ "if " ++ show e ++ " then goto " ++ t ++ " else goto " ++ f
+  show (Call ress f cargs succ) =
+    ind $ tuple ress ++ " = " ++ f ++ tuple (map show cargs) ++ " goto " ++ succ
+  show (Return      rargs) = ind $ "ret " ++ tuple (map show rargs)
+
+ind :: String -> String
+ind x = "  " ++ x
+
+{-
+instance Show Value where
+  show (B b) = show b
+  show (I i) = show i
+-}
index b22c411..ff227e8 100644 (file)
@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -Wall #-}
 {-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, NamedFieldPuns #-}
-module Ast2ir (astToIR) where
+module Ast2ir (astToIR, IdLabelMap) where
 
 import           Compiler.Hoopl
 import           Control.Monad
@@ -17,17 +17,19 @@ import qualified IR  as I
 -- the following operation:
 labelFor :: String -> LabelMapM Label
 getBody  :: forall n. Graph n C C   -> LabelMapM (Graph n C C)
-run      :: LabelMapM a -> I.M a
+run      :: LabelMapM a -> I.M (IdLabelMap, a)
 
 -- We proceed with the translation from AST to IR; the implementation of the monad
 -- is at the end of this file.
 
-astToIR :: A.Proc -> I.M I.Proc
+astToIR :: A.Proc -> I.M (IdLabelMap, I.Proc)
 astToIR (A.Proc {A.name = n, A.args = as, A.body = b}) = run $
   do entry <- getEntry b
      body  <- toBody   b
      return $ I.Proc { I.name  = n, I.args = as, I.body = body, I.entry = entry }
+     
 
+          
 getEntry :: [A.Block] -> LabelMapM Label
 getEntry [] = error "Parsed procedures should not be empty"
 getEntry (b : _) = labelFor $ A.first b
@@ -80,4 +82,4 @@ labelFor l = LabelMapM f
 getBody graph = LabelMapM f
   where f m = return (m, graph)
 
-run (LabelMapM f) = f M.empty >>=  return . snd
+run (LabelMapM f) = f M.empty -- >>=  return -- . snd
index 17f809a..1b91c94 100644 (file)
@@ -7,11 +7,12 @@ import PP
 data Expr = Lit   Lit
           | Var   Var
           | Load  Expr
-          | Binop BinOp Expr Expr
-data BinOp = Add | Sub | Mul | Div | Eq | Ne | Lt | Gt | Lte | Gte
+          | Binop BinOp Expr Expr deriving (Eq)
+                                           
+data BinOp = Add | Sub | Mul | Div | Eq | Ne | Lt | Gt | Lte | Gte deriving Eq
 
 data Lit = Bool Bool | Int Integer deriving Eq
-type Var = String
+type Var = String 
 
 --------------------------------------------------------------------------------
 --- Prettyprinting
diff --git a/testing/Ir2ast.hs b/testing/Ir2ast.hs
new file mode 100644 (file)
index 0000000..fdc9c77
--- /dev/null
@@ -0,0 +1,88 @@
+{-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, NamedFieldPuns #-}
+module Ir2ast (irToAst) where
+
+import           Compiler.Hoopl
+import           Control.Monad
+import qualified Data.Map       as M
+
+import qualified Ast as A
+import qualified IR  as I
+import Control.Monad.Reader
+
+type Rm = Reader (M.Map Label A.Lbl)
+
+invertMap :: (Ord k, Ord v) => M.Map k v -> M.Map v k
+invertMap m = foldl (\p (k,v) -> 
+                      if M.member v p 
+                      then error $ "irrefutable error in invertMap, the values are not unique"
+                      else M.insert v k p
+                    ) M.empty (M.toList m)
+
+
+strLabelFor :: Label -> Rm String
+strLabelFor l = do { mp <- ask
+                   ; case M.lookup l mp of
+                     Just x -> return x
+                     Nothing -> return $ "_hoopl_generated_label_" ++ (show l)
+                   }
+
+irToAst :: M.Map String Label -> I.Proc -> A.Proc
+irToAst mp (I.Proc {I.name = n, I.args = as, I.body = graph, I.entry = entry }) = 
+  runReader (do { body <- fromGraph entry graph
+                ; return $ A.Proc { A.name = n, A.args = as, A.body = body }
+                }) (invertMap mp)
+
+fromGraph :: Label -> Graph I.Insn C C -> Rm [A.Block]
+fromGraph entry g = let entryNode = gUnitOC (BlockOC BNil (I.Branch entry))
+                        blks = reverse $ postorder_dfs (gSplice entryNode g)
+                    in foldM (\p blk -> do { ablk <- fromBlock blk ()
+                                           ; return (ablk:p)
+                                           }) [] blks
+               
+              
+
+type instance IndexedCO C () (Rm (A.Lbl, [A.Insn])) = ()
+type instance IndexedCO C (Rm A.Block) (Rm (A.Lbl, [A.Insn])) = Rm A.Block
+
+fromBlock :: Block I.Insn C C -> () -> Rm A.Block
+fromBlock blk = foldBlockNodesF3 (fromIrInstCO, fromIrInstOO, fromIrInstOC) blk 
+
+  
+fromIrInstCO :: I.Insn C O -> () -> Rm (A.Lbl, [A.Insn])
+fromIrInstCO inst p = case inst of
+  I.Label l -> strLabelFor l >>= \x -> return (x, [])
+
+  
+fromIrInstOO :: I.Insn O O -> Rm (A.Lbl, [A.Insn]) -> Rm (A.Lbl, [A.Insn])
+fromIrInstOO inst p = case inst of
+  I.Assign v e -> do { (sl, insts) <- p
+                     ; return (sl, (A.Assign v e):insts)
+                     }
+  I.Store a e -> do { (sl, insts) <- p 
+                    ; return (sl, (A.Store a e):insts)
+                    }
+
+
+fromIrInstOC :: I.Insn e x -> Rm (A.Lbl, [A.Insn]) -> Rm A.Block
+fromIrInstOC inst p = case inst of
+  I.Branch tl -> do { (l, insts) <- p 
+                    ; stl <- strLabelFor tl
+                    ; return $ A.Block {A.first = l, A.mids = reverse insts 
+                                       , A.last = A.Branch stl}
+                    }
+  I.Cond e tl fl -> do { (l, insts)<- p
+                       ; stl <- strLabelFor tl
+                       ; sfl <- strLabelFor fl
+                       ; return $ A.Block {A.first = l, A.mids = reverse insts
+                                          , A.last = A.Cond e stl sfl}
+                       }
+  I.Call vars name exps el -> do { (l, insts) <- p
+                                 ; tel <- strLabelFor el
+                                 ; return $ A.Block {A.first = l, A.mids = reverse insts
+                                                    , A.last = A.Call vars name exps tel}
+                                 }
+  I.Return exps -> do { (l, insts) <- p
+                      ; return $ A.Block {A.first = l, A.mids = reverse insts
+                                         , A.last = A.Return exps}
+                      }
index 6db804b..a6f90f0 100644 (file)
@@ -4,12 +4,17 @@ import Test
 import System.IO
 
 -- Hardcoding test locations for now
-tests = map (\t -> "tests" ++ "/" ++ t)
-            (["test1", "test2", "test3", "test4"] ++
+tests = map (\t -> "testing" ++ "/" ++ "tests" ++ "/" ++ t)
+        (["test1", "test2", "test3", "test4"] ++
              ["if-test", "if-test2", "if-test3", "if-test4"])
+        
+test_expected_results = map (\t -> "testing" ++ "/" ++ "tests" ++ "/" ++ t)
+                        (["test1.expected", "test2.expected", "test3.expected", "test4.expected"] ++
+                         ["if-test.expected", "if-test2.expected", "if-test3.expected", "if-test4.expected"])
+        
 
 main :: IO ()
 main = do hSetBuffering stdout NoBuffering
           hSetBuffering stderr NoBuffering
-          mapM (\x -> putStrLn ("Test:" ++ x) >> parseTest x >> optTest x) tests
+          mapM (\(x, ex) -> putStrLn ("Test:" ++ x) >> parseTest x >> optTest x ex) (zip tests test_expected_results)
           return ()
index bcb6846..883d899 100644 (file)
@@ -1,6 +1,5 @@
 Here is some testing code which may also serve as a sample client.
 
-
 Base system
 ~~~~~~~~~~~
   Ast.hs         Abstract syntax for a language of basic blocks,
@@ -15,6 +14,9 @@ Base system
                  the string labels in the source from the abstract Labels
                  defined by Hoopl.
 
+  Ir2Ast.hs      Translated from IR to Ast. The original string Labels to the
+                 abstract Labels mappings are used to do this translation.
+
 
 Optimizations
 ~~~~~~~~~~~~~
index 8c34b1c..f007b49 100644 (file)
@@ -4,7 +4,10 @@ module Test (parseTest, evalTest, optTest) where
 
 import Compiler.Hoopl
 import Control.Monad.Error
+import System.Exit
 
+import qualified Ast as A
+import qualified Ir2ast as Ia
 import Ast2ir
 import ConstProp
 import Eval  (evalProg, ErrorM)
@@ -14,7 +17,7 @@ import Parse (parseCode)
 import Simplify
 import Debug.Trace
 
-parse :: String -> String -> ErrorM (M [Proc])
+parse :: String -> String -> ErrorM (M [(IdLabelMap, Proc)])
 parse file text =
   case parseCode file text of
     Left  err -> throwError $ show err
@@ -25,12 +28,12 @@ parseTest file =
   do text <- readFile file
      case parse file text of
        Left err -> putStrLn err
-       Right p  -> mapM (putStrLn . showProc) (runSimpleUniqueMonad $ runWithFuel 0 p) >> return ()
+       Right p  -> mapM (putStrLn . showProc . snd) (runSimpleUniqueMonad $ runWithFuel 0 p) >> return ()
 
 evalTest' :: String -> String -> ErrorM String
 evalTest' file text =
   do procs   <- parse file text
-     (_, vs) <- testProg (runSimpleUniqueMonad $ runWithFuel 0 procs)
+     (_, vs) <- (testProg . snd . unzip) (runSimpleUniqueMonad $ runWithFuel 0 procs)
      return $ "returning: " ++ show vs
   where
     testProg procs@(Proc {name, args} : _) = evalProg procs vsupply name (toV args)
@@ -45,10 +48,9 @@ evalTest file =
        Left err -> putStrLn err
        Right  s -> putStrLn s
 
-optTest' :: String -> String -> ErrorM (M [Proc])
-optTest' file text =
-  do procs <- parse file text
-     return $ procs >>= mapM optProc
+optTest' :: M [Proc] -> ErrorM (M [Proc])
+optTest' procs = 
+  return $ procs >>= mapM optProc
   where
     optProc proc@(Proc {entry, body, args}) =
       do { (body',  _, _) <- analyzeAndRewriteFwd fwd (JustC [entry]) body
@@ -74,14 +76,50 @@ constPropPass = FwdPass
   , fp_rewrite  = constProp `thenFwdRw` simplify }
 -- @ end cprop.tex
 
-optTest :: String -> IO ()
-optTest file =
+toAst :: [(IdLabelMap, Proc)] -> [A.Proc] 
+toAst l = fmap (uncurry Ia.irToAst) l 
+
+compareAst :: [A.Proc] -> [A.Proc] -> IO ()
+compareAst [] [] = return ()
+compareAst (r:results) (e:expected) =
+  if r == e
+  then compareAst results expected
+  else 
+    do { putStrLn "expecting"
+       ; putStrLn $ A.showProc e
+       ; putStrLn "resulting"
+       ; putStrLn $ A.showProc r
+       ; putStrLn "the result does not match the expected, abort the test!!!!"
+       ; exitFailure
+       }
+compareAst results expected = do { putStrLn "expecting"
+                                 ; mapM_ (putStrLn . A.showProc) expected
+                                 ; putStrLn "resulting"
+                                 ; mapM_ (putStrLn . A.showProc) results
+                                 ; putStrLn "the result does not match the expected, abort the test!!!!"
+                                 ; exitFailure
+                                 }
+        
+  
+
+optTest :: String -> String -> IO ()
+optTest file expectedFile =
   do text    <- readFile file
-     case optTest' file text of
-       Left err -> putStrLn err
-       Right p  -> mapM_ (putStrLn . showProc) (runSimpleUniqueMonad $ runWithFuel fuel p)
+     expectedText <- readFile expectedFile
+     case (parse file text, parse expectedFile expectedText) of
+       (Left err, _) -> putStrLn err
+       (_, Left err) -> putStrLn err
+       (Right lps, Right exps) -> 
+         case optTest' (liftM (snd . unzip) lps) of
+           Left err -> putStrLn err
+           Right p  -> do { let opted = runSimpleUniqueMonad $ runWithFuel fuel p
+                                lbmaps = runSimpleUniqueMonad $ runWithFuel fuel (liftM (fst . unzip) lps)
+                                expected = runSimpleUniqueMonad $ runWithFuel fuel exps
+                          ; mapM_ (putStrLn . showProc) opted
+                          ; compareAst (toAst (zip lbmaps opted)) (toAst expected)
+                          }
   where
-    fuel = 99999
+    fuel = 9999
 
 
 
diff --git a/testing/mkfile b/testing/mkfile
deleted file mode 100644 (file)
index 4778294..0000000
+++ /dev/null
@@ -1,22 +0,0 @@
-HS=`echo *.hs`
-
-all:V: Main
-clean:V: 
-       rm -f Main
-       rm -f *.o *.hi *~
-
-Main: $HS
-       ghc --make Main.hs
-
-FUNSOUT=16
-
-test:VQ: 
-       rm -f Main
-       ghc --make Main.hs
-       if ./Main > /dev/null && [ `./Main | grep '^f.*{$' | wc -l ` -eq $FUNSOUT ]
-       then
-         echo "Passed `expr $FUNSOUT / 2` tests" >&2
-       else
-          echo "Test failed" >&2
-         exit 1
-        fi
index 9ee7ffc..22cc56a 100644 (file)
@@ -1,4 +1,5 @@
-Test:tests/test1
+Test suite hoopl-test: RUNNING...
+Test:testing/tests/test1
 f(a, b) {
 L1:
   r0 = 3
@@ -9,10 +10,18 @@ L1:
 
 f(a, b) {
 L1:
+  r0 = 3
+  r1 = 4
+  r2 = 7
+  ret (7)
+}
+
+f(a, b) {
+L1:
   ret (7)
 }
 
-Test:tests/test2
+Test:testing/tests/test2
 f(a, b) {
 L1:
   x = 5
@@ -43,7 +52,22 @@ L4:
   ret (y)
 }
 
-Test:tests/test3
+f(a, b) {
+L1:
+  x = 5
+  y = 0
+  goto L2
+L2:
+  if x > 0 then goto L3 else goto L4
+L3:
+  y = y + x
+  x = x - 1
+  goto L2
+L4:
+  ret (y)
+}
+
+Test:testing/tests/test3
 f(x, y) {
 L1:
   goto L2
@@ -74,7 +98,22 @@ L5:
   goto L2
 }
 
-Test:tests/test4
+f(x, y) {
+L1:
+  goto L2
+L2:
+  if x > 0 then goto L3 else goto L4
+L3:
+  (z) = f(x - 1, y - 1) goto L5
+L4:
+  ret (y)
+L5:
+  y = y + z
+  x = x - 1
+  goto L2
+}
+
+Test:testing/tests/test4
 f(x) {
 L1:
   y = 5
@@ -90,6 +129,16 @@ L4:
 
 f(x) {
 L1:
+  y = 5
+  goto L2
+L2:
+  goto L4
+L4:
+  ret ((x + 5) + 4)
+}
+
+f(x) {
+L1:
   goto L2
 L2:
   goto L4
@@ -97,7 +146,7 @@ L4:
   ret ((x + 5) + 4)
 }
 
-Test:tests/if-test
+Test:testing/tests/if-test
 f() {
 L1:
   x = 3 + 4
@@ -111,12 +160,21 @@ L3:
 
 f() {
 L1:
+  x = 7
+  z = True
+  goto L2
+L2:
+  ret (1)
+}
+
+f() {
+L1:
   goto L2
 L2:
   ret (1)
 }
 
-Test:tests/if-test2
+Test:testing/tests/if-test2
 f(a) {
 L1:
   x = 3 + 4
@@ -141,6 +199,7 @@ L7:
 
 f(a) {
 L1:
+  x = 7
   res = 0
   goto L2
 L2:
@@ -157,7 +216,25 @@ L7:
   goto L2
 }
 
-Test:tests/if-test3
+f(a) {
+L1:
+  res = 0
+  goto L2
+L2:
+  if a > 0 then goto L3 else goto L4
+L3:
+  a = a - 1
+  res = res + 7
+  goto L5
+L4:
+  ret (res)
+L5:
+  goto L7
+L7:
+  goto L2
+}
+
+Test:testing/tests/if-test3
 f(x) {
 L1:
   if x > 5 then goto L2 else goto L3
@@ -175,14 +252,40 @@ f(x) {
 L1:
   if x > 5 then goto L2 else goto L3
 L2:
+  z = 1
   goto L4
 L3:
+  z = 1
   goto L4
 L4:
   ret (1)
 }
 
-Test:tests/if-test4
+f(x) {
+L1:
+  if x > 5 then goto L2 else goto L3
+L2:
+  goto L4
+L3:
+  goto L4
+L4:
+  ret (1)
+}
+
+Test:testing/tests/if-test4
+f(x) {
+L1:
+  if x > 5 then goto L2 else goto L3
+L2:
+  z = 1
+  goto L4
+L3:
+  z = 2
+  goto L4
+L4:
+  ret (z)
+}
+
 f(x) {
 L1:
   if x > 5 then goto L2 else goto L3
@@ -209,3 +312,5 @@ L4:
   ret (z)
 }
 
+Test suite hoopl-test: PASS
+Test suite logged to: dist/test/hoopl-3.10.2.1-hoopl-test.log
diff --git a/testing/tests/if-test.expected b/testing/tests/if-test.expected
new file mode 100644 (file)
index 0000000..9957111
--- /dev/null
@@ -0,0 +1,6 @@
+f() {
+L0:
+  goto "L1"
+L1:
+  ret (1)
+}
\ No newline at end of file
diff --git a/testing/tests/if-test2.expected b/testing/tests/if-test2.expected
new file mode 100644 (file)
index 0000000..d2abcb7
--- /dev/null
@@ -0,0 +1,17 @@
+f(a) {
+L0:
+  res = 0
+  goto L1
+L1:
+  if a > 0 then goto L2 else goto L6
+L6:
+  ret (res)
+L2:
+  a = a - 1
+  res = res + 7
+  goto L3
+L3:
+  goto L5
+L5:
+  goto L1
+}
diff --git a/testing/tests/if-test3.expected b/testing/tests/if-test3.expected
new file mode 100644 (file)
index 0000000..f87eeba
--- /dev/null
@@ -0,0 +1,10 @@
+f(x) {
+L0:
+  if x > 5 then goto L1 else goto L2
+L2:
+  goto L3
+L1:
+  goto L3
+L3:
+  ret (1)
+}
diff --git a/testing/tests/if-test4.expected b/testing/tests/if-test4.expected
new file mode 100644 (file)
index 0000000..6c2adc9
--- /dev/null
@@ -0,0 +1,12 @@
+f(x) {
+L0:
+  if x > 5 then goto L1 else goto L2
+L1:
+  z = 1
+  goto L3
+L2:
+  z = 2
+  goto L3
+L3:
+  ret (z)
+}
diff --git a/testing/tests/test1.expected b/testing/tests/test1.expected
new file mode 100644 (file)
index 0000000..34c5767
--- /dev/null
@@ -0,0 +1,4 @@
+f (a, b) {
+L100:
+  ret (7)
+}
diff --git a/testing/tests/test2.expected b/testing/tests/test2.expected
new file mode 100644 (file)
index 0000000..48ae0ff
--- /dev/null
@@ -0,0 +1,14 @@
+f (a, b) {
+L100:
+  x = 5
+  y = 0
+  goto L101
+L101:
+  if x > 0 then goto L102 else goto L103
+L102:
+  y = y + x
+  x = x - 1
+  goto L101
+L103:
+  ret (y)
+}
diff --git a/testing/tests/test3.expected b/testing/tests/test3.expected
new file mode 100644 (file)
index 0000000..9dd9bce
--- /dev/null
@@ -0,0 +1,14 @@
+f (x, y) {
+L100:
+  goto L101
+L101:
+  if x > 0 then goto L102 else goto L104
+L102:
+  (z) = f(x-1, y-1) goto L103
+L103:
+  y = y + z
+  x = x - 1
+  goto L101
+L104:
+  ret (y)
+}
diff --git a/testing/tests/test4.expected b/testing/tests/test4.expected
new file mode 100644 (file)
index 0000000..e0b9da1
--- /dev/null
@@ -0,0 +1,9 @@
+f(x) {
+L100:
+  goto "L101"
+L101:
+  goto "L103"
+L103:
+  ret ((x + 5) + 4)
+}
+
diff --git a/validate b/validate
deleted file mode 100755 (executable)
index 4458c48..0000000
--- a/validate
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/bin/sh
-
-set -e
-
-cabal sdist
-
-cd src && mk
-cd ../testing && mk