Raise exception when dividing by 0

And fix pretty-prinitng of functions

Fixes #44

.gitignore

@@ -10,4 +10,4 @@ dist
 *.tix
 
 # Files generated when running benchmarks
-report.html
+*.html

examples/icfp17-example.tml

@@ -6,9 +6,7 @@ let t = trace (
 let f = fun f (x : int) : unit =>
             if (x == 0)
             then y := 6 * !z
-            else if !z /= 0
-                 then y := 9 / !z
-                 else (raise "Division by zero") ;;
+            else y := 9 / !z ;;
             w := g (!y + 12) in
 (try f 0 with x => y := 42);; !y) in
 bwdSlice (t, 42)

examples/icfp17-example2.tml

@@ -9,7 +9,6 @@ in
 let t = trace (
     let a = ref 1 in
     let b = ref 2 in
-    map (fun f (c : ref int) : int => (b := !b - 1) ;;
-                   if !c == 0 then (raise "Division by zero") else 1 / !c)
+    map (fun f (c : ref int) : int => (b := !b - 1) ;; 1 / !c)
     RefCons (a, (RefCons (b, RefNil)))) in
 bwdSlice (t, raise "Division by zero")

lib/Language/Slicer/Eval.hs

@@ -133,7 +133,6 @@ evalMatch (ORet (VInL v)) m
 evalMatch (ORet (VInR v)) m
     = let (x, e) = inR m
       in maybeWithBinder x v (evalM' e)
-evalMatch (OExn v) _ = return (OExn v)
 evalMatch _ _
     = evalError "evalMatch: scrutinee does not reduce to a constructor"
 
@@ -189,31 +188,40 @@ evalTraceOp PrimProfile [ORet (VTrace _ t _ _)]
 evalTraceOp PrimProfileDiff [ORet (VTrace _ t _ _)]
     = do liftIO $ putStrLn (show (profileDiff t))
          return (ORet VUnit)
-evalTraceOp op vs = liftEvalM $ evalOpExn op vs
+evalTraceOp op vs = evalOpExn op vs
 
-evalOpExn :: Primitive -> [Outcome] -> SlM Outcome
+evalOpExn :: Primitive -> [Outcome] -> EvalM Outcome
 evalOpExn f rs =
   case extractExn rs of
-    Left vs -> do v <- evalOp f vs
-                  return (ORet v)
-    Right exn -> return (exn)
-  where extractExn [] = Left []
+    Left vs   -> evalOp f vs
+    Right exn -> return exn
+  where extractExn :: [Outcome] -> Either [Value] Outcome
+        extractExn [] = Left []
         extractExn (ORet v : rs') = case extractExn rs' of
                                         Left vs -> Left (v:vs)
                                         Right exn -> Right exn
         extractExn (OExn v : _) = Right (OExn v)
         extractExn _ = Right (OHole)
 
-evalOp :: Primitive -> [Value] -> SlM Value
-evalOp f [VInt    i, VInt    j] | isCommonOp  f = return ((commonOps ! f) (i,j))
-evalOp f [VBool   i, VBool   j] | isCommonOp  f = return ((commonOps ! f) (i,j))
-evalOp f [VString i, VString j] | isCommonOp  f = return ((commonOps ! f) (i,j))
-evalOp f [VInt    i, VInt    j] | isIntBinOp  f = return ((intBinOps ! f) (i,j))
-evalOp f [VInt    i, VInt    j] | isIntRelOp  f = return ((intRelOps ! f) (i,j))
-evalOp f [VBool   i, VBool   j] | isBoolRelOp f = return ((boolRelOps! f) (i,j))
-evalOp f [VBool   b]            | isBoolUnOp  f = return ((boolUnOps ! f) b)
-evalOp _ vs                     | VHole `elem` vs = return VHole
-evalOp _ vs                     | VStar `elem` vs = return VStar
+evalOp :: Primitive -> [Value] -> EvalM Outcome
+evalOp OpDiv [_    , VInt    0]
+    = return (OExn (VString "Division by zero"))
+evalOp f [VInt    i, VInt    j] | isCommonOp  f
+    = return (ORet ((commonOps ! f) (i,j)))
+evalOp f [VBool   i, VBool   j] | isCommonOp  f
+    = return (ORet ((commonOps ! f) (i,j)))
+evalOp f [VString i, VString j] | isCommonOp  f
+    = return (ORet ((commonOps ! f) (i,j)))
+evalOp f [VInt    i, VInt    j] | isIntBinOp  f
+    = return (ORet ((intBinOps ! f) (i,j)))
+evalOp f [VInt    i, VInt    j] | isIntRelOp  f
+    = return (ORet ((intRelOps ! f) (i,j)))
+evalOp f [VBool   i, VBool   j] | isBoolRelOp f
+    = return (ORet ((boolRelOps! f) (i,j)))
+evalOp f [VBool   b]            | isBoolUnOp  f
+    = return (ORet ((boolUnOps ! f) b))
+evalOp _ vs | VHole `elem` vs = return (ORet VHole)
+evalOp _ vs | VStar `elem` vs = return (ORet VStar)
 evalOp f vs = evalError ("Op " ++ show f ++ " not defined for " ++ show vs)
 
 -- Note [No exceptions in scrutinee]

lib/Language/Slicer/Resugar.hs

@@ -370,8 +370,8 @@ instance Pretty RMatch where
 
 instance Pretty RCode where
     pPrint (RRec name args body)
-        = text "fun" <+> pPrint name <+> sep (map pPrint args) <+> text "=>" <+>
-          nest 2 (pPrint body)
+        = parens (text "fun" <+> pPrint name <+> sep (map pPrint args)
+                  <+> text "=>" <+> nest 2 (pPrint body))
 
 -- | Should the expression be wrapped in parentheses?
 parenth :: RExp -> Bool

tests/golden-templates/icfp17-example.golden

@@ -1,7 +1,7 @@
 Running ../../examples/icfp17-example.tml
-val it = let f = fun f x => if x == 0
+val it = let f = (fun f x => if x == 0
                    then y := 6 * !z
-                   else _
+                   else _)
 in try
      f 0
    with _ =>

tests/golden-templates/icfp17-example2.golden

@@ -1,8 +1,5 @@
 Running ../../examples/icfp17-example2.tml
 val it = let a = _
 in let b = ref 2
-   in map
-      fun f c => b := !b - 1 ;; if !c == 0
-                                then raise "Division by zero"
-                                else _
+   in map (fun f c => b := !b - 1 ;; 1 / !c)
       RefCons (_, RefCons (b, _)) : trace(intlist)