Changeset 4914

Timestamp:

06/22/05 20:57:31 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

6641

Message:

* 01-sanity/07-test.t is now working!

Location:

src

Files:

• Main.hs (modified) (3 diffs)
• Pugs/Compile/PIR.hs (modified) (1 diff)
• Pugs/Prim.hs (modified) (1 diff)
• Pugs/Prim/Eval.hs (modified) (3 diffs)

src/Main.hs

@@ -29 +29 @@
 import Pugs.Trans
 import Pugs.Embed
+import Pugs.Prim.Eval (requireInc)
 import qualified Data.Map as Map
 import Data.IORef
@@ -74 +75 @@
 
 run ("-C":backend:"-e":prog:_)           = doCompileDump backend "-e" prog
-run ("-C":backend:file:_)                = readFile file >>= doCompileDump backend file
+run ("-C":backend:file:_)                = slurpFile file >>= doCompileDump backend file
 
 run ("-B":backend:"-e":prog:_)           = doCompileRun backend "-e" prog
-run ("-B":backend:file:_)                = readFile file >>= doCompileRun backend file
+run ("-B":backend:file:_)                = slurpFile file >>= doCompileRun backend file
 
 run ("--external":mod:"-e":prog:_)    = doExternal mod "-e" prog
@@ -312 +313 @@
     writeFile "a.pir" pir
     evalParrotFile "a.pir"
+
+slurpFile :: FilePath -> IO String
+slurpFile file = do
+    prog <- readFile file
+    libs <- getLibs
+    file <- expandInc libs prog
+    -- writeFile "ZZZ" file
+    return file
+    where
+    expandInc :: [FilePath] -> String -> IO String
+    expandInc incs str = case breakOnGlue "\nuse " str of
+        Nothing -> return str
+        Just (pre, post) -> do
+            let (mod, (_:rest)) = span isAlphaNum (dropWhile isSpace post)
+            mod'    <- includeInc incs mod
+            rest'   <- expandInc incs rest
+            return $ pre ++ mod' ++ rest'
+    includeInc :: [FilePath] -> String -> IO String
+    includeInc _ ('v':_) = return []
+    includeInc incs name = do
+        let name' = concat (intersperse "/" names) ++ ".pm"
+            names = split "::" name
+        pathName    <- requireInc incs name' (errMsg name incs)
+        readFile pathName
+    errMsg file incs = "Can't locate " ++ file ++ " in @*INC (@*INC contains: " ++ unwords incs ++ ")."
+

src/Pugs/Compile/PIR.hs

@@ -114 +114 @@
         rhsC    <- trans rhs
         return $ lhsC `KEYED` rhsC
-    trans (PApp cxt fun args) = do
+    trans (PApp _ fun args) = do
         funC    <- trans fun {- case fun of
             PExp (PVar name) -> return $ lit name

src/Pugs/Prim.hs

@@ -253 +253 @@
 op1 "evalfile" = \v -> do
     filename <- fromVal v
-    opEvalfile filename
+    opEvalFile filename
 op1 "Pugs::Internals::eval_perl5" = \v -> do
     str <- fromVal v

src/Pugs/Prim/Eval.hs

@@ -2 +2 @@
     -- used by Pugs.Prim
     op1EvalHaskell,
-    opEval, opEvalfile,
-    opRequire,
+    opEval, opEvalFile,
+    opRequire, requireInc,
     EvalError(..), EvalResult(..), EvalStyle(..),
     -- used by Pugs.Eval -- needs factored somewhere bettwen
@@ -28 +28 @@
 opRequire :: Bool -> Val -> Eval Val
 opRequire dumpEnv v = do
-    file    <- fromVal v
-    incs    <- fromVal =<< readVar "@*INC"
-    requireInc incs file (errMsg file incs)
+    file        <- fromVal v
+    incs        <- fromVal =<< readVar "@*INC"
+    pathName    <- requireInc incs file (errMsg file incs)
+    -- %*INC{file} = pathname
+    evalExp $ Syn "="
+        [ Syn "{}"
+            [ Var "%*INC", Val . VStr $ decodeUTF8 file ]
+            , Val . VStr $ decodeUTF8 pathName
+        ]
+    str         <- liftIO $ readFile pathName
+    opEval style pathName (decodeUTF8 str)
     where
     style = MkEvalStyle
@@ -37 +45 @@
                                            else EvalResultLastValue)}
     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
-                -- %*INC{file} = pathname
-                evalExp $
-                    Syn "=" [ Syn "{}" [ Var "%*INC", Val . VStr $ decodeUTF8 file ]
-                            , Val . VStr $ decodeUTF8 pathName
-                            ]
-                str <- liftIO $ readFile pathName
-                opEval style pathName (decodeUTF8 str)
 
-opEvalfile :: String -> Eval Val
-opEvalfile filename = do
+requireInc :: (MonadIO m) => [FilePath] -> FilePath -> String -> m String 
+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 return pathName
+
+opEvalFile :: String -> Eval Val
+opEvalFile filename = do
     ok <- liftIO $ doesFileExist filename
     if (not ok)