コンテンツにスキップ

48時間でSchemeを書こう/評価: 第二部

リンクを追加
出典: フリー教科書『ウィキブックス（Wikibooks）』

追加のプリミティブ: 部分適用

[編集]

型エラーや悪い引数などを対処できるようになったので、プリミティブのリストを、単純な計算以上のことをするように肉付けしていきます。等価性評価、条件演算子、基本的な文字列操作などを加えましょう。

始めに、以下をプリミティブのリストに加えてください。 

              ("=", numBoolBinop (==)),
              ("<", numBoolBinop (<)),
              (">", numBoolBinop (>)),
              ("/=", numBoolBinop (/=)),
              (">=", numBoolBinop (>=)),
              ("<=", numBoolBinop (<=)),
              ("&&", boolBoolBinop (&&)),
              ("||", boolBoolBinop (||)),
              ("string=?", strBoolBinop (==)),
              ("string<?", strBoolBinop (<)),
              ("string>?", strBoolBinop (>)),
              ("string<=?", strBoolBinop (<=)),
              ("string>=?", strBoolBinop (>=)),

これらは私たちがまだ書いていない補助関数、numBoolBinop・boolBoolBinop・strBoolBinopに依存しています。可変長の引数を取り整数を返す代わりに、これらは全て2つの引数を取り真偽値を返します。これらが互いに引数の型のみが違うので、一般化されたboolBinop関数に重複箇所をまとめましょう。boolBinopはその引数に適用するunpackerによってパラメータ化されます。 

boolBinop :: (LispVal -> ThrowsError a) -> (a -> a -> Bool) -> [LispVal] -> ThrowsError LispVal
boolBinop unpacker op args = if length args /= 2 
                             then throwError $ NumArgs 2 args
                             else do left <- unpacker $ args !! 0
                                     right <- unpacker $ args !! 1
                                     return $ Bool $ left `op` right

引数それぞれが型エラーを投げるかもしれないので、(Errorモナドの)doブロックの中でそれらを順番にunpackしなくてはなりません。その後、opを2つの引数に適用して、それをBoolコンストラクタで包んで返します。どんな関数もバックティックで囲むことで中置演算子にすることができます(`op`)。

型シグネチャも見てみてください。boolBinopは2つの関数を最初の二引数として取ります。一つ目の関数はLispValからHaskellの地の型に戻すのに使われ、二つ目が実際に行うべき操作となります。振舞の違うところをパラメータ化することで、関数を再利用しやすくできます。

ではboolBinopを異なるunpackerで特定化する3つの関数を定義しましょう。 

numBoolBinop = boolBinop unpackNum
strBoolBinop = boolBinop unpackStr
boolBoolBinop = boolBinop unpackBool

私たちはHaskellにどのように文字列をLispValからunpackするかまだ教えていませんでした。これは値に対してパターンマッチを行ない、それを返すかエラーを投げる、というunpackNumと似た動作をします。繰り返しになりますが、文字列として解釈できる値を渡された時は、これらの関数は暗黙の内にそれを文字列に変換します。 

unpackStr :: LispVal -> ThrowsError String
unpackStr (String s) = return s
unpackStr (Number s) = return $ show s
unpackStr (Bool s) = return $ show s
unpackStr notString = throwError $ TypeMismatch "string" notString

真偽値をunpackするのにも似たようなコードを使います。 

unpackBool :: LispVal -> ThrowsError Bool
unpackBool (Bool b) = return b
unpackBool notBool = throwError $ TypeMismatch "boolean" notBool

次のステップに進む前に、これをコンパイル・テストして上手くいくことを確かめましょう。 

% ghc -package parsec -o simple_parser [../code/listing6.1.hs listing6.1.hs]
% ./simple_parser "(< 2 3)"
#t
% ./simple_parser "(> 2 3)"
#f
% ./simple_parser "(>= 3 3)"
#t
% ./simple_parser "(string=? \"test\"  \"test\")"
#t
% ./simple_parser "(string<? \"abc\" \"bba\")"
#t

条件分岐: パターンマッチ2

[編集]

