@@ -51,7 +51,7 @@ data ExecVal = EP NameType Name ExecVal
51instance Show ExecVal where
51instance Show ExecVal where
52 show (EP _ n _) = show n
52 show (EP _ n _) = show n
53 show (EV i) = "!!V" ++ show i ++ "!!"
53 show (EV i) = "!!V" ++ show i ++ "!!"
54− show (EBind n b body) = "EBind " ++ show b ++ " <<fn>> "
54+ show (EBind n b body) = "EBind " ++ show b ++ " <<fn>>"
55 show (EApp e1 e2) = show e1 ++ " (" ++ show e2 ++ ")"
55 show (EApp e1 e2) = show e1 ++ " (" ++ show e2 ++ ")"
56 show (EType _) = "Type"
56 show (EType _) = "Type"
57 show EErased = "[__]"
57 show EErased = "[__]"
@@ -339,6 +339,7 @@ execApp' env ctxt bnd@(EBind n b body) (arg:args) = do ret <- body arg
339 execApp' env ctxt f' (as ++ args)
339 execApp' env ctxt f' (as ++ args)
340execApp' env ctxt (EThunk i) args = do f <- force i
340execApp' env ctxt (EThunk i) args = do f <- force i
341 execApp' env ctxt f args
341 execApp' env ctxt f args
342+execApp' env ctxt app@(EApp _ _) args2 | (f, args1) <- unApplyV app = execApp' env ctxt f (args1 ++ args2)
342execApp' env ctxt f args = return (mkEApp f args)
343execApp' env ctxt f args = return (mkEApp f args)
@@ -352,9 +353,6 @@ execCase env ctxt ns sc args =
352 let arity = length ns in
353 let arity = length ns in
353 if arity <= length args
354 if arity <= length args
354 then do let amap = zip ns args
355 then do let amap = zip ns args
356−-- trace ("Environment: " ++ show env) $ return ()
357−-- trace ("Case exec in " ++ take 1000 (show amap) ++ "\nwith " ++ show sc++"\n") $ return ()
358 caseRes <- execCase' env ctxt amap sc
356 caseRes <- execCase' env ctxt amap sc
359 case caseRes of
357 case caseRes of
360 Just res -> Just <$> execApp' (map (\(n, tm) -> (n, tm)) amap ++ env) ctxt res (drop arity args)
358 Just res -> Just <$> execApp' (map (\(n, tm) -> (n, tm)) amap ++ env) ctxt res (drop arity args)