Changeset 4376 for src/Pugs/Prim/Eval.hs

Timestamp:

06/04/05 16:13:31 (4 years ago)

Author:

gaal

svk:copy_cache_prev:

5943

Message:

opEval refactoring, introduce EvalStyle? type
TODO: allow some evals (eg., require/use) to raise exceptions on errors

Files:

• src/Pugs/Prim/Eval.hs (modified) (6 diffs)

src/Pugs/Prim/Eval.hs

@@ -4 +4 @@
     opEval, opEvalfile,
     opRequire,
+    EvalError(..), EvalResult(..), EvalStyle(..),
     -- used by Pugs.Eval -- needs factored somewhere bettwen
     retEvalResult, 
@@ -12 +13 @@
 import Pugs.Internals
 
+data EvalError = EvalErrorFatal
+               | EvalErrorUndef
+               deriving Eq
+data EvalResult = EvalResultLastValue
+                | EvalResultModule
+                | EvalResultEnv
+                deriving Eq
+data EvalStyle = MkEvalStyle
+               { evalError  :: EvalError
+               , evalResult :: EvalResult
+               }
+
 opRequire :: Bool -> Val -> Eval Val
 opRequire dumpEnv v = do
@@ -18 +31 @@
     requireInc incs file (errMsg file incs)
     where
+    style = MkEvalStyle{ evalError  = EvalErrorFatal
+                       , evalResult = (if dumpEnv == True then EvalResultEnv else EvalResultLastValue)}
     errMsg file incs = "Can't locate " ++ file ++ " in @INC (@INC contains: " ++ unwords incs ++ ")."
     requireInc [] _ msg = fail msg
@@ -27 +42 @@
             else do
                 str <- liftIO $ readFile pathName
-                opEval (Just dumpEnv) pathName (decodeUTF8 str)
+                opEval style pathName (decodeUTF8 str)
 
 opEvalfile :: String -> Eval Val
@@ -36 +51 @@
         else do
             contents <- liftIO $ readFile filename
-            opEval Nothing filename $ decodeUTF8 contents
+            opEval MkEvalStyle{ evalError=EvalErrorUndef, evalResult=EvalResultLastValue} filename $ decodeUTF8 contents
 
 op1EvalHaskell :: Val -> Eval Val
@@ -42 +57 @@
     str     <- fromVal cv
     val     <- resetT $ evalHaskell str
-    retEvalResult False val
+    retEvalResult MkEvalStyle{ evalError=EvalErrorUndef, evalResult=EvalResultLastValue} val
 
-opEval :: Maybe Bool -> String -> String -> Eval Val
-opEval flag name str = do
+opEval :: EvalStyle -> FilePath -> String -> Eval Val
+opEval style path str = do
     env <- ask
-    let env' = parseProgram env name str
-        trans | flag == Just True = (`mergeStmts` Syn "env" [])
-              | otherwise         = id
+    let env' = parseProgram env path str
+        trans = case evalResult style of
+            EvalResultEnv -> (`mergeStmts` Syn "env" [])
+            _             -> id
     val <- resetT $ local (const env') $ do
         evl <- asks envEval
         evl (trans $ envBody env')
-    retEvalResult (maybe False id flag) val
+    retEvalResult style val
 
-retEvalResult :: Bool -> Val -> Eval Val
-retEvalResult external val = do
+retEvalResult :: EvalStyle -> Val -> Eval Val
+retEvalResult style val = do
     glob <- askGlobal
     errSV <- findSymRef "$!" glob
     case val of
-        VError str _ | not external  -> do
+        VError str _ -> do
             writeRef errSV (VStr str)
+            when (evalError style == EvalErrorFatal) $ do
+                --trace ("fatal error" ++ str) $ return ()
+                --FIXME: this should be made to throw an exception.
+                fail str
             retEmpty
         _ -> do