Changeset 4914 for src/Main.hs

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!

Files:

• src/Main.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 ++ ")."
+