Commit 2ae32da136b472ea61b4d54842cadb357344c293 - Argyle

Checkpoint changes to S-expression parser. Chris Pressey 6 months ago

6 changed file(s) with 341 addition(s) and 159 deletion(s). Raw diff Collapse all Expand all

-0

README.md less more

107	107	* writing optimizers, such as constant subexpression eliminators
108	108	* installing any of the above as a pre-evaluation step
109	109
	110	TODO
	111	----
	112
	113	* actually use locally nameless style (bound vars in own namespace)
	114
110	115	[Falderal]: https://catseye.tc/node/Falderal

+49

-7

src/Language/Argyle/Parser.hs less more

10	10	import Control.Monad ((>=>))
11	11
12	12	import qualified Language.Argyle.ConsList as L
13		import Language.Argyle.Sexpr2ConsList (parse)
	13	import Language.Argyle.Sexpr2ConsList (parse, ParseResult(..))
14	14	import Language.Argyle.ConsList2AST (parseConsListExpr)
15	15	import Language.Argyle.AST (AST)
16	16	import Language.Argyle.Value (ABT)
17	17	import Language.Argyle.AST2ABT (astToABT)
18	18
	19	-- \| Convert an S-expression string to a ConsList
19	20	sexprToConsList :: String -> Either String L.ConsList
20	21	sexprToConsList input =
21	22	case parse input of
22		(Nothing, _) ->
23		Left "Failed to parse S-expression"
24		(Just consList, remaining) ->
25		if not $ all isSpace remaining
26		then Left $ "Unexpected characters after S-expression: '" ++ remaining ++ "'"
27		else Right $ consList
	23	Complete consList remaining ->
	24	if all isSpace remaining
	25	then Right consList
	26	else Left $ "Unexpected characters after S-expression: '" ++ remaining ++ "'"
	27	Incomplete count _ ->
	28	Left $ "Incomplete S-expression: missing " ++ show count ++ " closing parentheses"
	29	Error err ->
	30	Left $ "Parse error: " ++ show err
28	31
	32	-- \| Convert an S-expression string to an AST
29	33	sexprToAST :: String -> Either String AST
30	34	sexprToAST = sexprToConsList >=> parseConsListExpr
31	35
	36	-- \| Convert an S-expression string to an ABT
32	37	sexprToABT :: String -> Either String ABT
33	38	sexprToABT = sexprToConsList >=> parseConsListExpr >=> astToABT
	39
	40	-- \| Process multi-line S-expression input, collecting until complete
	41	-- Returns Nothing if more input is needed, Just result if complete
	42	processMultiLine :: String -> Maybe (Either String L.ConsList)
	43	processMultiLine input =
	44	case parse input of
	45	Complete consList remaining ->
	46	if all isSpace remaining
	47	then Just $ Right consList
	48	else Just $ Left $ "Unexpected characters after S-expression: '" ++ remaining ++ "'"
	49	Incomplete _ _ ->
	50	Nothing
	51	Error err ->
	52	Just $ Left $ "Parse error: " ++ show err
	53
	54	-- \| Process multi-line input and convert to AST if complete
	55	-- Returns Nothing if more input is needed
	56	processMultiLineAST :: String -> Maybe (Either String AST)
	57	processMultiLineAST input =
	58	case processMultiLine input of
	59	Nothing -> Nothing
	60	Just result -> Just $ result >>= parseConsListExpr
	61
	62	-- \| Process multi-line input and convert to ABT if complete
	63	-- Returns Nothing if more input is needed
	64	processMultiLineABT :: String -> Maybe (Either String ABT)
	65	processMultiLineABT input =
	66	case processMultiLineAST input of
	67	Nothing -> Nothing
	68	Just result -> Just $ result >>= astToABT
	69
	70	-- \| Check if input is complete
	71	isComplete :: String -> Bool
	72	isComplete input =
	73	case parse input of
	74	Complete _ remaining -> all isSpace remaining
	75	_ -> False⏎

+56

-23

src/Language/Argyle/REPL.hs less more

