HaskellでLispを書く日記 このページをアンテナに追加 RSSフィード

2007-03-17

今日までの全コード 今日までの全コード - HaskellでLispを書く日記 を含むブックマーク はてなブックマーク - 今日までの全コード - HaskellでLispを書く日記 今日までの全コード - HaskellでLispを書く日記 のブックマークコメント

import Text.ParserCombinators.Parsec

data Sexp = Nil | Symbol String | Cons Sexp Sexp | Subr (Sexp->Sexp)

instance Eq Sexp where
  (==) Nil Nil = True
  (==) (Symbol a) (Symbol b) = a==b
  (==) (Cons a as) (Cons b bs) = a==b && as==bs
  (==) _ _ = False

instance Show Sexp where
  show (Nil) = "()"
  show (Symbol a) = a
  show (Cons a b) = "(" ++ show a ++ showCdr b ++ ")"
  show (Subr _) = "#<subr>"

showCdr (Nil) = ""
showCdr (Cons a b) = " " ++ show a ++ showCdr b
showCdr a = " . " ++ show a

instance Read Sexp where
  readsPrec _ s = case parse sexpParser "" s of Right a -> [(a,"")]

sexpParser = spaces >>
  (    do { string "("; listParser }
   <|> do { string "'"; a<-sexpParser; return (Cons (Symbol "quote") (Cons a Nil)) }
   <|> do { a<-many1 $ noneOf "'( )"; return (Symbol a) } )

listParser = spaces >>
  (    do { string ")"; return Nil }
   <|> do { string "."; a<-sexpParser; listParser; return a }
   <|> do { a<-sexpParser; b<-listParser; return (Cons a b) } )

true = Symbol "#t"
false = Symbol "#f"

eval (Nil) env = Nil
eval (Symbol s) env = assoc s env
eval (Cons (Symbol "quote") (Cons a _)) _ = a
eval (Cons (Symbol "if") (Cons p (Cons t (Cons e _)))) env = if eval p env /= false then eval t env else eval e env
eval (Cons fun arg) env = apply (eval fun env) (evals arg env)

evals (Cons a b) env = Cons (eval a env) (evals b env)
evals a env = eval a env

apply (Subr fun) arg = fun arg

assoc s (Cons (Cons (Symbol k) v) e) = if s==k then v else assoc s e
assoc s _ = error $ "unbound variable: " ++ show s

define key val env = Cons (Cons (Symbol key) val) env
env =
 define "car" (Subr (\(Cons (Cons a _) _)->a)) $
 define "cdr" (Subr (\(Cons (Cons _ a) _)->a)) $
 define "cons" (Subr (\(Cons a (Cons b _))->Cons a b)) $
 define "eq?" (Subr (\(Cons a (Cons b _))->if a==b then true else false)) $
 define "pair?" (Subr (\(Cons a _)->case a of Cons _ _ -> true; _ -> false )) $
   read "((x . (a b c)) (y . a) (#t . #t) (#f . #f))"

lisp str = print $ eval (read str) env

main = do
  lisp "(pair? x)"
  lisp "(pair? y)"
  lisp "(pair? ())"
  lisp "(eq? x y)"
  lisp "(eq? (car x) y)"
トラックバック - http://haskell.g.hatena.ne.jp/haskelisp/20070317