`foldr`で`dropWhile`と不動点コンビネータ 補足
以下の記事の補足:
式をいじっていて気付いたのだが、不動点コンビネータを使った解は:
dropWhile p = foldr (const f) undefined (repeat undefined) where f _ [] = [] f g ys@(x:xs) = if p x then g xs else ys
に落とし込める。(fix
とdropWhileNR
関数を別にしていたから当初気付かなかった)
これはそもそも別解の:
dropWhile p xs = foldr f id xs xs where f x g ys@(_:zs) | p x = g zs | otherwise = ys
から式変形で導出できる。x
とys
の最初の要素が同一なので:
dropWhile p xs = foldr f id xs xs where f _ g ys@(z:zs) | p z = g zs | otherwise = ys
あるいはif
を使って:
dropWhile p xs = foldr f id xs xs where f _ g ys@(z:zs) = if p z then g zs else ys
に変形できる。そうすると、foldrの第三引数になっているxs
の要素はDon't Careパターンに適用されるだけなのでrepeat undefined
で代用できそう:
dropWhile p xs = foldr f id (repeat undefined) xs where f _ g ys@(z:zs) = if p z then g zs else ys
上記のコードには問題があって、dropWhile (<5) [1..4]
などでエラーを起こす。
実はfoldr
の第三引数のxs
は、要素は使われなかったがリスト自体の長さは「いつ第二引数のid
を返すか」を判定するのに使われていた。具体的にはxs
が空リストになった時にid
を返す。
なので明示的にその停止条件を入れる:
dropWhile p xs = foldr f id (repeat undefined) xs where f _ _ [] = [] f _ g ys@(z:zs) = if p z then g zs else ys
これはf _ _ [] = id []
と同じ。foldr
の第二引数も使わないのでundefined
で代用できる:
dropWhile p xs = foldr f undefined (repeat undefined) xs where f _ _ [] = [] f _ g ys@(z:zs) = if p z then g zs else ys
そしてdropWhile p xs = foldr f undefined (repeat undefined) xs
のxs
も、それ以降の定義ではまったく使われないので両辺から消してしまう:
dropWhile p = foldr f undefined (repeat undefined) where f _ _ [] = [] f _ g ys@(z:zs) = if p z then g zs else ys
f _
は(const f)
と同義だ。f
の第一引数は必ずDon't Careパターンで無視されているので:
dropWhile p = foldr (const f) undefined (repeat undefined) where f _ [] = [] f g ys@(z:zs) = if p z then g zs else ys
Haskellで50行以内のミニマルコンパイラ
こんなツイートが流れてきた:
A complete #compiler to x86 in one page for my lecture today. pic.twitter.com/PwFl4V5czy
— Joe Gibbs Politz (@joepolitz) 2018年4月11日
元となっているのは"An Incremental Approach to Compiler Construction"という論文とのこと。
面白そうだったので、許可をとってHaskellで再現してみた。(Thanks @joepolitz !)
S式のパース
元のOCamlのコードでは文字列をS式にパースするライブラリを使っている。多分Haskellでも存在すると思うが、今回は簡単なパーサを自前で作る:
data Sexp = Atom String | List [Sexp] parseSexp :: Parser Sexp parseSexp = parseAtom <|> parseList parseAtom :: Parser Sexp parseAtom = ((many1 letter) <|> (many1 digit)) >>= return . Atom parseList :: Parser Sexp parseList = between (char '(') (char ')') $ sepBy parseSexp (many1 space) >>= return . List stringToSexp :: String -> Sexp stringToSexp s = case parse parseSexp "compiler" s of Left err -> error $ "Parse failed at String->Sexp conversion: " ++ show err Right sexp -> sexp
今の所、アルファベット文字だけのAtom
か数字だけのAtom
、そしてそれらを()
で囲ったList
だけをパースする。
エラーハンドリングもめんどくさがってParsecがエラーを返してきたら直接error
を投げるようにしている。さらにこのエラーはどこでもキャッチされない。
言語仕様とS式からASTへ
今回コンパイルするソース言語は非常に簡単。
Expressionは整数か、一つのExpressionに対するInc
かDec
オペレータの適用、だけ。
以下の定義のとおり:
data Op = Inc | Dec data Expr = ENum Integer | EOp Op Expr
さきほど定義したパーサが返すS式をこのExpr型を使ったASTに変換する:
sexpToExpr :: Sexp -> Expr sexpToExpr (Atom s) = ENum (read s :: Integer) sexpToExpr (List [Atom "inc", arg]) = EOp Inc (sexpToExpr arg) sexpToExpr (List [Atom "dec", arg]) = EOp Dec (sexpToExpr arg) sexpToExpr _ = error "Parse failed at Sexp->Expr conversion"
これも簡単。パターンマッチ便利。
ただ、今読み直してみると(inc a)
とかだとread
がエラーを投げていて統一感がないな・・・
ASTからアセンブラ
Expr
型のデータに表されるASTをアセンブラ命令の文字列に変換する。
使う命令が三つしかない上、そもそもASTが枝分かれとかしないのでものすごく簡単:
exprToInstrs :: Expr -> [String] exprToInstrs (ENum n) = ["move eax, " ++ show n] exprToInstrs (EOp Inc e) = exprToInstrs e ++ ["add eax, 1"] exprToInstrs (EOp Dec e) = exprToInstrs e ++ ["sub eax, 1"]
組み合わせたらコンパイラ
あとは組み合わせて、すべてのプログラム共通のヘッダ部分・フッタ部分を付け加えるだけ:
compile :: String -> String compile s = body `seq` header ++ body ++ footer where header = "section . text\nglobal our_code_starts_here\nour_code_starts_here:\n" body = concat $ map (printf " %s\n") $ exprToInstrs $ sexpToExpr $ stringToSexp s footer = " ret\n"
面白いところがあるとすれば、パースエラーが起きた場合にはヘッダを出力したくないのでseq
をつかってパース部分を先行評価している部分か。
あとはmain
関数のIO
モナド内で、ファイル名を受けとり、ファイルを読んでコンパイルし、標準出力に送る:
main :: IO () main = do args <- getArgs source <- readFile $ head args putStrLn $ compile source
全部で50行以内。非常に簡単なソース言語とはいえ、おおまかな枠組みが「ひとめ」で展望できるような形で実装できたのは面白かった。
これからhttp://scheme2006.cs.uchicago.edu/11-ghuloum.pdfもちょこちょこ実装していきたい。
`foldr`で`dropWhile`と不動点コンビネータ
前回のブログの問題元は今は亡き?Monad.Reader第6号の"Getting a Fix from the Right Fold"という記事。
私が考えた答えの「失敗例」は出てくるけど、パターンマッチを使わないで遅延評価が無限リストにも効く解は出てこない。
しかし別解は非常にエレガントなものが一つ、理解の範疇になかったものが一つ。
foldr
で関数を作成する
エレガントな解は「foldr
と入力リストでまず関数を作り、その関数を再度リストに適用する」というもの。
まずは簡単な定義から:
dropWhile p xs = foldr f id xs xs where f x g | p x = g . tail | otherwise = id
どういうふうに作動するかといえば
dropWhile (<3) [1..10] = foldr f id [1..10] [1..10] = f 1 (foldr f id [2..10]) [1..10] = (foldr f id [2..10] . tail) [1..10] = (f 2 (foldr f id [3..10]) . tail) [1..10] = (foldr f id [3..10] . tail . tail) [1..10] = (f 3 (foldr f id [4..10]) . tail . tail) [1..10] = (id . tail . tail) [1..10] = (id . tail) [2..10] = id [3..10] = [3..10]
正常に作動するし無限リストも扱えそう。ただし、遅延評価している分(id . tail .... tail)
の部分が一旦スペースリークを起こしているのがわかる。
foldr f id xs xs
のf
の定義を同値性を保ったまま少しいじることで効率化が図れる:
dropWhile p xs = foldr f id xs xs where f x g ys@(_:zs) | p x = g . zs | otherwise = ys
where f x g
だったところをf x g ys
に変え、さらにys@(_:zs)
とtail
部分にパターンマッチしている。
これで挙動は以下のとおりとなる:
dropWhile (<3) [1..10] = foldr f id [1..10] [1..10] = f 1 (foldr f id [2..10]) [1..10] = foldr f id [2..10] [2..10] = f 2 (foldr f id [3..10]) [2..10] = foldr f id [3..10] [3..10] = f 3 (foldr f id [4..10]) [3..10] = [3..10]
tail
を貯めてから最終的に適用するのではなく、都度都度最終的な引数であるリストに対してtail
を適用するのと同値なパターンマッチをすることで、効率よく「foldr
とリストで関数を作って、同じリストに適用する」を実装している。
foldr
で不動点コンビネータを作成
fix f = f (fix f)
という性質を持つ関数fix
のことだ。
foldr
でfix
を定義できる:
fix :: (a -> b) -> a -> b fix f = foldr (const f) undefined (repeat undefined)
使われている関数をいくつか説明する。
const
は二つの引数をとり、第二引数を評価することなく必ず第一引数を返す:
const :: a -> b -> a const f _ = f
repeat x
はx
が無限に続くリストを返す:
repeat :: a -> [a] repeat x = x : repeat x
fix f = f (fix f)
が成り立つ証明:
fix f = foldr (const f) undefined (repeat undefined) = foldr (const f) undefined (undefined : repeat undefined) = (const f) undefined (foldr (const f) undefined (repeat undefined)) = f (foldr (const f) undefined (repeat undefined) = f (fixed f) -- QED
undefined
が任意の型を取り得ることを利用している。
こうして定義した不動点コンビネータを使って任意の再帰を表現できる、らしい。
たしかにTypes and Programming Languagesでも
The omega combinator has a useful generalization called the fixed-point combinator, which can be used to help define recursive functions such as factorial
などと書いてあった。
sum
で試してみる。
sum
の再帰的定義:
sum :: Num a => [a] -> a sum [] = 0 sum (x:xs) = x + sum xs
この定義から再帰部分を抜き出して引数r
とする:
sumNoRec r [] = 0 sumNoRec r (x:xs) = x + r xs
このsumNoRec
をfix
に引数として渡すと、再帰的sum
と同じ関数になる:
sumfp = fix sumNoRec
確かめてみる:
sumfp [1, 2, 3] = (fix sumNoRec) [1, 2, 3] = (foldr (const sumNoRec) undefined (repeat undefined)) [1, 2, 3] = (foldr (const sumNoRec) undefined (undefined : repeat undefined)) [1, 2, 3] = (const sumNoRec) undefined (foldr (const sumNoRec) undefined (repeat undefined)) [1, 2, 3] = sumNoRec (foldr (const sumNoRec) undefined (repeat undefined)) [1, 2, 3] = 1 + (foldr (const sumNoRec) undefined (repeat undefined)) [2, 3] = 1 + (foldr (const sumNoRec) undefined (undefined : repeat undefined)) [2, 3] = 1 + (const sumNoRec) undefined (foldr (const sumNoRec) undefined (repeat undefined)) [2, 3] = 1 + sumNoRec (foldr (const sumNoRec) undefined (repeat undefined)) [2, 3] = 1 + (2 + (foldr (const sumNoRec) undefined (repeat undefined)) [3]) = 1 + (2 + (foldr (const sumNoRec) undefined (undefined : repeat undefined)) [3]) = 1 + (2 + (const sumNoRec) undefined (foldr (const sumNoRec) undefined (repeat undefined)) [3]) = 1 + (2 + sumNoRec (foldr (const sumNoRec) undefined (repeat undefined)) [3]) = 1 + (2 + (3 + (foldr (const sumNoRec) undefined (repeat undefined)) [])) = 1 + (2 + (3 + (foldr (const sumNoRec) undefined (undefined : repeat undefined)) [])) = 1 + (2 + (3 + (const sumNoRec) undefined (foldr (const sumNoRec) undefined (repeat undefined)) [])) = 1 + (2 + (3 + sumNoRec (foldr (const sumNoRec) undefined (repeat undefined)) [])) = 1 + (2 + (3 + 0)) = 6
たしかにsumNoRec
の停止条件が満たされるまで、何回でもfix
によってsumNoRec
が適用されるのがわかる。
dropWhile
をfix
で
dropWhile
の再帰的定義:
dropWhile p [] = [] dropWhile p ys@(x:xs) | p x = dropWhile p xs | otherwise = ys
dropWhileNR
の定義:
dropWhileNR r p [] = [] dropWhileNR r p ys@(x:xs) | p x = r p xs | otherwise = ys
dropWhileFP
の定義:
dropWhileFP = fix dropWhileNR
挙動チェック:
dropWhileFP (<3) [1..10] = (fix dropWhileNR) (<3) [1..10] = (foldr (const dropWhileNR) undefined (repeat undefined)) (<3) [1..10] = (foldr (const dropWhileNR) undefined (undefined : repeat undefined)) (<3) [1..10] = ((const dropWhileNR) undefined (foldr (const dropWhileNR) undefined (repeat undefined))) (<3) [1..10] = (dropWhileNR (foldr (const dropWhileNR) undefined (repeat undefined))) (<3) [1..10] = (foldr (const dropWhileNR) undefined (repeat undefined)) (<3) [2..10] = (foldr (const dropWhileNR) undefined (undefined : repeat undefined)) (<3) [2..10] = ((const dropWhileNR) undefined (foldr (const dropWhileNR) undefined (repeat undefined))) (<3) [2..10] = (dropWhileNR (foldr (const dropWhileNR) undefined (repeat undefined))) (<3) [2..10] = (foldr (const dropWhileNR) undefined (repeat undefined)) (<3) [3..10] = (foldr (const dropWhileNR) undefined (undefined : repeat undefined)) (<3) [3..10] = ((const dropWhileNR) undefined (foldr (const dropWhileNR) undefined (repeat undefined))) (<3) [3..10] = (dropWhileNR (foldr (const dropWhileNR) undefined (repeat undefined))) (<3) [3..10] = [3..10]
信じがたいことに実際に上手くいくようだ。というか、書き下してみてようやく何故上手くいくのかが腑に落ちてきた・・・
実用性はわからないが、とりあえず
の二点は忘れることはないと思う。
TaPLにはこういうコンビネータによる計算がいろいろと載っていそうなので、ぜひ近いうちに読んでいきたい。
`foldr`を使って`dropWhile`を定義する
Haskellの高階関数のfoldr
でdropWhile
を定義せよ、という問題を見たのでやってみる。
foldr
foldr
の定義は以下のとおり:
foldr :: (a -> b -> b) -> b -> [a] -> b foldr f e [] = e foldr f e (x:xs) = f x (foldr f e xs)
「わかってるねんで?foldrがreduce、foldlがfold。ときどきごっちゃになんねん」 「(PythonやClojureの)reduceはfoldlです」
エスカレーターとエレベーター ……ちょっと時々ごっちゃになるねん
— 春日歩(大阪) (@osakabot) 2017年4月5日
とにかくややこしい。
foldr (+) 0 [1, 2, 3] = 1 + (2 + (3 + 0))) foldl (+) 0 [1, 2, 3] = ((0 + 1) + 2) + 3
でどっちにベースの要素e
がつくかでleft/rightを判断するのがよさそう。
dropWhile
dropWhile
を高階関数を使わずに定義するなら:
dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile p [] = [] dropWhile p ys@(x:xs) = if p x then dropWhile p xs else ys
になる。
foldr
でfilter
まず、より簡単なfilter
をfoldr
で定義してみる:
filter :: (a -> Bool) -> [a] -> [a] filter p = foldr f [] where f x xs = if p x then (x:xs) else xs
filter
がなぜ簡単かというと、x
を含むかどうかはp x
の結果のみで決定できるからだ。
逆に言うとdropWhile
が複雑なのはp x
だけでなく、「以前の要素がp
を満たしていたか」も判断基準になってくるから。
foldr
とreverse
でdropWhile
ということで、一番簡単な解決法はreverse
を使ってリストを逆転させてしまうこと。
dropWhile p = reverse . foldr f [] . reverse where f x xs = if p x && (null xs) then xs else x:xs
これでfoldr f e (x:xs)
の結果を返す時、foldr f e xs
の結果を判断材料にできる。
しかし問題も大きい。そもそもO(n)
の処理を三回やっているし、さらに重要なのは遅延評価の強みを消してしまっていること。dropWhile
の第一要素を計算するためにリストすべてをいったん調べなければいけない。とくにundefined
が含まれるpartial listや無限リストなどは扱えなくなってしまう。
foldr
でdropWhile
というわけで本命:
dropWhile p = fst . foldr f ([], []) where f x xst = case p x of True -> (fst xst, ys) False -> (ys, ys) where ys = x : snd xst
foldr
なのでリストの右側から考えて
- 今後左側の要素がすべてpを満たした場合
- 左側にpを満たさない要素があった場合
の結果リストをタプルで持っている。
これで
Prelude> take 5 $ dropWhile even ([2, 4, 6, 7, 8] ++ [1..]) [7,8,1,2,3]
のように無限リストにも対応出来る。
パターンマッチによる失敗例
ちなみにこれは:
dropWhile p = fst . foldr f ([], []) where f x (a, b) = case p x of True -> (a, c) False -> (c, c) where c = x : b
としてしまうと無限リストなどの場合stack overflow
を起こしてうまくいかない。なんとなく直観的にはわかるのだが説明はできない・・・
HaskellとParsecでLisp REPL その8(変数定義)
今回の変更
「ユーザによる変数定義」機能を追加する。
これはかなり大きな変更で、変数の内容を保持・評価するために、変更可能な「状態」を導入する必要がある。
Haskellだと状態をState
やST
モナドで管理することも可能(らしい)のだが、基本的にそれらは「ローカルに状態が必要な関数」に役にたつようだ。今回のケースでは変数の状態はほぼグローバルに必要な上、REPL上でユーザからのIOの間で状態を保持する必要がある、ということでIO
モナド内で状態を持つIORef
を使う。
IORef
モナド
IORef
というのはData.IORef
に定義されているモナド。今回は以下の関数で扱う:
newIORef :: a -> IO (IORef a) readIORef :: IORef a -> IO a writeIORef :: IORef a -> a -> IO ()
あまり「他言語の機能との比喩」は好きではないが、newIORef
はコンストラクタ、readIORef
はgetter、writeIORef
はsetter、そしてIORef
自体はポインタ的なもの、という理解だ。上記の関数は、型からもわかる通り、使うと必ずIO
モナドの中に入る。
Environment
モジュール
新しくEnvironment
というモジュールを作成した。定義された変数すべてを持ち歩く「環境」変数を定義するモジュールである。
type Env = IORef [(String, IORef LispVal)]
個別のユーザ定義変数は(変数名, IORef 値)
というタプルで表現される。
それらを集めたリストをさらにIORef
モナドで包んだのが環境変数を保持するための型であるEnv
。
そして、「初期状態」を表すEnv
型のnullEnv
も定義:
nullEnv :: IO Env nullEnv = newIORef []
REPLが始まったばかりでユーザがまだなにも定義していない状態を表している。
Variables
モジュール
Variables
モジュールも新しく追加。変数定義・代入・値取得などの関数をここに書いていく。
以下の関数を定義:
isBound :: Env -> String -> IO Bool // 変数が定義されているか確認 getVar :: Env -> String -> IO LispVal // 変数の値を取得 setVar :: Env -> String -> LispVal -> IO LispVal // 値を既存の変数に代入 defineVar :: Env -> String -> LispVal -> IO LispVal // 変数を定義してから値を代入
まずは、ある変数がすでに定義されているかどうかを調べるヘルパー関数:
isBound :: Env -> String -> IO Bool isBound envRef var = readIORef envRef >>= return . lookup var >>= return . maybe False (const True)
環境を表すenvRef
の中身をlookup
して成功か失敗かを返す。
maybe
関数の第二引数はJust
値に適用する関数なので、const True
で引数がなんだろうと常に「真」を返す関数を作成して渡している。
次に値取得:
getVar :: Env -> String -> IO LispVal getVar envRef var = readIORef envRef >>= return . lookup var >>= maybe (return $ Bool False) readIORef
値が存在しない場合はLispVal
のBool False
を返し、存在する場合はreadIORef
で変数に含まれる値を返す。環境も個々の変数もIORef
を使っているのでreadIORef
を二回使っている。
すでに存在する変数に対する代入:
setVar :: Env -> String -> LispVal -> IO LispVal setVar envRef var val = do { env <- readIORef envRef; maybe (return ()) (flip writeIORef val) (lookup var env); return val; }
代入するべき変数がlookup
で見つかったらwriteIORef
で代入。見つからなかったら何もしない。式全体の値は代入されるべき値。
変数が未定義の時に暗黙裡に失敗しているのがいや。エラー処理を実装する時に直す。
変数の定義:
defineVar :: Env -> String -> LispVal -> IO LispVal defineVar envRef var val = do { alreadyDefined <- isBound envRef var; if alreadyDefined then setVar envRef var val else do { valRef <- newIORef val; env <- readIORef envRef; writeIORef envRef ((var, valRef):env); return val; } }
すでに定義されている場合は値を代入するだけ。
変数が未定義の場合、その変数と値のタプルを追加した新しい環境変数を作成し、それをenvRef
に代入している。
評価器
eval
にVariables
で定義した関数を追加していく。
今まで評価は
eval :: LispVal -> LispVal
だったのが
eval :: Env -> LispVal -> IO LispVal
に変わった。この型の違いは
- ある
LispVal
を評価するには、評価対象だけではなく、世界の状態をもつEnv
も必要 - 「評価」自体がIOを発生させ得る
という大きな変更を反映している。
それをふまえて既存のeval
にも少し変更を加えないといけない。
一番簡単なのはこういうふうに:
eval env lispVal = return lispVal
引数を増やして、IO
モナドに入れるためにreturn
を追加するだけ。
関数適用やif
構文ももちょこちょことモナド的な構文に変えている:
それでようやくVariables
で定義した関数を追加できる:
eval env (Atom var) = getVar env var
Atom
一個をそのまま評価する場合、以前はAtom
そのものを返していたのだが、変数として扱うようになった。
あとはset!
とdefine
を定義するだけ:
eval env (List [Atom "set!", Atom var, form]) = eval env form >>= setVar env var eval env (List [Atom "define", Atom var, form]) = eval env form >>= defineVar env var
REPL・Main
あまり大きな変更はないのだが、まずreadEvalPrint
が環境env
を引数として取るようにしたこと:
readEvalPrint :: Env -> String -> IO () readEvalPrint env str = (eval env $ readExpr str) >>= putStrLn . show
今までmain
関数でREPLの構成関数を組み合わせていたのを、nullEnv
を初期値としてreadEvalPrint
に渡す必要があったので独立したREPL
関数にまとめたこと:
readEvalPrintLoop :: IO () readEvalPrintLoop = nullEnv >>= loopUntil (== "quit") (readPrompt ">> ") . readEvalPrint
これでmain
関数がすっきりした:
main :: IO () main = readEvalPrintLoop
実行
>> (define x 5) 5 // xを定義 >> (+ x 1) 6 // xを変数として使った式の評価 > (set! x 6) 6 // xに代入 >> (+ x 1) 7 // xの値が変わっている >> (set! y 2) 2 // 未定義の変数yに代入 >> (+ x y) 6 // yはまだ未定義なので値は0として扱われる >> (define y 1) 1 // yの定義 >> (+ x y) 7 // yの値がつかわれている >> (set! y 2) 2 // yに代入 >> (+ x y) 8 // 新しいyの値が使われている
次回
次はモナド・トランスフォーマを使ったエラー処理の枠組みを追加する。
HaskellとParsecでLisp REPL その7(if構文)
今回の変更
条件分岐のための構文を追加。
(if a b c)
という式は、まずa
を評価し、もし真ならb
を、偽ならc
を評価してその結果が値となる。
b
とc
のどちらかひとつしか評価されないのが重要なので、関数ではなく構文として定義。
実装としてはeval
にルールをひとつ追加しただけ。
評価器
eval
への変更:
eval (List [Atom "if", ifForm, thenForm, elseForm]) = case eval ifForm of Bool True -> eval thenForm Bool False -> eval elseForm
条件を評価してからパターンマッチで次に評価する式を決めている。
この評価ルールは関数適用のルールより先に書く必要がある。関数適用の評価ルールは「先頭が任意のAtom
型の任意のリスト」に当てはまるので、もしif
のルールがその後に来てしまうと絶対に使われなくなってしまう。
LispVal
・パーサ・REPL・Main
全部変更なし。構文をeval
をちょこっといじるだけで加えられるのはいい。
注意点
(if a b)
や(if a b c d)
のような、if
と一緒に含まれる要素の数が3以外の場合、上記の評価ルールに当てはまらない- 次の評価ルールに当てはまってしまい、
if
が関数として評価される
- 次の評価ルールに当てはまってしまい、
という問題がある。回避しようと思うなら、「要素数が3以外の時はエラー」と明示的に評価ルールを追加すればいい。
実行
>> (if #t 5 0) 5 >> (if #f 5 0) 0 >> (if (= 5 5) (+ 5 2) (* 5 2)) 7 // ネスト挙動も正常 >> (if (= 5 2) (+ 5 2) (* 5 2)) 10 >> (if (> 4 3) 1 2 3) 0 // 要素数が一致しない場合、`if`が未定義の関数として扱われて結果が0になる >> (if 1 10 0) repl: src/Evaluator.hs:(8,3)-(10,31): Non-exhaustive patterns in case
おっと、ふと試してみたらバグが見つかった。たしかにifForm
がBool型じゃない場合を想定していなかった。
case ifBool of Bool True -> eval envRef thenForm _ -> eval envRef elseForm
に修正しておこう・・・
次回
次回は「ユーザによる変数定義」機能を実装する。
HaskellとParsecでLisp REPL その6(数値比較と論理演算)
今回の変更
前回Bool値を定義できたので、=
、/=
、<
、>
などやand
/or
を実装する。
Functions
Functionsモジュールのprimitives
にどんどん追加していく:
primitives :: [(String, [LispVal] -> LispVal)] primitives = [ ... ("=", numBoolBinOp (==)), ("/=", numBoolBinOp (/=)), (">", numBoolBinOp (>)), (">=", numBoolBinOp (>=)), ("<", numBoolBinOp (<)), ("<=", numBoolBinOp (<=)), ("and", boolBoolBinOp (&&)), ("or", boolBoolBinOp (||)) ]
やはりHaskellの関数をwrapする形で[LispVal] -> LispVal
型の関数を作成していく。
まず、数値二つをとってブール値を返すnumBoolBinOp
:
numBoolBinOp :: (Integer -> Integer -> Bool) -> [LispVal] -> LispVal numBoolBinOp op [x, y] = Bool $ op (lvToInteger x) (lvToInteger y) numBoolBinOp op _ = Bool False
パターンマッチを使って、引数の数が2ならop
を数値化した引数に適用してBool
化、2以外ならBool False
を返す。以前numerify
という名前にしていた関数をlvToInteger
に変えてみた。
次に、ブール値を一つ以上とってブール値を返すboolBoolBinOp
:
boolBoolBinOp op args = Bool $ foldl1 op $ map lvToBool args
おっとboolBoolBinOp
の型定義し忘れてる。型推論があるので記事を書くまで気付かなかった・・・
正しくは:
boolBoolBinOp :: (Bool -> Bool -> Bool) -> [LispVal] -> LispVal boolBoolBinOp op args = Bool $ foldl1 op $ map lvToBool args
これはnumBinOp
と似たような定義。op
の引数と戻り値の型がBool
で一致しているのでfoldl1
が使える。やはりbinOpではない・・・
LispVal
をHaskellのInteger
やBool
に変換する関数:
lvToInteger :: LispVal -> Integer lvToInteger (Number n) = n lvToInteger _ = 0 lvToBool :: LispVal -> Bool lvToBool (Bool b) = b lvToBool _ = False
現在はまだLispVal
の型がNumber型やBool型でない場合は0やFalseにしている。
Functions以外のコード
変更なし
実行
>> (> 5 4) #t >> (= 6 (* 3 2)) #t // 四則演算をネストできる >> (= 4 4 4) #f // 引数が2以外の場合は必ず#f >> (and (> 6 3) (< 6 5)) #f // 論理演算も可能 >> (or (> 6 3) (< 6 5) (<= 10 7)) #t // 論理演算は引数2以外でも可 >> quit
次回
if
構文を追加する。