48時間でSchemeを書こう/Scheme関数の定義

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

　さて、私たちは変数を定義できるようになったので、関数をもっとよく拡張することができるでしょう。このセクションのあとに、私たちはSchemeの中でオリジナル関数を定義し、他の関数から呼ぶことができるようになるでしょう。私たちの実装は、終わりに近づいています。

　新しいLispValコンストラクタを定義するところから始めましょう。 

             | PrimitiveFunc ([LispVal] -> ThrowsError LispVal)
             | Func {params :: [String], vararg :: (Maybe String), 
                      body :: [LispVal], closure :: Env}

　私たちはprimitivesのために別のコンストラクタを追加しました。というのも、私たちは +やeqv?等を変数に格納して関数に渡せるようになりたいのです。PrimitiveFuncコンストラクタはThrowsError LispValに対して、引数のリストを取るような関数を扱います。それはprimitiveのリストに格納されているものと同じタイプです。

　私たちは同様に、ユーザー定義型関数を扱うためのコンストラクタが欲しいわけです。私たちは4つの情報を扱います。

  1. 関数のボディの中で束縛されるような、パラメーターの名前。
  2. 可変長の引数のリストが使われているかどうか。使われているなら、束縛されている変数の名前
  3. 関数のボディ。リストとして表現されている。
  4. 関数が作られる環境

　これはrecord型の例になります。レコード型は Haskell では少し不格好なので、ここでは実演目的のためだけに用います。しかし、レコード型は大きなスケールのプログラミングには非常に重要です。

　次に、私たちは新しい型を含めるために、show関数を編集しましょう。 

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) ++ ") ...)"

　全てを表示するのではなく、primitives に対しては"<primitive>"という単語をだけを、ユーザー定義型関数に対してはヘッダー情報だけを出力します。これは、レコード型に対するパターンマッチングの一例にもなっています。そして一般的な代数タイプは、まさにパターンがコンストラクタの呼び出しのようになっています。フィールド名は、最初に書かれ、束縛される変数名が後に続きます。

　次に、applyを変更する必要があります。関数の名前を渡す代わりに、実際の関数に置き換えられるLispValを渡すようにすると、コードがシンプルになります。私たちに必要なのは、ただ関数が吐き出す値を読むことであり、それを適用することなのです。 

apply :: LispVal -> [LispVal] -> IOThrowsError LispVal
apply (PrimitiveFunc func) args = liftThrows $ func args

　私たちがユーザー定義型関数にはちあわせたとき、この興味深いコードが起きます。Recordsは名フィールド名(見られるよりも上に)か、フィールドポジションの両方にマッチするパターンで、後の方で使います。 

apply (Func params varargs body closure) args = 
    if num params /= num args && varargs == Nothing
       then throwError $ NumArgs (num params) args
       else (liftIO $ bindVars closure $ zip params args) >>= bindVarArgs varargs >>= evalBody
    where remainingArgs = drop (length params) args
          num = toInteger . length
          evalBody env = liftM last $ mapM (eval env) body 
          bindVarArgs arg env = case arg of
              Just argName -> liftIO $ bindVars env [(argName, List $ remainingArgs)]
              Nothing -> return env

　この関数が行う一番始めのことは、期待されている引数の数に対して、パラメーターの長さをチェックことです。もしマッチしていないのならば、エラーを吐きます。私たちは、より読みやすくするためのローカル関数であるnumを定義し、このプログラムに短い断片で作ってみましょう。

