Commit a17ff344585c6edcc3a1e99df7d0181f37fd6434 - del

importing from files sorta-kinda working Haldean Brown 4 years ago

4 changed file(s) with 56 addition(s) and 23 deletion(s). Raw diff Collapse all Expand all

-5

del.cabal less more

40	40	build-depends: base >=4.9 && <4.10
41	41	, bytestring >=0.10 && <0.11
42	42	, 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
43	51	, 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
49	52
50	53	executable genbuiltins
51	54	main-is: GenBuiltins.hs

-1

src/Language/Del/Compile.hs less more

47	47	case R.read prog of
48	48	Success forms -> do
49	49	let ast = buildAST forms
50		r <- collectImports [] ast
	50	env <- defaultImportEnv
	51	r <- collectImports env [] ast
51	52	case r of
52	53	Success res -> return $ runCompile res
53	54	Failure err -> return $ Failure err

-0

src/Language/Del/CompileDefs.hs less more

25	25	-- name, full native call expr
26	26	\| ApplyHeadNotId Expr
27	27	\| ImportNameClash T.Text [T.Text]
	28	\| BadImport Source
28	29	deriving (Eq)
29	30
30	31	data Artifact a

84	85	show e ++ "\n"
85	86	show (ImportNameClash imp overlaps) =
86	87	"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

+43

-17

src/Language/Del/Imports.hs less more

0	0	module Language.Del.Imports where
1	1
	2	import Control.Monad
	3	import Data.List.Split
2	4	import qualified Data.Map.Strict as Map
3	5	import qualified Data.Text as T
4	6	import Language.Del.AST
5	7	import Language.Del.CompileDefs
6	8	import Language.Del.Load
7	9	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
8	24
9	25	mergeBinds :: T.Text -> Map.Map T.Text Def -> Map.Map T.Text Def -> Artifact (Map.Map T.Text Def)
10	26	mergeBinds alias orig new =

16	32	then Failure $ ImportNameClash alias (Map.keys overlap)
17	33	else return $ Map.union orig aliased
18	34
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
21	42
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
31	45
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)) =
34	60	if elem src loaded
35		then collectImports loaded (AST m xs)
	61	then collectImports env loaded (AST m xs)
36	62	else do
37		iast <- loadImport src
	63	iast <- loadImport env src
38	64	case iast of
39	65	Success (AST b imps) -> (return $ mergeBinds alias m b) >>=
40	66	(\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))
42	68	Failure e -> return $ Failure e)
43	69	Failure e -> return $ Failure e
44	70
45	71	-- 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