add very basic module importing

This commit is contained in:
darkf 2013-10-28 18:48:57 -07:00
parent 73d2d68cff
commit 07a89daec1
2 changed files with 56 additions and 22 deletions

View File

@ -11,7 +11,8 @@ import Data.List (intercalate)
import Control.Monad.Trans (lift)
import Control.Monad.Trans.State (StateT, runStateT, evalStateT, get, put)
import System.IO (Handle, hPutStr, hGetLine, hFlush, hClose, hIsEOF, openBinaryFile, IOMode(..), stdout, stdin)
import System.IO.Unsafe (unsafePerformIO)
import System.Directory (doesFileExist)
import System.FilePath (FilePath, splitExtension)
import AST
import Parser (parseProgram)
@ -27,6 +28,7 @@ data Value = IntV Integer
| StreamV Int
| TupleV [Value]
| ListV [Value]
| DictV (M.Map Value Value)
| Builtin BIF
| FnV Env [(Pattern, AST)] -- closure pattern->body bindings
deriving (Eq)
@ -54,6 +56,7 @@ instance Show Value where
show (BoolV b) = show b
show (TupleV v) = "(" ++ intercalate "," (map show v) ++ ")"
show (ListV v) = show v
show (DictV d) = "<dict " ++ show d ++ ">"
show (FnV _ _) = "<fn>"
show (StreamV _) = "<stream>"
show (Builtin _) = "<built-in>"
@ -153,6 +156,31 @@ _loop args@(TupleV [fn@(FnV _ _), arg]) = do
_loop $ TupleV [fn, v]
else return arg
-- import a module name as a module
_Import (StrV modname) = do
(h,env) <- get -- save current state
put initialState
(path,modname) <- lift $ findModule modname -- find the module file
evalFile path -- evaluate the module file
(_,[modenv]) <- get -- get the module env
let (_, [initialEnv]) = initialState
let modenv' = M.difference modenv initialEnv -- subtract prelude stuff
-- convert String to StrV in env keys
let modenv'' = map (\(k,v) -> (StrV k, v)) $ M.toAscList modenv'
let mod = DictV (M.fromAscList modenv'') -- package module into a dict
let env' = bind env modname mod -- bind it
put (h,env') -- restore state
return mod -- return module value
where
findModule :: FilePath -> IO (FilePath, String)
findModule modname = do
let path = modname ++ ".lamb"
exists <- doesFileExist path
if exists then
return (path, fst $ splitExtension path)
else error $ "module " ++ modname ++ " couldn't be found"
initialState = ([stdout, stdin],
[M.fromList [("id", FnV emptyEnv [(VarP "x", Var "x")]),
("loop", Builtin $ BIF _loop),
@ -170,7 +198,8 @@ initialState = ([stdout, stdin],
("fclose", Builtin $ BIF _fclose),
("fopen", Builtin $ BIF _fopen),
("sockopen", Builtin $ BIF _sockopen),
("itos", Builtin $ BIF _itos)]])
("itos", Builtin $ BIF _itos),
("import", Builtin $ BIF _Import)]])
eval :: AST -> InterpState Value
@ -337,11 +366,31 @@ apply (FnV _ pats) arg =
apply (Builtin (BIF fn)) arg = fn arg
evalProgram :: [AST] -> IO Value -- fold the state from each node and return the result
evalProgram nodes = evalStateT (foldr1 (>>) $ map eval nodes) initialState
-- some helper programs for evaluation
evalString :: String -> IO Value
evalProgram :: [AST] -> InterpState Value
evalProgram nodes = foldr1 (>>) $ map eval nodes
evalString :: String -> InterpState Value
evalString program =
case parseProgram program of
Left err -> error $ show err
Right prg -> evalProgram prg
isLiterate :: FilePath -> Bool
isLiterate path = snd (splitExtension path) == ".lilamb"
-- Takes the lines of a literate program and returns the lines for a new executable program
-- from lines beginning with four spaces.
parseLiterate :: [String] -> [String]
parseLiterate lns = [drop 4 line | line <- lns, take 4 line == " "]
evalFile :: FilePath -> InterpState Value
evalFile path = do
contents <- lift $ if path == "-" then getContents else readFile path
if isLiterate path then
evalString . unlines . parseLiterate . lines $ contents
else evalString contents
evalFileV :: FilePath -> IO Value
evalFileV path = evalStateT (evalFile path) initialState

19
lamb.hs
View File

@ -5,7 +5,7 @@
import System.Environment (getArgs)
import System.Directory (doesFileExist)
import System.FilePath (FilePath, splitExtension)
import Interp (evalProgram, evalString, Value(UnitV))
import Interp (evalFileV, Value(UnitV))
-- returns Nothing if all files exist, or Just path for the first one that doesn't
allExist :: [FilePath] -> IO (Maybe FilePath)
@ -16,25 +16,10 @@ allExist (x:xs) = do
if exists then allExist xs
else return $ Just x
isLiterate :: FilePath -> Bool
isLiterate path = snd (splitExtension path) == ".lilamb"
-- Takes the lines of a literate program and returns the lines for a new executable program
-- from lines beginning with four spaces.
parseLiterate :: [String] -> [String]
parseLiterate lns = [drop 4 line | line <- lns, take 4 line == " "]
evalFile :: String -> IO Value
evalFile path = do
contents <- if path == "-" then getContents else readFile path
if isLiterate path then
evalString . unlines . parseLiterate . lines $ contents
else evalString contents
main = do
args <- getArgs
exist <- allExist args
case exist of
Just file -> putStrLn $ "error: file " ++ file ++ " doesn't exist"
Nothing ->
mapM_ evalFile args
mapM_ evalFileV args