　呼び出しがされた途端に出てくると、呼び出しの大半はモナディックパイプの中で、引数が新しい環境に束縛され、関数のボディの中にある式が評価されることになります。私たちが行うこの処理をパラメーターの名前や(既に評価された)引数の値をペアのリストを通ってzipするということになります。だから、私たちはこれを取りますし、関数のクロージャ(現在の環境では、まだ出来ません。これは私たちに辞書型スコープがないといけません）、そして関数の中で評価するための新しい環境を作るために、彼らが使われるでしょう。関数の全体としてはIOThrowsErrorである、IO型が結果となり、そして私たちは複合モナドの中にliftIOする必要があるわけです。

　今や、残された引数を、ローカル関数として使われているbindVarArgを使って、varArgs変数変数に束縛するときです。もし関数がvarArgsを取れないのなら(Nothing節のことですね)、私たちはただ存在している環境を返します。同様に、私たちは、変数の名前をkeyとして、残った引数を値として、単独のリストを作成し、bindVarsに渡します。既に変数へ束縛されている引数全てを無視するための、ビルドイン関数である、drop を使うことを、可読性のために、remainingArgsは、ローカル変数として定義しています。

　最後のステージは、この新しい環境の中で、関数のボディーを評価することです。そのために、ローカル変数であるevalBodyを使います。これは、関数のボディの中で、モナディック関数であるeval envに対して、全ての節をマッピングし、最後の節の値を返します。 　今や変数の中で、primitivesを、普段の値として扱うことができるので、プログラムがスタートしたときに、これらを束縛する必要がでてきます。 

primitiveBindings :: IO Env
primitiveBindings = nullEnv >>= (flip bindVars $ map makePrimitiveFunc primitives)
    where makePrimitiveFunc (var, func) = (var, PrimitiveFunc func)

　これは、最初のnull環境を取り、PrimitiveFuncラッパーで構成された、名前と値のペアの枝葉を作り、そして新しい環境に対して、新しいペアを束縛します。私たちは同様に、runOneとrunReplをprimitiveBindingsの代わりに編集しなくてはいけません。 

runOne :: String -> IO ()
runOne expr = primitiveBindings >>= flip evalAndPrint expr

runRepl :: IO ()
runRepl = primitiveBindings >>= until_ (== "quit") (readPrompt "Lisp>>> ") . evalAndPrint

　最終的に、私たちはlambda と define関数をエバリューターの中でサポートできるよう編集する必要があります。私たちは、IOThrowsErrorモナドの中で、関数オブジェクトを作るための、ちょとした簡単ことを、手助けしてくれる少しの関数を作り始めてみましょう。 

makeFunc varargs env params body = return $ Func (map showVal params) varargs body env
makeNormalFunc = makeFunc Nothing
makeVarargs = makeFunc . Just . showVal

　ここで、makeNormalFunc と makeVarArgs は、 makeFunc の最初の引数が、通常の関数と可変長引数の関数用に適切に設定された特殊型とみなすことができます。これはコードを簡潔にするために如何にファーストクラスの関数を使うかという良い例です。

　今、私たちは更なるeval節を追加することで、これらを使えるようにしましょう。彼らは、変数を定義する節の後、そして関数が適応される前に追加されるべきです。 

eval env (List (Atom "define" : List (Atom var : params) : body)) =
    makeNormalFunc env params body >>= defineVar env var
eval env (List (Atom "define" : DottedList (Atom var : params) varargs : body)) =
    makeVarargs varargs env params body >>= defineVar env var
eval env (List (Atom "lambda" : List params : body)) =
    makeNormalFunc env params body
eval env (List (Atom "lambda" : DottedList params varargs : body)) =
    makeVarargs varargs env params body
eval env (List (Atom "lambda" : varargs@(Atom _) : body)) =
    makeVarargs varargs env [] body
eval env (List (function : args)) = do 
    func <- eval env function
    argVals <- mapM (eval env) args
    apply func argVals

　これらは、かたちを解きほぐすためのパターンマッチングを使って、適応する関数の手助けをします。この定義の場合ですと、私たちは同様に、ローカル環境の中で変数を束縛できるよう、アウトプットをdefineVarに流し込みます。私たちは同様に、liftThrowsを外すために、関数を適応する節を編集する必要があります。というのは、applyは既にIOThrowsErrorかモナドの中で動いているからです。

　さて、コンパイルして、プログラムを走らせることができるようになりました、これを使ってリアルなプログラムを書いてみましょう！ 

debian:/home/jdtang/haskell_tutorial/code# ghc -package parsec -fglasgow-exts -o lisp [../code/listing9.hs listing9.hs]
debian:/home/jdtang/haskell_tutorial/code# ./lisp
Lisp>>> (define (f x y) (+ x y))
(lambda ("x" "y") ...)
Lisp>>> (f 1 2)
3
Lisp>>> (f 1 2 3)
Expected 2 args; found values 1 2 3
Lisp>>> (f 1)
Expected 2 args; found values 1
Lisp>>> (define (factorial x) (if (= x 1) 1 (* x (factorial (- x 1)))))
(lambda ("x") ...)
Lisp>>> (factorial 10)
3628800
Lisp>>> (define (counter inc) (lambda (x) (set! inc (+ x inc)) inc))
(lambda ("inc") ...)
Lisp>>> (define my-count (counter 5))
(lambda ("x") ...)
Lisp>>> (my-count 3)
8
Lisp>>> (my-count 6)
14
Lisp>>> (my-count 5)
19
"https://ja.wikibooks.org/w/index.php?title=48時間でSchemeを書こう/Scheme関数の定義&oldid=176896" より作成