Some non-monadic, non-combinator-based code to parse S-expressions.
Chris Pressey
6 years ago
| 0 | module Sexpr where | |
| 1 | ||
| 2 | import Data.Char | |
| 3 | ||
| 4 | data Sexpr = Atom String | |
| 5 | | Cons Sexpr Sexpr | |
| 6 | | Null | |
| 7 | deriving (Ord, Eq) | |
| 8 | ||
| 9 | instance Show Sexpr where | |
| 10 | show (Atom s) = s | |
| 11 | show (Cons a b) = "(" ++ (show a) ++ (showTail b) | |
| 12 | where showTail Null = ")" | |
| 13 | showTail (Cons h t) = " " ++ (show h) ++ showTail t | |
| 14 | showTail x = " . " ++ (show x) ++ ")" | |
| 15 | show Null = "()" | |
| 16 | ||
| 17 | ||
| 18 | parse :: String -> (Maybe Sexpr, String) | |
| 19 | parse "" = (Nothing, "") | |
| 20 | parse (c:rest) | |
| 21 | | isSpace c = parse rest | |
| 22 | | c == '(' = parseList rest | |
| 23 | | c == ')' = (Nothing, rest) | |
| 24 | | isAlpha c = parseAtom (c:rest) | |
| 25 | ||
| 26 | parseList :: String -> (Maybe Sexpr, String) | |
| 27 | parseList s = | |
| 28 | case parse s of | |
| 29 | (Just head, rest) -> | |
| 30 | case parseList rest of | |
| 31 | (Just tail, rest') -> (Just $ Cons head tail, rest') | |
| 32 | (Nothing, rest') -> (Just Null, rest') | |
| 33 | (Nothing, rest) -> | |
| 34 | (Just Null, rest) | |
| 35 | ||
| 36 | parseAtom :: String -> (Maybe Sexpr, String) | |
| 37 | parseAtom "" = (Nothing, "") | |
| 38 | parseAtom (c:rest) | |
| 39 | | isAlpha c = | |
| 40 | case parseAtom rest of | |
| 41 | (Nothing, rest') -> (Just $ Atom [c], rest') | |
| 42 | (Just (Atom a), rest') -> (Just $ Atom ([c] ++ a), rest') | |
| 43 | | otherwise = (Nothing, rest) | |
| 44 | ||
| 45 | ||
| 46 | testCases = [ | |
| 47 | "atom", | |
| 48 | "(cons a b)", | |
| 49 | " atom ", | |
| 50 | " ( cons a b ) ", | |
| 51 | "(zork (cons (cdr a) (list a b () d)) r)" | |
| 52 | ] | |
| 53 | ||
| 54 | test = testAll testCases | |
| 55 | ||
| 56 | testAll [] = return () | |
| 57 | testAll (t:rest) = | |
| 58 | let | |
| 59 | (Just s, remainder) = parse t | |
| 60 | in do | |
| 61 | print (t, s) | |
| 62 | testAll rest |