日比野
啓
|
|
静的型の型推論言語というのが今の私の認識です。 関数型言語らしい機能が注目されますが、 それ以外のスタイルも良く利用さ れます。
ここではこの記事を読みすすめるにあたって必要そうな OCaml の機能について簡単に紹介します。
以下、 対話環境の入出力を前提に話をすすめます。
ocaml-interp パッケージの /usr/bin/ocaml が対話環境のプログラムです。
# は対話環境のプロンプトです。 ユーザーの入力の終わりを対話環境に認識してもらうために;;を入力します。 なので 対話環境の# プロンプトの後ろから;;までがユーザーの入力です。 - :から始まる内容は対話環境の出力 です。
# 1;;
- : int = 1 # "abc";; - : string = "abc" # (1, "abc");; - : int * string = (1, "abc") # (1, ("abc", 2), 3);; - : int * (string * int) * int = (1, ("abc", 2), 3) # [ "a"; "b"; "c"];; - : string list = ["a"; "b"; "c"] # "a" :: "b" :: "c" :: [];; - : string list = ["a"; "b"; "c"] |
値を表す式を入力すると対話環境は型の名前と値を出力しています。 1はint型、 "abc"はstring型となっています。 対話 環 境 に 式 を 入 力 し た の で 評 価 が 行 な わ れ 、 そ の 結 果 と し て の 出 力 で す 。
(1, ("abc", 2), 3)のようにコンマで区切って括弧でくくった値はタプルです。 値と値の組を表現できます。 型の名前は *で連ねます。 任意の型の値を組にできる強力な機能です。
[ ]でリストを表現することができます。 また、 ::は lisp でいうところの cons です。 リストの要素は全て同じ型である必要 があります。
次は値を表現する前にあらかじめ型の定義が必要であるような値です。
# type vec_2d = { x : int; y : int };;
type vec_2d = { x : int; y : int; } # { x = 1; y = 2 };; - : vec_2d = {x = 1; y = 2} # type int_or_string_or_none = I of int | S of string | N;; type int_or_string_or_none = I of int | S of string | N # I 3;; - : int_or_string_or_none = I 3 # S "hello";; - : int_or_string_or_none = S "hello" # N;; - : int_or_string_or_none = N |
一つ目の例はレコードです。 C の構造体のようなもので、 フィールド名とフィールドの型を定義に記述します。 vec_2dとい うレコードの型を定義して、 { x = 1; y = 2 }という値を評価させました。
二つ目はバリアントあるいは代数データ型と呼ばれている種類の型です。 int_or_string_or_noneという型を定義してい て、 その値は I というタグの付いた int か S というタグの付いた string か N というタグのどれかということです。 このタグ のことをコンストラクタと呼びます。
バリアントは再帰的な定義も可能で、 この機能で簡単に木構造を表現できます。
# type str_tree = Leaf of string | Tree of (str_tree * str_tree);;
type str_tree = Leaf of string | Tree of (str_tree * str_tree) # Leaf "abc";; - : str_tree = Leaf "abc" # Tree (Leaf "a", Tree (Leaf "b", Leaf "c"));; - : str_tree = Tree (Leaf "a", Tree (Leaf "b", Leaf "c")) |
次は関数を表現する値です。
# (fun x -> x + 1);;
- : int -> int = <fun> # (fun x -> x);; - : ’a -> ’a = <fun> |
(fun x -> x + 1)は関数です。 型がint -> intと出力されていますが、 これは int を受けとって int を返す関数という 意味です。 +の引数は int と int なので結果としてxはint、 fun x -> x + 1はint -> intというように型の推論が行な われています。
二番目の(fun x -> x)も関数です。 型が’a -> ’aと出力されていますが、 これは何かある型の値を受けとって、 同じ型 の値を返す関数という意味です。 この’a -> ’aの関数は任意の型に対して適用が可能なので、 全ての型についてこの関数が 定義されている (int -> intもstring -> stringも ... etc) のと同様の効果があります。 このような型を多相型と呼び ま す 。
letを使って値を変数に束縛します。 以下はvにたいして整数をfに対して関数を束縛しています。
# let v = 123;;
val v : int = 123 # v;; - : int = 123 # let f x y = (x + y) * (x - y);; val f : int -> int -> int = <fun> # f 5 3;; - : int = 16 |
OCaml は値の構造を分解しつつ変数を束縛することができます。 次の例ではタプルを分解して束縛を行なってい ます。
# let (x, y) = (2, 3 + 4);;
val x : int = 2 val y : int = 7 # let (a, (b, c)) = (1, (2, 3));; val a : int = 1 val b : int = 2 val c : int = 3 |
match ... withを使用すると、 構造分解を試みつつ条件分岐することができます。
関数lenはリストが空かどうかを判定しながら再帰しています。 束縛の定義時に自身の定義を使用するときにはletではな くlet recを使います。
関数 whatは先程定義したバリアント int_or_string_or_noneの値の種類によって返す文字列を変えてい ます。
関数get_intはint_or_string_or_noneが int のときだけ Some int を返し、 そうでないときは None を返します。 ’a option は組み込みの型で、 ある型の値が有るかあるいは無いかを表現できるバリアントです。
# let rec len ls = match ls with [] -> 0 | x :: rest -> 1 + len rest;;
val len : ’a list -> int = <fun> # len [1; 2; 3];; - : int = 3 # let what v = match v with I _ -> "int" | S _ -> "string" | N -> "none";; val what : int_or_string_or_none -> string = <fun> # what (S "abc");; - : string = "string" # what N;; - : string = "none" # let get_int v = match v with I i -> Some i | _ -> None ;; val get_int : int_or_string_or_none -> int option = <fun> # get_int N;; - : int option = None # get_int (I 10);; - : int option = Some 10 |
プログラムの規模がおおきくなってくると名前空間が重要になってきます。 OCaml には module の機能が あり名前空間を分けることができます。 あるコンパイル単位が xyz.ml というファイル名だった場合、 その 中の定義は Xyz という module の中に配置されます。 モジュール内にたとえば abc という名前があった場 合 、 公 開 さ れ て い れ ば 他 の コ ン パ イ ル 単 位 の フ ァイ ル か ら も Xyz.abc という名前でアクセスすることができ ます。
(* xyz.ml *)
let abc = "abc" ... (* 他のファイル *) ... Xyz.abc ... |
module の中にさらに module を定義することもできます。 xyz.ml の中に作った module SubXyz は、 Xyz.SubXyz という 名前の module です。
定義済みのモジュールを使って module を定義することもできます。 組み込みの module である List を使って Xyz.L を定義 しています。
(* xyz.ml *)
module SubXyz = struct ... end module L = List |
関数型言語とは何でしょうか。 ここでは関数を値としてあつかえる言語ということにして、 そのような言語のインタプリタを作 る話をします。
例えば以下のようなプログラムを考えます。
;; scheme function
(define (f) ;; env A (let ((x 1) (y 2) (z 3)) ;; env B (let ((y 4)) ;; env C (let ((z 5)) ;; env D (+ x y z))))) |
(* OCaml function *)
let f () = (* env A *) let (x, y, z) = (1, 2, 3) in (* env B *) let y = 4 in (* env C *) let z = 5 in (* env D *) x + y + z |
変数の値の解決のためのテーブルを環境 (environment) と呼ぶことにして、 次の図ような構造になっていると考えてみます。 変数の検索は上から下に行なわれるとすると、 それぞれのコメントの位置の環境は矢印の位置を参照していると考えてよいは ずです。
さらに以下のようなプログラムを考えます。
(define (f x y)
;; env f (* x y 2)) ;;env X (let ((x 1) (y 2)) (define (g) ;; env g (f 3 4)) (g)) ;;; may be another call of (f x y) |
let rec f x y =
(* env f *) x * y * 2 (* env X *) let (x, y) = (1, 2) let rec g () = (* env g *) f 3 4 let v = g () (* may be another call of f x y *) |
するとそれぞれのコメントの位置の環境は次の図のようになっているはずです。
ここで環境 X は同じ環境なので、 共有させることにすると次のような構造を考えることができます。 ここで注意する必要が あるのは、 環境 f は関数 f が呼び出される度に異なるということです。 f の定義位置である環境 X は共通ですが、 環境 f は関数 f が呼び出される度に環境 X を指す環境を伸長する必要があります。
以下のようなプログラムを考えます。
(define h
(let ((x 1) (y 2)) ;; env c (let ((f (lambda (z) ;; env l (+ x y z)))) f))) ;; env X (h 3) ;;; may be another call of (h x) |
let rec h =
let (x, y) = (1, 2) in (* env c *) let f z = (* env l *) x + y + z in f (* env X *) let v = h 3 (* may be another call of h x *) |
関数が変数 h に束縛されています。 しかも h は x, y を束縛している let の外側にあるにもかかわらず、 呼び出した際には x, y の値を評価します。
この let のような機能をレキシカルスコープと呼び、 またこのような関数をレキシカルクロージャ (lexical closure) あるいは 単にクロージャ (closure) と呼びます。
上の例での環境を考えてみると次のような構造になっているはずです。
h に束縛されている closure はあきらかに環境 c を知っている必要があります。 なぜなら呼び出し時には環境 c を指す環境を生成しなければならないからです。 したがって closure は以下のような構造になっていると考 えることができます。 env は closure の定義位置の環境で args は仮引数リストそして body は関数本体の式 です。
式の評価に必要な環境を評価器内で渡しながら、 let や関数呼び出しの際には環境を伸長する方針を取ると、 比較的簡単にイ ンタプリタを実装することができます。 また、 環境を保持する構造を考えれば closure を実現することもでき ます。
参考資料: http://www.sato.kuis.kyoto-u.ac.jp/~igarashi/class/isle4-05w/text/eopl003.html
ocamllex は OCaml に付属している字句解析関数生成器 (lexer generator) で、 OCaml から呼び出せる lexer を生成してくれ ます。 以下のように C 言語でもおなじみの lex, flex と似たような使用感になっています。
{ (* header *) (* Lexing のルール部分で参照したい内容を OCaml で書く *) } (* 文字列パターンの定義 *) (* 字句解析 (lexing) のルール記述 *) { (* trailer *) (* ルール部分で生成された関数を参照する内容を OCaml で書く *) } |
同様に、 ocamlyacc は OCaml に付属している構文解析関数生成器 (parser generator) で、 OCaml から呼び出せ る parser を生成してくれます。 こちらもやはり、 以下のように yacc, bison と似たような使用感になってい ます。
%{ (* header *) (* 構文木生成処理で参照したい内容を OCaml で書く *) %} /* declarations */ /* 終端記号の型や構文木の root の宣言 */ %% /* rules */ /* 文脈自由文法と構文木生成処理を記述 */ %% (* trailer *) (* 生成された parser の関数を参照する内容を OCaml で書く *) |
ocamllex と ocamlyacc を併用する場合には、 ocamlyacc で生成させた parser の終端記号の定義を lexer から参照させるよう にするのがもっとも単純な使い方です。
以下が S 式 parser を生成させる例です。 sParser.mly を ocamlyacc で処理すると sParser.ml が生成され、 sLexer.mll を ocamllex で処理すると sLexer.ml が生成されます。
sParser.mly 型ごとに終端記号を %token で宣言し、 %start と %type で構文木の root とその型を指定します。 root の名前が構文解析関 数の名前になります。
yacc と同じ要領で文脈自由文法を記述していきます。 expr は真偽値、 数値、 文字列であるか、 あるいは、 expr ドット対また は expr を並べたものを括弧で括ったものという定義になっています。
%{ (* sParser.mly *) module C = SCons %} /* File sparser.mly */ %token LPAREN RPAREN DOT_SYMBOL EOL BOOL_TRUE BOOL_FALSE %token <SCons.s_int> INT %token <float> FLOAT %token <string> SYMBOL %token <string> STRING %start expr %type <SCons.s_expr> expr %% expr_list: { C.Null } | expr DOT_SYMBOL expr { C.Cons($1, $3) } | expr expr_list { C.Cons($1, $2) } expr: | BOOL_TRUE { C.Bool(true) } | BOOL_FALSE { C.Bool(false) } | INT { C.Int($1) } | FLOAT { C.Float($1) } | SYMBOL { C.Symbol($1) } | STRING { C.String($1) } | LPAREN expr_list RPAREN { $2 } |
sLexer.mll 文字列パターンの定義では、 正規表現の要領で文字集合や繰り返しの表現を利用して定義を作り、 let で名前を付けていきま す。 文字を ” でくくる以外は正規表現と同様です。 定義した文字列パターンをさらに別の文字列パターンに再利用することが できます。
ル ー ル 記 述 の 部 分 で は 、 token の文字列パターンと token 生成式を lex の要領で記述していきます。 キーワード rule の後の 文字列が lexer の関数名になります。 なのでここではその関数の名前は token です。
字句解析 (Lexing) の過程における入力ファイル内の位置は、 lexbuf の lex_start_p に記号 (token) の開始位置が、 lex_curr_p に token の終了の次の位置が保持されています。 ocamllex デフォルトの動作では pos_cnum フィールドが 更新されるのみなので、 ファイル先頭からのバイト数しかわかりません。 陽に行数の認識やタブによるカラ ム数の補正を行なう場合には、 lex_start_p と token をもとに lex_curr_p を修正してやる必要があります。 *9
{
(* sLexer.mll*) module LX = Lexing module P = SParser ... (* 中略 *) let fix_position lexbuf = let newline pos = { pos with LX.pos_lnum = pos.LX.pos_lnum + 1; LX.pos_cnum = pos.LX.pos_cnum + 1; LX.pos_bol = pos.LX.pos_cnum + 1; } in let tab pos = { pos with LX.pos_cnum = pos.LX.pos_cnum + 8 - (pos.LX.pos_cnum - pos.LX.pos_bol) mod 8 } in let other pos = { pos with LX.pos_cnum = pos.LX.pos_cnum + 1 } in let rec fix_pos_rec pos str = let len = (String.length str) in match (if len > 0 then (Some (str.[0]), String.sub str 1 (len - 1)) else (None, "")) with (None, _) -> pos | (Some ’\n’, rest) -> fix_pos_rec (newline pos) rest | (Some ’\t’, rest) -> fix_pos_rec (tab pos) rest | (Some _, rest) -> fix_pos_rec (other pos) rest in let _ = lexbuf.LX.lex_curr_p <- fix_pos_rec (LX.lexeme_start_p lexbuf) (LX.lexeme lexbuf) in () } /* 文字列パターンの定義 */ let str_esc = ’\\’ let double_quote = ’"’ let str_escaped_char = str_esc _ let str_char = [^ ’\\’ ’"’] let str = double_quote (str_char | str_escaped_char)* double_quote let left_paren = ’(’ let right_paren = ’)’ let space = [’ ’ ’\t’ ’\n’ ’\r’]+ let dot_symbol = ’.’ let bool_true = ’#’ ’t’ let bool_false = ’#’ ’f’ let int = ’-’? [’0’ - ’9’]+ let float = ’-’? [’0’ - ’9’]+ ’.’ [’0’ - ’9’]* | ’-’? [’0’ - ’9’]* ’.’ [’0’ - ’9’]+ let symbol = [^ ’"’ ’(’ ’)’ ’ ’ ’\t’ ’\n’ ’\r’]+ /* lexing のルール記述 */ rule token = parse | left_paren { P.LPAREN } | right_paren { P.RPAREN } | space { fix_position lexbuf; token lexbuf } | dot_symbol { P.DOT_SYMBOL } | bool_true { P.BOOL_TRUE } | bool_false { P.BOOL_FALSE } | int { expr_integer (LX.lexeme lexbuf) } | float { P.FLOAT(Pervasives.float_of_string(LX.lexeme lexbuf)) } | symbol { P.SYMBOL(LX.lexeme lexbuf) } | str { fix_position lexbuf; P.STRING(expr_string(LX.lexeme lexbuf)) } | eof { raise Eof } |
Haskell にはブロックの開始や終了の token や式の区切りの token を省略することができる layout rule という機能がありま す。 そのため省略された token を lexing の過程で補ってやる必要があります。
まず、 通常と同様に lexing を行なって token 列を生成し、 その token 列に規則に従って token を補うというように、 2 段階 の工程を行ないます。
まずは.mll の header 部分です。
後から layout rule において必要となるカラム数を数えあげる処理ために位置情報の修正を行なう関数 (fix_position) を定義 しています。 また、 Haskell の文字および文字列リテラルはリテラル内のルールが複雑度の高い仕様なので、 別の lexer(後述) を呼び出しつつ実際の文字列表現を構成する関数 (decode_char, decode_string) を準備してい ます。
{
(* lexer0.mll header 部分 *) module LX = Lexing module P = Parser ... (* 中略 *) let fix_position lexbuf = let newline pos = { pos with LX.pos_lnum = pos.LX.pos_lnum + 1; LX.pos_cnum = pos.LX.pos_cnum + 1; LX.pos_bol = pos.LX.pos_cnum + 1; } in let tab pos = { pos with LX.pos_cnum = pos.LX.pos_cnum + 8 - (pos.LX.pos_cnum - pos.LX.pos_bol) mod 8 } in let other pos = { pos with LX.pos_cnum = pos.LX.pos_cnum + 1 } in let rec fix_pos_rec pos str = let len = (String.length str) in match (if len > 0 then (Some (str.[0]), String.sub str 1 (len - 1)) else (None, "")) with (None, _) -> pos | (Some ’\n’, rest) -> fix_pos_rec (newline pos) rest | (Some ’\t’, rest) -> fix_pos_rec (tab pos) rest | (Some _, rest) -> fix_pos_rec (other pos) rest in let _ = lexbuf.LX.lex_curr_p <- fix_pos_rec (LX.lexeme_start_p lexbuf) (LX.lexeme lexbuf) in () ... (* 中略 *) |
decode_char, decode_string 文字および文字列デコーダー
... (* 中略 *)
let decode_cexpr cexpr = let fchar = String.get cexpr 0 in let escexp = String.sub cexpr 1 ((String.length cexpr) - 1) in let fmatch exp str = Str.string_match (Str.regexp exp) str 0 in if fchar = ’\\’ then match escexp with "NUL" -> Some ’\x00’ | "SOH" | "^A" -> Some ’\x01’ | "STX" | "^B" -> Some ’\x02’ ... (* 中略 *) | "RS" | "^^" -> Some ’\x1e’ | "US" | "^_" -> Some ’\x1f’ | "SP" -> Some ’ ’ | "\\" -> Some ’\\’ | "\"" -> Some ’"’ | "’" -> Some ’\’’ | "DEL" -> Some ’\x7f’ | _ when fmatch "^[0-9]+$" escexp -> Some (Char.chr (int_of_string escexp)) | _ when fmatch "^[xX][0-9a-zA-Z]+$" escexp -> Some (Char.chr (int_of_string ("0" ^ escexp))) | _ when fmatch "^[oO][0-7]+$" escexp -> Some (Char.chr (int_of_string ("0" ^ escexp))) | _ -> None else Some fchar let decode_char lexbuf = let cstr = LX.lexeme lexbuf in let len = String.length cstr in match decode_cexpr (String.sub cstr 1 (len - 2)) with Some c -> c | None -> failwith (F.sprintf "Unkown char expression %s" cstr) let decode_string lexbuf = let sexpr = LX.lexeme lexbuf in let len = String.length sexpr in let strlbuf = Lexing.from_string (String.sub sexpr 1 (len - 2)) in let rec decode result = match HsStr.char strlbuf with HsStr.Eos -> result | HsStr.Char cstr -> if cstr = "\\&" then decode (result ^ "&") else decode (result ^ match (decode_cexpr cstr) with None -> failwith (F.sprintf "Unkown char expression ’%s’ in literal string" cstr) | Some c -> (String.make 1 c)) | HsStr.Gap g -> decode result in decode "" } |
次に文字列パターンの定義です。
行数はちょっと多いですが、 特に難しいところはありません。 問題のリテラル文字列ですが、 リテラル文字列部分の文字列パ ターン自体は問題なく表現できています。 しかし、 リテラルで表現される文字列自体を復元するのが複雑なので前記および後述 のような準備が必要になります。
/* lexer0.mll 文字列パターン定義部分 */
let special = [’(’ ’)’ ’,’ ’;’ ’[’ ’]’ ’‘’ ’{’ ’}’] let space = ’ ’ let newline = ("\r\n"|[’\n’ ’\r’]) let tab = ’\t’ let dashes = ’-’ ’-’ ’-’* let ascSmall = [’a’-’z’] let small = ascSmall | ’_’ let ascLarge = [’A’-’Z’] let large = ascLarge let plus = ’+’ let minus = ’-’ let exclamation = ’!’ let ascSymbol_nbs = [ ’!’ ’#’ ’$’ ’%’ ’&’ ’*’ ’+’ ’.’ ’/’ ’<’ ’=’ ’>’ ’?’ ’@’ ’^’ ’|’ ’-’ ’~’ ] let ascSymbol = ascSymbol_nbs | ’\\’ let symbol = ascSymbol let ascDigit = [’0’-’9’] let digit = ascDigit let octit = [’0’-’7’] let hexit = ascDigit | [’a’-’z’ ’A’-’Z’] let decimal = (digit)+ let octal = (octit)+ let hexadecimal = (hexit)+ let exponent = [’e’ ’E’] [’+’ ’-’]? decimal let float = decimal ’.’ decimal exponent? | decimal exponent let graphic = small | large | symbol | digit | special | [’:’ ’"’ ’\’’] let any = graphic | space | tab let comment = dashes ((space | tab | small | large | symbol | digit | special | [’:’ ’"’ ’\’’]) (any)*)? newline let whitechar = newline | space | tab let whitestuff = whitechar | comment let whitespace = (whitestuff)+ (* let lwhitechar = space | tab let lwhitestuff = lwhitechar | comment let lwhitespace = (lwhitestuff)+ *) let char_gr = small | large | ascSymbol_nbs | digit | special | [’:’ ’"’] let str_gr = small | large | ascSymbol_nbs | digit | special | [’:’ ’\’’] let charesc = [’a’ ’b’ ’f’ ’n’ ’r’ ’t’ ’v’ ’\\’ ’"’ ’\’’] let str_charesc = charesc | ’&’ let cntrl = ascLarge | [’@’ ’[’ ’\\’ ’]’ ’^’ ’_’] let gap = ’\\’ (whitechar)+ ’\\’ (* let gap = ’\\’ (lwhitechar | newline)+ ’\\’ *) let ascii = (’^’ cntrl) | "NUL" | "SOH" | "STX" | "ETX" | "EOT" | "ENQ" | "ACK" | "BEL" | "BS" | "HT" | "LF" | "VT" | "FF" | "CR" | "SO" | "SI" | "DLE" | "DC1" | "DC2" | "DC3" | "DC4" | "NAK" | "SYN" | "ETB" | "CAN" | "EM" | "SUB" | "ESC" | "FS" | "GS" | "RS" | "US" | "SP" | "DEL" let escape = ’\\’ ( charesc | ascii | decimal | ’o’ octal | ’x’ hexadecimal ) let str_escape = ’\\’ ( str_charesc | ascii | decimal | ’o’ octal | ’x’ hexadecimal ) let char = ’\’’ (char_gr | space | escape) ’\’’ let string = ’"’ (str_gr | space | str_escape | gap)* ’"’ let varid = small (small | large | digit | ’\’’)* let conid = large (small | large | digit | ’\’’)* let varsym = symbol (symbol | ’:’)* let consym = ’:’ (symbol | ’:’)* let modid = conid |
最後にルール記述です。
スペース、 タブ、 改行などを含んでいる whitespace や string のところで fix_position を呼んで位置情報を補正しています。 また char や string のリテラルから文字や文字列を構成するために decode_char, decode_string を呼び出してい ます。
(* lexer0.mll ルール記述部分 *)
rule token = parse | ’(’ { P.SP_LEFT_PAREN(loc lexbuf) } | ’)’ { P.SP_RIGHT_PAREN(loc lexbuf) } | ’,’ { P.SP_COMMA(loc lexbuf) } | ’;’ { P.SP_SEMI(loc lexbuf) } | ’[’ { P.SP_LEFT_BRACKET(loc lexbuf) } | ’]’ { P.SP_RIGHT_BRACKET(loc lexbuf) } | ’‘’ { P.SP_B_QUOTE(loc lexbuf) } | ’{’ { P.SP_LEFT_BRACE(loc lexbuf) } | ’}’ { P.SP_RIGHT_BRACE(loc lexbuf) } (** special tokens *) | "case" { P.K_CASE(loc lexbuf) } | "class" { P.K_CLASS(loc lexbuf) } | "data" { P.K_DATA(loc lexbuf) } | "default" { P.K_DEFAULT(loc lexbuf) } | "deriving" { P.K_DERIVING(loc lexbuf) } | "do" { P.K_DO(loc lexbuf) } | "else" { P.K_ELSE(loc lexbuf) } | "if" { P.K_IF(loc lexbuf) } | "import" { P.K_IMPORT(loc lexbuf) } | "in" { P.K_IN(loc lexbuf) } | "infix" { P.K_INFIX(loc lexbuf) } | "infixl" { P.K_INFIXL(loc lexbuf) } | "infixr" { P.K_INFIXR(loc lexbuf) } | "instance" { P.K_INSTANCE(loc lexbuf) } | "let" { P.K_LET(loc lexbuf) } | "module" { P.K_MODULE(loc lexbuf) } | "newtype" { P.K_NEWTYPE(loc lexbuf) } | "of" { P.K_OF(loc lexbuf) } | "then" { P.K_THEN(loc lexbuf) } | "type" { P.K_TYPE(loc lexbuf) } | "where" { P.K_WHERE(loc lexbuf) } | "_" { P.K_WILDCARD(loc lexbuf) } (** reservedid *) | ".." { P.KS_DOTDOT(loc lexbuf) } | ":" { P.KS_COLON(loc lexbuf) } | "::" { P.KS_2_COLON(loc lexbuf) } | "=" { P.KS_EQ(loc lexbuf) } | "\\" { P.KS_B_SLASH(loc lexbuf) } | "|" { P.KS_BAR(loc lexbuf) } | "<-" { P.KS_L_ARROW(loc lexbuf) } | "->" { P.KS_R_ARROW(loc lexbuf) } | "@" { P.KS_AT(loc lexbuf) } | "~" { P.KS_TILDE(loc lexbuf) } | "=>" { P.KS_R_W_ARROW(loc lexbuf) } (** reservedop *) | "as" { P.K_AS(loc lexbuf) } (** maybe varid *) | "qualified" { P.K_QUALIFIED(loc lexbuf) } (** maybe varid *) | "hiding" { P.K_HIDING(loc lexbuf) } (** maybe varid *) | varid { P.T_VARID(LX.lexeme lexbuf, loc lexbuf) } | conid { P.T_CONID(LX.lexeme lexbuf, loc lexbuf) } (** identifiers or may be qualified ones *) | whitespace { fix_position lexbuf; P.WS_WHITE(loc lexbuf) } (** comment begining with dashes is not varsym *) (** white spaces *) | plus { P.KS_PLUS(loc lexbuf) } (** maybe varsym *) | minus { P.KS_MINUS(loc lexbuf) } (** maybe varsym *) | exclamation { P.KS_EXCLAM(loc lexbuf) } (** maybe varsym *) | varsym { P.T_VARSYM(LX.lexeme lexbuf, loc lexbuf) } | consym { P.T_CONSYM(LX.lexeme lexbuf, loc lexbuf) } (** symbols or may be qualified ones *) | modid ’.’ varid { P.T_MOD_VARID(decode_with_mod lexbuf, loc lexbuf) } | modid ’.’ conid { P.T_MOD_CONID(decode_with_mod lexbuf, loc lexbuf) } | modid ’.’ varsym { P.T_MOD_VARSYM(decode_with_mod lexbuf, loc lexbuf) } | modid ’.’ consym { P.T_MOD_CONSYM(decode_with_mod lexbuf, loc lexbuf) } (** qualified xx *) | char { P.L_CHAR(decode_char lexbuf, loc lexbuf) } | string { fix_position lexbuf; P.L_STRING(decode_string lexbuf, loc lexbuf) } | decimal | (’0’ [’o’ ’O’] octal) | (’0’ [’x’ ’X’] hexadecimal) { P.L_INTEGER(Int64.of_string(LX.lexeme lexbuf), loc lexbuf) } | float { P.L_FLOAT(float_of_string(LX.lexeme lexbuf), loc lexbuf) } | eof { P.EOF(loc lexbuf) } ... /* 以下略 */ |
文字列の lexer です。
ここでの token は文字列リテラル内の 1 文字の表現あるいはギャップ (gap) です。 Haskell では 1 つの文字列リテラルを中断 して、 間に空白や改行やコメントを記述した後に、 再開することができます。 この空白や改行やコメントの部分が gap です。
ここで定義された char 関数を利用して decode_string 関数は文字列を構成していくようになっています。
{
(* hsStr.mll *) module LX = Lexing type ct = Char of string | Gap of string | Eos } let special = [’(’ ’)’ ’,’ ’;’ ’[’ ’]’ ’‘’ ’{’ ’}’] let space = ’ ’ let newline = ("\r\n"|[’\n’ ’\r’]) let tab = ’\t’ let ascSmall = [’a’-’z’] let small = ascSmall let ascLarge = [’A’-’Z’] let large = ascLarge let ascSymbol_nbs = [ ’!’ ’#’ ’$’ ’%’ ’&’ ’*’ ’+’ ’.’ ’/’ ’<’ ’=’ ’>’ ’?’ ’@’ ’^’ ’|’ ’-’ ’~’ ] let ascDigit = [’0’-’9’] let digit = ascDigit let octit = [’0’-’7’] let hexit = ascDigit | [’a’-’z’ ’A’-’Z’] let decimal = (digit)+ let octal = (octit)+ let hexadecimal = (hexit)+ let lwhitechar = space | tab let str_gr = small | large | ascSymbol_nbs | digit | special | [’:’ ’\’’] let charesc = [’a’ ’b’ ’f’ ’n’ ’r’ ’t’ ’v’ ’\\’ ’"’ ’\’’] let str_charesc = charesc | ’&’ let cntrl = ascLarge | [’@’ ’[’ ’\\’ ’]’ ’^’ ’_’] let gap = ’\\’ (lwhitechar | newline)+ ’\\’ let ascii = (’^’ cntrl) | "NUL" | "SOH" | "STX" | "ETX" | "EOT" | "ENQ" | "ACK" | "BEL" | "BS" | "HT" | "LF" | "VT" | "FF" | "CR" | "SO" | "SI" | "DLE" | "DC1" | "DC2" | "DC3" | "DC4" | "NAK" | "SYN" | "ETB" | "CAN" | "EM" | "SUB" | "ESC" | "FS" | "GS" | "RS" | "US" | "SP" | "DEL" let str_escape = ’\\’ ( str_charesc | ascii | decimal | ’o’ octal | ’x’ hexadecimal ) rule char = parse | str_gr | space | str_escape { Char(LX.lexeme lexbuf) } | gap { Gap(LX.lexeme lexbuf) } | eof { Eos } |
参考資料: http://www.sampou.org/haskell/report-revised-j/lexemes.html
この節の始めにも書いたように layout rule は、 token 列にさらに token を補ってやる処理です。 まずは補うルールを確認してみましょう。 以下に、 Haskell 98 Language Report の改訂版の和 訳*10 か ら引用してみます。
................................................................................................... 引用ここ から.........................................................................................................
レイアウトの影響は、 この節では、 レイアウトを用いているプログラムに、 どのようにして、 ブレースとセミコロ ンを追加するかを記述することによって指定する。 この仕様は、 変換を行う関数 L の形をとる。 L への入 力は
f = ("Hello \
\Bill", "Jake") |
では、 \Billの前に< n > は挿入されることはない。 なぜなら、 完全な字句の開始場所ではないからだ。 ま た、 , の前にも< n > は置かれることはない。 なぜなら、 その前に白空白以外のものがあるか らだ。 )
字句の「インデント」 は字句の最初の文字のカラム数である。 ひとつの行のインデントとは最も左にある 字句のインデントを表す。 このカラム数を決定するために以下のような規約をもつ固定幅のフォントを仮定 する。
レイアウトルールにあわせるために、 ソースプログラム中の Unicode 文字は ASCII 文字と同じ幅の固定幅であると看倣す。 しかしながら、 見た目との混乱を避けるためプログラマは暗黙のレイアウトの意味が非空白文字の幅に依存するようなプログ ラムを書かないようにすべきである。
L tokens [ ] は、 tokens のレイアウトに関知しない変換をもたらす。 ここで、 tokens はモジュールの字句解析および上述の ようにカラム数表示子を追加した結果である。 L の定義は以下のとおり、 ここでは 「:」 をストリーム構築操作子として使い、 「[ ]」 は空のストリームである。
L (<n>:ts) (m:ms) = ; : (L ts (m:ms)) if m = n
= } : (L (<n>:ts) ms) if n < m L (<n>:ts) ms = L ts ms L ({n}:ts) (m:ms) = { : (L ts (n:m:ms)) if n > m (Note 1) L ({n}:ts) [] = { : (L ts [n]) if n > 0 (Note 1) L ({n}:ts) ms = { : } : (L (<n>:ts) ms) (Note 2) L (}:ts) (0:ms) = } : (L ts ms) (Note 3) L (}:ts) ms = parse-error (Note 3) L ({:ts) ms = { : (L ts (0:ms)) (Note 4) L (t:ts) (m:ms) = } : (L (t:ts) ms) if m /= 0 and parse-error(t) (Note 5) L (t:ts) ms = t : (L ts ms) L [] [] = [] L [] (m:ms) = } : L [] ms if m /=0 (Note 6) |
............................................................................................引用ここまで以 下略 ........................................................................................................
だいぶ長くなってしまったので Note は省略です。
わかりにくいですが、 ここでも内部的には 2 段階になっています。
まず元の token 列に一つ目の操作を適用します。 以下のような規則だと考えるとわかりやすいかもしれま せん。
つぎに二つ目の操作である関数 L を適用します。
L はもとの token 列とインデントレベルのスタックを引数にとり、 もとの token 列に token を挿入したものを返す関数です。 やはり以下のような規則だと考えるとわかりやすいかもしれません。
参考資料: http://www.sampou.org/haskell/report-revised-j/syntax-iso.html#layout
「parse error にならない限りブロックを継続」 のルールはかなり実装がやっかいでした。 今回利用した ocamlyacc は yacc や bison と同じように LALR(1) の parser generator となっており、 基本的には token 列を途中まで読み込んだ位置とその token および一つ先の token によって構文解析中の次の動作を決定しています。 ここで出てきたような parse error になるまで ブロックが閉じるかわからないような仕様とはあまり相性が良くありません。 backtrack を行なえるような parser ならこのよ うな仕様に対してもより簡単に対応できると考えられます。 今回は token 列の token ごとに parse error のフラグを付加してや りなおしを行なうことで対応しました。 実行効率はよくありませんが問題になるほど token 数が多くなら なければ大丈夫そうです。 将来的には Packrat parsing のような方法で parser を書き直してみたいところ です。
OCaml で上 layout rule を実装した関数が次のような感じです。 token 列への一つ目の操作と二つ目の操作を順番に載せて います。 P.BLK_OPEN が{n}で P.BLK_LEVEL が< n > にあたるものです。 もとの定義と似たよう記述で表現できてい るのがわかるでしょうか。
let all_token_rev_list lexbuf =
let unget_s = S.create () in let get_token () = L0.token lexbuf in let blk_level_pair tk = let loc = L0.get_location tk in (loc.T.start_p.T.col + 1, loc) in let eof_token_p = (function P.EOF(_) -> true | _ -> false) in let rec scan_start () = match get_token () with (P.SP_LEFT_BRACE _ | P.K_MODULE _) as start -> start | P.WS_WHITE _ -> scan_start () | other -> let _ = S.push other unget_s in P.BLK_OPEN (blk_level_pair other) in let scan_next prev = let rec scan_next_rec () = let cur = if (S.is_empty unget_s) then (get_token ()) else (S.pop unget_s) in match (prev, cur) with (_, (P.EOF(_) as eoft)) -> eoft | (_, P.WS_WHITE(_)) -> (scan_next_rec ()) | ((P.K_LET(_) | P.K_WHERE(_) | P.K_DO(_) | P.K_OF(_)), (P.SP_LEFT_BRACE(_) as lbr)) -> lbr | ((P.K_LET(_) | P.K_WHERE(_) | P.K_DO(_) | P.K_OF(_)), tk) -> let (_, (level, loc)) = (S.push tk unget_s, blk_level_pair tk) in P.BLK_OPEN((if (eof_token_p tk) then 0 else level), loc) | (_, tk) -> let (_, loc) as p = blk_level_pair tk in if (loc.T.start_p.T.line - (L0.get_location prev).T.end_p.T.line) > 0 then let _ = S.push tk unget_s in P.BLK_LEVEL p else tk in (scan_next_rec ()) in (LST.fold_left (fun r a -> ((a, new_err_flag ()) :: r)) [] (LST.create_stream (scan_start ()) scan_next eof_token_p)) |
let rec layout istream levels =
let push_new_token tok lform = LST.Cons ((tok, new_err_flag ()), lform) in let (tok, err) = match LST.peek istream with None -> raise Parsing.Parse_error | Some x -> x in match (tok, levels) with ((P.BLK_LEVEL (n, loc)), (m :: mstl as ms)) when m = n -> let addtk = P.SP_SEMI(loc) in push_new_token addtk (lazy (layout (LST.tl istream) ms)) | ((P.BLK_LEVEL (n, loc)), m :: ms) when n < m -> push_new_token (P.SP_RIGHT_BRACE(loc)) (lazy (layout istream ms)) | ((P.BLK_LEVEL (n, _)), ms) -> layout (LST.tl istream) ms | ((P.BLK_OPEN (n, loc)), (m :: ms as levels)) when n > m -> push_new_token (P.SP_LEFT_BRACE(loc)) (lazy (layout (LST.tl istream) (n :: levels))) (* Note 1 *) | ((P.BLK_OPEN (n, loc)), []) when n > 0 -> push_new_token (P.SP_LEFT_BRACE(loc)) (lazy (layout (LST.tl istream) [n])) (* Note 1 *) | ((P.BLK_OPEN (n, loc)), ms) -> push_new_token (P.SP_LEFT_BRACE(loc)) (lazy (push_new_token (P.SP_RIGHT_BRACE(loc)) (lazy (layout (push_new_token (P.BLK_LEVEL(n, loc)) (lazy (LST.tl istream))) ms)))) (* Note 2 *) | ((P.SP_RIGHT_BRACE _ as rbr), 0 :: ms) -> LST.Cons ((rbr, err), lazy (layout (LST.tl istream) ms)) (* Note 3 *) | ((P.SP_RIGHT_BRACE _), ms) -> raise Parsing.Parse_error (* Note 3 *) | ((P.SP_LEFT_BRACE _ as lbr), ms) -> LST.Cons ((lbr, err), lazy (layout (LST.tl istream) (0 :: ms))) (* Note 4 *) | ((P.EOF loc as eoft), []) -> LST.Cons ((eoft, err), lazy (LST.Nil)) | ((P.EOF loc), m :: ms) when m <> 0 -> push_new_token (P.SP_RIGHT_BRACE(loc)) (lazy (layout istream ms)) (* Note 6 *) | (t, (m :: mstl)) when m <> 0 && (!err) -> err := false; push_new_token (P.SP_RIGHT_BRACE(L0.get_location t)) (lazy (layout istream mstl)) (* parse-error(t) Note 5 case *) | (t, ((m :: mstl) as ms)) -> LST.Cons ((t, err), lazy (layout (LST.tl istream) ms)) | (t, ms) -> LST.Cons ((t, err), lazy (layout (LST.tl istream) ms)) |
文脈自由文法の定義を全部載せてしまうと長すぎて大変なので、 ここでは単項の expression の部分と、 二項演算および二項演 算パターンの定義を見ていくことにします。
単項の表現 aexp としてここで定義されているのは、 変数、 コンストラクタ、 リテラル、 括弧でくくられた expression、 タ プル、 リスト、 リスト内包表記、 括弧でくくられた left secion、 括弧でくくられた right secion (section は二項演算式でどち らか充足しているもの)、 レコードの生成、 レコードをコピーして更新です。 単項の表現は二項演算の引数、 関数、 関数の引数 となり得ます。
/* parser.mly 単項 expression */
/* aexp -> qvar (variable) | gcon (general constructor) | literal | ( exp ) (parenthesized expression) | ( exp1 , ... , expk ) (tuple, k>=2) | [ exp1 , ... , expk ] (list, k>=1) | [ exp1 [, exp2] .. [exp3] ] (arithmetic sequence) | [ exp | qual1 , ... , qualn ] (list comprehension, n>=1) | ( expi+1 qop(a,i) ) (left section) | ( lexpi qop(l,i) ) (left section) | ( qop(a,i)<-> expi+1 ) (right section) | ( qop(r,i)<-> rexpi ) (right section) | qcon { fbind1 , ... , fbindn } (labeled construction, n>=0) | aexp<qcon> { fbind1 , ... , fbindn } (labeled update, n >= 1) */ aexp: qvar { E.VarE $1 } /*(variable)*/ | gcon { E.ConsE $1 } /*(general constructor)*/ | literal { E.LiteralE $1 } | SP_LEFT_PAREN exp SP_RIGHT_PAREN { E.ParenE $2 } /*(parenthesized expression)*/ | SP_LEFT_PAREN exp SP_COMMA exp_list SP_RIGHT_PAREN { E.TupleE ($2 :: $4) } /*(tuple, k>=2)*/ | SP_LEFT_BRACKET exp_list SP_RIGHT_BRACKET { E.ListE ($2) } /*(list, k>=1)*/ | SP_LEFT_BRACKET exp KS_DOTDOT SP_RIGHT_BRACKET { E.ASeqE($2, None, None) } /*(arithmetic sequence)*/ | SP_LEFT_BRACKET exp SP_COMMA exp KS_DOTDOT SP_RIGHT_BRACKET { E.ASeqE($2, Some $4, None) } /*(arithmetic sequence)*/ | SP_LEFT_BRACKET exp KS_DOTDOT exp SP_RIGHT_BRACKET { E.ASeqE($2, None, Some $4) } /*(arithmetic sequence)*/ | SP_LEFT_BRACKET exp SP_COMMA exp KS_DOTDOT exp SP_RIGHT_BRACKET { E.ASeqE($2, Some $4, Some $6) } /*(arithmetic sequence)*/ | SP_LEFT_BRACKET exp KS_BAR qual_list SP_RIGHT_BRACKET { E.LCompE ($2, $4) } /*(list comprehension, n>=1)*/ | SP_LEFT_PAREN op2_left_section SP_RIGHT_PAREN { E.MayLeftSecE ($2) } /*(left section)*/ | SP_LEFT_PAREN op2_right_section SP_RIGHT_PAREN { E.MayRightSecE ($2) } /*(right section)*/ | qcon SP_LEFT_BRACE fbind_list SP_RIGHT_BRACE { E.LabelConsE ($1, OH.of_list $3) } /*(labeled construction, n>=1)*/ | qcon SP_LEFT_BRACE SP_RIGHT_BRACE { E.LabelConsE ($1, OH.create 0) } /*(labeled construction, n=0)*/ | aexp SP_LEFT_BRACE fbind_list SP_RIGHT_BRACE { E.LabelUpdE ($1, OH.of_list $3) } /*(labeled update, n >= 1)*/ ; exp_list: exp SP_COMMA exp_list { $1 :: $3 } | exp { [$1] } ; qual_list: qual SP_COMMA qual_list { $1 :: $3 } | qual { [$1] } ; fbind_list: fbind SP_COMMA fbind_list { $1 :: $3 } | fbind { [$1] } ; qual: pat KS_L_ARROW exp { LC.Gen($1, $3) } /*(generator)*/ | K_LET decl_list { LC.Let $2 } /*(local declaration)*/ | exp { LC.Guard $1 } /*(guard)*/ ; |
二項演算 expression および二項演算パターンの構文解析
Haskell の二項演算子には level 0 から level 9 までの優先順位 (おおきい方が先に結合) があり、 その優先順位と結合規則 (右結 合、 左結合、 なし) を演算子を定義しているソースコード内で指定することができます。 しかも通常の関数を二項演算子として 扱う*11 ことも でき、 括弧なしで非常に複雑な式が記述可能です。 パターンについても、 関数にもなっているコンストラクタを二項演算子とし て使って、 二項演算式の形式でパターンを記述していけます。 もちろん二項演算子として使った場合のコンストラクタにも優先 順位と結合規則があり、 指定の方法は同様となっています。
こ こ で 問 題 と な る の は 構 文 解 析 時 に 優 先 順 位 が 決 定 し て い な い と い う こ と で す 。 こ こ で は expression、 パターン共に、 引数 と演算子が交互に連なっているリストとして構文解析を行なっています。
/* parser.mly 二項演算 expression */
... /* 略 */ /* expression */ exp: exp0 { E.Top ($1, None) } | exp0 KS_2_COLON context KS_R_W_ARROW typ { E.Top ($1, Some ($5, Some $3)) } /*(expression type signature)*/ | exp0 KS_2_COLON typ { E.Top ($1, Some ($3, None)) } /*(expression type signature)*/ /* lexp6: - exp7 ; */ /* expi -> expi+1 [qop(n,i) expi+1] | lexpi | rexpi lexpi -> (lexpi | expi+1) qop(l,i) expi+1 rexpi -> expi+1 qop(r,i) (rexpi | expi+1) */ /* exp0: -> [-] exp10 {qop [-] exp10} */ exp0: op2_expn_list { E.Exp0 $1 } op2_expn_list: ks_minus exp10 op2_right_section { E.ExpF (E.Minus $2, $3) } | exp10 op2_right_section { E.ExpF ($1, $2) } | ks_minus exp10 { E.ExpF (E.Minus $2, E.Op2End) } | exp10 { E.ExpF ($1, E.Op2End) } op2_right_section: qop op2_expn_list { E.Op2F ($1, $2) } op2_left_section: ks_minus exp10 qop op2_left_section { E.ExpF (E.Minus $2, E.Op2F ($3, $4)) } | exp10 qop op2_left_section { E.ExpF ($1, E.Op2F($2, $3)) } | ks_minus exp10 qop { E.ExpF (E.Minus $2, E.Op2F ($3, E.Op2NoArg)) } | exp10 qop { E.ExpF ($1, E.Op2F ($2, E.Op2NoArg)) } exp10: KS_B_SLASH apat_list KS_R_ARROW exp { E.LambdaE ($2, $4) } /*(lambda abstraction, n>=1)*/ | K_LET decl_list K_IN exp { E.LetE ($2, $4) } /*(let expression)*/ | K_IF exp K_THEN exp K_ELSE exp { E.IfE ($2, $4, $6) } /*(conditional)*/ | K_CASE exp K_OF SP_LEFT_BRACE alt_list SP_RIGHT_BRACE { E.CaseE ($2, $5) } /*(case expression)*/ | K_DO SP_LEFT_BRACE stmt_list_exp SP_RIGHT_BRACE { E.DoE $3 } /*(do expression)*/ | fexp { E.FexpE $1 } /* fexp -> [fexp] aexp (function application) */ fexp: aexp_list { E.make_fexp $1 } ; aexp_list: aexp aexp_list { fun fexp -> $2 (E.FappE (fexp, $1)) } | aexp { fun fexp -> E.FappE (fexp, $1) } ; /* fexp -- FfunE (fexp) */ /* fexp ae1 -- FappE (FfunE (fexp), ae1) */ /* fexp ae1 ae2 -- FappE (FappE (FfunE (fexp), ae1), ae2) */ |
/* parser.mly パターンおよび 二項演算パターン */
.../* 略 */ pat: var ks_plus integer /*(successor pattern)*/ { match $3 with (S.Int (i), loc) -> P.PlusP($1, i, loc) | _ -> failwith "plus integer pattern syntax error." } | pat0 { $1 } /* pati -> pati+1 [qconop(n,i) pati+1] | lpati | rpati */ /* lpati -> (lpati | pati+1) qconop(l,i) pati+1 */ /* lpat6: ks_minus integer (negative literal) { match $2 with (S.Int (v), l) -> S.P.MIntP (v, l) | _ -> failwith "negative integer literal pattern syntax error." } | ks_minus float (negative literal) { match $2 with (S.Float (v), l) -> S.P.MFloatP (v, l) | _ -> failwith "negative integer literal pattern syntax error." } ; */ /* rpati -> pati+1 qconop(r,i) (rpati | pati+1) */ pat0: op2_patn_list { P.Pat0 $1 } op2_patn_list: ks_minus integer op2_patn_right { let p = match $2 with (S.Int (x), loc) -> P.MIntP (x, loc) | _ -> failwith "negative integer literal pattern syntax error." in P.PatF (p, $3) } | ks_minus float op2_patn_right { let p = match $2 with (S.Float (x), loc) -> P.MFloatP (x, loc) | _ -> failwith "negative integer literal pattern syntax error." in P.PatF (p, $3) } | pat10 op2_patn_right { P.PatF ($1, $2) } op2_patn_right: qconop op2_patn_list { P.Op2F ($1, $2) } | { P.Op2End } pat10: apat { $1 } | gcon apat_list /*(arity gcon = k, k>=1)*/ { P.ConP($1, $2) } apat_list: apat apat_list { $1::$2 } | apat { [$1] } apat: var { P.VarP $1 } | var KS_AT apat /*(as pattern)*/ { P.AsP($1, $3) } | gcon /*(arity gcon = 0)*/ { P.ConP($1, []) } | qcon SP_LEFT_BRACE fpat_list SP_RIGHT_BRACE /*(labeled pattern, k>=0)*/ /* may be error pattern */ { P.LabelP($1, $3) } | literal { P.LiteralP($1) } | K_WILDCARD /*(wildcard)*/ { P.WCardP } | SP_LEFT_PAREN pat SP_RIGHT_PAREN /*(parenthesized pattern)*/ { $2 } | SP_LEFT_PAREN tuple_pat SP_RIGHT_PAREN /*(tuple pattern, k>=2)*/ { P.TupleP $2 } | SP_LEFT_BRACKET list_pat SP_RIGHT_BRACKET /*(list pattern, k>=1)*/ { P.ListP $2 } | KS_TILDE apat /*(irrefutable pattern)*/ { P.Irref $2 } |
一度、 構文解析が完了した後に二項演算子の優先順位の解決を行ないます。 構文木を再帰的に辿り、 二項演算式の交互のリス トを木構造に置き換えます。
具体的には、 二項演算式の一番左側の 2 つの単項表現expaa, expbb および 2 つの演算子opaa, opbb について着目すると、 二 項演算式は次の二通りのいずれかの形になっているはずです。
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||
この考え方をもとに演算子の優先順位と結合規則を考慮しつつ再帰呼び出しの関数を実装すると以下のようになり ます。
type ’exp op2list_opf =
Op2F of (ID.idwl * ’exp op2list_expf) | Op2End and ’exp op2list_expf = ExpF of (’exp * ’exp op2list_opf) (* | UniOpF of (ID.idwl * ’exp * ’exp op2list_opf) *) | Op2NoArg ... (* 中略 *) let rec explist2term func list = let exp10_fun = SYA.maptree_exp10 func in let rec fold_leafs list = let scanned_op2exp op expAA expBB = E.VarOp2E (op, exp10_fun expAA, exp10_fun expBB) in match list with | E.ExpF (exp, E.Op2End) -> (* list *) E.uni_exp (exp10_fun exp) | E.ExpF (expAA, E.Op2F (op_aa, (E.ExpF (expBB, E.Op2End)))) -> E.uni_exp (scanned_op2exp op_aa expAA expBB) | E.ExpF (expAA, E.Op2F ((op_aa, _) as op_aa_wl, ((E.ExpF (expBB, E.Op2F ((op_bb, _) as op_bb_wl, rest))) as cdr))) -> begin let (aa_fixity, _) = eval_op2_fixity modbuf op_aa in let (bb_fixity, _) = eval_op2_fixity modbuf op_bb in (* F.printf "(%s, %d) vs (%s, %d)\n" (ID.name_str op_aa) (snd aa_fixity) (ID.name_str op_bb) (snd bb_fixity); *) match (aa_fixity, bb_fixity) with | ((_, aa_i), (_, bb_i)) when aa_i > bb_i -> fold_leafs (E.expf_cons (scanned_op2exp op_aa_wl expAA expBB) op_bb_wl rest) | ((SYN.InfixLeft, aa_i), (SYN.InfixLeft, bb_i)) when aa_i = bb_i -> fold_leafs (E.expf_cons (scanned_op2exp op_aa_wl expAA expBB) op_bb_wl rest) | ((_, aa_i), (_, bb_i)) when aa_i < bb_i -> E.expf_cons expAA op_aa_wl (fold_leafs cdr) | ((SYN.InfixRight, aa_i), (SYN.InfixRight, bb_i)) when aa_i = bb_i -> E.expf_cons expAA op_aa_wl (fold_leafs cdr) | _ -> failwith (F.sprintf "Syntax error for operator priority. left fixity %s, right fixity %s" (SYN.fixity_str aa_fixity) (SYN.fixity_str bb_fixity)) end | _ -> failwith "Arity 2 operator expression syntax error." in match fold_leafs list with | E.ExpF (exp, E.Op2End) -> exp | E.ExpF (exp, E.Op2F (_, E.Op2NoArg)) -> failwith "explist2term: section not implemented." | folded -> explist2term func folded |
type ’pat op2list_opf =
Op2F of (ID.idwl * ’pat op2list_patf) | Op2End and ’pat op2list_patf = PatF of (’pat * ’pat op2list_opf) | Op2NoArg ... (* 中略 *) let rec patlist2term min_i func list = let pat_fun = SYA.maptree_pat func in let rec fold_leafs list = let scanned_op2pat op patAA patBB = P.ConOp2P (op, pat_fun patAA, pat_fun patBB) in match list with | P.PatF (pat, P.Op2End) -> P.uni_pat (pat_fun pat) | P.PatF (patAA, P.Op2F (op_aa_wl, (P.PatF (patBB, P.Op2End)))) -> P.uni_pat (scanned_op2pat op_aa_wl patAA patBB) | P.PatF (patAA, P.Op2F ((op_aa, _) as op_aa_wl, ((P.PatF (patBB, P.Op2F ((op_bb, _) as op_bb_wl, rest))) as cdr))) -> begin let (aa_fixity, _) = eval_op2_fixity modbuf op_aa in let (bb_fixity, _) = eval_op2_fixity modbuf op_bb in match (aa_fixity, bb_fixity) with ((_, aa_i), _) when aa_i < min_i -> failwith (F.sprintf "Pat%d cannot involve fixity %s operator." min_i (SYN.fixity_str aa_fixity)) | (_, (_, bb_i)) when bb_i < min_i -> failwith (F.sprintf "Pat%d cannot involve fixity %s operator." min_i (SYN.fixity_str bb_fixity)) | ((_, aa_i), (_, bb_i)) when aa_i > bb_i -> fold_leafs (P.patf_cons (scanned_op2pat op_aa_wl patAA patBB) op_bb_wl rest) | ((SYN.InfixLeft, aa_i), (SYN.InfixLeft, bb_i)) when aa_i = bb_i -> fold_leafs (P.patf_cons (scanned_op2pat op_aa_wl patAA patBB) op_bb_wl rest) | ((_, aa_i), (_, bb_i)) when aa_i < bb_i -> P.patf_cons patAA op_aa_wl (fold_leafs cdr) | ((SYN.InfixRight, aa_i), (SYN.InfixRight, bb_i)) when aa_i = bb_i -> P.patf_cons patAA op_aa_wl (fold_leafs cdr) | _ -> failwith (F.sprintf "Syntax error for operation priority. left fixity %s, right fixity %s" (SYN.fixity_str aa_fixity) (SYN.fixity_str bb_fixity)) end | _ -> failwith "Arity 2 operator pattern syntax error." in match fold_leafs list with | P.PatF (pat, P.Op2End) -> pat | P.PatF (pat, P.Op2F (_, P.Op2NoArg)) -> failwith "patlist2term: section not implemented." | folded -> patlist2term min_i func folded |
5.2.1節でも述べた、 環境を渡してゆく方法で Haskell の評価器を実装するために以下の型の環境 (env_t)、 単純な closure(lambda_t)、 関数定義のための closure(closure_t) を定義しました。
先の議論での closure は仮引数リスト、 body の expression、 および環境の 3 つを持っているデータ型でした。 こち らで同じ役割を果たす lambda_t では、 Haskell の関数の仮引数がパターン照合 (pattern match) を行なう ので仮引数リストの代わりに pattern のリストを持っているのと、 Haskell の関数束縛宣言およびパターン 照合による束縛宣言における where 節の環境を構築するための関数を保持するのフィールドを増やしてい ます。
また、 Haskell の関数定義の pattern match によって複数の expression を書き分ける機能を、 単純な closure に置き換える のは困難なため、 複数の closure を持つことのできる型 closure_t を導入しました。
type lambda_t = {
arg_pat_list : P.pat list; body : E.t; lambda_env : env_t; apply_where : (env_t -> env_t); } and closure_t = | SPat of (lambda_t) | MPat of (lambda_t list) | Prim of (thunk_t list -> value_t) and value_t = | Bottom | IO | Literal of SYN.literal | Cons of (ID.id * (thunk_t list)) | LabelCons of (ID.id * (ID.id, thunk_t) OH.t ) | Tuple of (thunk_t list) | List of (thunk_t list) | Closure of (closure_t * int * E.aexp list) and thunk_t = unit -> value_t and pre_value_t = Thunk of (unit -> value_t) | Thawed of value_t and scope_t = (S.t, thunk_t) H.t (* あるスコープでの環境 *) and env_t = { symtabs : (scope_t) list; top_scope : scope_t; } |
Haskell の評価戦略はデフォルトで遅延評価 (lazy evaluation) です。 次のようなプログラムを定義してg (f 1 2) 2を評価す ることを考えてみます。
f x y = x + y
g x y = x * y |
話を簡単にするために+, *はプリミティブであるということにすると、 まずgを評価すると(f 1 2) * 2となります。 つ ぎに、 *はそれ以上評価しても意味がないプリミティブなので f が評価され、 (1 + 2) * 2となり、 以下3 * 2, 6となって評 価が終了します。
他の多数のプログラミング言語は eager evaluation を採用しているものが多く、 その場合は関数の引数が完全に評価された あとに関数が評価されます。 書きくだしてみると、 g (f 1 2) 2-> g (1 + 2) 2-> g 3 2-> g 3 2-> 3 * 2 -> 6のような感じになるはずです。
lazy evaluation を実装するには、 関数の引数を評価するときに最後まで評価するのではなく、 引数の計算を行なうような closure を生成することで対応することができます。 この小さな closure をここでは thunk と呼んでいます。 環境 env_t の持っ ている値を thunk_t にしているのはそのためです。
make_thunk で thunk ごとに評価前の関数 (Thunk) または評価後の値 (Thawed) を保持する pre_value_t 型の構造を作っ ています。 thunk を初めて呼び出したときに評価が行なわれて値が保持され、 以降の thunk 呼び出しでは単に Thawed の保持 する値が返るようになります。
and thunk_t = unit -> value_t
and pre_value_t = Thunk of (unit -> value_t) | Thawed of value_t and scope_t = (S.t, thunk_t) H.t (* あるスコープでの環境 *) and env_t = { symtabs : (scope_t) list; top_scope : scope_t; } ...(* 中略 *) let thunk_value thunk = match thunk with Thunk (f) -> f () | Thawed (v) -> v let expand_thunk thunk_ref = match !thunk_ref with Thunk (_) -> let v = thunk_value (!thunk_ref) in let _ = thunk_ref := Thawed v in v | Thawed (v) -> v let make_thawed value = (fun () -> value) let make_thunk eval_fun env evalee = let delay_fun = fun () -> (eval_fun env evalee) in let thunk_ref = ref (Thunk delay_fun) in fun () -> expand_thunk thunk_ref |
Haskell のパターン照合 (pattern match) は lazy evaluation と組み合わさるようにして動作します。 実際の評価に必要な部分 しか pattern match に対応する expression を評価しないように動きます。
次のプログラムを考えます。
main = let { (p, (q, r)) = (print 1, (print 2, print 3)) } in
q |
このプログラムを実行すると2のみが出力されます。 (p, (q, r))と(print 1, (print 2, print 3))の pattern match が行なわれますが実際に必要になるqのみが最後まで評価されます。
pattern match の際に pattern に従って構造分解を行ない、 その構造分解に対応した thunk から thunk への分解を行なって いきます。 末端に変数の pattern があれば環境に thunk を書き込みます。 pattern match の失敗をたとえば case 式で認識する ために真理値を返しています。
たとえばタプルの場合は、 まずタプルに対応するはずの thunk を評価し、 結果をタプルの要素に分解します。 タプルのそれ ぞれの要素はやはりまた thunk になっているので、 タプルの pattern のそれぞれの要素と pattern match を行なう ように再帰します。 それぞれの要素の pattern match が全て成功すれば、 タプルの pattern match も成功 です。
(* Lazy pattern match against thunk *)
and bind_pat_with_thunk pat = let sub_patterns_match env pat_list thunk_list = L.fold_left2 (fun (matchp_sum, tlist_sum) pat thunk -> let (matchp, tlist) = bind_pat_with_thunk pat env thunk in (matchp_sum & matchp, L.append tlist_sum tlist)) (true, []) pat_list thunk_list in match pat with ... (* 中略 *) | P.VarP (id, _) -> (fun env thunk -> let _ = bind_thunk_to_env env id thunk in (true, [thunk])) | P.AsP ((id, _), pat) -> (fun env thunk -> let (_, (matchp, tlist)) = (bind_thunk_to_env env id thunk, bind_pat_with_thunk pat env thunk) in (matchp, thunk :: tlist)) ... (* 中略 *) | P.WCardP -> (fun _ thunk -> (true, [thunk])) | P.TupleP pat_list -> (fun env thunk -> let value = thunk () in match value with Tuple (args) when (L.length args) = (L.length pat_list) -> sub_patterns_match env pat_list args | _ -> (false, [thunk])) | P.ListP pat_list -> (fun env thunk -> let value = thunk () in match value with List (args) when (L.length args) = (L.length pat_list) -> sub_patterns_match env pat_list args | _ -> (false, [thunk])) ... (* 略 *) |
結構な分量になってしまいましたが、 それでもかなり端折って関数型言語のプログラミングと Haskell ライクなインタプリタを 実装するにあたって苦心したトピックを紹介してみました。
今後の課題としては未実装の部分を実装していくことと、 ocamlyacc による parsing を Packrat parsing に置き換えること でより仕様に沿った構文解析をエレガントに行なえるようにすることです。
第
61 回東京エリア Debian 勉強会 2010 年 2 月
____________________________________________________________________________________________