「HaskellでLispを書く日記」を読む(1)

「HaskellでLispを書く日記」を写経しながら読んでみます。

import Text.ParserCombinators.Parsec
import Debug.Trace

data Sexp = Nil | Symbol String |Cons Sexp Sexp deriving Show

Show、Read クラスのインスタンスも定義してありますがSexp型データの確認をするために省略して動作させてみます。

-- S式用パーサ:S式はアトムかリストのどちらか。
sexpParser :: Parser Sexp
sexpParser = spaces >>
 (    do { string "("; listParser }
  <|> do { string "'"; a <- sexpParser; return (Cons (Symbol "quote")(Cons a Nil)) }
  <|> do { a<- many1 $ noneOf "'( )"; return (Symbol a) } )

-- リスト用パーサ:まずひとつS式を読み込んでcar部、
-- cdr部はリスト用パーサを再帰的に呼び出す。
-- 終端の閉じかっこ")"を検出すると Nilを返す。
-- リスト用パーサ2:最初の文字が"."かどうかを見て、そうだったらひとつS式を読み込む
-- （"b"の部分）ここでそのまま読み込んだS式を返して次の処理に進んでしまうと、
-- パーサのカーソル（？）が")"の位置のままになっているのでまずい。
-- このためリストパーサで1回空読みをさせてカーソル位置を")"の後ろに進めてから"b"の部分の値を返すようにする。
listParser :: Parser Sexp
listParser = spaces >>
 (    do { string ")"; return Nil }
  <|> do { string "."; a<-sexpParser; listParser; return a }
  <|> do { a<-sexpParser; b<-listParser; return (Cons a b) } )

main = do
   parseTest  sexpParser  "()"             -- > Nil
   parseTest  sexpParser  "hello"          -- > Symbol "hello"
   parseTest  sexpParser  "123"            -- > Symbol "123"
   parseTest  sexpParser  "(abc)"          -- > Cons (Symbol "abc") Nil
   parseTest  sexpParser  "(a b 123)"
   -- > Cons (Symbol "a") (Cons (Symbol "b") (Cons (Symbol "123") Nil))
   parseTest  sexpParser   "(car '(a b))"
   -- > Cons (Symbol "car") (Cons (Cons (Symbol "quote") (Cons (Cons (Symbol "a") 
   --                                                    (Cons (Symbol "b") Nil)) Nil)) Nil)
   parseTest  sexpParser  "(abc ((xyz) abc 123))"
   parseTest  sexpParser  "(a . b)"
           -- > Cons (Symbol "a") (Symbol "b")
   parseTest  sexpParser  "(a . (b . c))"
   -- > Cons (Symbol "a") (Cons (Symbol "b") (Symbol "c"))

Read クラスのインスタンス作成はreadsPrecを定義することにより行います。Read クラスのソースを見ると内部では Parsec が使われているのが分かります。

• Text.Read

import Text.ParserCombinators.Parsec

data Sexp = Nil | Symbol String | N Integer | Cons Sexp Sexp

instance Show Sexp where
  show (Nil) = "()"
  show (N a) = show a
  show (Symbol a) = a
  show (Cons a b) = "(" ++ show a ++ showCdr b ++ ")"

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 :: Parser Sexp
sexpParser = spaces >>
 (    do { string "("; listParser }
  <|> do { string "'"; a <- sexpParser; return (Cons (Symbol "quote")(Cons a Nil)) }
  <|> do { a<- many1 digit ; return (N (read a)) }
  <|> do { a<- many1 $ noneOf "'( )"; return (Symbol a) } )

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


main = do
  print (read "()"::Sexp)            -- > ()
  print (read "a"::Sexp)             -- > a
  print (read "123"::Sexp)           -- > 123
  print (read "(a b)"::Sexp)         -- > (a b)
  print (read "(a 456)"::Sexp)       -- > (a 456)
  print (read "(a . (b . c))"::Sexp) -- > (a b . c)
  print (read "(car '(a b))"::Sexp)  -- > (car (quote (a b)))