Haskell で作る micro Scheme
今回は Haskell で小さな Scheme インタプリタ "micro Scheme" を作ってみましょう。Lisp や Scheme で小さな Scheme 処理系を作ることはとても簡単です。Haskell で Scheme を作る場合、Scheme の構文解析が必要になりますが、Scheme の基本的な構文は簡単なので、難しいところはほとんどありません。
まずは最初に、Scheme の基本的な構文について簡単に説明しましょう。Lisp や Scheme の詳しい説明は拙作のページ Common Lisp 入門 や お気楽 Scheme プログラミング入門 をお読みください。
●Scheme の S 式とは？
Lisp や Scheme では、すべてのデータをまとめて「S 式 (symbolic expression)」と呼びます。次の図を見てください。
S 式は「アトム (atom)」と「リスト (list)」に分けられます。リストは「連結リスト (linked list)」のことで、アトムはリスト以外のデータすべてのことを意味します。リストは左右の丸カッコで囲み、要素を空白で区切ります。なお、Lisp / Scheme のリストは Haskell のリストとは違い、異なるデータ型でもいっしょに格納することができます。もちろん、リストを入れ子にすることもできます。
Scheme は S 式の値を計算することで動作します。値を計算することを「評価 (evaluation)」するといいます。評価規則はデータ型によって決められています。
- リスト
リストの先頭要素を評価し、その値が関数であればそれを実行して結果を返す。たとえばシンボルの場合、その値 (関数) を取り出して実行し、その結果を返す。ほかの要素は引数として関数に渡される。 - シンボル
そのシンボルに格納されている値を返す。 - その他
自分自身を返す。
簡単な例を示しましょう。処理系は Gauche (Scheme) を使いました。
gosh> (+ 1 2) 3 gosh> (* (+ 1 2) (- 3 4)) -3
+, *, - はシンボルで、それぞれ加算、乗算、減算を行う関数を格納しています。(+ 1 2) を実行する場合、関数 + を実行する前に、引数の 1, 2 を評価します。この場合、引数がリストやシンボルでないので、そのまま関数に渡されます。評価しても自分自身になるデータ型を「自己評価フォーム」といいます。通常の関数では、引数は必ず評価されることを覚えておいて下さい。
引数がリストの場合、そのリストをプログラムとして実行します。2 番目の例を見てください。関数 * の第 1 引数はリストなので、Scheme はそのリストの第 1 要素を関数として実行しようとします。この結果は 3 になります。
次に第 2 引数を調べます。これもリストなので - を関数として実行します。この結果は -1 になります。これで * に与える引数をすべてチェックしたので、最後に * を実行します。そして、その結果が -3 になるわけです。
引数を評価しない関数もあります。これを「シンタックス形式」といいます。
gosh> (define a 10) a gosh> a 10 gosh> (define b (+ 1 2 3)) b gosh> b 6
define はシンボルに値をセットします。この場合、シンボルは変数として機能します。define には第 1 引数にシンボル、第 2 引数にセットする値を渡します。Gauche の場合、define の返り値は値をセットしたシンボルになります。define はシンタックス形式なので、第 1 引数のシンボルは評価しないことに注意してください。define は第 1 引数をそのまま受け取り、第 2 引数を評価した結果をシンボルに代入します。第 2 引数にリストを書けば、その実行結果がシンボルに代入されます。
●クォート (quote)
Scheme の場合、変数 (シンボル) には整数、実数、文字列、シンボル、リストなど S 式であれば何でも格納することができます。ところで、整数は define で変数に代入できましたが、シンボルやリストを変数に代入することができるのでしょうか。define の第 2 引数は「評価」されることを思い出してください。
gosh> (define x 10) x gosh> (define y x) <-- 引数 x が評価され 10 が y に代入される y gosh> y 10
変数 y にシンボル x を代入する場合、define にそのまま x を与えると、x が評価されてその値が y に代入されてしまいます。リストの場合は、それがプログラムとして実行されるので、リスト自身を変数に代入することはできません。シンボルやリストを変数に代入するときは、引数が評価されては困るのです。そのため、引数を評価しないようにする関数が用意されています。次の例を見てください。
gosh> (define y 'x) y gosh> y x gosh> (define y '(1 2 3 4)) y gosh> y (1 2 3 4)
引用符 ' をつけると、その次の S 式は評価されません。引用符は関数 quote の省略形で、'x は Scheme 処理系によって、(quote x) と変換されます。quote はシンタックス形式で、引数を評価せずにそのまま返す働きをします。したがって、(define y 'x) の場合、(quote x) が評価されて x 自身が返り値となります。つまり、シンボル x に格納されている値が取り出されるのではなく、x 自身が関数に渡されるのです。その結果、変数 y にシンボル x を代入することができます。
同様に、リストの場合も引用符をつけることで、変数に代入することができます。この場合、リストは評価されない、つまり、プログラムとして実行されないので、最初の要素が関数である必要はありません。'(1 2 3 4) は (quote (1 2 3 4)) に変換され、それが評価されて (1 2 3 4) というリスト自身が define に渡されます。
この場合、リストはプログラムではなくデータとして扱うことになります。リストにプログラムとデータという 2 つの役割を持たせていることが、ほかの言語とは最も異なる Scheme (Lisp) の特徴です。
シンタックス形式以外の関数は引数を必ず評価するので、リストやシンボル自身をデータとして扱うために quote を頻繁に使うことになります。いちいち (quote (1 2 3 4)) と書いていては面倒だし、プログラムが読みにくくなってしまいます。そこで、'(1 2 3 4) のような省略形が使われるようになりました。
シンボルとリスト以外のデータは、評価されても自分自身になる自己評価フォームですから、数値や文字列には引用符を付ける必要はありません。
●条件分岐
Lisp / Scheme では、シンタックス形式を使って条件分岐を実現します。Scheme には、条件分岐を実行する関数がいくつかありますが、いちばん簡単な関数が if です。if は英語で「もしも」という意味ですから、まさに条件分岐そのものを表しています。if の基本的な使い方は次のようになります。
(if <条件部> <処理Ａ> <処理Ｂ>)
if は 3 つの引数を受け取りますが、シンタックス形式なので引数は評価されずにそのまま if に渡されます。最初に、if は <条件部> を評価します。この評価結果が真であれば、条件を満たしていると判断し、処理 A を評価します。この場合、処理 B は評価されません。評価結果が偽であれば、処理 B を評価します。この場合、処理 A は評価されません。Scheme の場合、偽は #f で表し、それ以外の値を真と判断します。真偽値を返す述語の場合、条件を満たす場合は #t を返します。#t は真を表す代表選手なのです。
簡単な実行例を示します。
gosh> (if (eq? 'a 'a) 1 0) 1 gosh> (if (eq? 'a 'b) 1 0) 0
最初の例は同じシンボル a を比較しているので、(eq? 'a 'a) は真を返します。したがって、then 節の 1 が評価されて if の返り値は 1 になります。次の例は異なるシンボル a と b を比較しているので、(eq? 'a 'b) は偽を返します。else 節の 0 が評価されて if の返り値は 0 になります。
●ラムダ式
Scheme の場合、ユーザが定義する関数は「ラムダ式 (lambda expression)」で表すことができます。ラムダはギリシャ文字のλのことです。ラムダ式の構文を示します。
(lambda (<仮引数名> ....) 処理１ 処理２ ・・・ 処理Ｍ)
Scheme の場合、ラムダ式を評価すると関数を表すデータになります。Scheme ではこれを「クロージャ (closure)」といいます。そして、このクロージャを define でシンボルに束縛すれば、関数を定義することができます。
簡単な例を示します。
gosh> (lambda (x) (* x x)) #<closure #f> gosh> (define square (lambda (x) (* x x))) square gosh> (square 10) 100
このように、define とラムダ式を使えば簡単に関数を定義することができます。
また、次のようにラムダ式をリストの先頭要素にもってくれば、それを評価することができます。
gosh> ((lambda (x) (* x x)) 2) 4
もちろん、高階関数でラムダ式を使うこともできます。
gosh> (map (lambda (x) (* x x)) '(1 2 3 4 5)) (1 4 9 16 25) gosh> (map (lambda (x) (cons x x)) '(1 2 3 4 5)) ((1 . 1) (2 . 2) (3 . 3) (4 . 4) (5 . 5))
map はマップ関数のことです。
●可変個引数
Scheme の場合、ラムダ式の仮引数は次に示す 3 通りのパターンがあります。
- (lambda (a b c) ... )
- (lambda (a b c . args) ... )
- (lambda args ... )
1 は今まで説明した関数呼び出しと同じ形式で、3 個の仮引数 a, b, c があります。この場合、実引数も 3 個必要になります。2 はドットリストで仮引数を表していて、仮引数 a, b, c は 1 と同じですが、引数 args には残りの引数がリストに格納されて渡されます。つまり、3 個以上の引数を受け取ることができます。3 のように変数 args だけの場合、与えられた引数すべてがリストに格納されて args に渡されます。引数がない場合、args は空リストになります。つまり、0 個以上の引数を受け取る関数になります。
簡単な例を示しましょう。
gosh> ((lambda (a b c . args) (list a b c args)) 1 2 3) (1 2 3 ()) gosh> ((lambda (a b c . args) (list a b c args)) 1 2 3 4 5 6) (1 2 3 (4 5 6)) gosh> ((lambda args (list args))) (()) gosh> ((lambda args (list args)) 1 2 3) ((1 2 3))
list は引数をリストに格納して返す関数です。このように、Scheme では可変個の引数を受け取る関数を簡単に定義することができます。
●最小の Scheme
次は、Lisp / Scheme に必要な最低限の機能には何があるか考えてみましょう。参考文献 1 によると、次に示す機能だけを含む Lisp を「純 LISP (pure LISP)」と呼ぶそうです。196 頁より引用します。
純 LISP の機能としては, 次のようなものだけが含まれます。
- CAR, CDR, CONS という基本的リスト処理機能。
- ATOM, NULL, EQUAL という基本的述語。
- プログラムの実行は, 再帰呼び出しを含めた関数呼び出しだけで, PROG などの順次処理を含まない。
- 変数値はラムダ式による束縛によってのみ与えられる。SETQ は存在しない。
このほかに, さらに次のような制限を設ける人もいます。- 数値を含まない。自然数は (A A ... A) というように n 個の要素を持つリストで表す。
- 関数定義関数の存在を許さない。関数に相当するものはラムダ式で与える。
car, cdr, cons は Haskell の head, tail, コンス演算子 (::) に対応します。このほかにも、純LISP - Wikipedia には 『純LISPには二種のデータ(リスト、アトム)、及びそれらを操作する五つの基本関数だけが存在する』 と書かれています。基本関数は car, cdr, cons, eq, atom の 5 つです。eq は等値を判定する述語、atom はデータ型がアトムであれば真を返す述語です。
5 つの基本関数とラムダ式だけでプログラムを作るのは大変です。そこで、条件分岐 cond と関数定義 defun を追加することにします。LISP - Wikipedia によると、これを『最小の Lisp』 というそうです。
今回は最小の Lisp にならって、次に示す関数を持つ小さな Scheme 処理系を作ることにします。
- car
- cdr
- cons
- quote
- eq?
- pair?
- if
- define
ただし、実装が難しい機能は省略します。また、エラーチェックも可能な限り省くことにします。厳密な意味で Scheme とはいえませんが、その分だけ簡単にプログラムを作ることができます。
●S 式のデータ型
それではプログラムを作りましょう。最初に S 式を表すデータ型を定義します。
リスト : S 式の定義
data SExpr = INT Integer
| REAL Double
| SYM String
| STR STRING
| CELL SExpr SExpr
| NIL
型名は SExpr としました。INT は整数 Integer、REAL は実数 Double、STR は文字列 String を表します。SYM はシンボルを表します。Lisp / Scheme の場合、同じ名前のシンボルは基本的にひとつしか存在しないのですが、今回は同じ名前のシンボルを何個でも作ってよいことにします。そのかわり、シンボルの等値は名前 (String) で判定することにします。
CELL はコンスセルを表します。Haskell や ML 系の言語と違って、Lisp / Scheme のリストは二分木と同じ構造になります。たとえば (1 2 3) の場合、コンスセルは次のように連結されます。
上図では、コンスセルを箱で表しています。左側の CAR がデータを格納する場所で、CDR が次のコンスセルと連結しています。CELL SExpr SExpr の左側の引数が CAR を、右側の引数が CDR を表します。この例では、3 つのコンスセルが接続されています。それから、最後尾のコンスセルの CDR にはデータ NIL を格納します。NIL は空リストを表すデータとして使います。
このほかに、関数を表すデータ型が必要になりますが、これはあとで追加することにします。
●ドットリスト
Lisp / Scheme の場合、リストの終端は CDR 部に格納されるデータがセル以外であれば、そこがリストの終端であることがわかります。つまり、NIL でなくてもかまわないのです。リストの終端が NIL 以外のデータである場合、そのリストを次のように表します。
左右の括弧の中間にドット ( . ) を置き、左側に CAR 部のデータを、右側に CDR 部のデータを書きます。つまり、リスト (a) は (a . NIL) と表すことができます。このようなデータを「ドット対 (dotted pair)」と呼びます。たとえば、CAR 部がシンボル a で CDR 部がシンボル b であれば (a . b) となります。
それでは、リスト (a b c) の終端を d に変えてみましょう。ドット対を使った表記法では、(a . (b . (c . d))) となりますが、これは (a b c . d) と表すことができます。
このように、NIL 以外のアトムで終端されたリストを「ドットリスト (dotted list)」と呼びます。ドットの後ろは CDR にセットするデータを指定するのですから、複数のデータを書いたり省略してはいけません。次の場合はエラーになります。
( . a) ; CAR がない (a . ) ; CDR がない (a . b c) ; CDR にデータが複数ある (a . . b) ; ドットが複数ある (a . b . c )
●S 式の表示
S 式を表示するプログラムは簡単です。次のリストを見てください。
リスト : S 式の表示
showCell :: SExpr -> String
showCell (CELL a d) =
show a ++ case d of
NIL -> ""
INT x -> " . " ++ show x
REAL x -> " . " ++ show x
SYM x -> " . " ++ x
STR x -> " . " ++ show x
_ -> " " ++ showCell d
showCell xs = show xs
instance Show SExpr where
show (INT x) = show x
show (REAL x) = show x
show (SYM x) = x
show (STR x) = show x
show NIL = "()"
show xs = "(" ++ showCell xs ++ ")"
SExpr を型クラス Show のインスタンスに設定します。関数 show の引数が INT, REAL, STR であれば、格納されているデータ型を文字列に変換します。SYM は x をそのまま返します。これで文字列は " で囲まれて表示され、シンボルは " で囲まれずに表示されます。NIL ならば "()" を返します。最後の節は引数 xs が CELL の場合です。関数 showCell を呼び出して、その結果をカッコ ( ) で囲みます。
showCell は引数が CELL a d ならば show a で CAR を文字列に変換します。次に、CDR が NIL であれば空文字列 "" を連結します。INT, REAL, STR, SYM の場合はドットリストなので、ドット " . " と格納されているデータ型を文字列に変換して連結します。それ以外の場合はコンスルがつながっているので、空白 " " と showCell d の返り値を連結します。
それでは実行してみましょう。
*Main> INT 10
10
*Main> REAL 1.234
1.234
*Main> SYM "abc"
abc
*Main> STR "hello, world"
"hello, world"
*Main> NIL
()
*Main> CELL (INT 1) NIL
(1)
*Main> CELL (INT 1) (INT 2)
(1 . 2)
*Main> CELL (STR "hello, world") (STR "foo bar baz")
("hello, world" . "foo bar baz")
*Main> CELL (INT 1) (CELL (REAL 2) NIL)
(1 2.0)
*Main> CELL (INT 1) (CELL (REAL 2) (CELL (SYM "abc") NIL))
(1 2.0 abc)
*Main> CELL (CELL (INT 1) NIL) NIL
((1))
*Main> CELL (CELL (INT 1) NIL) (CELL (CELL (INT 2) NIL) NIL)
((1) (2))
正常に動作していますね。
●S 式の読み込み
次は S 式を読み込むプログラムを作ります。最初にパーサの型とエラーを表す型を定義します。
リスト : Parser と ParseErr の定義 -- パーサエラーの定義 data ParseErr = ParseErr String String deriving Show -- パーサの定義 type Parser a = Either ParseErr a -- エラーの送出 parseError :: String -> String -> Parser a parseError x s = Left (ParseErr x s)
ParseErr はパーサで発生したエラーを表します。最初の引数は、エラーが発生したあとの残りの文字列、2 番目の引数はエラーメッセージを表します。パーサの型名は Parser a とし、型は Either ParseErr a となります。ParseError はエラーを送出します。ParseErr を生成して、Left に包んで返すだけです。
次は S 式を読み込む関数 readSExpr を作ります。
リスト : S 式の読み込み
isAlpha' :: Char -> Bool
isAlpha' x = elem x "!$%&*+-/:<=>?@^_~"
isIdent0 :: Char -> Bool
isIdent0 x = isAlpha x || isAlpha' x
isIdent1 :: Char -> Bool
isIdent1 x = isAlphaNum x || isAlpha' x
isREAL :: Char -> Bool
isREAL x = elem x ".eE"
isNUM :: String -> Bool
isNUM (x:_) = isDigit x
isNUM _ = False
quote = SYM "quote"
getNumber :: String -> Parser (SExpr, String)
getNumber xs =
let (s, ys) = span isDigit xs
in if not (null ys) && isREAL (head ys)
then case reads xs of
[] -> parseError "" "" -- ありえないエラー
[(y', ys')] -> return (REAL y', ys')
else return (INT (read s), ys)
readSExpr :: String -> Parser (SExpr, String)
readSExpr [] = parseError "" "EOF"
readSExpr (x:xs)
| isSpace x = readSExpr xs
| isDigit x = getNumber (x:xs)
| isIdent0 x = if x == '+' && isNUM xs
then getNumber xs
else if x == '-' && isNUM xs
then do (y, ys) <- getNumber xs
case y of
INT x -> return (INT (- x), ys)
REAL x -> return (REAL (- x), ys)
else let (name, ys) = span isIdent1 (x:xs)
in return (SYM name, ys)
| otherwise =
case x of
'(' -> readCell 0 xs
';' -> readSExpr $ dropWhile (/= '\n') xs
'"' -> case reads (x:xs) of
[] -> parseError "" ""
[(y, ys)] -> y `seq` ys `seq` return (STR y, ys)
'\'' -> readSExpr xs >>= \(e, ys) -> e `seq` ys `seq` return (CELL quote (CELL e NIL), ys)
_ -> parseError xs ("unexpected token: " ++ show x)
関数 isAlpha' は英字として扱う記号、つまりシンボルの名前に使用できる記号を表します。関数 isIdent0 はシンボルの最初の文字を、isIdent1 はそれ以降の文字を表します。Scheme の仕様とは異なりますが、ご容赦くださいませ。関数 getNumber は整数 (INT) または実数 (REAL) を返します。この処理は電卓プログラムとほぼ同じです。
readSExpr は文字列を受け取り、S 式と残りの文字列を返します。入力が空文字列の場合はエラーを返します。次の節で、先頭文字 x が空白文字ならば x を読み捨てます。数字の場合は getNumber を呼び出します。isIdent0 x が真の場合、x が '+' または '- ' で次の文字が数字であれば、'+' と '-' を符号として扱います。そうでなければ、シンボルの名前 name として読み込んで SYM name を返します。
それ以外の場合は case で場合分けします。'(' の場合はリストを読み込む関数 readCell を呼び出します。';' はコメント行の開始を表します。';' から行末までのデータを読み捨てます。'"' は文字列の開始を表します。reads で文字列を読み込み、STR に格納して返します。'\'' の場合はクォートの処理を行います。readSExpr xs でクォート以降の S 式を読み込み、CELL quote (CELL e NIL) を返します。これで (quote e) を返すことができます。それ以外の記号はエラーを返します。
次はリストを読み込む関数 readCell を作ります。
リスト : リストの読み込み
readCell :: Int -> String -> Parser (SExpr, String)
readCell _ [] = parseError "" "EOF"
readCell n (x:xs)
| isSpace x = readCell n xs
| otherwise =
case x of
')' -> xs `seq` return (NIL, xs)
'.' -> if n == 0
then parseError xs "invalid dotted list"
else do (e, ys) <- readSExpr xs
case dropWhile isSpace ys of
')':zs -> return (e, zs)
_ -> parseError xs "invalid dotted list"
'(' -> do (a, ys) <- readCell 0 xs
(d, zs) <- readCell 1 ys
return (CELL a d, zs)
_ -> do (a, ys) <- readSExpr (x:xs)
(d, zs) <- readCell 1 ys
return (CELL a d, zs)
readCell の第 1 引数は整数 Int で、最初に呼び出すときは 0 を、それ以降の呼び出しは 1 を指定します。これはドットリストのチェックに使います。入力が空文字列の場合はエラーを返します。空白文字の場合はそれを読み飛ばします。あとは case で場合分けします。
右カッコ ) の場合はリストが終了したので NIL を返します。ドット . の場合、引数 n が 0 であればドットの前に要素が存在しないのでエラーを返します。そうでなければ、CDR 部の S 式を readSExpr で読み込みます。次に、dropWhile で空白文字を読み飛ばし、次の文字が右カッコ ) であることを確認します。この場合は式 e を返します。右カッコでなければエラーを返します。
左カッコ ( の場合はリストが入れ子になっています。readCell 0 で CAR 部のリスト a を読み込み、readCell 1 で CDR 部のリスト d を読み込みます。あとは CELL a d を返します。それ以外の場合は readSExpr で CAR 部の要素 a を読み込み、readCell 1 で CDR 部の要素を読み込んで CELL a d を返します。
簡単な実行例を示します。
*Main> readSExpr "1"
Right (1,"")
*Main> readSExpr "1.2345"
Right (1.2345,"")
*Main> readSExpr "abc"
Right (abc,"")
*Main> readSExpr "-1234"
Right (-1234,"")
*Main> readSExpr "+1234"
Right (1234,"")
*Main> readSExpr "-1.234"
Right (-1.234,"")
*Main> readSExpr "+1.234"
Right (1.234,"")
*Main> readSExpr "+ 1234"
Right (+," 1234")
*Main> readSExpr "- 1234"
Right (-," 1234")
*Main> readSExpr "\"hello, world\""
Right ("hello, world","")
*Main> readSExpr "(1 2 3 4)"
Right ((1 2 3 4),"")
*Main> readSExpr "()"
Right ((),"")
*Main> readSExpr "(1 . 2)"
Right ((1 . 2),"")
*Main> readSExpr "(1 2 . 3)"
Right ((1 2 . 3),"")
*Main> readSExpr "((1 2) (3 4))"
Right (((1 2) (3 4)),"")
*Main> readSExpr "'1234"
Right ((quote 1234),"")
*Main> readSExpr "'(1 2 3 4)"
Right ((quote (1 2 3 4)),"")
*Main> readSExpr "(1 2 3 4"
Left (ParseErr "" "EOF")
*Main> readSExpr ")"
Left (ParseErr "" "unexpected token: ')'")
*Main> readSExpr "(1 .)"
Left (ParseErr "" "unexpected token: ')'")
*Main> readSExpr "( . 2)"
Left (ParseErr " 2)" "invalid dotted list")
*Main> readSExpr "(1 . 2 3)"
Left (ParseErr " 2 3)" "invalid dotted list")
*Main> readSExpr "(1 . . 2)"
Left (ParseErr " 2)" "unexpected token: '.'")
正常に動作していますね。
今回はここまでです。次回は S 式を評価する処理を作りましょう。
●参考文献, URL
- 黒川利明, 『LISP 入門』, 培風館, 1982
- Patrick Henry Winston, Berthold Klaus Paul Horn, 『LISP 原書第 3 版 (1)』, 培風館, 1992
18. Lisp で書く Lisp - R. Kent Dybvig (著), 村上雅章 (訳), 『プログラミング言語 SCHEME』, 株式会社ピアソン・エデュケーション, 2000
9.2 Scheme のメタ循環インタプリタ - Ravi Sethi (著), 神林靖 (訳), 『プログラミング言語の概念と構造』, アジソンウェスレイ, 1995
第 11 章 定義インタプリタ - 小西弘一, 清水剛, 『ＣプログラムブックⅢ』, アスキー, 1986
- Harold Abelson, Gerald Jay Sussman, Julie Sussman, "Structure and Interpretation of Computer Programs",
4.1 The Metacircular Evaluator - 稲葉雅幸, ソフトウェア特論, Scheme インタプリタ
●プログラムリスト
--
-- mscheme.hs : microScheme
--
-- Copyright (C) 2013-2021 Makoto Hiroi
--
import Data.Char
-- S 式の定義
data SExpr = INT Integer
| REAL Double
| SYM String
| STR String
| CELL SExpr SExpr
| NIL
-- パーサエラーの定義
data ParseErr = ParseErr String String deriving Show
-- パーサの定義
type Parser a = Either ParseErr a
-- エラーの送出
parseError :: String -> String -> Parser a
parseError x s = Left (ParseErr x s)
--
-- S 式の表示
--
showCell :: SExpr -> String
showCell (CELL a d) =
show a ++ case d of
NIL -> ""
INT x -> " . " ++ show x
REAL x -> " . " ++ show x
SYM x -> " . " ++ x
STR x -> " . " ++ show x
_ -> " " ++ showCell d
showCell xs = show xs
instance Show SExpr where
show (INT x) = show x
show (REAL x) = show x
show (SYM x) = x
show (STR x) = show x
show NIL = "()"
show xs = "(" ++ showCell xs ++ ")"
--
-- S 式の読み込み
--
isAlpha' :: Char -> Bool
isAlpha' x = elem x "!$%&*+-/:<=>?@^_~"
isIdent0 :: Char -> Bool
isIdent0 x = isAlpha x || isAlpha' x
isIdent1 :: Char -> Bool
isIdent1 x = isAlphaNum x || isAlpha' x
isREAL :: Char -> Bool
isREAL x = elem x ".eE"
isNUM :: String -> Bool
isNUM (x:_) = isDigit x
isNUM _ = False
quote = SYM "quote"
getNumber :: String -> Parser (SExpr, String)
getNumber xs =
let (s, ys) = span isDigit xs
in if not (null ys) && isREAL (head ys)
then case reads xs of
[] -> parseError "" "" -- ありえないエラー
[(y', ys')] -> return (REAL y', ys')
else return (INT (read s), ys)
readSExpr :: String -> Parser (SExpr, String)
readSExpr [] = parseError "" "EOF"
readSExpr (x:xs)
| isSpace x = readSExpr xs
| isDigit x = getNumber (x:xs)
| isIdent0 x = if x == '+' && isNUM xs
then getNumber xs
else if x == '-' && isNUM xs
then do (y, ys) <- getNumber xs
case y of
INT x -> return (INT (- x), ys)
REAL x -> return (REAL (- x), ys)
else let (name, ys) = span isIdent1 (x:xs)
in return (SYM name, ys)
| otherwise =
case x of
'(' -> readCell 0 xs
';' -> readSExpr $ dropWhile (/= '\n') xs
'"' -> case reads (x:xs) of
[] -> parseError "" ""
[(y, ys)] -> y `seq` ys `seq` return (STR y, ys)
'\'' -> readSExpr xs >>= \(e, ys) -> e `seq` ys `seq` return (CELL quote (CELL e NIL), ys)
_ -> parseError xs ("unexpected token: " ++ show x)
readCell :: Int -> String -> Parser (SExpr, String)
readCell _ [] = parseError "" "EOF"
readCell n (x:xs)
| isSpace x = readCell n xs
| otherwise =
case x of
')' -> xs `seq` return (NIL, xs)
'.' -> if n == 0
then parseError xs "invalid dotted list"
else do (e, ys) <- readSExpr xs
case dropWhile isSpace ys of
')':zs -> return (e, zs)
_ -> parseError xs "invalid dotted list"
'(' -> do (a, ys) <- readCell 0 xs
(d, zs) <- readCell 1 ys
return (CELL a d, zs)
_ -> do (a, ys) <- readSExpr (x:xs)
(d, zs) <- readCell 1 ys
return (CELL a d, zs)
改訂 2021 年 8 月 1 日