git.haldean.org del / a17ff34
importing from files sorta-kinda working Haldean Brown 2 years ago
4 changed file(s) with 56 addition(s) and 23 deletion(s). Raw diff Collapse all Expand all
4040 build-depends: base >=4.9 && <4.10
4141 , bytestring >=0.10 && <0.11
4242 , containers >=0.5 && <0.6
43 , deepseq >=1.4 && <1.5
44 , directory >=1.3 && <1.4
45 , filepath >=1.4 && <1.5
46 , lens >=4.15 && <4.16
47 , parsec >=3.1 && <3.2
48 , req >=0.2 && <0.3
49 , split >=0.2 && <0.3
50 , text >=1.2 && <1.3
4351 , transformers >=0.5 && <0.6
44 , text >=1.2 && <1.3
45 , parsec >=3.1 && <3.2
46 , deepseq >=1.4 && <1.5
47 , lens >=4.15 && <4.16
48 , req >=0.2 && <0.3
4952
5053 executable genbuiltins
5154 main-is: GenBuiltins.hs
4747 case R.read prog of
4848 Success forms -> do
4949 let ast = buildAST forms
50 r <- collectImports [] ast
50 env <- defaultImportEnv
51 r <- collectImports env [] ast
5152 case r of
5253 Success res -> return $ runCompile res
5354 Failure err -> return $ Failure err
2525 -- name, full native call expr
2626 | ApplyHeadNotId Expr
2727 | ImportNameClash T.Text [T.Text]
28 | BadImport Source
2829 deriving (Eq)
2930
3031 data Artifact a
8485 show e ++ "\n"
8586 show (ImportNameClash imp overlaps) =
8687 "importing " ++ T.unpack imp ++ " causes these names to appear more than once:\n\n\t" ++ show overlaps
88 show (BadImport s) =
89 "couldn't find source for import of package " ++ show s
00 module Language.Del.Imports where
11
2 import Control.Monad
3 import Data.List.Split
24 import qualified Data.Map.Strict as Map
35 import qualified Data.Text as T
46 import Language.Del.AST
57 import Language.Del.CompileDefs
68 import Language.Del.Load
79 import qualified Language.Del.Reader as R
10 import System.Directory
11 import System.Environment
12 import System.FilePath
13
14 data ImportEnv = ImportEnv [FilePath] deriving (Show, Eq)
15
16 defaultImportEnv :: IO ImportEnv
17 defaultImportEnv = do
18 cwd <- getCurrentDirectory
19 incvarm <- lookupEnv "DEL_INCLUDE"
20 let dirs = [cwd] ++ (case incvarm of
21 Nothing -> []
22 Just incvar -> splitOn ":" incvar)
23 return $ ImportEnv dirs
824
925 mergeBinds :: T.Text -> Map.Map T.Text Def -> Map.Map T.Text Def -> Artifact (Map.Map T.Text Def)
1026 mergeBinds alias orig new =
1632 then Failure $ ImportNameClash alias (Map.keys overlap)
1733 else return $ Map.union orig aliased
1834
19 findSourceFile :: T.Text -> IO FilePath
20 findSourceFile = undefined
35 fileInDir :: String -> FilePath -> IO (Maybe FilePath)
36 fileInDir base dir
37 = let path = dir </> base
38 in do
39 exists <- doesFileExist path
40 return $ if exists then Just path
41 else Nothing
2142
22 loadImport :: Source -> IO (Artifact AST)
23 loadImport (Right _) = error "URL imports not yet supported"
24 loadImport (Left name) = do
25 path <- findSourceFile name
26 contents <- readFile path >>= return . T.pack
27 let forms = R.read contents
28 case forms of
29 Success f -> return $ Success (buildAST f)
30 Failure e -> return $ Failure e
43 findSourceFile :: ImportEnv -> T.Text -> IO (Maybe FilePath)
44 findSourceFile (ImportEnv dirs) base = mapM (fileInDir $ T.unpack base) dirs >>= return . msum
3145
32 collectImports :: [Source] -> AST -> IO (Artifact AST)
33 collectImports loaded (AST m ((Import src alias):xs)) =
46 loadImport :: ImportEnv -> Source -> IO (Artifact AST)
47 loadImport _ (Right _) = error "URL imports not yet supported"
48 loadImport env s@(Left name) =
49 findSourceFile env name >>= \path -> case path of
50 Nothing -> return $ Failure (BadImport s)
51 Just p -> do
52 contents <- readFile p >>= return . T.pack
53 let forms = R.read contents
54 case forms of
55 Success f -> return $ Success (buildAST f)
56 Failure e -> return $ Failure e
57
58 collectImports :: ImportEnv -> [Source] -> AST -> IO (Artifact AST)
59 collectImports env loaded (AST m ((Import src alias):xs)) =
3460 if elem src loaded
35 then collectImports loaded (AST m xs)
61 then collectImports env loaded (AST m xs)
3662 else do
37 iast <- loadImport src
63 iast <- loadImport env src
3864 case iast of
3965 Success (AST b imps) -> (return $ mergeBinds alias m b) >>=
4066 (\merged -> case merged of
41 Success mm -> collectImports (src:loaded) (AST mm (xs ++ imps))
67 Success mm -> collectImports env (src:loaded) (AST mm (xs ++ imps))
4268 Failure e -> return $ Failure e)
4369 Failure e -> return $ Failure e
4470
4571 -- No imports in the AST, or the previous pattern would have matched; done!
46 collectImports _ a = return $ Success a
72 collectImports _ _ a = return $ Success a