7	7	import System.IO
8	8	import Control.Monad (when)
9	9
10		import Language.Argyle.Parser (sexprToConsList, sexprToAST, sexprToABT)
	10	import Language.Argyle.Parser (sexprToAST, sexprToABT, sexprToConsList)
11	11	import Language.Argyle.Value (showValue, unparseABT)
12	12	import qualified Language.Argyle.Interpreter as I
	13	import qualified Language.Argyle.Sexpr2ConsList as S
13	14
14	15
15	16	parseUsing :: (String -> Either String x) -> String -> IO (Maybe x)

39	40	Nothing -> do
40	41	return abt
41	42
42
43	43	data ReplState = ReplState
44		{ showParse :: Bool -- Flag to control parse output display
	44	{ showParse :: Bool -- Flag to control parse output display
	45	, inputBuffer :: String -- Accumulated input buffer
45	46	}
46	47
47	48	repl :: IO ()

49	50	putStrLn "Argyle REPL (homoiconic interpreter)"
50	51	putStrLn "Type 'exit' or 'quit' to leave"
51	52	putStrLn "Type '+p' to enable parse output, '-p' to disable"
	53	putStrLn "Multi-line input is supported - continue until expression is complete"
52	54
53	55	hSetBuffering stdout NoBuffering
54		replLoop $ ReplState { showParse=False }
	56	replLoop $ ReplState { showParse=False, inputBuffer="" }
55	57	exitSuccess
56	58
57		replLoop s@(ReplState { showParse=showParse }) = do
58		putStr "> "
	59	replLoop :: ReplState -> IO ()
	60	replLoop s@(ReplState { showParse=showParse, inputBuffer=buffer }) = do
	61	let prompt = if null buffer then "> " else "... "
	62	putStr prompt
59	63	input <- getLine
	64
60	65	case input of
61	66	"exit" -> exitSuccess
62	67	"quit" -> exitSuccess
63	68	"+p" -> do
64	69	putStrLn "Parse output enabled"
65		replLoop $ ReplState { showParse=True }
	70	replLoop $ s { showParse=True }
66	71	"-p" -> do
67	72	putStrLn "Parse output disabled"
68		replLoop $ ReplState { showParse=False }
69		_ -> do
	73	replLoop $ s { showParse=False }
	74	_ -> processInput s input
	75
	76	processInput :: ReplState -> String -> IO ()
	77	processInput s@(ReplState { showParse=showParse, inputBuffer=buffer }) input =
	78	case S.parse (buffer ++ input) of
	79	S.Complete expr remainder -> do
	80	-- We have a complete expression
70	81	when showParse $ do
71		showParses input
72		putStrLn "Evaluation:"
73
74		-- Evaluate the input
75		case sexprToABT input of
	82	putStrLn $ "ConsList: " ++ show expr
	83
	84	-- Convert to AST
	85	case sexprToAST (buffer ++ input) of
76	86	Left err -> do
77		putStrLn $ "Error: " ++ err
78		replLoop $ ReplState { showParse=showParse }
79		Right abt -> do
80		case I.runEval abt of
	87	putStrLn $ "AST Error: " ++ err
	88	replLoop $ s { inputBuffer="" }
	89	Right ast -> do
	90	when showParse $
	91	putStrLn $ "AST: " ++ show ast
	92
	93	-- Convert to ABT
	94	case sexprToABT (buffer ++ input) of
81	95	Left err -> do
82		putStrLn $ "Error: " ++ err
83		replLoop $ ReplState { showParse=showParse }
84		Right value -> do
85		putStrLn $ showValue value
86		replLoop $ ReplState { showParse=showParse }
	96	putStrLn $ "ABT Error: " ++ err
	97	replLoop $ s { inputBuffer="" }
	98	Right abt -> do
	99	when showParse $ do
	100	putStrLn $ "ABT: " ++ show abt
	101	putStrLn $ unparseABT [] abt
	102	putStrLn "Evaluation:"
	103
	104	-- Evaluate
	105	case I.runEval abt of
	106	Left err -> do
	107	putStrLn $ "Eval Error: " ++ err
	108	replLoop $ s { inputBuffer="" }
	109	Right value -> do
	110	putStrLn $ showValue value
	111	replLoop $ s { inputBuffer="" }
	112
	113	S.Incomplete count accumulated ->
	114	-- Need more input
	115	replLoop $ s { inputBuffer=accumulated }
	116
	117	S.Error err -> do
	118	putStrLn $ "Parse Error: " ++ show err
	119	replLoop $ s { inputBuffer="" }⏎

+69

-78

src/Language/Argyle/Sexpr2ConsList.hs less more

10	10
11	11	data ParseError =
12	12	UnmatchedCloseParen
13		\| UnmatchedOpenParen
	13	\| UnmatchedOpenParen Int -- Now includes count of unclosed parens
14	14	\| UnexpectedChar Char
15	15	\| UnterminatedString
16	16	\| EmptyInput
17		deriving (Show)
	17	deriving (Show, Eq)
18	18
19		type Parser a = String -> Either ParseError (a, String)
	19	data ParseResult a =
	20	Complete a String -- Successful parse with remainder
	21	\| Incomplete Int String -- Needs more input, with paren count and accumulated input
	22	\| Error ParseError -- Parse error
	23	deriving (Show, Eq)
20	24
21		-- Main parsing function that ensures complete input consumption
22		parse :: String -> (Maybe ConsList, String)
23		parse input = case parseComplete parseExpr (skipWhitespaceAndComments input) of
24		Left err -> (Nothing, input)
25		Right (result, rest) -> (Just result, rest)
	25	-- Main parsing function that handles incomplete input
	26	parse :: String -> ParseResult ConsList
	27	parse input =
	28	if all isSpace input
	29	then Error EmptyInput
	30	else case parseExpr (skipWhitespaceAndComments input) 0 of
	31	Right (result, rest, 0) -> Complete result rest
	32	Right (result, rest, count) -> Incomplete count input
	33	Left (UnmatchedOpenParen count) -> Incomplete count input
	34	Left err -> Error err
26	35
27		-- Parser that ensures complete consumption of valid input
28		parseComplete :: Parser a -> Parser a
29		parseComplete p input = case p input of
30		Left err -> Left err
31		Right (result, rest) -> Right (result, rest)
32
33		-- Main expression parser
34		parseExpr :: Parser ConsList
35		parseExpr "" = Left EmptyInput
36		parseExpr input@(c:cs)
37		\| isSpace c = parseExpr (skipWhitespaceAndComments cs)
38		\| c == ';' = parseExpr (skipComment cs)
39		\| c == '(' = parseList cs
40		\| c == ')' = Left UnmatchedCloseParen
41		\| c == '"' = parseString cs
42		\| isDigit c = parseNumber input
43		\| isAtomStart c = parseAtom input
	36	-- Expression parser now tracks paren count
	37	parseExpr :: String -> Int -> Either ParseError (ConsList, String, Int)
	38	parseExpr "" count
	39	\| count > 0 = Left $ UnmatchedOpenParen count
	40	\| otherwise = Left EmptyInput
	41	parseExpr input@(c:cs) count
	42	\| isSpace c = parseExpr (skipWhitespaceAndComments cs) count
	43	\| c == ';' = parseExpr (skipComment cs) count
	44	\| c == '(' = parseList cs (count + 1)
	45	\| c == ')' = if count <= 0
	46	then Left UnmatchedCloseParen
	47	else Right (Nil, cs, count - 1)
	48	\| c == '"' = do
	49	(str, rest) <- parseString cs
	50	Right (String str, rest, count)
	51	\| isDigit c =
	52	let (ds, rest) = span isDigit input
	53	in Right (Number (read ds), rest, count)
	54	\| isAtomStart c =
	55	let (token, rest) = span isAtomChar input
	56	in Right (Atom token, rest, count)
44	57	\| otherwise = Left $ UnexpectedChar c
45	58
46		-- Skip over whitespace and comments
	59	-- Parse a list, maintaining paren count
	60	parseList :: String -> Int -> Either ParseError (ConsList, String, Int)
	61	parseList input count = case skipWhitespaceAndComments input of
	62	"" -> Left $ UnmatchedOpenParen count
	63	')':cs -> Right (Nil, cs, count - 1)
	64	str -> do
	65	(first, rest1, count1) <- parseExpr str count
	66	(rest, rest2, count2) <- parseList (skipWhitespaceAndComments rest1) count1
	67	case rest of
	68	Nil -> Right (Cons first Nil, rest2, count2)
	69	_ -> Right (Cons first rest, rest2, count2)
	70
	71	-- String parsing remains mostly unchanged but returns Either for consistency
	72	parseString :: String -> Either ParseError (String, String)
	73	parseString = parseStringHelper ""
	74	where
	75	parseStringHelper acc "" = Left UnterminatedString
	76	parseStringHelper acc ('"':rest) = Right (acc, rest)
	77	parseStringHelper acc ('\\':'"':rest) = parseStringHelper (acc ++ "\"") rest
	78	parseStringHelper acc ('\\':'\\':rest) = parseStringHelper (acc ++ "\\") rest
	79	parseStringHelper acc (c:rest) = parseStringHelper (acc ++ [c]) rest
	80
	81	-- Helpers for character classification (unchanged)
	82	isAtomStart :: Char -> Bool
	83	isAtomStart c = isAlpha c \|\| c == '_' \|\| c == '+' \|\| c == '-' \|\| c == '*' \|\| c == '/' \|\| c == '?'
	84
	85	isAtomChar :: Char -> Bool
	86	isAtomChar c = isAtomStart c \|\| isDigit c
	87
	88	-- Skip whitespace and comments (unchanged)
47	89	skipWhitespaceAndComments :: String -> String
48	90	skipWhitespaceAndComments "" = ""
49	91	skipWhitespaceAndComments input@(c:cs)

51	93	\| c == ';' = skipWhitespaceAndComments (skipComment cs)
52	94	\| otherwise = input
53	95
54		-- Skip to the end of the current line (for comments)
55	96	skipComment :: String -> String
56	97	skipComment "" = ""
57	98	skipComment (c:cs)
58	99	\| c == '\n' = cs
59		\| otherwise = skipComment cs
60
61		-- Parse a list of expressions
62		parseList :: Parser ConsList
63		parseList input = case skipWhitespaceAndComments input of
64		"" -> Left UnmatchedOpenParen
65		')':cs -> Right (Nil, cs)
66		str -> case parseExpr str of
67		Left err -> Left err
68		Right (first, rest) -> case parseList (skipWhitespaceAndComments rest) of
69		Left err -> Left err
70		Right (Nil, rem) -> Right (Cons first Nil, rem)
71		Right (rest', rem) -> Right (Cons first rest', rem)
72
73		-- Parse an atom (identifiers)
74		parseAtom :: Parser ConsList
75		parseAtom input = let (token, rest) = span isAtomChar input
76		in if null token
77		then Left $ UnexpectedChar (head input)
78		else Right (Atom token, rest)
79
80		-- Parse a number
81		parseNumber :: Parser ConsList
82		parseNumber input = let (ds, rest) = span isDigit input
83		in if null ds
84		then Left $ UnexpectedChar (head input)
85		else Right (Number (read ds), rest)
86
87		-- Parse a string with escape sequences
88		parseString :: Parser ConsList
89		parseString input = parseStringHelper "" input
90		where
91		parseStringHelper acc "" = Left UnterminatedString
92		parseStringHelper acc ('"':rest) = Right (String acc, rest)
93		parseStringHelper acc ('\\':'"':rest) = parseStringHelper (acc ++ "\"") rest
94		parseStringHelper acc ('\\':'\\':rest) = parseStringHelper (acc ++ "\\") rest
95		parseStringHelper acc (c:rest) = parseStringHelper (acc ++ [c]) rest
96
97		-- Helpers for character classification
98		isAtomStart :: Char -> Bool
99		isAtomStart c = isAlpha c \|\| c == '_' \|\| c == '+' \|\| c == '-' \|\| c == '*' \|\| c == '/' \|\| c == '?'
100
101		isAtomChar :: Char -> Bool
102		isAtomChar c = isAtomStart c \|\| isDigit c
103
104		-- Helper to drop whitespace
105		dropWhile1 :: (a -> Bool) -> [a] -> [a]
106		dropWhile1 p [] = []
107		dropWhile1 p (x:xs)
108		\| p x = dropWhile p xs
109		\| otherwise = x:xs
	100	\| otherwise = skipComment cs⏎

+130

-27

src/Language/Argyle/Tests/Sexpr2ConsListTests.hs less more

6	6
7	7	import Test.HUnit
8	8
9		import Language.Argyle.Sexpr2ConsList (parse)
	9	import Language.Argyle.Sexpr2ConsList (parse, ParseResult(..), ParseError(..))
10	10	import qualified Language.Argyle.ConsList as L
11	11
12	12	-- Test cases grouped by category

16	16	, TestLabel "List Expressions" listTests
17	17	, TestLabel "Whitespace Handling" whitespaceTests
18	18	, TestLabel "Complex Expressions" complexTests
	19	, TestLabel "Multi-line Input" multiLineTests
	20	, TestLabel "Error Handling" errorTests
	21	, TestLabel "Incomplete Expression" incompleteTests
19	22	]
20	23
21	24	-- Helper function to compare parsed results
22	25	assertParsedEquals :: String -> L.ConsList -> Test
23	26	assertParsedEquals input expected =
24	27	TestCase $ case parse input of
25		(Just actual, _) -> assertEqual ("Parsing " ++ show input)
26		expected
27		actual
28		(Nothing, _) -> assertFailure $ "Failed to parse: " ++ input
	28	Complete actual rest -> assertEqual ("Parsing " ++ show input)
	29	expected
	30	actual
	31	Incomplete n _ -> assertFailure $ "Expected complete parse but got incomplete with " ++ show n ++ " unclosed parens"
	32	Error err -> assertFailure $ "Failed to parse: " ++ show err
	33
	34	-- Helper function to assert incomplete parse
	35	assertIncomplete :: String -> Int -> Test
	36	assertIncomplete input expectedCount =
	37	TestCase $ case parse input of
	38	Complete _ _ -> assertFailure "Expected incomplete parse but got complete result"
	39	Incomplete count _ -> assertEqual ("Checking incomplete parse count for " ++ show input)
	40	expectedCount
	41	count
	42	Error err -> assertFailure $ "Expected incomplete but got error: " ++ show err
	43
	44	-- Helper function to assert parse error
	45	assertParseError :: String -> ParseError -> Test
	46	assertParseError input expectedError =
	47	TestCase $ case parse input of
	48	Complete _ _ -> assertFailure "Expected error but got complete result"
	49	Incomplete _ _ -> assertFailure "Expected error but got incomplete result"
	50	Error err -> assertEqual ("Checking error for " ++ show input)
	51	expectedError
	52	err
