Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
70 lines (58 sloc) 2.42 KB
module LispData where
import Text.ParserCombinators.Parsec hiding (spaces)
import Control.Monad.Error
import Data.IORef
import IO hiding (try)
type Env = IORef [(String, IORef LispVal)]
type IOThrowsError = ErrorT LispError IO
data LispVal = Atom String
| List [LispVal]
| DottedList [LispVal] LispVal
| Number Integer
| String String
| Bool Bool
| PrimitiveFunc ([LispVal] -> ThrowsError LispVal)
| Func {params :: [String], vararg :: (Maybe String),
body :: [LispVal], closure :: Env}
| IOFunc ([LispVal] -> IOThrowsError LispVal)
| Port Handle
instance Show LispVal where show = showVal
showVal :: LispVal -> String
showVal (Atom x) = x
showVal (List x) = "(" ++ unwordsList x ++ ")"
showVal (DottedList h t) = "(" ++ unwordsList h ++ " . " ++ showVal t ++ ")"
showVal (Number x) = show x
showVal (String x) = show x
showVal (Bool True) = "#t"
showVal (Bool False) = "#f"
showVal (PrimitiveFunc _) = "<primitive>"
showVal (Func {params = args, vararg = varargs, body = body, closure = env}) =
"(lambda (" ++ unwords (map show args) ++
(case varargs of
Nothing -> ""
Just arg -> " . " ++ arg) ++ ") ...)"
showVal (Port _) = "<IO port>"
showVal (IOFunc _) = "<IO primitive>"
data LispError = NumArgs Integer [LispVal]
| TypeMismatch String LispVal
| Parser ParseError
| BadSpecialForm String LispVal
| NotFunction String String
| UnboundVar String String
| Default String
showError :: LispError -> String
showError (UnboundVar message varname) = message ++ ": " ++ varname
showError (BadSpecialForm message form) = message ++ ": " ++ show form
showError (NotFunction message func) = message ++ ": " ++ show func
showError (NumArgs expected found) = "Expected " ++ show expected
++ " args; found values " ++ unwordsList found
showError (TypeMismatch expected found) = "Invalid type: expected " ++ expected
++ ", found " ++ show found
showError (Parser parseErr) = "Parse error at " ++ show parseErr
instance Show LispError where show = showError
instance Error LispError where
noMsg = Default "An error has occurred"
strMsg = Default
type ThrowsError = Either LispError
unwordsList :: [LispVal] -> String
unwordsList = unwords . map show
Something went wrong with that request. Please try again.