では次に、我々の評価器にif節を加えましょう。標準Schemeと同じように、私たちの評価器は#fを偽とし、それ以外の値全てを真とします。 

eval (List [Atom "if", pred, conseq, alt]) = 
    do result <- eval pred
       case result of
         Bool False -> eval alt
         otherwise -> eval conseq

これは入れ子のパターンマッチの例です。ここでは、4つの要素を持つリストに対してマッチを行っています。4要素の内、最初はアトム"if"でなければなりませんが、他はどんなSchemeの式でもよいです。最初の引数を取って評価し、それが真であればその次を、偽であればその次の次の式を評価します。

コンパイル・実行してください。条件分岐で遊ぶことができます。 

% ghc -package parsec -o simple_parser [../code/listing6.2.hs listing6.2.hs]
% ./simple_parser "(if (> 2 3) \"no\" \"yes\")"
"yes"
% ./simple_parser "(if (= 3 3) (+ 2 3 (- 5 1)) \"unequal\")"
9

リストのプリミティブ: car、cdrとcons

[編集]

おまけとして、リストを扱うプリミティブも加えましょう。Schemeのリストをペアによってではなく、Haskellの代数的データ型によって表現することにしたので、多くのLispに比べこれらプリミティブの定義はいくらか複雑になります。書き下されたS式に対してそれらがどう振る舞うかで考えるのが一番簡単でしょう。

  1. (car '(a b c)) = a
  2. (car '(a)) = a
  3. (car '(a b . c)) = a
  4. (car 'a) = エラー(リストではない)
  5. (car 'a 'b) = エラー(carは引数を一つしかとらない)

これらは極めて直感的にパターン節に変換することができます。(x : xs)がリストの最初の要素と残りを分けてくれることを思い出してください。 

car :: [LispVal] -> ThrowsError LispVal
car [List (x : xs)] = return x
car [DottedList (x : xs) _] = return x
car [badArg] = throwError $ TypeMismatch "pair" badArg
car badArgList = throwError $ NumArgs 1 badArgList

cdrでも同じことをします。

  1. (cdr '(a b c)) = (b c)
  2. (cdr '(a b)) = (b)
  3. (cdr '(a)) = NIL
  4. (cdr '(a . b)) = b
  5. (cdr '(a b . c)) = (b . c)
  6. (cdr 'a) = エラー(リストではない)
  7. (cdr 'a 'b) = エラー(carは引数を一つしかとらない)

最初の3ケースは一つの節で表現することができます。私たちのパーサは()をList []として表現していて、(x : xs)というパターンを[x]に対してマッチさせる時、xsは[]に束縛されます。他の場合は別の節で扱いましょう。 

cdr :: [LispVal] -> ThrowsError LispVal
cdr [List (x : xs)] = return $ List xs
cdr [DottedList [xs] x] = return x
cdr [DottedList (_ : xs) x] = return $ DottedList xs x
cdr [badArg] = throwError $ TypeMismatch "pair" badArg
cdr badArgList = throwError $ NumArgs 1 badArgList

consはちょっと難しいので、節一つ一つを見ていきましょう。何かとnilをコンスすると、nilを最後とする一要素のリストができます。 

cons :: [LispVal] -> ThrowsError LispVal
cons [x1, List []] = return $ List [x1]

何かとリストをコンスすると、リストの先頭に要素を貼り付けるような感じになります。 

cons [x, List xs] = return $ List $ x : xs

ただし、そのリストがDottedListだった場合、末尾は変らないのでそれはDottedListのままであるべきです。 

cons [x, DottedList xs xlast] = return $ DottedList (x : xs) xlast

二つの非リストをコンスした場合、もしくはリストを先にした場合、DottedListができます。これはそのようなコンスセルがnilで終わっていないからです。 

cons [x1, x2] = return $ DottedList [x1] x2

最後に、2つより多いまたは少ない引数を渡されたらエラーです。 

cons badArgList = throwError $ NumArgs 2 badArgList

私たちの最後のステップはeqv?を実装することです。Schemeは三段階の等価性述語を提供しています: eq?、eqv?、そしてequal?です。eq?とeqv?は私たちの目的からすると大体同じです；それらは2つのものを、同じ字面を持てば同じであると認識し、かなり遅い述語です。そこで私たちは一つだけ関数を書いて、eq?とeqv?という2つの名前で登録することができます。 

eqv :: [LispVal] -> ThrowsError LispVal
eqv [(Bool arg1), (Bool arg2)] = return $ Bool $ arg1 == arg2
eqv [(Number arg1), (Number arg2)] = return $ Bool $ arg1 == arg2
eqv [(String arg1), (String arg2)] = return $ Bool $ arg1 == arg2
eqv [(Atom arg1), (Atom arg2)] = return $ Bool $ arg1 == arg2
eqv [(DottedList xs x), (DottedList ys y)] = eqv [List $ xs ++ [x], List $ ys ++ [y]]
eqv [(List arg1), (List arg2)] = return $ Bool $ (length arg1 == length arg2) && 
                                                    (all eqvPair $ zip arg1 arg2)
    where eqvPair (x1, x2) = case eqv [x1, x2] of
                               Left err -> False
                               Right (Bool val) -> val
eqv [_, _] = return $ Bool False
eqv badArgList = throwError $ NumArgs 2 badArgList

リストの比較以外、これらの殆どは自明です。これはリストが同じ長さかどうか確かめた後、2つのリストをzipし、allを使ってどれか一つでもeqvPairが偽を返すペアがあれば偽を返すようにします。eqvPairは局所的定義の一例です。それはwhereを使って定義され、普通の関数のように働きますが、eqvのその節のその部分のみで有効です。eqvは引数の数が2である限りエラーを投げないので、Left err -> Falseが実行されることはありません。

Equal?と弱い型付け: 異型リスト

[編集]

以前私たちは弱い型付けを導入したので、型を無視して2つの値が同じと解釈できるかどうか見るequal?関数を実装します。例えば、(eqv? 2 "2") => #fですが、(equal? 2 "2") => #tであって欲しいのです。基本的には、unpack関数全てを試してみて、その中のどれかがHaskell的に等しければ真を返すようにします。

明らかな方法は、unpack関数をリストに格納してmapMを使ってそれらを順に実行するというものですが、残念ながら、これは上手くいきません。なぜなら、標準ではHaskellはリストは同じ型のものしか含むことができないからです。色々なunpack関数は違った型の値を返すので、同じリストにしまうことはできません。

ここでは型クラスによって制約される異型リスト(heterogeneous list)を作るために存在型というGHCの拡張を使うことでこの問題を回避します。Haskellでは言語拡張はとてもありふれたことです。言語拡張はそれなりに大きなプログラムを書くときには事実上必須で、しばしば異なる実装間で互換性があります(存在型はHugsとGHCの両方で動き、標準化の候補です)。この拡張を使うために特別なフラグをコンパイラに渡す必要があることに注意してください。後述してあるように -fglasgow-exts を付けるか、より新しい、 -XExistentialQuantification を付けるか、あるいは {-# LANGUAGE ExistentialQuantification #-} というプラグマをファイルの先頭に付けるかのどれかをする必要があります。一般に -Xfoo というコンパイラのフラグをつけることと {-# LANGUAGE foo #-} というプラグマをソースコード中に入れることは等価です。

最初にやらなければならないのは、LispVal -> 何かという関数において、その「何か」が同値性をサポートしていればどんなものでも保持することのできる型を定義することです。 

data Unpacker = forall a. Eq a => AnyUnpacker (LispVal -> ThrowsError a)

これは、型の制約を除けば、普通の代数的データ型と同じようなものです。上の定義は「Eqのインスタンスであるどんな型についても、LispValからその型への関数で、エラーを投げるかもしれないものからUnpackerを定義することができる」と言っています。AnyUnpackerで関数をラップしなければなりませんが、そうすれば私たちはUnpackerのリストを作ることができ、やりたかったことができるようになります。

equal?に直接取り掛かるのではなく、まずunpackerを取ってそれがunpackする2つのLispValが等しいかどうか判断するヘルパー関数を定義しましょう。 

unpackEquals :: LispVal -> LispVal -> Unpacker -> ThrowsError Bool
unpackEquals arg1 arg2 (AnyUnpacker unpacker) = 
             do unpacked1 <- unpacker arg1
                unpacked2 <- unpacker arg2
                return $ unpacked1 == unpacked2
        `catchError` (const $ return False)

実際の関数を得るためにパターンマッチした後、ThrowsErrorモナドのためのdoブロックに入ります。ここでLispValからHaskellの値を取り出し、それらが等しいかどうか調べます。もしその過程のどこかでエラーが起これば、constを使って偽を返します。constを使うのはcatchErrorがエラーに適用する関数を求めているからです。

最後に、equal?をこれらの補助関数を使って定義します。 

equal :: [LispVal] -> ThrowsError LispVal
equal [arg1, arg2] = do
    primitiveEquals <- liftM or $ mapM (unpackEquals arg1 arg2) 
                      [AnyUnpacker unpackNum, AnyUnpacker unpackStr, AnyUnpacker unpackBool]
    eqvEquals <- eqv [arg1, arg2]
    return $ Bool $ (primitiveEquals || let (Bool x) = eqvEquals in x)
equal badArgList = throwError $ NumArgs 2 badArgList

最初のアクションが[unpackNum, unpackStr, unpackBool]の異型リストを作り、それに部分適用された(unpackEquals arg1 arg2)をmapします。これはBoolのリストを作るので、Preludeの関数orでそのどれか一つでも真であれば真を返すようにします。

二つ目のアクションはeqv?で2つの引数を比べます。equal?の方がeqv?より緩くあってほしいので、equal?は少なくともeqv?が真を返す時は真を返すべきです。加えて、これによってリストやdotted-listのような場合を扱わなくてよくなります(ただ、これはバグを引き起こします。このセクションの練習問題2番を見てください)。

最後に、equal?はこれらの値のorを取って、結果をBoolコンストラクタに包んでLispValを返します。let (Bool x) = eqvEquals in xは代数的データ型からさっと値を取り出すやり方で、Bool xをeqvEqualsの値にパターンマッチさせ、xを返します。let式の結果はキーワードinに続く式の結果です。

これらの関数を使うには、プリミティブのリストに加える必要があります。 

              ("car", car),
              ("cdr", cdr),
              ("cons", cons),
              ("eq?", eqv),
              ("eqv?", eqv),
              ("equal?", equal)]

このコードをコンパイルするには、-fglasgow-extsでGHC拡張を有効にしなければなりません。 

% ghc -package parsec -fglasgow-exts -o parser [../code/listing6.4.hs listing6.4.hs]
% ./simple_parser "(cdr '(a simple test))"
(simple test)
% ./simple_parser "(car (cdr '(a simple test)))"
simple
% ./simple_parser "(car '((this is) a test))"
(this is)
% ./simple_parser "(cons '(this is) 'test)"
((this is) . test)
% ./simple_parser "(cons '(this is) '())"
((this is))
% ./simple_parser "(eqv? 1 3)"
#f
% ./simple_parser "(eqv? 3 3)"
#t
% ./simple_parser "(eqv? 'atom 'atom)"
#t

練習問題

  1. #f以外の値全てを真と扱うのではなく、ifの定義を変えて条件部に真偽値のみを受け付け、そうでない時はエラーを投げるようにしなさい。
  2. equal?はリストの中の値をequal?ではなくeqv?で比較しているというバグがあります。例えば、(equal? '(1 "2") '(1 2)) => #fとなりますが、これは#tを返すことが期待されます。equal?を改良して再帰的にリストの中の値の型を無視するようにしなさい。これをeqv?でやったように明示的に実装してもよいし、リストの節を等価性判定述語を引数に取る別の補助関数に括り出してもよいでしょう。
  3. condとcaseを実装しなさい。
  4. 残りのstring functionsを実装しなさい。まだstring-set!の実装方法がわからないと思います。これはHaskellで実装するのが難しいのですが、それについては次の2章でカバーします。
"https://ja.wikibooks.org/w/index.php?title=48時間でSchemeを書こう/評価:_第二部&oldid=176905" より作成