「Write Yourself a Scheme in 48 Hours」 を写経してみる(16) : 基本 IO の作成(2)

ioPrimitives が追加になって、"apply"など組み込み関数が使えるようになったかと思って実行してみるとエラーになります。

ioPrimitives :: [(String, [LispVal] -> IOThrowsError LispVal)]
ioPrimitives = [("apply", applyProc),
                ("open-input-file", makePort ReadMode),
                ("open-output-file", makePort WriteMode),
                ("close-input-port", closePort),
                ("close-output-port", closePort),
                ("read", readProc),
                ("write", writeProc),
                ("read-contents", readContents),
                ("read-all", readAll)]

エラー・・・Orz

Lisp>>> (apply + '(1 2 3))
listing10.hs: listing10.hs:(143,0)-(153,34): Non-exhaustive patterns in function apply

wikibooks には "We also need to update apply, so that it can handle IOFuncs:" とあり、 apply (IOFunc func) args = func args のパターンが追加されたようです。
しかし、http://jonathan.tang.name/files/scheme_in_48/code/listing10.hs にはその記述がありません。

  • apply (IOFunc func) args = func args を追加しました。
apply :: LispVal -> [LispVal] -> IOThrowsError LispVal
apply (IOFunc func) args                      = func args  -- このパターンを追加しました。
apply (PrimitiveFunc func) args               = liftThrows $ func args
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 
Lisp>>> (apply + '(1 2 3))
6
Lisp>>> (open-input-file "test.scm")
<IO port>

Lisp>>> (load "stdlib.scm")
(lambda ("pred" . lst) ...)
Lisp>>> (map (curry + 2) '(1 2 3 4))
(3 4 5 6)
Lisp>>> (filter even? '(1 2 3 4))
(2 4)
Lisp>>> (map odd? '(1 2 3 4))
(#t #f #t #f)
Lisp>>> ((lambda (x y) (+ x y)) 2 3)
5
Lisp>>> (define add (lambda (x y) (+  x y)))
(lambda ("x" "y") ...)
Lisp>>> quit

動作しました。