Haskellのレイアウトルールの実装
背景
個人的な目的で、関数型プログラミング言語を開発しており、Haskell に近い文法を実現するため、レイアウトルールやユーザ定義演算子の結合性解決などを実装した。実装を中心として説明をする。
完成したコードはこちら：https://github.com/ksrky/plato-parser
レイアウトルールとは
Haskell プログラムではレイアウトに依存したコードを書くことで、ブレースやセミコロンを省略でき、その仕様を定めたものをレイアウト（またはオフサイド）ルールという。うまく説明できないので、ちゃんとした説明は Haskell2010 Language Report の2.7 節で確認してほしい。
おなじく Languge report の10.3 節で、レイアウトルールの形式的定義が与えられている。
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
L ({n} : ts) [] = { : (L ts [n]) if n > 0
L ({n} : ts) ms = { : } : (L (< n >: ts) ms)
L (} : ts) (0 : ms) = } : (L ts ms)
L (} : ts) ms = parse-error
L ({ : ts) ms = { : (L ts (0 : ms))
L (t : ts) (m : ms) = } : (L (t : ts) ms) if m≠0 and parse-error(t)
L (t : ts) ms = t : (L ts ms)
L [] [] = []
L [] (m : ms) = } : L [] ms if m≠0
t や ts はトークンを表していて、この定義はレイアウトルールを適用する前に、プログラム中の全てのトークンが確定していることを前提としている。そのため、ここに載っているコードをそのまま使うなら、字句解析 → レイアウトルール適用 → 構文解析というフローになるだろう。こちらの方がレイアウトルールのアルゴリズムが明確になってわかりやすいような気もするが、GHC は Alex と Happy を使ったモナドパーサーを採用している。つまり字句解析と構文解析の境界がないので、上ようなフローでパースしていない。だから、GHC の真似をするなら、少し実装上工夫がいる。
レイアウトなしのレキサー、パーサーの実装
レキサー、パーサーにはそれぞれAlexとHappyというライブラリを使用している。
Alex の wrapper は使わず、一からパーサーモナドを作っている。（src/Monad.hs）
パーサーは、Language Report をほとんどそのまま書き下した。加えて、GHC や Agda のパーサーを参考にした。
Syntax
抽象構文木は以下のような感じ（独自言語の仕様で、数値や文字列がなかったりする）
SrcLoc
LX型はLocated Xの別名で型Xの値とコード中の位置情報が含まれている。Locatedはsrc/SrcLoc.hsで定義されている。GHC のコードを参考にした。
data Loc
= Loc
!Int -- line number
!Int -- column number
deriving (Eq, Ord, Show)
data Span
= Span
Loc -- start loc
Loc -- end loc
| NoSpan
deriving (Eq, Ord, Show)
data Located a = L Span a
deriving (Eq, Ord, Show, Functor, Foldable, Traversable)
Name
また、識別子は Name 型に変換される。GitLab のドキュメントなどを参考にした。
data Name = Name {nameSpace :: NameSpace, nameText :: T.Text}
data NameSpace
= VarName
| ConName
| TyvarName
| TyconName
deriving (Eq, Show)
レイアウトルールの実装
以上の説明はだいぶ雑になったが、ここからが本題となる。
この言語のレイアウトルールでは、以下のようなコード
-- data type declaration and case expression
module Bool
data Bool = True | False
not : Bool -> Bool
not = \b -> case b of
True -> False
False -> True
は、セミコロンやブレースを挿入して、レイアウトに依存しない以下のようなコードに変換される。（Haskell とやや違うので注意）
;module Bool
;data Bool = True | False
;not : Bool -> Bool
;not = \b -> case b of {
;True -> False
;False -> True
}
ただし、Lexer と Parser が相互に状態を持っているため、中間状態でこのようなテキストは出力されない。
文頭の空白文字列
まずはこのルールを書き換える。
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
< n >は行頭の空白文字数を表す。n が現在のインデントレベル m（文字数）に一致すれば、;を挿入し、n が m より小さければ現在のブロックが終了したとみて、}を挿入し、現在のインデントレベルをポップする。n が m より大きいとき、例えば、
names = [ "Tom"
, "John"
, "Mary"
]
はレイアウトではないので、スキップする。
これを実装するにはまず、トップレベルでは< 0 >を扱わなければならないが、0 文字の空白文字列は Alex ではマッチせず、代わりに最初のトークンにマッチする。そのため、< 0 >だけを別に扱う必要がある。以下のコードで token 関数はキーワードやシンボルや識別子それぞれのトークンを lex する関数をラップしている。
token :: (T.Text -> Token) -> Action
token f ainp@(pos, _, _, inp) len = do
let sp = mkSpan pos inp len
t = T.take len inp
lev <- getIndentLevels
scd <- getStartCode
case lev of
_ | scd == code -> ret sp (f t)
m : ms
| m == 0 -> do
-- L (< 0 >: ts) (m : ms) = ; : (L ts (m : ms)) if m = 0
setStartCode code
setInput ainp
ret sp (TokSymbol SymSemicolon)
| m > 0 -> do
-- L (< 0 >: ts) (m : ms) = } : (L (< 0 >: ts) ms) if m > 0
setIndentLevels ms
setInput ainp
ret sp (TokSymbol SymVRBrace)
[] -> do
-- L (< 0 >: ts) [] = L ts []
setStartCode code
setInput ainp
ret sp (TokSymbol SymSemicolon)
_ -> error "unreachable: negative indent level"
まず、この実装の場合、Alex の start code を使って Lexer が文頭にある時は 0、文中にある時は code という状態を持っていて、文頭にある時には 0 文字の空白文字列を処理する必要があるが、文中にある時はその必要がないのでスキップしている。start code が 0 だった場合は、入力を消費せず、セミコロンやブレースを挿入し、start code を code にして次の状態に渡している。
また、インデントレベルが空のときはトップレベルであることを示しているから、かならず文頭の空白文字数 0 にマッチし、;を挿入する。これは、module ModuleName where {...}という記法を採用していない、この言語独自のルールである。
n < n >の扱いもほとんど同様。
spaces :: Action -- start code = 0
spaces ainp@(pos, _, _, inp) len = do
lev <- getIndentLevels
let sp = mkSpan pos inp 0
case lev of
m : ms
| m == len -> do
-- L (< n >: ts) (m : ms) = ; : (L ts (m : ms)) if m = n
setStartCode code
setIndentLevels (m : ms)
ret sp (TokSymbol SymSemicolon)
| len < m -> do
-- L (< n >: ts) (m : ms) = } : (L (< n >: ts) ms) if n < m
setInput ainp
setIndentLevels ms
ret sp (TokSymbol SymVRBrace)
_ -> do
-- L (< n >: ts) ms = L ts ms if n > m
setStartCode code
alexMonadScan
レイアウトキーワード
次は、以下のルールを書き換える。
L ({n} : ts) (m : ms) = { : (L ts (n : m : ms)) if n > m
L ({n} : ts) [] = { : (L ts [n]) if n > 0
L ({n} : ts) ms = { : } : (L (< n >: ts) ms)
{n}はレイアウトキーワード（let, of）に続く最初のトークンのインデントレベルである。例えば
f = let x = 2
y = 3
in x + y
において、let の中のインデントレベルは 1 ではなく 8 なので、yの前に閉じ括弧が挿入されてしまい、yでパースエラーになる。
layoutKeyword :: Keyword -> Action
layoutKeyword key (pos, _, _, inp) len = do
let sp = mkSpan pos inp len
setStartCode layout
ret sp (TokKeyword key)
layoutSpaces :: AlexInput -> Int -> Parser (Located Token)
layoutSpaces (pos@(PsPosn _ _ col), _, _, inp) len = do
setStartCode code
lev <- getIndentLevels
let sp = mkSpan pos inp 0
n = col - 1 + len
case lev of
_ | T.length inp > len && T.unpack inp !! len == '{' -> do
-- Explicit open brace after layout keywords
setStartCode code
alexMonadScan
m : ms | n > m -> do
-- L ({n} : ts) (m : ms) = { : (L ts (n : m : ms)) if n > m
setIndentLevels (n : m : ms)
ret sp (TokSymbol SymVLBrace)
[] | n > 0 -> do
-- L ({n} : ts) [] = { : (L ts [n]) if n > 0
setIndentLevels [n]
ret sp (TokSymbol SymVLBrace)
_ -> do
-- L ({n} : ts) ms = { : } : (L (< n >: ts) ms)
setIndentLevels [n]
ret sp (TokSymbol SymVLBrace)
明示的に現れる開き括弧は後で処理するため、スキップする。新しいインデントレベルが現在より深くなっていれば開き括弧を挿入する。現在がトップレベルの場合（インデントレベルのスタックが空のとき）も同様。
三つ目のルールに関しては、レイアウトキーワードの後が空のブロックでも良いということ（eg. let {} in <expr> case <expr> of {}）だが、Alex は 2 トークンを返すことはできないので少し困る。しかし、ここで開き括弧を挿入すれば、閉じ括弧の挿入は、EOF に達したときに閉じ括弧を挿入するルールと、パースエラーに遭遇したときに閉じ括弧を挿入するルールで満たされるので問題ない。
明示された開き括弧、閉じ括弧
明示された開き括弧の処理は簡単で、インデントレベルのスタックに 0 を追加するだけ。
leftBrace :: Action
leftBrace (pos, _, _, inp) len = do
-- L ({ : ts) ms = { : (L ts (0 : ms))
setStartCode code
let sp = mkSpan pos inp len
lev <- getIndentLevels
setIndentLevels (0 : lev)
return $ L sp (TokSymbol SymLBrace)
閉じ括弧は、その前に明示された開き括弧があるかを検査する必要があり、それは現在のインデントレベルが 0 であることで確認できる。
rightBrace :: Action
rightBrace (pos, _, _, inp) len = do
setStartCode code
let sp = mkSpan pos inp len
lev <- getIndentLevels
case lev of
0 : ms -> do
-- L (} : ts) (0 : ms) = } : (L ts ms)
setIndentLevels ms
ret sp (TokSymbol SymRBrace)
_ -> do
-- L (} : ts) ms = parse-error
lift $ throwPsError sp "missing an opening brace before closing"
パースエラー
最後のルールだけ、レキサーからではなく、パーサーから操作する必要がある。
L (t : ts) (m : ms) = } : (L (t : ts) ms) if m≠0 and parse-error(t)
parse-error(t)をどのように検出するかだが、それは Parser.y を以下のように記述することで実現できる。（How do Haskell compilers implement the parse-error(t) rule in practice?を参考にした）
lexpr :: { Located Expr }
: ...
| 'let' '{' decls '}' 'in' expr { cSL $1 $6 (LetExpr $3 $6) }
| 'let' 'v{' decls close 'in' expr { cSL $1 $6 (LetExpr $3 $6) }
| 'case' expr 'of' '{' alts '}' { L (combineSpans $1 $6) (CaseExpr $2 $5) }
| 'case' expr 'of' 'v{' alts close { L (combineSpans $1 $6) (CaseExpr $2 $5) }
close :: { Span }
: 'v}' { $1 }
| error {% popLayoutLevel $1 }
Happy の挙動が正確にはわからないので何とも言えないが、とりあえずこれでうまくいく。レキサーによって既に閉じ括弧が挿入されていれば、closeの最初のパターン（'v}'、virtual close curly の意）にマッチするし、そうでなければerrorで、その次の任意のトークンにマッチし、popLayoutLevelが呼ばれる。
popLayoutLevel :: Located Token -> Parser Span
popLayoutLevel (L sp _) = do
lev <- getIndentLevels
ts <- getPrevTokens
scd <- getStartCode
case lev of
m : ms | m /= 0 -> do
-- L (t : ts) (m : ms) = } : (L (t : ts) ms) if m≠0 and parse-error(t)
setIndentLevels ms
return sp
_ -> lift $ throwPsError sp "parse error"
ここでは、インデントレベルが 0 でない、すなわち直前に明示的な開き括弧がなかった場合に、閉じ括弧が挿入される。
先ほどのerrorにはファイルの終端を表す EOF トークンもマッチする（たぶん）ため、同時に以下のルールも満たされている。
ファイルの末端
最後の 3 つのルールのうち 1 つ目は、Lexer そのものの挙動であるが、残りの 2 つの実装は少し複雑になる。
L (t : ts) ms = t : (L ts ms)
L [] [] = []
L [] (m : ms) = <closing brace> : L [] ms if m≠0
トークンのスタックが空、すなわち EOF に達したときに、明示された開き括弧のブロック内なのであればエラーを返し、現在のインデントレベルがあれば閉じ括弧を挿入し、そのどちらでもなければ字句解析を終了する。
alexMonadScan = do
ainp@(pos, _, _, inp) <- getInput
scd <- getStartCode
lev <- getIndentLevels
let sp = mkSpan pos inp 0
case alexScan ainp scd of
AlexEOF -> do
cd <- getCommentDepth
when (cd > 0) $ lift $ throwPsError sp "unterminated block comment"
case lev of
-- L [] [] = []
-- L [] (m : ms) = <closing brace> : L [] ms if m≠0
[] -> return $ L sp TokEOF
0 : _ -> lift $ throwPsError sp "closing brace missing"
_ : ms -> do
setIndentLevels ms
ret sp (TokSymbol SymVRBrace)
AlexError _ -> lift $ throwPsError sp "lexical error"
AlexSkip ainp' _len -> do
setInput ainp'
ユーザー定義演算子の結合性解決
Haskell では、演算子をユーザーが定義でき、その結合性をプログラム中のどこからでも指定できる。これを実現するには、まず中置式を結合性不明のままパースしておいて、あとから結合性を適用していくことになる。この結合性解決アルゴリズムは Language Report の10.6 節でコード付きで解説されており、この通りに実装すればよい。
一つ工夫した点があるとすれば、パーサーが出力する構文木と結合性解決した後の構文木を同一に扱っている点である。パーサーでは中置式はすべて右結合としてパースし、( )で囲われている式のみ、専用の構文（Factor）を追加した。これは結合性解決後、取り除かれる。
data Expr
= ...
| OpExpr LExpr LName LExpr
| Factor LExpr -- removed after fixity resolution
infixexpr :: { Located Expr }
: lexpr op infixexpr { cLL $1 $3 (OpExpr $1 $2 $3) }
| lexpr { $1 }
aexpr :: { Located Expr }
: '(' expr ')' { L (combineSpans $1 $3) (Factor $2) }
| ...
以下のような型クラスにより、構文木内の中置式を探索する。
class Resolver a where
resolve :: MonadThrow m => OpDict -> Located a -> m (Located a)
OpDictは演算子の文字列と結合性のペアであり、パーサーによって生成される。
中置式を変換する際、右結合としてパースした式を直線化する必要があり、以下の linear 関数と相互再帰することで実現している。
linear :: MonadThrow m => OpDict -> Located Expr -> m [Tok]
linear opdict (L _ (OpExpr e1 lx@(L _ x) e2)) = do
e1' <- linear opdict e1
e2' <- linear opdict e2
let op = case M.lookup x opdict of
Just op' -> op'
Nothing -> Op lx maxPrec Leftfix
return $ e1' ++ [TOp op] ++ e2'
linear opdict e = do
e' <- resolve opdict e
return [TExp e']
一つ注意点は、この言語は数値を持たず、負の数を記述するための前置演算子-を含んでいないから、これを削除している。
その他
例外処理について
例外処理には何を使ってもよいと思うが、あとで他のモナドと併用できると便利なので、MonadThrow を用いて一般化した。
ユーザー定義演算子
予約されたシンボルを lex してから、ユーザー定義演算子を lex しようとすると、==のような演算子が= =のように 2 トークンとして解釈されてしまうので、まず演算子に使用できるシンボルを全てユーザー定義演算子と仮定して、後からそれを分離するという方法を取っている。
varsym :: Action
varsym (pos, _, _, inp) len = do
let sp = mkSpan pos inp len
t = T.take len inp
case lookup t commonSymbols of
Just sym -> return $ L sp (TokSymbol sym)
Nothing -> return $ L sp (TokVarSym t)
commonSymbols :: [(T.Text, Symbol)]
commonSymbols =
[ ("->", SymArrow)
, ("\\", SymBackslash)
, (":", SymColon)
, ("=", SymEqual)
, ("|", SymVBar)
]
Discussion