29	53
30	54	-- Tests for atomic expressions
31	55	atomicTests :: Test
32	56	atomicTests = TestList
33	57	[ "Parse simple atom" ~:
34	58	assertParsedEquals "atom" (L.Atom "atom")
	59
	60	, "Parse number" ~:
	61	assertParsedEquals "42" (L.Number 42)
	62
	63	, "Parse string" ~:
	64	assertParsedEquals "\"hello\"" (L.String "hello")
	65
	66	, "Parse escaped string" ~:
	67	assertParsedEquals "\"hello\\\"world\"" (L.String "hello\"world")
35	68	]
36	69
37	70	-- Tests for list expressions
38	71	listTests :: Test
39	72	listTests = TestList
40		[ "Parse cons expression" ~:
	73	[ "Parse empty list" ~:
	74	assertParsedEquals "()" L.Nil
	75
	76	, "Parse single element list" ~:
	77	assertParsedEquals "(atom)"
	78	(L.Cons (L.Atom "atom") L.Nil)
	79
	80	, "Parse cons expression" ~:
41	81	assertParsedEquals "(cons a b)"
42	82	(L.Cons (L.Atom "cons")
43	83	(L.Cons (L.Atom "a")

55	95	(L.Cons (L.Atom "cons")
56	96	(L.Cons (L.Atom "a")
57	97	(L.Cons (L.Atom "b") L.Nil)))
	98
	99	, "Parse with comments" ~:
	100	assertParsedEquals "(cons a ; comment here\n b)"
	101	(L.Cons (L.Atom "cons")
	102	(L.Cons (L.Atom "a")
	103	(L.Cons (L.Atom "b") L.Nil)))
58	104	]
59	105
60	106	-- Tests for complex nested expressions
61	107	complexTests :: Test
62	108	complexTests = TestList
63		[ "Parse complex nested expression" ~:
	109	[ "Parse nested list expression" ~:
64	110	assertParsedEquals "(zork (cons (cdr a) (list a b () d)) r)"
65	111	(L.Cons (L.Atom "zork")
66	112	(L.Cons

76	122	(L.Cons (L.Atom "d") L.Nil)))))
77	123	L.Nil)))
78	124	(L.Cons (L.Atom "r") L.Nil)))
79		]
80
81		-- Test remainder handling
82		remainderTests :: Test
83		remainderTests = TestList
84		[ "Check empty remainder after atom" ~:
85		TestCase $ case parse "atom" of
86		(Just _, remainder) -> assertEqual "Should be empty" "" remainder
87
88		, "Check empty remainder after list" ~:
89		TestCase $ case parse "(cons a b)" of
90		(Just _, remainder) -> assertEqual "Should be empty" "" remainder
91
92		, "Check remainder after incomplete parse" ~:
93		TestCase $ case parse "(cons a b) extra" of
94		(Just _, remainder) -> assertEqual "Should contain extra" " extra" remainder
	125
	126	, "Parse nested expression with comments" ~:
	127	assertParsedEquals "(let ; outer let\n ((x 1)\n (y 2)) ; bindings\n (add x y))"
	128	(L.Cons (L.Atom "let")
	129	(L.Cons
	130	(L.Cons
	131	(L.Cons (L.Atom "x")
	132	(L.Cons (L.Number 1) L.Nil))
	133	(L.Cons
	134	(L.Cons (L.Atom "y")
	135	(L.Cons (L.Number 2) L.Nil))
	136	L.Nil))
	137	(L.Cons
	138	(L.Cons (L.Atom "add")
	139	(L.Cons (L.Atom "x")
	140	(L.Cons (L.Atom "y") L.Nil)))
	141	L.Nil)))
	142	]
	143
	144	-- Tests for multi-line input handling
	145	multiLineTests :: Test
	146	multiLineTests = TestList
	147	[ "Incomplete single line" ~:
	148	assertIncomplete "(let ((x 1)" 2
	149
	150	, "Incomplete multi-line expression" ~:
	151	assertIncomplete "(let\n ((x 1)\n (y 2)\n" 2
	152
	153	, "Complete multi-line expression" ~:
	154	assertParsedEquals "(let\n ((x 1)\n (y 2))\n (add x y))"
	155	(L.Cons (L.Atom "let")
	156	(L.Cons
	157	(L.Cons
	158	(L.Cons (L.Atom "x")
	159	(L.Cons (L.Number 1) L.Nil))
	160	(L.Cons
	161	(L.Cons (L.Atom "y")
	162	(L.Cons (L.Number 2) L.Nil))
	163	L.Nil))
	164	(L.Cons
	165	(L.Cons (L.Atom "add")
	166	(L.Cons (L.Atom "x")
	167	(L.Cons (L.Atom "y") L.Nil)))
	168	L.Nil)))
	169	]
	170
	171	-- Tests for error handling
	172	errorTests :: Test
	173	errorTests = TestList
	174	[ "Unmatched close paren" ~:
	175	assertParseError ")" UnmatchedCloseParen
	176
	177	, "Invalid character" ~:
	178	assertParseError "@invalid" (UnexpectedChar '@')
	179
	180	, "Unterminated string" ~:
	181	assertParseError "\"unterminated" UnterminatedString
	182
	183	, "Empty input" ~:
	184	assertParseError "" EmptyInput
	185	]
	186
	187	-- Tests for incomplete expression handling
	188	incompleteTests :: Test
	189	incompleteTests = TestList
	190	[ "Single open paren" ~:
	191	assertIncomplete "(" 1
	192
	193	, "Nested incomplete" ~:
	194	assertIncomplete "(((" 3
	195
	196	, "Partially complete" ~:
	197	assertIncomplete "(complete) (" 1
	198
	199	, "Complex incomplete" ~:
	200	assertIncomplete "(let ((x 1) (y " 3
95	201	]
96	202
97	203	-- Main function to run the test suite
98	204	runTests :: IO Counts
99		runTests = runTestTT $ TestList
100		[ tests
101		, TestLabel "Remainder Handling" remainderTests
102		]
	205	runTests = runTestTT tests⏎

