-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathlisp-parse.hs
88 lines (73 loc) · 2.81 KB
/
lisp-parse.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
import System.Console.Haskeline
import Data.Char
import Data.List
import qualified Data.Map as Map
-- Data type
data LispObject = Atom String | List [LispObject]
-- Output
instance Show LispObject where
show (Atom a) = a
show (List l) = "(" ++ (intercalate " " (map show l)) ++ ")"
showIndented :: LispObject -> String
showIndented = showIndented' ""
showIndented' indent (Atom a) = indent ++ a ++ "\n"
showIndented' indent (List l) = indent ++ "(\n" ++ concat (map (showIndented' (indent ++ " ")) l) ++ indent ++ ")\n"
-- Input
parseLispObject :: String -> (LispObject, String)
parseLispObject (c:cs) = case c of
'(' -> let (list, rest) = parseList cs in (List list, rest)
_ -> let (atom, rest) = span (\c -> c /= ' ' && c /= ')') (c:cs) in (Atom atom, rest)
parseList :: String -> ([LispObject], String)
parseList (c:cs) = case c of
' ' -> parseList (cs)
')' -> ([], cs)
_ -> let (firstElement, afterFirst) = parseLispObject (c:cs)
(restOfList, restOfInput) = parseList afterFirst
in (firstElement:restOfList, restOfInput)
parseList "" = ([], "")
-- Evaluate
type Environment = Map.Map String LispValue
defaultEnv :: Environment
defaultEnv = Map.fromList [
("+", Function (\values -> Number (sum (map fromNumber values)))),
("list", Function (\list -> ValueList list)),
("car", Function (\[ValueList (l:_)] -> l)),
("pi", Number 3)
]
data LispValue = Number Int | Function ([LispValue] -> LispValue) | ValueList [LispValue]
instance Show LispValue where
show (Number i) = show i
show (Function _) = "A function"
show (ValueList l) = "(" ++ (intercalate " " (map show l)) ++ ")"
fromNumber :: LispValue -> Int
fromNumber (Number i) = i
fromFunction :: LispValue -> [LispValue] -> LispValue
fromFunction (Function f) = f
eval :: Environment -> LispObject -> LispValue
eval env (Atom string) =
if isDigit (head string)
then Number (read string)
else env Map.! string
eval env (List [Atom "let", List initializers, expression]) =
let
[Atom name, value] = initializers
env' = Map.insert name (eval env value) env
in eval env' expression
eval env (List (function:params)) = (fromFunction (eval env function)) (map (eval env) params)
-- Simple REPL
handleLine :: String -> String
handleLine inputLine =
"Simple show: " ++ show object ++ "\n" ++
"Indented show:\n" ++ showIndented' " " object ++
"Evaluated: " ++ show (eval defaultEnv object) ++ "\n"
where (object, _) = parseLispObject inputLine
main :: IO () -- Copied from Haskeline documentation
main = runInputT defaultSettings {historyFile = Just ".lisp_history"} loop
where
loop :: InputT IO ()
loop = do
minput <- getInputLine "> "
case minput of
Nothing -> return ()
Just input -> do outputStrLn $ handleLine input
loop