Commit 74f114b5998416c5c5301dfd5283bd3d66bf6680 - Argyle

lookupVar is not actually needed, it seems. Chris Pressey 3 months ago

3 changed file(s) with 93 addition(s) and 57 deletion(s). Raw diff Collapse all Expand all

+34

-33

src/Language/Argyle/Interpreter.hs less more

0	0	{-# LANGUAGE LambdaCase #-}
1	1
2	2	module Language.Argyle.Interpreter where
	3
	4	import Debug.Trace
3	5
4	6	import qualified Data.Map as Map
5	7	import qualified Data.Set as Set

35	37	env <- ask
36	38	-- Build bindings for all unbound vars in the quoted ABT
37	39	let unboundVars = Set.elems $ collectUnboundVars abt
38		bindings <- mapM (\v -> do
39		maybeAbt <- lookupVar v env
40		case maybeAbt of
41		Just abt -> return (v, abt)
42		Nothing -> throwError $ "Required binding not found in environment: " ++ v)
43		unboundVars
	40	bindings <- mapM (\name -> do
	41	case Map.lookup name env of
	42	Just value -> return (name, Literal value)
	43	Nothing -> throwError $ "Required binding not found in environment: " ++ name)
	44	(traceShow ("literal-unbound-vars", unboundVars) unboundVars)
44	45	return $ VABT $
45	46	if null bindings
46	47	then abt

76	77	Operator op args ->
77	78	throwError $ "Unknown operator: '" ++ op ++ "' with args '" ++ show args ++ "'"
78	79
79		-- \| Look up a variable in the environment and convert its value to an ABT
80		lookupVar :: String -> Environment -> Eval (Maybe ABT)
81		lookupVar x env = case Map.lookup x env of
82		Just val -> case val of
83		VNum n -> return $ Just $ Literal (VNum n)
84		VString s -> return $ Just $ Literal (VString s)
85		VABT abt -> return $ Just abt
86		VBuiltin name f -> return $ Just $ Literal (VBuiltin name f)
87		VClosure param body closedEnv -> do
88		-- Find free variables in the closure's body
89		let unboundVars = Set.elems $ collectUnboundVars body
90		-- Look up their values in the closure's environment
91		bindings <- mapM (\v -> do
92		maybeAbt <- lookupVar v env
93		case maybeAbt of
94		Just abt -> return (v, abt)
95		Nothing -> throwError $ "Required binding not found in environment: " ++ v)
96		unboundVars
97		-- Wrap the lambda in bindings for its free variables
98		return $ Just $
99		if null bindings
100		then Binder param body
101		else Operator "let"
102		[ foldr Binder (Binder param body) (map fst bindings)
103		, Operator "values" (map snd bindings)
104		]
105		Nothing -> return Nothing
	80	-- -- \| Look up a variable in the environment and convert its value to an ABT
	81	-- lookupVar :: String -> Environment -> Eval (Maybe ABT)
	82	-- lookupVar x env = case Map.lookup x env of
	83	-- Just val -> case val of
	84	-- VNum n -> return $ Just $ Literal (VNum n)
	85	-- VString s -> return $ Just $ Literal (VString s)
	86	-- VABT abt -> return $ Just abt
	87	-- VBuiltin name f -> return $ Just $ Literal (VBuiltin name f)
	88	-- VClosure param body closedEnv -> do
	89	-- -- Find unbound variables in the closure's body
	90	-- let unboundVars = Set.elems $ collectUnboundVars body
	91	-- -- Look up their values in the closure's environment
	92	-- bindings <- mapM (\v -> do
	93	-- maybeAbt <- lookupVar v env
	94	-- case maybeAbt of
	95	-- Just abt -> return (v, abt)
	96	-- Nothing -> throwError $ "Required binding not found in environment: " ++ v)
	97	-- (traceShow ("lookupvar-unbound-vars", x, unboundVars) unboundVars)
	98	-- -- Wrap the lambda in bindings for its free variables
	99	-- return $ Just $
	100	-- if null bindings
	101	-- then Binder param body
	102	-- else Operator "let"
	103	-- [ foldr Binder (Binder param body) (map fst bindings)
	104	-- , Operator "values" (map snd bindings)
	105	-- ]
	106	-- Nothing -> return Nothing
106	107
107	108	-- \| Function application
108	109	apply :: Value -> Value -> Eval Value

+39

-13

src/Language/Argyle/REPL.hs less more

4	4	import Control.Monad (when)
5	5
6	6	import Language.Argyle.Parser (sexprToConsList, sexprToAST, sexprToABT)
7		import Language.Argyle.Value (showValue)
	7	import Language.Argyle.Value (showValue, unparseABT)
8	8	import qualified Language.Argyle.Interpreter as I
	9
	10
	11	parseUsing :: (String -> Either String x) -> String -> IO (Maybe x)
	12	parseUsing converter source = do
	13	case converter source of
	14	Left err -> do
	15	putStrLn $ "Parse Error!: " ++ err
	16	return Nothing
	17	Right val ->
	18	return $ Just val
	19
	20	showParses source = do
	21	conslist <- parseUsing (sexprToConsList) source
	22	putStrLn $ show conslist
	23	ast <- parseUsing (sexprToAST) source
	24	putStrLn $ show ast
	25	abt <- parseUsing (sexprToABT) source
	26	putStrLn $ show abt
	27	case abt of
	28	Just theAbt -> do
	29	putStrLn $ unparseABT theAbt
	30	return abt
	31	Nothing -> do
	32	return abt
	33
	34	-- putStrLn "Parse output:"
	35	-- case sexprToConsList input of
	36	-- Left err -> putStrLn $ "ConsList parse error: " ++ err
	37	-- Right conslist -> do
	38	-- putStrLn $ "ConsList: " ++ show conslist
	39	-- case sexprToAST input of
	40	-- Left err -> putStrLn $ "AST parse error: " ++ err
	41	-- Right ast -> do
	42	-- putStrLn $ "AST: " ++ show ast
	43	-- case sexprToABT input of
	44	-- Left err -> putStrLn $ "ABT conversion error: " ++ err
	45	-- Right abt -> putStrLn $ "ABT: " ++ show abt
9	46
10	47
11	48	data ReplState = ReplState

36	73	replLoop $ ReplState { showParse=False }
37	74	_ -> do
38	75	when showParse $ do
39		putStrLn "Parse output:"
40		case sexprToConsList input of
41		Left err -> putStrLn $ "ConsList parse error: " ++ err
42		Right conslist -> do
43		putStrLn $ "ConsList: " ++ show conslist
44		case sexprToAST input of
45		Left err -> putStrLn $ "AST parse error: " ++ err
46		Right ast -> do
47		putStrLn $ "AST: " ++ show ast
48		case sexprToABT input of
49		Left err -> putStrLn $ "ABT conversion error: " ++ err
50		Right abt -> putStrLn $ "ABT: " ++ show abt
	76	showParses input
51	77	putStrLn "Evaluation:"
52	78
53	79	-- Evaluate the input

+20

-11

src/Main.hs less more

9	9	import Data.Maybe (fromMaybe)
10	10
11	11	import Language.Argyle.Parser (sexprToConsList, sexprToAST, sexprToABT)
12		import Language.Argyle.Value (showValue, ABT)
	12	import Language.Argyle.Value (ABT, showValue, unparseABT)
13	13	import qualified Language.Argyle.Tests.Runner as TestRunner
14	14	import qualified Language.Argyle.Interpreter as I
15	15	import Language.Argyle.REPL (repl)

21	21
22	22	case args of
23	23	["parse", filename] -> do
24		conslist <- readUsing (sexprToConsList) filename
25		putStrLn $ show conslist
26		ast <- readUsing (sexprToAST) filename
27		putStrLn $ show ast
28		abt <- readUsing (sexprToABT) filename
29		putStrLn $ show abt
	24	source <- readFile filename
	25	showParses source
30	26	["eval", filename] -> do
31	27	abt <- readABTfrom filename
32	28	case I.runEval abt of

44	40	_ ->
45	41	usage
46	42
47		readUsing :: (String -> Either String x) -> FilePath -> IO x
48		readUsing converter filename = do
49		input <- readFile filename
50		case converter input of
	43	showParses source = do
	44	conslist <- parseUsing (sexprToConsList) source
	45	putStrLn $ show conslist
	46	ast <- parseUsing (sexprToAST) source
	47	putStrLn $ show ast
	48	abt <- parseUsing (sexprToABT) source
	49	putStrLn $ unparseABT abt
	50	putStrLn $ show abt
	51
	52	parseUsing :: (String -> Either String x) -> String -> IO x
	53	parseUsing converter source = do
	54	case converter source of
51	55	Left err -> do
52	56	abortWith $ "Error: " ++ err
53	57	Right val ->
54	58	return val
	59
	60	readUsing :: (String -> Either String x) -> FilePath -> IO x
	61	readUsing converter filename = do
	62	input <- readFile filename
	63	parseUsing converter input
55	64
56	65	readABTfrom :: FilePath -> IO ABT
57	66	readABTfrom = readUsing sexprToABT