@@ -81,7 +81,7 @@ toTT (EApp e1 e2) = do e1' <- toTT e1
8181toTT (EType u) = return $ TType u
8282toTT EErased = return Erased
8383toTT (EConstant c) = return (Constant c)
84−toTT (EThunk i) = (force i) >>= toTT
84+toTT (EThunk i) = return (P (DCon 0 0) (MN i "THUNK") Erased) --(force i) >>= toTT
8585toTT (EHandle _) = return Erased
8686
8787unApplyV :: ExecVal -> (ExecVal, [ExecVal])
@@ -163,7 +163,7 @@ ioWrap tm = mkEApp (EP (DCon 0 2) (UN "prim__IO") EErased) [EErased, tm]
163163ioUnit :: ExecVal
164164ioUnit = ioWrap (EP Ref unitCon EErased)
165165
166−type ExecEnv = [(Name, Binder ExecVal)]
166+type ExecEnv = [(Name, ExecVal)]
167167
168168doExec :: ExecEnv -> Context -> Term -> Exec ExecVal
169169doExec env ctxt p@(P Ref n ty) =
@@ -179,22 +179,17 @@ doExec env ctxt p@(P Ref n ty) =
179179doExec env ctxt p@(P Bound n ty) =
180180 case lookup n env of
181181 Nothing -> execFail "not found"
182− Just (Let _ tm) -> return tm
183− Just b -> execFail $ "Unknown binder " ++ show b
182+ Just tm -> return tm
184183doExec env ctxt (P (DCon a b) n _) = return (EP (DCon a b) n EErased)
185184doExec env ctxt (P (TCon a b) n _) = return (EP (TCon a b) n EErased)
186−doExec env ctxt v@(V i) | i < length env = do let binder = env !! i
187− case binder of
188− (_, (Let t v)) -> return v
189− (_, (NLet t v)) -> return v
190− (n, b) -> doExec env ctxt (P Bound n Erased)
185+doExec env ctxt v@(V i) | i < length env = return (snd (env !! i))
191186 | otherwise = execFail "env too small"
192187doExec env ctxt (Bind n (Let t v) body) = do v' <- doExec env ctxt v
193− doExec ((n, Let EErased v'):env) ctxt body
188+ doExec ((n, v'):env) ctxt body
194189doExec env ctxt (Bind n (NLet t v) body) = trace "NLet" $ undefined
195190doExec env ctxt tm@(Bind n b body) = return $
196191 EBind n (fmap (\_->EErased) b)
197− (\arg -> doExec ((n, Let EErased arg):env) ctxt body)
192+ (\arg -> doExec ((n, arg):env) ctxt body)
198193doExec env ctxt a@(App _ _) = execApp env ctxt (unApply a)
199194doExec env ctxt (Constant c) = return (EConstant c)
200195doExec env ctxt (Proj tm i) = let (x, xs) = unApply tm in
@@ -227,8 +222,12 @@ execApp' env ctxt (EP _ (UN "unsafePerformIO") _) (ty:action:rest) | (prim__IO,
227222 execApp' env ctxt v rest
228223
229224execApp' env ctxt (EP _ (UN "io_bind") _) args@(_:_:v:k:rest) | (prim__IO, [_, v']) <- unApplyV v =
230− do res <- execApp' env ctxt k [v'] >>= tryForce
225+ do v'' <- tryForce v'
226+ res <- execApp' env ctxt k [v''] >>= tryForce
231227 execApp' env ctxt res rest
228+execApp' env ctxt con@(EP _ (UN "io_return") _) args@(tp:v:rest) =
229+ do v' <- tryForce v
230+ execApp' env ctxt (mkEApp con [tp, v']) rest
232231
233232-- Special cases arising from not having access to the C RTS in the interpreter
234233execApp' env ctxt (EP _ (UN "mkForeign") _) (_:fn:EConstant (Str arg):rest)
@@ -299,6 +298,8 @@ execApp' env ctxt f@(EP _ n _) args =
299298 primResBool (s1 == s2)
300299 getOp (UN "prim__intToFloat") [EConstant (I i)] =
301300 primRes Fl (fromRational (toRational i))
301+ getOp (UN "prim__intToStr") [EConstant (I i)] =
302+ primRes Str (show i)
302303 getOp (UN "prim__ltInt") [EConstant (I i1), EConstant (I i2)] =
303304 primResBool (i1 < i2)
304305 getOp (UN "prim__mulBigInt") [EConstant (BI i1), EConstant (BI i2)] =
@@ -352,10 +353,11 @@ execCase env ctxt ns sc args =
352353 if arity <= length args
353354 then do let amap = zip ns args
354355-- debugThunks
356+-- trace ("Environment: " ++ show env) $ return ()
355357-- trace ("Case exec in " ++ take 1000 (show amap) ++ "\nwith " ++ show sc++"\n") $ return ()
356358 caseRes <- execCase' env ctxt amap sc
357359 case caseRes of
358− Just res -> Just <$> execApp' (map (\(n, tm) -> (n, Let EErased tm)) amap ++ env) ctxt res (drop arity args)
360+ Just res -> Just <$> execApp' (map (\(n, tm) -> (n, tm)) amap ++ env) ctxt res (drop arity args)
359361 Nothing -> return Nothing
360362 else return Nothing
361363
@@ -363,7 +365,7 @@ execCase env ctxt ns sc args =
363365execCase' :: ExecEnv -> Context -> [(Name, ExecVal)] -> SC -> Exec (Maybe ExecVal)
364366execCase' env ctxt amap (UnmatchedCase _) = return Nothing
365367execCase' env ctxt amap (STerm tm) =
366− Just <$> doExec (map (\(n, v) -> (n, Let EErased v)) amap ++ env) ctxt tm
368+ Just <$> doExec (map (\(n, v) -> (n, v)) amap ++ env) ctxt tm
367369execCase' env ctxt amap (Case n alts) | Just tm <- lookup n amap =
368370 do tm' <- tryForce tm
369371 case chooseAlt tm' alts of