@@ -11,6 +11,8 @@ import Idris.Core.TT
11import Idris.Core.Evaluate
11import Idris.Core.Evaluate
12import Idris.Core.CaseTree
12import Idris.Core.CaseTree
14import Debug.Trace
16import Debug.Trace
16import Util.DynamicLinker
18import Util.DynamicLinker
@@ -113,9 +115,9 @@ initState :: Idris ExecState
113initState = do ist <- getIState
115initState = do ist <- getIState
114 return $ ExecState (idris_dynamic_libs ist)
116 return $ ExecState (idris_dynamic_libs ist)
116−type Exec = ErrorT String (StateT ExecState IO)
118+type Exec = ErrorT Err (StateT ExecState IO)
118−runExec :: Exec a -> ExecState -> IO (Either String a)
120+runExec :: Exec a -> ExecState -> IO (Either Err a)
119runExec ex st = fst <$> runStateT (runErrorT ex) st
121runExec ex st = fst <$> runStateT (runErrorT ex) st
121getExecState :: Exec ExecState
123getExecState :: Exec ExecState
@@ -124,7 +126,7 @@ getExecState = lift get
124putExecState :: ExecState -> Exec ()
126putExecState :: ExecState -> Exec ()
125putExecState = lift . put
127putExecState = lift . put
127−execFail :: String -> Exec a
129+execFail :: Err -> Exec a
128execFail = throwError
130execFail = throwError
130execIO :: IO a -> Exec a
132execIO :: IO a -> Exec a
@@ -138,7 +140,7 @@ execute tm = do est <- initState
138 do res <- doExec [] ctxt tm
140 do res <- doExec [] ctxt tm
140 case res of
142 case res of
141− Left err -> fail err
143+ Left err -> ierror err
142 Right tm' -> return tm'
144 Right tm' -> return tm'
144ioWrap :: ExecVal -> ExecVal
146ioWrap :: ExecVal -> ExecVal
@@ -160,16 +162,16 @@ doExec env ctxt p@(P Ref n ty) =
160 [CaseOp _ _ _ _ _ (CaseDefs _ ([], STerm tm) _ _)] -> -- nullary fun
162 [CaseOp _ _ _ _ _ (CaseDefs _ ([], STerm tm) _ _)] -> -- nullary fun
161 doExec env ctxt tm
163 doExec env ctxt tm
162 [CaseOp _ _ _ _ _ (CaseDefs _ (ns, sc) _ _)] -> return (EP Ref n EErased)
164 [CaseOp _ _ _ _ _ (CaseDefs _ (ns, sc) _ _)] -> return (EP Ref n EErased)
163− [] -> execFail $ "Could not find " ++ show n ++ " in definitions."
165+ [] -> execFail . Msg $ "Could not find " ++ show n ++ " in definitions."
164 thing -> trace (take 200 $ "got to " ++ show thing ++ " lookup up " ++ show n) $ undefined
166 thing -> trace (take 200 $ "got to " ++ show thing ++ " lookup up " ++ show n) $ undefined
165doExec env ctxt p@(P Bound n ty) =
167doExec env ctxt p@(P Bound n ty) =
166 case lookup n env of
168 case lookup n env of
167− Nothing -> execFail "not found"
169+ Nothing -> execFail . Msg $ "not found"
168 Just tm -> return tm
170 Just tm -> return tm
169doExec env ctxt (P (DCon a b) n _) = return (EP (DCon a b) n EErased)
171doExec env ctxt (P (DCon a b) n _) = return (EP (DCon a b) n EErased)
170doExec env ctxt (P (TCon a b) n _) = return (EP (TCon a b) n EErased)
172doExec env ctxt (P (TCon a b) n _) = return (EP (TCon a b) n EErased)
171doExec env ctxt v@(V i) | i < length env = return (snd (env !! i))
173doExec env ctxt v@(V i) | i < length env = return (snd (env !! i))
172− | otherwise = execFail "env too small"
174+ | otherwise = execFail . Msg $ "env too small"
173doExec env ctxt (Bind n (Let t v) body) = do v' <- doExec env ctxt v
175doExec env ctxt (Bind n (Let t v) body) = do v' <- doExec env ctxt v
174 doExec ((n, v'):env) ctxt body
176 doExec ((n, v'):env) ctxt body
175doExec env ctxt (Bind n (NLet t v) body) = trace "NLet" $ undefined
177doExec env ctxt (Bind n (NLet t v) body) = trace "NLet" $ undefined
@@ -244,7 +246,7 @@ execApp env ctxt (EP _ fp _) (_:fn:EConstant (Str f):EConstant (Str mode):rest)
244 (\e -> let _ = ( e::SomeException)
246 (\e -> let _ = ( e::SomeException)
245 in return $ Right (ioWrap (EPtr nullPtr), tail rest))
247 in return $ Right (ioWrap (EPtr nullPtr), tail rest))
246 case f of
248 case f of
247− Left err -> execFail err
249+ Left err -> execFail . Msg $ err
248 Right (res, rest) -> execApp env ctxt res rest
250 Right (res, rest) -> execApp env ctxt res rest
250execApp env ctxt (EP _ fp _) (_:fn:(EHandle h):rest)
252execApp env ctxt (EP _ fp _) (_:fn:(EHandle h):rest)