Tociyuki::Diary RSSフィード

tociyuki による Perl・Ruby・C++・C で書き散らしたコードを中心に、日常雑記も混在 : B  F  twitter  GitHub  CPAN  本館  公開鍵
 

2017年03月26日

[]3imp ヒープベース compile/VM での begin 形式

3imp では、 begin 形式と lambda 形式のボディを、 入れ子の lambda 形式へ変換してコンパイルするとあります。 それでも間違いではないのですが、 一つ注意点があって、 入れ子になっている lambda 形式の束縛変数は変換時に gensym で作ったもの、 もしくはボディ中の自由変数と一致しないようにα変換したものでなければなりません。 このことは、 ボディでは lambda 形式への変換で作られた束縛変数を決して参照できないことを意味しており、 参照されることがない変数は最適化で除去されて環境フレームが空になります。 当然、 空の環境フレームはあっても無駄なので最適化で環境から取り除かれます。 結果として、 入れ子の lambda 形式に変換したとしても、 環境はボディ開始時点から変更されずにシーケンスの個々の式の評価に受け渡していくだけだということになります。 この結論は CEK マシンのシーケンスの遷移に一致します。

begin を実装するには、 シーケンスの並びの一つ一つを評価する前に、 その時点の環境をクローズして継続を作るようにします。 当然ながら、 この継続でシーケンスの次の式を評価をするようにジャンプ先を指定します。このような継続は 3imp VM の frame 命令で作ることができるので、 begin は frame 命令を使って実装する方が CEK マシンに合っています。

ということで、 begin と lambda ボディの並びをコンパイラに組み込むと、 次のようになります。

