「Write Yourself a Scheme in 48 Hours」 を写経してみる(13) : Scheme関数の定義

まず、 LispVal型のデータを見ますと二つの型が追加されています。

data LispVal = Atom String
             | List [LispVal]
             | DottedList [LispVal] LispVal
             | Number Integer
             | String String
             | Bool Bool
             | PrimitiveFunc ([LispVal] -> ThrowsError LispVal)     -- 追加(1)
             | Func {params :: [String], vararg :: (Maybe String),  -- 追加(2)
                      body :: [LispVal], closure :: Env}

次にその PrimitiveFunc と Func ... を表示するための関数。

showVal :: LispVal -> String
showVal (PrimitiveFunc _) = "<primitive>"                                       -- 追加(1)
showVal (Func {params = args, vararg = varargs, body = body, closure = env}) =  -- 追加(2)
  "(lambda (" ++ unwords (map show args) ++ 
     (case varargs of 
        Nothing -> ""
        Just arg -> " . " ++ arg) ++ ") ...)" 

instance Show LispVal where show = showVal

関数を評価する eval に6パターンが追加されています。

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

wikibooks には他にも追加された部分が記述されていますが、最下段に実行するようすが掲載されています。

Lisp>>> (define (f x y) (+ x y))
(lambda ("x" "y") ...)
Lisp>>> (f 1 2)
3

(define (f x y) (+ x y))の内部データを見たいですね。

data LispVal = Atom String
             | List [LispVal]
             | DottedList [LispVal] LispVal
             | Number Integer
             | String String
             | Bool Bool deriving Show

-- こちらはコメントにします。
-- instance Show LispVal where show = showVal

として (define (f x y) (+ x y)) の内部データを確認してみます。

>  readExpr "(define (f x y) (+ x y))"
-- >   Right (List [Atom "define",  List [Atom "f",Atom "x",Atom "y"],List [Atom "+",Atom "x",Atom "y"]])
--    eval env (List (Atom "define" : List (Atom var : params)          : body)) 

-- 最初のパターンにマッチし、次のように対応するするのが分かります。
--  var    = "f"
--  params = [Atom "x",Atom "y"]
--  body   = [Atom "+",Atom "x",Atom "y"]

(define (f x y) (+ x y)) の実行はmakeNormalFunc env params body が実行され、さらに defineVar env var で環境に登録されます。

eval env (List (Atom "define" : List (Atom var : params) : body)) = makeNormalFunc env params body >>= defineVar env var

defineVar は defineVar env var value と言う引数の順序ですので makeNormalFunc は makeNormalFunc env params body から 環境に登録するための value を作って渡しています。

--  params = [Atom "x",Atom "y"]
--  body   = [Atom "+",Atom "x",Atom "y"]

> map showVal [Atom "x",Atom "y"] -- > ["x","y"]

-- makeNormalFunc = makeFunc Nothing なので

makeFunc Nothing env params body = return $ Func (map showVal params)  Nothing body env

Func {params :: [String], vararg :: (Maybe String), body :: [LispVal], closure :: Env}

defineVar が var をkey として Func型のデータを環境に保存するのですが、その様子を確認してみます。

-- LispVal 定義、Showインスタンスを元に戻します。

instance Show LispVal where show = showVal
>  readExpr "(define (f x y) (+ x y))"
-- > Right (define (f x y) (+ x y))

先程のリスト(内部表現データ)を入力すると、showVal によりS式に。

> List [Atom "define",  List [Atom "f",Atom "x",Atom "y"],List [Atom "+",Atom "x",Atom "y"]]
-- > (define (f x y) (+ x y))
> let List (Atom "define" : List (Atom var : params) : body) = 
  List [Atom "define",  List [Atom "f",Atom "x",Atom "y"],List [Atom "+",Atom "x",Atom "y"]]

> var    -- > "f"
> params -- > [x,y]
> body   -- > [(+ x y)]

-- Func (map showVal params)  Nothing body env
-- 内部表現だと次のようになる。
-- Func ["x", "y"]  Nothing [Atom "+",Atom "x",Atom "y"] env

> env<-nullEnv

> let showIOThrowsError a = runErrorT ((liftM show a)  `catchError` (return . show)) 
>  showIOThrowsError$ makeNormalFunc env params body
-- > Right "(lambda (\"x\" \"y\") ...)"

-- defineVar が返す値
> showIOThrowsError $ (makeNormalFunc env params body >>=  defineVar env var)
-- > Right "(lambda (\"x\" \"y\") ...)"

-- getVar で変数 "f" を読み出してみる。
>  showIOThrowsError $ getVar env "f"
-- > Right "(lambda (\"x\" \"y\") ...)"

> showEnv env
-- > [("f",(lambda ("x" "y") ...))]

内部データを見やすいように ShowVal を書き換えます。

showVal :: LispVal -> String
showVal (String contents) = "String \"" ++ contents ++ "\""
showVal (Atom name)       = "Atom \""   ++ name ++ "\""
showVal (Number contents) = "Number " ++ show contents
showVal (Bool True)       = "Bool True"
showVal (Bool False)      = "Bool False"
showVal (List contents)   = "List " ++ showValList contents ++ ""
showVal (DottedList head tail) = "DottedList " ++ showValList head ++ " " ++ showVal tail
showVal (PrimitiveFunc _) = "PrimitiveFunc <primitive>"
showVal (Func {params = args, vararg = varargs, body = body, closure = env}) = 
  "Func { params =" ++ show args  ++ " vararg=" ++ show varargs ++ " body=" ++ show body
  ++ " closure= Env }"

showValList :: [LispVal] -> String
showValList = flip showList "" 

unwordsList :: [LispVal] -> String
unwordsList = unwords . map showVal


instance Show LispVal where show = showVal
>  readExpr "(define (f x y) (+ x y))"
-- > Right List [Atom "define",List [Atom "f",Atom "x",Atom "y"],List [Atom "+",Atom "x",Atom "y"]]

>  env<-nullEnv
> let List (Atom "define" : List (Atom var : params) : body) =  
      List [Atom "define",  List [Atom "f",Atom "x",Atom "y"],List [Atom "+",Atom "x",Atom "y"]]

>  Func (map showVal params)  Nothing body env
Func { params =["Atom \"x\"","Atom \"y\""] vararg=Nothing body=[List [Atom "+",Atom "x",Atom "y"]] closure= Env }

define で関数が定義される様子を調べました。
(define (f x y) (+ x y))のとき

関数:(+ x y)
パラメータのリスト:(x y)

が保存されます。
次回に (f x y) が呼ばれたとき、パラメータのリスト:(x y)に f に対応する + を適用させれば良いのではないかと思うのであります。