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

Timestamp:

05/16/05 16:57:02 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

4878

Message:

* use ClassName; ClassName.new is now parsed correctly.
* hence, changing ::Tree.new to Tree.new in Tree's tests.

Files:

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

src/Pugs/Prim/Eval.hs

@@ -3 +3 @@
     op1EvalHaskell,
     opEval,
+    opRequire,
     -- used by Pugs.Eval -- needs factored somewhere bettwen
     retEvalResult, 
 ) where
-import Control.Monad.Reader
 import Pugs.AST
 import Pugs.Parser
 import Pugs.Embed
+import Pugs.Internals
+
+opRequire :: Bool -> Val -> Eval Val
+opRequire dumpEnv v = do
+    file    <- fromVal v
+    incs    <- fromVal =<< readVar "@*INC"
+    requireInc incs file (errMsg file incs)
+    where
+    errMsg file incs = "Can't locate " ++ file ++ " in @INC (@INC contains: " ++ unwords incs ++ ")."
+    requireInc [] _ msg = fail msg
+    requireInc (p:ps) file msg = do
+        let pathName = p ++ "/" ++ file
+        ok <- liftIO $ doesFileExist pathName
+        if (not ok)
+            then requireInc ps file msg
+            else do
+                str <- liftIO $ readFile pathName
+                opEval (Just dumpEnv) pathName (decodeUTF8 str)
 
 op1EvalHaskell :: Val -> Eval Val
@@ -25 +43 @@
             retEmpty
 
-opEval :: Bool -> String -> String -> Eval Val
-opEval fatal name str = do
+opEval :: Maybe Bool -> String -> String -> Eval Val
+opEval flag name str = do
     env <- ask
     let env' = runRule env id ruleProgram name str
+        trans | flag == Just True = (`mergeStmts` Syn "env" [])
+              | otherwise         = id
     val <- resetT $ local (const env') $ do
         evl <- asks envEval
-        evl (envBody env')
-    retEvalResult fatal val
+        evl (trans $ envBody env')
+    retEvalResult (maybe False id flag) val
 
 retEvalResult :: Bool -> Val -> Eval Val
-retEvalResult fatal val = do
+retEvalResult external val = do
     glob <- askGlobal
     errSV <- findSymRef "$!" glob
     case val of
-        VError str _ | not fatal  -> do
+        VError str _ | not external  -> do
             writeRef errSV (VStr str)
             retEmpty