(define (compile-3imp-heapbased x e)

  (define (extend e r) (cons r e))

  (define (clookup x e)
    (let looplevel ((e e) (level 0))
      (if (null? e) (error "variable not found -- comp" x)
        (let looploc ((vars (car e)) (loc 0))
          (cond
            ((null? vars) (looplevel (cdr e) (+ level 1)))
            ((eq? x (car vars)) (cons level loc))
            (else (looploc (cdr vars) (+ loc 1))) )))))

  (define (complist x* e next)
    (if (null? (cdr x*))
      (comp (car x*) e next)
      (comp (car x*) e (complist (cdr x*) e next)) ))

  (define (comp x e next)
    (cond
      ((symbol? x)
        `(refer ,(clookup x e) ,next) )
      ((pair? x)
        (cond
          ((eq? (car x) 'quote)
            `(constant ,(cadr x) ,next) )
          ((eq? (car x) 'lambda)
            (let ((vars (cadr x)) (body (cddr x)))
              `(close ,(complist body (extend e vars) '(return)) ,next) ))
          ((eq? (car x) 'call/cc)
            (let ((c `(conti (argument ,(comp x e '(apply))))))
              (if (equal? next '(return))
                c
                `(frame ,next ,c) )))
          ((eq? (car x) 'set!)
            (let ((var (cadr x)) (expr (caddr x)))
              (comp expr e `(assign ,(clookup var e) ,next)) ))
          ((eq? (car x) 'if)
            (let ((pred (cadr x))
                  (succ (comp (caddr x) e next))
                  (alt  (if (null? (cdddr x))
                          `(constant #f ,next)
                          (comp (cadddr x) e next) )))
              (comp pred e `(test ,succ ,alt)) ))
          ((eq? (car x) 'begin)
            (if (null? (cdr x))
              `(constant #f ,next)
              (complist (cdr x) e next) ))
          (else
            (let loop ((args (cdr x))
                       (c (comp (car x) e `(apply))))
              (if (null? args)
                (if (equal? next '(return))
                  c
                  `(frame ,next, c) )
                (loop (cdr args) (comp (car args) e `(argument ,c))) )))))
      (else
        `(constant ,x ,next) )))

  (comp x e '(halt)) )

例えば、 アプリケーションを 3 つ並べたラムダ形式をコンパイルすると次のようになります。

gosh> (compile-3imp-heapbased '((lambda (x) (f x) (g x) (h x)) 3) '((f g h))) 
(frame (halt)
  (constant 3 (argument (close
      (frame 
        (frame (refer (0 . 0) (argument (refer (1 . 2) (apply))))
          (refer (0 . 0) (argument (refer (1 . 1) (apply)))))
        (refer (0 . 0) (argument (refer (1 . 0) (apply)))))
    (apply)))))

これでは読みにくいので実行順に整理してみます。 VM の遷移を追うと環境のセーブとリストアを期待したようにおこなっています。

#C01=(frame #C20#   ; e  a         r       s
#C02=(constant 3    ; e  a         r1= ()  (#C20# e r s)
#C03=(argument      ; e  3         r1= ()  (#C20# e r s)
#C04=(close #C06#   ; e  3         r1=(3)  (#C20# e r s)
#C05=(apply)))))    ; e  (#C06# e) r1=(3)  (#C20# e r s)
;(lambda (x) (f x) (g x) (h x))
#C06=(frame #C11#   ; e1 (#C06# e) r1= ()  (#C20# e r s)
#C07=(refer (0 . 0) ; e1 (#C06# e) r2= ()  (#C11# e1 r1 (#C20# e r s))
#C08=(argument      ; e1 3         r2= ()  (#C11# e1 r1 (#C20# e r s))
#C09=(refer (1 . 0) ; e1 3         r2= (3) (#C11# e1 r1 (#C20# e r s))
#C10=(apply)))))    ; e1 (#f# e)   r2= (3) (#C11# e1 r1 (#C20# e r s))
#C11=(frame #C16#   ; e1 af        r1= ()  (#C20# e r s)
#C12=(refer (0 . 0) ; e1 af        r3= ()  (#C16# e1 r1 (#C20# e r s))
#C13=(argument      ; e1 3         r3= ()  (#C16# e1 r1 (#C20# e r s))
#C14=(refer (1 . 1) ; e1 3         r3=(3)  (#C16# e1 r1 (#C20# e r s))
#C15=(apply)))))    ; e1 (#g# e)   r3=(3)  (#C16# e1 r1 (#C20# e r s))
#C16=(refer (0 . 0) ; e1 ag        r1= ()  (#C20# e r s)
#C17=(argument      ; e1 3         r1= ()  (#C20# e r s)
#C18=(refer (1 . 2) ; e1 3         r1=(3)  (#C20# e r s)
#C19=(apply))))     ; e1 (#h# e)   r1=(3)  (#C20# e r s)

#C20=(halt)         ; e  ah        r       s

[]3imp ヒープ・ベース・コンパイラ/VM と CEK マシンの関係

Dybvig Three Implementation Models for Scheme (以下 3imp) のヒープ・ベース VM は、 VM だけでは CEK マシンから逸脱する動作もできてしまいますが、 コンパイラで CEK マシンに等価になるようにコード生成して制限をかけています。

複合手続きのアプリケーション評価を取り上げます。 CEK マシンでは 2 フェーズの状態遷移をおこなっていました。 式から継続を作成するフェーズと、 式評価の結果を継続に摘要するフェーズを交互に繰り返します。 アプリケーションの S 式を先頭から昇順に評価していく場合、 最初に得る式を継続メンバに記録してから実引数を評価してリストを作成していきます。 そして最後の実引数を評価してから apply フェーズへ移って、 実引数とクロージャの仮引数で新しい環境フレームを作ってクロージャの環境に追加して新しい環境を作ります。 それから、 できた新しい環境で手続き本体を評価します。

(M M1 M2 M3) E K
-> M  E (kfn (M1 M2 M3) E K)
     -> (kfn (M1 M2 M3) E K) (val (procedure Xf (Mf) Ef))
-> M1 E (kap    (M2 M3) E K (procedure Xf (Mf) Ef) ())
     -> (kap    (M2 M3) E K (procedure Xf (Mf) Ef) ())         (val a1)
-> M2 E (kap       (M3) E K (procedure Xf (Mf) Ef) (a1))
     -> (kap       (M3) E K (procedure Xf (Mf) Ef) (a1))       (val a2)
-> M3 E (kap         () E K (procedure Xf (Mf) Ef) (a1 a2))
     -> (kap         () E K (procedure Xf (Mf) Ef) (a1 a2))    (val a3)
     -> (kap         () E K (procedure Xf (Mf) Ef) (a1 a2 a3)) (apply)
-> Mf ((Xf . (a1 a2 a3)) . Ef) K

ところが、 Scheme は、 実引数をどのような順番で評価してもかまわないことになっているので、 実引数の最後から先頭へと逆順に評価しても良いわけです。 そうすることで、 引数のリストを cons で低コストに作れるようになりますし、 継続で手続きを覚えておく必要もなくなります。

(M M1 M2 M3) E K
-> M3 E (arg (M2 M1 M) E K         ())
     -> (arg (M2 M1 M) E K         ()) (val a3)
-> M2 E (arg    (M1 M) E K       (a3))
     -> (arg    (M1 M) E K       (a3)) (val a2)
-> M1 E (arg       (M) E K    (a2 a3))
     -> (arg       (M) E K    (a2 a3)) (val a1)
-> M  E (apply      () E K (a1 a2 a3))
     -> (apply      () E K (a1 a2 a3)) (val (procedure Xf (Mf) Ef))
-> Mf ((Xf . (a1 a2 a3)) . Ef) K

アプリケーションを逆順に書き直すなら、 ついでに継続でおこなう処理も一緒に書き込んでしまいます。 これで、 どの継続摘要をどのタイミングでおこなうべきかをコード化できるため、 評価を 1 フェーズでおこなえるようになります。

(M M1 M2 M3) E K
== M3      E (((arg) M2 (arg) M1 (arg) M (apply)) E K         ()) A
-> (arg)   E (      (M2 (arg) M1 (arg) M (apply)) E K         ()) (val a3)
-> M2      E (         ((arg) M1 (arg) M (apply)) E K       (a3)) (val a3)
-> (arg)   E (               (M1 (arg) M (apply)) E K       (a3)) (val a2)
-> M1      E (                  ((arg) M (apply)) E K    (a2 a3)) (val a2)
-> (arg)   E (                        (M (apply)) E K    (a2 a3)) (val a1)
-> M       E (                          ((apply)) E K (a1 a2 a3)) (val a1)
-> (apply) E (                                 () E K (a1 a2 a3)) (val (procedure Xf (Mf) Ef))
-> Mf ((Xf . (a1 a2 a3)) . Ef) K

だいぶ 3imp VM に近づきました。 さらに、 環境レジスタ e と実引数リスト r を書き換えるのは手続きを apply するときだけなので、 途中の M3、M2、M1、M がアプリケーションのときに限ってそれぞれで継続を作成するようコード化すると 3imp VM になります。

ところで、 3imp VM は CEK マシン用なので、 apply 命令はジャンプします。 そのため、 単に apply するだけで末尾ジャンプできます。 さらに、 ジャンプと同時にレジスタ r のリストを空にしておくことで、 ジャンプ先ですぐに実引数リストを作り始めることができるように工夫してあります。 なお、 arg は命令コードでは argument です。 さらに、 3imp VM は入れ子リスト構造になっており、 そのままではとても読みにくいのでフラットに並べ替えたリストに書き直しておきます。

(M M1 M2 M3) e s r a
== (M3 (argument) M2 (argument) M1 (argument) M (apply)) e s         () a
->    ((argument) M2 (argument) M1 (argument) M (apply)) e s         () a3
->               (M2 (argument) M1 (argument) M (apply)) e s       (a3) a3
->                  ((argument) M1 (argument) M (apply)) e s       (a3) a2
->                             (M1 (argument) M (apply)) e s    (a2 a3) a2
->                                ((argument) M (apply)) e s    (a2 a3) a1
->                                           (M (apply)) e s (a1 a2 a3) a1
->                                             ((apply)) e s (a1 a2 a3) (procedure Xf (Mf) Ef)
->                             Mf ((Xf . (a1 a2 a3)) . Ef) s         () (procedure Xf (Mf) Ef)

まず継続作成が不要な簡単な場合から。 例えば、 M3、 M1、 M が定数か変数参照のときは、 環境レジスタ e も、 実引数リスト・レジスタ r も変化しません。 なので、 これらには継続作成は不要です。

(f 0 M2 10)
== ((constant 10) (argument) M2 (argument) (constant 0) (argument) (refer f) (apply))

M2 がアプリケーションのとき、 環境レジスタ e と実引数リスト・レジスタ r を上書きするので、 継続を作成する必要があります。 継続を作成する命令は frame の名称になっていて、 「すぐに実行する部」と「後で実行する部」の両方を指定します。 「後で実行する部」は M2 の評価結果を実引数リストへ加えるところから後半の部分すべてになります。 frame 命令の状態遷移はとても簡単です。 継続レジスタ s へ「後で実行する部」と 2 つのレジスタ e r の内容をセーブしてから、 r レジスタのリストを空にします。 そして「すぐに実行する部」の遷移を始めます。

M2 のアプリケーション評価が終わると、 どこかで継続摘要がおこなわれて、 frame で作成しておいた継続の遷移が始まります。 継続摘要をおこなう命令は return で、 定数評価の直後に挿入するのがパターンです。 また、 apply 命令でプリミティブ摘要をするときも、 return と同じ継続摘要をおこなうように遷移させます。

(f 0 (g x) 10)
== ((constant 10) (argument)
    (frame
      ((argument) (constant 0) (argument) (refer f) (apply))  ; 後で実行する部
      ((refer x) (argument) (refer g) (apply))))              ; すぐに実行する部

遷移

((frame C M)) e  s           r  a  ->  M e (C e r . s) () a
((return))    e' (C e r . s) r' a  ->  C e s           r  a

極端な話、 実引数の定数の評価に frame と return を挿入しても正しく動作しますが、 作成した継続を即座に廃棄するだけで、 こんなコードを生成するのは無駄です。

((frame
   ((argument) M2 (argument) (constant 0) (argument) (refer f) (apply))
   ((constant 10) (return))))

   ((frame C M))            e s              () a 
-> ((constant 10) (return)) e (C e () . s)   () a
-> ((return))               e (C e () . s)   () 10
-> ((argument) M2 ...)      e s              () 10
-> (M2 ...)                 e s            (10) 10

2017年03月24日

[]SICP 積極制御評価器と CEK マシンの関係

サスマン「計算機プログラムの構造と解釈 第二版」(以下 SICP) 5.4 節記載の Scheme の積極制御評価器は、 いきなりレジスタ計算機のアセンブリのソースがずらずらと並んでいて見落としがちですけど、 CEK マシンを実装したものになっています。 というよりも、 時系列ではおそらく逆で、 この評価器や ML の評価器の動作を整理していった結果として、 CEK マシンへと至ったのが真相なのでしょう。

CEK マシンのレジスタとの対応関係を読み取ると、 K レジスタが参照する継続オブジェクトのメンバを頻繁に利用するため、 メンバをレジスタへ割り当ててあることがわかります。 さらに、 SICP Scheme は現在の継続を扱わないため、 浅い束縛でレジスタの値をスタックへセーブ・リストアしつつ評価をおこないます。 レジスタ名や値の表記には、 SICP だけでなく、 Dybvig Three Implementation Models for Scheme (以下 3imp)のヒープベース VM との関係を見る目的も兼ねて、 3imp VM のレジスタ表記にも一部合わせてあります。 ちなみに、 3imp ヒープベース VM は、 スタックベース VM への布石として、 あれはあれで興味深いものです。

レジスタ

              CEK マシン    3imp VM     積極制御評価器
                      C     x           exp
                      E     e           env
     K=(tag C E K fn R)     s           スタック
                  K.tag                 continue
                    K.C                 unev
                    K.K                 スタックを使ってリストにしていないのでなし。
                   K.fn     aが兼ねる   proc
                    K.R     r           args

              K (val a)     a           val

CEK マシンは 2 フェーズでλ関数を評価します。 最初のフェーズは CEK の 3 組で始まり、 評価対象の式 M を C レジスタに置いて状態遷移を開始します。 このフェーズが進み値 a が得られると次のフェーズに移り、 K レジスタの継続へ値を摘要します。 ここでは継続摘要を K (val a) と表記することにします。さらに、 積極制御評価器は apply フェーズを加えて 3 フェーズになっているので、 これも便宜的に K (apply) と書くことで apply フェーズに入ることを示すことにします。

最初の CEK で始まるフェーズは、 積極制御評価器の eval_dispatch ラベルで始まる箇所に相当します。 continue、unev、env レジスタをスタックへプッシュして、 それらを上書きする箇所で継続を成長させています。 継続摘要フェーズへ移るときは、 val レジスタに値を置いて、 continue レジスタの指すラベルへジャンプします。

a は定数 (数値、文字列、クロージャ・オブジェクト)
x はシンボル
M M+ M* X はリスト、  M* は () であっても良く、 M+ は (M . M*)

                             a E K  ->  K (val a)           ;(number? a)
                             a E K  ->  K (val a)           ;(string? a)
                     (quote a) E K  ->  K (val a) 
                             x E K  ->  K (val a)           ;a==(ref (varf x E))
               (lambda X . M+) E K  ->  K (val (procedure E X . M+))     ;注1
                    (set! x M) E K  ->  M E (kst x  E K)
                  (define x M) E K  ->  M E (kdf x  E K)
         (define (x . X) . M+) E K  ->  (lambda X . M+) E (kdf x E K)
                   (if M . M+) E K  ->  M E (kif M+ E K)
                     (begin M) E K  ->  M E K
                (begin M . M+) E K  ->  M E (ksq M+ E K)
                      (M . M*) E K  ->  M E (kfn M* E K)

注1: lambda 形式の本体 M+ に含まれる define 形式を letrec へ置き換える処理を
     おこなってからクロージャを作成する *べき* だが、 SICP では省いてある。

継続適応フェーズの左辺は E レジスタに依存しないので省いています。 SICP では、 個々の遷移をラベルに分けて記述してあります。 その中での、 スタックへの save/restore 操作と状態遷移の K の変化がぴったりと一致しています。

  (kst x        E K) (val a)        ->  K (val OK)          ;(setf! (varf x E) a)
  (kdf x        E K) (val a)        ->  K (val OK)          ;(define-var x a E)
  (kif (M . M*) E K) (val a)        ->  M E K               ;a != #f
  (kif (M1 M)   E K) (val #f)       ->  M E K
  (kif (M1)     E K) (val #f)       ->  K (val #f)
  (ksq (M . M+) E K) (val a)        ->  M E (ksq M+ E K)
  (ksq (M)      E K) (val a)        ->  M E K
  (kfn (M . M*) E K) (val fn)       ->  M E (kap M* E K fn ())
  (kap (M . M*) E K fn R) (val a)   ->  M E (kap M* E K fn R1)
  (kfn ()       E K) (val fn)       ->  (kap () E K fn ()) (apply)
  (kap ()       E K fn R) (val a)   ->  (kap () E K fn R1) (apply)
                                                            ;R1==(append R (list a))

最後は apply フェーズです。 ここも左辺から E レジスタを省いています。 ラベルは apply_dispatch になっていて、 このフェーズは proc と args レジスタを使います。 プリミティブ摘要では val に計算結果を置いて、 continue にジャンプします。 アプリケーションではクロージャ・オブジェクトの環境にフレームをつないで env レジスタに置き、 CEK フェーズに入ります。

(kap () E' K (primitive op)         R) (apply)  ->  K (val (apply-primitive op R))
(kap () E' K (procedure E X M)      R) (apply)  ->  M ((X . R) . E) K
(kap () E' K (procedure E X M . M+) R) (apply)  ->  M #0=((X . R) . E) (ksq M+ #0# K)

2017年03月17日

[][]トライ木主導の字句解析器の試行

プログラミング言語 Oberon-0 の字句解析をトライ木をメインに使うやりかたで書いてみました。 この言語は多数のキーワードが定義されていて、 トライ木はキーワードと記号にマッチするように作ってあります。 キーワードの途中で失敗したときに、 識別子として解析を続けるようにします。 コメント開始記号はトライ木でマッチした後にそれぞれ用の関数で解析を続けます。 この手の字句解析を決定性オートマトンで記述すると状態のほとんどがキーワードや記号のトライが食いつぶしてしまって、 無駄が増えてしまいます。 なので、 トライ部分はトライとしてダブル配列で扱い、 そうでない残りは関数で処理することにしたわけです。

トライ木のダブル配列は静的に作成したものを使っています。 テーブルの生成には Ruby で書いてあります。

トライが扱う文字のコード化で、 制御文字を空白へ、 数字をゼロへ英小文字を a へと縮退したものを使って、トライの条件分岐サイズを抑えてあります。

# excludes [\x00- 1-9b-z]
i = 2
codes = {}
('!'.ord .. '0'.ord).each{|c| codes[c.chr] = i; i += 1 }
(':'.ord .. 'a'.ord).each{|c| codes[c.chr] = i; i += 1 }
('{'.ord .. '~'.ord).each{|c| codes[c.chr] = i; i += 1 }

キーワードは Oberon-0 コンパイラに合わせて Oberon-07 のものも含めてあり、 Oberon-0 で使わないリザーブ・キーワードを見つけると警告を表示して無視する方針にしています。 トークンの番号は Oberon-0 コンパイラのものに合わせています。

symbols = {
  :null => 0, :times => 1, :div => 3, :mod => 4,
  :and => 5, :plus => 6, :minus => 7, :or => 8, :eql => 9,
  :neq => 10, :lss => 11, :leq => 12, :gtr => 13, :geq => 14,
  :period => 18, :char => 20, :int => 21, :false => 23, :true => 24,
  :not => 27, :lparen => 28, :lbrak => 29,
  :ident => 31, :if => 32, :while => 34, :repeat => 35,
  :comma => 40, :colon => 41, :becomes => 42, :rparen => 44,
  :rbrak => 45, :then => 47, :of => 48, :do => 49,
  :semicolon => 52, :end => 53,
  :else => 55, :elsif => 56, :until => 57,
  :array => 60, :record => 61, :const => 63, :type => 64,
  :var => 65, :procedure => 66, :begin => 67, :module => 69,
  :eof => 70
}
tokens = [
  [:neq, '#'], [:and, "&"], [:null, "(*"], [:lparen, "("], [:rparen, ")"],
  [:times, "*"], [:plus, "+"], [:comma, ","], [:minus, "-"], [:period, "."],
  [:null, "/"], [:becomes, ":="], [:colon, ":"], [:semicolon, ";"],
  [:lss, "<"], [:leq, "<="], [:eql, "="], [:gtr, ">"], [:geq, ">="],
  [:lbrak, "["], [:rbrak, "]"], [:not, "~"], [:array, "ARRAY"],
  [:begin, "BEGIN"], [:null, "BY"], [:const, "CONST"], [:div, "DIV"],
  [:do, "DO"], [:else, "ELSE"], [:elsif, "ELSIF"], [:end, "END"],
  [:false, "FALSE"], [:null, "FOR"], [:if, "IF"], [:null, "IMPORT"],
  [:null, "IN"], [:null, "IS"], [:mod, "MOD"], [:module, "MODULE"],
  [:null, "NIL"], [:of, "OF"], [:or, "OR"], [:null, "POINTER"],
  [:procedure, "PROCEDURE"], [:record, "RECORD"], [:repeat, "REPEAT"],
  [:null, "RETURN"], [:then, "THEN"], [:null, "TO"], [:true, "TRUE"],
  [:type, "TYPE"], [:until, "UNTIL"], [:var, "VAR"], [:while, "WHILE"],
]

tokens からトライ木を作成し、 さらにそれをダブル配列にします。 ここはセオリー通りでなんのひねりもありません。

def create_trie(tokens, codes, symbols)
  rule = [[]]
  tokens.each do |tk, kw|
    state = 0
    kw.each_char do |c|
      state1 = rule[state][codes[c]]
      if state1.nil?
        state1 = rule.size
        rule << []
        rule[state][codes[c]] = state1
      end
      state = state1
    end
    rule[state][1] = symbols[tk]
  end
  rule
end

def compact_table(rule)
  base = [0, 0]
  check = [0, 0]
  modify_table(base, check, rule, 0, 1)
  check.each_index{|x| base[x] ||= 0; check[x] ||= 0 }
  offset = base.min
  if offset < 0
    base.each_index{|x| base[x] -= offset }
  end
  [base, check]
end

def modify_table(base, check, rule, rule_state, base_state)
  row = rule[rule_state]
  b = row.index{|x| not x.nil? }
  d = row.rindex{|x| not x.nil? }
  base[base_state] = -b
  until (b .. d).all?{|i| row[i].nil? or check[base[base_state] + i].nil? }
    base[base_state] += 1
  end
  (b .. d).each do |i|
    if row[i]
      base[base[base_state] + i] = 0
      check[base[base_state] + i] = base_state
    end
  end
  if rule[rule_state][1]
    base[base[base_state] + 1] = rule[rule_state][1]
  end
  (2 ... rule[rule_state].size).each do |c|
    if rule[rule_state][c]
      modify_table(base, check, rule, rule[rule_state][c], base[base_state] + c)
    end
  end
end

C++11 に作成した表を組み込んで使います。

static const long MAXINT = 2147483647L;

enum {
    TNULL      =  0, TTIMES     =  1, TDIV       =  3, TMOD       =  4,
    TAND       =  5, TPLUS      =  6, TMINUS     =  7, TOR        =  8,
    TEQL       =  9, TNEQ       = 10, TLSS       = 11, TLEQ       = 12,
    TGTR       = 13, TGEQ       = 14, TPERIOD    = 18, TCHAR      = 20,
    TINT       = 21, TFALSE     = 23, TTRUE      = 24, TNOT       = 27,
    TLPAREN    = 28, TLBRAKET   = 29, TIDENT     = 31, TIF        = 32,
    TWHILE     = 34, TREPEAT    = 35, TCOMMA     = 40, TCOLON     = 41,
    TBECOMES   = 42, TRPAREN    = 44, TRBRAKET   = 45, TTHEN      = 47,
    TOF        = 48, TDO        = 49, TSEMICOLON = 52, TEND       = 53,
    TELSE      = 55, TELSIF     = 56, TUNTIL     = 57, TARRAY     = 60,
    TRECORD    = 61, TCONST     = 63, TTYPE      = 64, TVAR       = 65,
    TPROCEDURE = 66, TBEGIN     = 67, TMODULE    = 69, TEOF       = 70,
};

enum { NTOK_CHECK = 187 };
static const unsigned char TOK_BASE[NTOK_CHECK] = {
      2,   0,   4,  12,   7,   5,   2,  23,  16,  22,  30,  31,  34,  35,
     40,  46,  42,  48,  49,  53,  54,   3,  30,  15,  35,  32,  44,  49,
     68,   8,  42,  71,   7,   9,  20,  73,  86,  92,  86,   2, 113,  43,
    125, 134, 153, 149,  44,  54,  13, 185,  14, 186,  11,  15,  16,  16,
     34,  11,  61, 187,  62,  47,  34,  33,  29,  67,  69,   2,  51,  34,
     30,  30,  75,  55,  65,  32,  78,   5,  51,  53,  87,  79,  68,  38,
     59,  63,  57,  89,  58,  91,  55,  58,  52,  67,  96,  25,  98,   2,
     34,  99,  64,  62,  61, 105,   2,  56,  62, 109,   2,   2,  85, 114,
    110,   6,  88, 117,  71,  84, 120,   2, 122,  50,  10,  93,  89,  85,
     94, 101,  89, 131,   2, 108, 123, 107, 109,  93,  97, 111, 140,  68,
    116, 105, 103, 118, 146,  63, 124, 106, 150,  37, 111, 116, 154,   2,
    119, 129, 123,  80, 107, 161,  49,   2, 162, 137, 167, 120,  26, 141,
    170,  66, 129, 142, 129, 140, 176,  59, 137, 179,  67, 149, 147, 155,
    184,  36,  31,  47,  29,
};
static const unsigned char TOK_CHECK[NTOK_CHECK] = {
      0,   0,   1,   2,   5,   1,  32,   1,   1,   1,   1,   1,   1,   1,
      1,   8,   1,   1,   1,   1,   1,   9,   7,   1,   1,   1,   1,   1,
      1,  10,  11,   1,   7,  12,  13,   1,   1,   1,   1,  14,   1,  16,
      1,   1,   1,   1,  61,  17,  18,   1,  68,   1,  19,  20,  73,  23,
     55,  56,  57,   1,  58,  16,  24,  62,  63,  64,  65,  82,  18,  25,
     69,  70,  71,  20,  72,  26,  75,  76,  81,  83,  79,  26,  24,  27,
     79,  27,  80,  84,  87,  85,  89,  28,  91,  92,  93,  94, 105,  96,
     99,  31, 106, 100, 101, 102, 103,  28,  31,  31, 107, 112,  35, 110,
     31, 111, 157, 114, 115,  36, 117, 118,  37, 120, 132,  38, 123, 124,
     38, 125, 127, 128, 129, 126,  37, 131, 133, 134, 135, 136, 137, 138,
     40, 140, 141, 142, 143, 144, 154, 146, 147, 148, 158, 150, 151, 152,
    140,  42, 155, 111, 140, 156, 159, 162,  42, 165, 163,  42, 164, 172,
    167, 168,  43, 170,  42, 171, 173, 174,  44, 176, 177,  45, 179, 180,
    181, 182,  49,  51,  59,
};

Oberon-0 コンパイラと同じで、 字句解析部へエラー時のソースコード行表示機能をあわせ持たせます。

struct scanner_type {
public:
    int m_sym;
    long m_value;
    std::string m_id;
    std::string m_filename;

    explicit scanner_type (std::string const& str);
    void get (void);
    void report_error (char const* msg);
    int error_count (void);

private:
    void getch (void);
    void identifier (void);
    void number (void);
    void comment (void);

    std::string::const_iterator m_text;
    std::size_t m_size;
    std::size_t m_pos;
    int m_error_count;
    int m_ch;
    int m_line;
    int m_column;
};

字句解析オブジェクトは、 コンストラクタへソース・コード全体を文字列にして作成します。 コンパイラ作成例題用の簡易言語なので、 ソースコードが長くなることは、 おそらくないでしょうから文字列に全部いれても問題ないでしょう。

scanner_type::scanner_type (std::string const& str)
    : m_id (), m_filename (), m_text (str.cbegin ()), m_size (str.size ()), m_pos (0)
{
    m_error_count = 0;
    m_ch = 0;
    m_line = 1;
    m_column = 0;
    getch ();
}

字句解析の中心部分である get メンバ関数は字句を一つ切り出す働きをします。 まず空白を読み飛ばして字句が数字で始まるときは数値リテラルとして読み取ります。 また、 英小文字で始まるときに識別子として読み取ります。 他の場合は上のトライ木を使って記号とキーワードを読み取っていきます。 英大文字でキーワードを読み終わる前に失敗したときは識別子として読み取りを続けます。 またキーワードの読み取りが終わっても英数字が続くときはキーワードではなく識別子として読み取ります。

void
scanner_type::get (void)
{
    int const base0 = TOK_BASE[0];
    do {
        while (0 <= m_ch && m_ch <= ' ')
            getch ();
        m_sym = TNULL;
        m_id.clear ();
        m_value = 0;
        if (m_ch < 0) {
            m_sym = TEOF;
        }
        else if (std::isdigit (m_ch)) {
            number ();
        }
        else if (std::islower (m_ch)) {
            identifier ();
        }
        else {
            int const alt = std::isupper (m_ch) ? TIDENT : TNULL;
            int next_state = 1;
            while (next_state > 0 && m_ch >= 0) {
                int const state = next_state;
                next_state = 0;
                int const code = m_ch > 'z' ? m_ch - ('{' - 58)
                               : m_ch > 'a' ? 'a'  - (':' - 18)
                               : m_ch > '9' ? m_ch - (':' - 18)
                               : m_ch > '0' ? '0'  - ('!' -  2)
                               : m_ch > ' ' ? m_ch - ('!' -  2)
                               : 0;
                int const i = TOK_BASE[state] - base0 + code;
                int const j = TOK_BASE[state] - base0 + 1;
                if (0 < i && i < NTOK_CHECK && TOK_CHECK[i] == state)
                    next_state = i;
                else if (alt == TIDENT && std::isalnum (m_ch))
                    identifier ();
                else if (0 < j && j < NTOK_CHECK && TOK_CHECK[j] == state)
                    m_sym = TOK_BASE[j] - base0;
                else
                    m_sym = alt;
                if (1 == state || next_state > 0) {
                    m_id.push_back (m_ch);
                    getch ();
                }
            }
            if (m_id == "(*")
                comment ();
            else if (m_sym == TNULL && alt == TIDENT)
                report_error ("reserved keyword");
            else if (m_sym == TNULL)
                report_error ("unrecognized symbol");
        }
    } while (m_sym == TNULL);
}

識別子は英数字列を読み取れるだけ読み取って、 長さリミットを越えていたらエラーを表示します。

void
scanner_type::identifier (void)
{
    m_sym = TIDENT;
    while (std::isalnum (m_ch)) {
        m_id.push_back (m_ch);
        getch ();
    }
    if (m_id.size () > 64)
        report_error ("too long identifier");
}

数字は 10 進数の符号なし整数しか実装しません。 長すぎたり数字の直後に空白をおかずに識別子が置いてあるときはエラーを発生するようにしています。 また 32 ビット符号整数の範囲を越えたときもエラーを投げます。

void
scanner_type::number (void)
{
    m_sym = TINT;
    int state = 1;
    while (std::isalnum (m_ch)) {
        if (1 != state)
            ;
        else if (m_ch > '9')
            state = 3;
        else if (m_value < (MAXINT - (m_ch - '0')) / 10)
            m_value = m_value * 10 + (m_ch - '0');
        else
            state = 2;
        m_id.push_back (m_ch);
        getch ();
    }
    if (1 != state)
        m_value = 0;
    if (2 == state)
        report_error ("too large number");
    else if (3 == state)
        report_error ("illegal digits");
    else if (m_id.size () > 64)
        report_error ("too long digits");
}

コメントに入れ子を許します。 カウンタを使って入れ子を追跡します。

void
scanner_type::comment (void)
{
    int level = 1;
    int state = 1;
    while (level > 0) {
        if (m_pos >= m_size) {
            report_error ("comment not closed");
            break;
        }
        if (2 == state && ')' == m_ch) {
            --level;
            state = 1;
        }
        else if (3 == state && '*' == m_ch) {
            ++level;
            state = 1;
        }
        else {
            state = '*' == m_ch ? 2 : '(' == m_ch ? 3 : 1;
        }
        getch ();
    }
}

getch はソースコードから一文字読み取ります。 単に読み取るだけでなく、 エラー表示に備えて行番号とカラム位置も合わせて更新していきます。

void
scanner_type::getch (void)
{
    if (m_pos >= m_size) {
        m_ch = -1;
    }
    else {
        if ('\n' == m_ch) {
            ++m_line;
            m_column = 0;
        }
        ++m_column;
        m_ch = m_text[m_pos++];
    }
}

エラーを表示します。 エラーのフォーマットは Clang のようにしておきました。

void
scanner_type::report_error (char const* msg)
{
    std::size_t const q = m_pos - 1;
    ++m_error_count;
    std::cerr << m_filename << ":" << m_line << ":" << m_column
        << ": error: " << msg << std::endl;
    for (std::size_t p = q - m_column + 1; p < m_size && '\n' != m_text[p]; ++p)
        std::cerr.put (m_text[p]);
    std::cerr << std::endl;
    for (std::size_t i = q - m_column + 1; i < q; ++i)
        std::cerr.put (' ');
    std::cerr << "^" << std::endl;
}