add very basic module importing
This commit is contained in:
parent
73d2d68cff
commit
07a89daec1
59
interp.hs
59
interp.hs
|
@ -11,7 +11,8 @@ import Data.List (intercalate)
|
||||||
import Control.Monad.Trans (lift)
|
import Control.Monad.Trans (lift)
|
||||||
import Control.Monad.Trans.State (StateT, runStateT, evalStateT, get, put)
|
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 (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 AST
|
||||||
import Parser (parseProgram)
|
import Parser (parseProgram)
|
||||||
|
|
||||||
|
@ -27,6 +28,7 @@ data Value = IntV Integer
|
||||||
| StreamV Int
|
| StreamV Int
|
||||||
| TupleV [Value]
|
| TupleV [Value]
|
||||||
| ListV [Value]
|
| ListV [Value]
|
||||||
|
| DictV (M.Map Value Value)
|
||||||
| Builtin BIF
|
| Builtin BIF
|
||||||
| FnV Env [(Pattern, AST)] -- closure pattern->body bindings
|
| FnV Env [(Pattern, AST)] -- closure pattern->body bindings
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
@ -54,6 +56,7 @@ instance Show Value where
|
||||||
show (BoolV b) = show b
|
show (BoolV b) = show b
|
||||||
show (TupleV v) = "(" ++ intercalate "," (map show v) ++ ")"
|
show (TupleV v) = "(" ++ intercalate "," (map show v) ++ ")"
|
||||||
show (ListV v) = show v
|
show (ListV v) = show v
|
||||||
|
show (DictV d) = "<dict " ++ show d ++ ">"
|
||||||
show (FnV _ _) = "<fn>"
|
show (FnV _ _) = "<fn>"
|
||||||
show (StreamV _) = "<stream>"
|
show (StreamV _) = "<stream>"
|
||||||
show (Builtin _) = "<built-in>"
|
show (Builtin _) = "<built-in>"
|
||||||
|
@ -153,6 +156,31 @@ _loop args@(TupleV [fn@(FnV _ _), arg]) = do
|
||||||
_loop $ TupleV [fn, v]
|
_loop $ TupleV [fn, v]
|
||||||
else return arg
|
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],
|
initialState = ([stdout, stdin],
|
||||||
[M.fromList [("id", FnV emptyEnv [(VarP "x", Var "x")]),
|
[M.fromList [("id", FnV emptyEnv [(VarP "x", Var "x")]),
|
||||||
("loop", Builtin $ BIF _loop),
|
("loop", Builtin $ BIF _loop),
|
||||||
|
@ -170,7 +198,8 @@ initialState = ([stdout, stdin],
|
||||||
("fclose", Builtin $ BIF _fclose),
|
("fclose", Builtin $ BIF _fclose),
|
||||||
("fopen", Builtin $ BIF _fopen),
|
("fopen", Builtin $ BIF _fopen),
|
||||||
("sockopen", Builtin $ BIF _sockopen),
|
("sockopen", Builtin $ BIF _sockopen),
|
||||||
("itos", Builtin $ BIF _itos)]])
|
("itos", Builtin $ BIF _itos),
|
||||||
|
("import", Builtin $ BIF _Import)]])
|
||||||
|
|
||||||
eval :: AST -> InterpState Value
|
eval :: AST -> InterpState Value
|
||||||
|
|
||||||
|
@ -337,11 +366,31 @@ apply (FnV _ pats) arg =
|
||||||
|
|
||||||
apply (Builtin (BIF fn)) arg = fn arg
|
apply (Builtin (BIF fn)) arg = fn arg
|
||||||
|
|
||||||
evalProgram :: [AST] -> IO Value -- fold the state from each node and return the result
|
-- some helper programs for evaluation
|
||||||
evalProgram nodes = evalStateT (foldr1 (>>) $ map eval nodes) initialState
|
|
||||||
|
|
||||||
evalString :: String -> IO Value
|
evalProgram :: [AST] -> InterpState Value
|
||||||
|
evalProgram nodes = foldr1 (>>) $ map eval nodes
|
||||||
|
|
||||||
|
evalString :: String -> InterpState Value
|
||||||
evalString program =
|
evalString program =
|
||||||
case parseProgram program of
|
case parseProgram program of
|
||||||
Left err -> error $ show err
|
Left err -> error $ show err
|
||||||
Right prg -> evalProgram prg
|
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
19
lamb.hs
|
@ -5,7 +5,7 @@
|
||||||
import System.Environment (getArgs)
|
import System.Environment (getArgs)
|
||||||
import System.Directory (doesFileExist)
|
import System.Directory (doesFileExist)
|
||||||
import System.FilePath (FilePath, splitExtension)
|
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
|
-- returns Nothing if all files exist, or Just path for the first one that doesn't
|
||||||
allExist :: [FilePath] -> IO (Maybe FilePath)
|
allExist :: [FilePath] -> IO (Maybe FilePath)
|
||||||
|
@ -16,25 +16,10 @@ allExist (x:xs) = do
|
||||||
if exists then allExist xs
|
if exists then allExist xs
|
||||||
else return $ Just x
|
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
|
main = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
exist <- allExist args
|
exist <- allExist args
|
||||||
case exist of
|
case exist of
|
||||||
Just file -> putStrLn $ "error: file " ++ file ++ " doesn't exist"
|
Just file -> putStrLn $ "error: file " ++ file ++ " doesn't exist"
|
||||||
Nothing ->
|
Nothing ->
|
||||||
mapM_ evalFile args
|
mapM_ evalFileV args
|
Loading…
Reference in New Issue