cleaning duties

src/Core/Examples.hs

@@ -78,10 +78,14 @@ facExample = [coreProg|
     main = fac 3;
 |]
 
-pairExample = [coreProg|
+pairExample1 = [coreProg|
     main = fst (snd (fst (MkPair (MkPair 1 (MkPair 2 3)) 4)));
 |]
 
+pairExample2 = [coreProg|
+    main = (if# False fst snd) (MkPair 2 3);
+|]
+
 corePrelude :: Module
 corePrelude = Module (Just ("Prelude", [])) $ Program
     [ ScDef "id" ["x"] $ "x"

src/TIM.hs

@@ -262,27 +262,26 @@ step st =
         primStep _ IntDivP st = primArith (div) st
         primStep _ IntEqP  st = primComp  (==) st
 
-        primStep _ IfP (TiState s d h g sts) = TiState s' d' h' g sts
+        primStep _ IfP (TiState s d h g sts) =
+            case needsEval cn of
+                True  -> TiState s' d' h g sts
                     where
-                -- the condition is evaluated if it is not in normal form
+                        s' = [c]
-                s' | needsEval cn               = [c]
+                        d' = drop 1 s : d
-                   | otherwise                  = drop 3 s
+                False -> TiState s' d h' g sts
-
+                    where
-                d' | needsEval cn               = drop 1 s : d
+                        s' = drop 3 s
-                   | otherwise                  = d
+                        h' = update rootAddr res h
-
+                        res = NInd $ if isTrue then t else f
-                h' | needsEval cn               = h
-                   | otherwise                  =
-                       update rootAddr (NInd $ if isTrue then t else f) h
-
-                [cn,tn,fn] = hViewUnsafe h <$> [c,t,f]
-                [c,t,f] = getArgs h s
                         rootAddr = head s'
                         isTrue = case cn of
-                    -- see Core.Examples.corePrelude; True and False are defined
+                            -- see Core.Examples.corePrelude; True and False are
-                    -- as Con 1 0 and Con 0 0, respectively
+                            -- defined as Con 1 0 and Con 0 0, respectively
                             NData 0 [] -> False
                             NData 1 [] -> True
+            where
+                cn = hLookupUnsafe c h
+                (c:t:f:_) = getArgs h s
 
         primStep _ CasePairP (TiState s d h g sts) =
             case needsEval pn of
@@ -300,7 +299,7 @@ step st =
                         a2 = s' !! 1
                         NData 0 [x,y] = pn
             where
-                [p,f] = getArgs h s
+                (p:f:_) = getArgs h s
                 pn = hLookupUnsafe p h
 
         primStep n (ConP t a) (TiState s d h g sts) =