+32

-24

src/Main.hs less more

16	16	import Language.Argyle.Value (ABT, showValue, unparseABT)
17	17	import qualified Language.Argyle.Tests.Runner as TestRunner
18	18	import qualified Language.Argyle.Interpreter as I
	19	import qualified Language.Argyle.Sexpr2ConsList as S
19	20	import Language.Argyle.REPL (repl)
20
21	21
22	22	main :: IO ()
23	23	main = do
24	24	args <- getArgs
25
26	25	case args of
27	26	["parse", filename] -> do
28	27	source <- readFile filename

44	43	_ ->
45	44	usage
46	45
47		showParses source = do
48		conslist <- parseUsing (sexprToConsList) source
49		putStrLn $ show conslist
50		ast <- parseUsing (sexprToAST) source
51		putStrLn $ show ast
52		abt <- parseUsing (sexprToABT) source
53		putStrLn $ unparseABT [] abt
54		putStrLn $ show abt
55
56		parseUsing :: (String -> Either String x) -> String -> IO x
57		parseUsing converter source = do
58		case converter source of
59		Left err -> do
60		abortWith $ "Error: " ++ err
61		Right val ->
62		return val
63
64		readUsing :: (String -> Either String x) -> FilePath -> IO x
65		readUsing converter filename = do
66		input <- readFile filename
67		parseUsing converter input
	46	showParses :: String -> IO ()
	47	showParses source = case S.parse source of
	48	S.Complete conslist remainder -> do
	49	putStrLn $ show conslist
	50	case sexprToAST source of
	51	Left err -> abortWith $ "AST Error: " ++ err
	52	Right ast -> do
	53	putStrLn $ show ast
	54	case sexprToABT source of
	55	Left err -> abortWith $ "ABT Error: " ++ err
	56	Right abt -> do
	57	putStrLn $ unparseABT [] abt
	58	putStrLn $ show abt
	59	S.Incomplete count _ ->
	60	abortWith $ "Incomplete expression: missing " ++ show count ++ " closing parentheses"
	61	S.Error err ->
	62	abortWith $ "Parse error: " ++ show err
68	63
69	64	readABTfrom :: FilePath -> IO ABT
70		readABTfrom = readUsing sexprToABT
	65	readABTfrom filename = do
	66	input <- readFile filename
	67	case S.parse input of
	68	S.Complete _ remainder \| not (all isSpace remainder) ->
	69	abortWith $ "Unexpected characters after expression: " ++ remainder
	70	S.Complete _ _ ->
	71	case sexprToABT input of
	72	Left err -> abortWith $ "Error: " ++ err
	73	Right abt -> return abt
	74	S.Incomplete count _ ->
	75	abortWith $ "Incomplete expression: missing " ++ show count ++ " closing parentheses"
	76	S.Error err ->
	77	abortWith $ "Parse error: " ++ show err
71	78
	79	usage :: IO ()
72	80	usage = abortWith
73	81	(
74	82	"Usage:\n" ++