$式: S式にHaskellの$を持ち込んで括弧が自動で閉じるようにしてみた

はじめに

この記事は　NEET Advent Calendar 2013 の参加記事です。

傍目に見てとてもカオスなAdventCalendarがあったので、こういう物を投げ込んでも大丈夫かもと思い参加しました。筆者も躁鬱病持ちなのでぜひ参加させてください。この記事によりカオス度が増すことが参加者増加に貢献することを願います。

ドル式

$式という物を考えました。S式(えすしき)ではなくて$ 式(どるしき)です。JSONに対するYAMLのような感じです。

こういう具合です。

partition.scm

(define (partition pred lis)
  (let recur ((lis lis))
    (if (null-list? lis)
      (values lis lis)
      (let ((elt (car lis))
            (tail (cdr lis)))
        (receive (in out) (recur tail)
          (if (pred elt)
            (values (if (pair? out) (cons elt in) lis) out)
              (values in (if (pair? in) (cons elt out) lis)))))))))
;
;                         ↓ ↑
;
$ define $ partition pred lis
  $ let recur $ $ lis lis
    $ if $ null-list? lis
      $ values lis lis
      $ let $ $ elt  $ car lis
              $ tail $ cdr lis
        $ receive (in out) $ recur tail
          $ if $ pred elt
            $ values $ if (pair? out) (cons elt in) lis
                     out
            $ values in
                     $ if (pair? in) (cons elt out) lis

アイデアの概要

閉じカッコを省略できるS式の構文糖を考えました。インデントの具合から閉じカッコを補完できます。

Haskellの$と一見似たように見えますが、あちらは中置でこちらは前置です。

$式パーサはカッコの中には干渉しないので、$式のパーサはS式のパーサとして（だいたい）後方互換で使えます。

S式と$式はJSONと(ややこしくない範囲の)YAMLのような関係にあります。精神としては、これは括弧を排除するものではなく、閉じ括弧をサボるためのものです。

GaucheとHaskellで半端に実装したものはありますが、考えた仕様通りにはなっていません。どなたか作ってくださると助かります。

使用例

$式で書いたできそこないの型推論機を図として一応載せます（動くかどうかはともかく、字面を見てください）。普通のカッコと混在している様子がわかると思います。

$ define-module infer
  $ use srfi-1
  $ use srfi-27
  $ use srfi-13
  $ use util.match
  $ use text.tr
  $ export
      infer
      generate-expr
      pretty-expr
      <infer-error>
      <infer-internal-error>
      <infer-type-mismatch-error>
      <infer-type-loop-error>
      <infer-syntax-error>
 
$ select-module infer
 
$ define-class <infer> $
  $ $ type-count :init-value -1
    $ cxt :init-value '()
 
$ define-condition-type <infer-error> <error> #f
$ define-condition-type <infer-internal-error> <infer-error> #f
$ define-condition-type <infer-type-mismatch-error> <infer-error> #f
$ define-condition-type <infer-type-loop-error> <infer-error> #f
$ define-condition-type <infer-syntax-error> <infer-error> #f
 
$ define-method newtype! $ (self <infer>)
  $ inc! $ ref self 'type-count
  $ ref self 'type-count
 
$ define-method add-substitution! $ (self <infer>) var type
  $ update! $ ref self 'cxt
    $ ^ $ cxt
      $ and-let $ $ entry $ assq var cxt
        $ error <infer-internal-error> "already registered" entry
      $ acons var type cxt
 
$ define-method infer $ expr env
  $ infer (make <infer>) expr env
 
$ define-method infer $ (self <infer>) expr env
  $ check-syntax expr
  $ make-typevar-readable $ resolve self $ infer-raw self expr env
 
$ define-method infer-raw $ (self <infer>) expr env
  $ let1 texpr $ newtype! self
    $ check self texpr expr env
    texpr
 
$ define $ number->symbol n
  $ unless $ <= 0 n (- (* 26 27) 1)
    $ error <infer-internal-error> #`"n must be between 0..,(- (* 26 27) 1)" n
  $ string->symbol
    $ tr "0-9a-p" "a-z"
      $ (cut string-copy <> 1)
        $ number->string (+ n (* 26 25)) 26
 
$ define $ memoize value-proc
  $ let1 dict '()
    $ ^ $ key
      $ or $ assq-ref dict key
           $ let1 value $ value-proc key
             $ push! dict $ cons key value
             value
 
$ define $ make-typevar-readable type
  $ let1 count -1
    $ rewrite-type type
      $ memoize
        $ ^_ $ inc! count
             $ number->name count
 
$ define $ rewrite-type type lookup
  $ let loop $ $ t type
    $ cond
      $ $ pair? type
        $ map loop type
      $ $ symbol? type
        type
      $ $ number? type
        $ lookup type
      $ else
        $ error <infer-internal-error> "unexpected type:" type
 
$ define-method resolve $ (self <infer>) n
  $ let1 cxt $ ref self 'cxt
    $ let loop $ $ n n
                 $ history '()
      $ cond
        $ $ memq n history
          $ raise <infer-type-loop-error> "loop detected" history n
        $ $ number? n
          $ let1 d $ assq-ref cxt n
           $ if d
              $ loop d $ cons n prev
              n
        $ $ pair? n
          $ map (cut loop <> (cons n prev)) type
        $ $ symbol? n
          n
        $ $ null? type
          $ error <infer-internal-error> "definition not found" n prev
        $ else
          $ error <infer-internal-error> "unexpected query" n prev
 
$ define-method unify $ (self <infer>) a b
  $ let $ $ a $ resolve self a
          $ b $ resolve self b
    $ cond
      $ $ and (pair? a) (pair? b) (= (length a) (length b))
        $ for-each (cut unify self <> <>) a b
      $ $ and (number? a) (number? b)
       ; as both are tip (local minimum), ensured by resolve, we can just join the set
        $ let1 t $ newtype! self
          $ add-substitution! self a t
          $ add-substitution! self b t
      $ $ number? a
        $ add-substitution! self a b
      $ $ number? b
        $ add-substitution! self b a
      $ $ equal? a b
        'ok
      $ else
        $ error <infer-type-mismatch-error> "type mismatch" a b
 
$ define-method unify-as-function $ (self <infer>) expected-type
  $ let1 t $ resolve self expected-type
    $ if $ pair? t
      t
      $ let1 pair $ cons $ newtype! self
                         $ newtype! self
        $ unify self pair expected-type
        pair
 
$ define $ refresh-type-variables type
  $ rewrite-type type
    $ memoize
      $ ^n $ if $ >= n 0
                n
                $ newtype! self
 
$ define-method check $ (self <infer>) expected-type expr env
  $ cond
    $ $ symbol? expr
      $ let1 t $ assq-ref (ref self 'env) expr
        $ unless t
          $ raise <infer-error> "type not found:" expr
        $ unify self expected-type $ refresh-type-variables t
    $ $ pair? expr
     $ case $ car expr
       $ $ ^
         $ check-abs self expected-type expr env
       $ $ let
         $ check-let self expected-type expr env
       $ else
         $ check-app self expected-type expr env
    $ $ number? expr
      $ unify self expected-type 'num
    $ $ boolean? expr
      $ unify self expected-type 'bool
    $ $ null? expr
      $ unify self expected-type 'null
    $ else
      $ error <infer-internal-error> "unknown expression" expr
 
$ define $ generalize type env
    $ let $ $ ftv $ collect-free-type-variables env
            $ count 0
      $ rewrite-type $ resolve type
        $ memoize
          $ ^t
            $ if $ memq t ftv
              t
              $ begin
                $ inc! count
                $ - count
 
$ define $ collect-free-type-variables env
  $ map resolve
    $ filter $ every-pred number? ($ <= 0 $)
      $ apply append
        $ map cdr env
 
$ define-method check-let $ (self <infer>) expected-type expr env
  ; actually it's let1
  $ match-let1 (_ var var-expr body) expr
    $ let* $ $ tvar    $ newtype! self
             $ var-env $ acons var tvar newtype
      $ check tvar var-expr var-env
      $ let1 body-env $ acons var (generalize tvar var-env) var-env
        $ check self expected-type body body-env
 
$ define-method check-app $ (self <infer>) expected-type expr env
  $ let1 callee-type $ newtype! self
    ; currying
    $ case $ length expr
      $ [1] $ error <infer-syntax-error> "malformed application" expr
      $ [2] $ check self callee-type (car expr) env
      $ else $ check-app self callee-type (drop-right expr 1) env
    $ match-let1 (targ . tresult) $ unify-as-function self callee-type
      $ check self targ (last expr) env
      $ unify self tresult expected-type
 
$ define-method check-abs $ (self <infer>) expected-type expr env
  $ match-let1 (targ . tresult) $ unify-as-function self expected-type
    $ match expr
      $ (_ ((? symbol? arg) rest ..1) body)
        $ check-abs self tresult `(^ ,rest ,body) $ acons arg targ env
      $ (_ (or ((? symbol? arg)) (? symbol? arg)) body)
        $ check self tresult body $ acons arg targ env
      $ else
        $ error <infer-syntax-error> "malformed lambda" expr
 
$ define $ check-syntax expr
  $ match expr
    $ $ _
      $ error <infer-syntax-error> "application without argument is not allowed" expr
    $ ('^ . args-and-body)
      $ match args-and-body
        $ ((or (? symbol?) ((? symbol?) ..1)) body)
          $ check-syntax body
        $ else
          $ error <infer-syntax-error> "malformed lambda" expr
    $ ('let . bind-and-body)
      $ match bind-and-body
        $ $ (? symbol?) bind-expr body
          $ check-syntax bind-expr
          $ check-syntax body
        $ else
          $ error <infer-syntax-error> "malformed let" expr
    $ $ ? pair?
      $ for-each check-syntax expr
    $ else
      'ok
 
$ define $ pretty-expr e
  $ match e
    $ $ '^ arg body
      #`"(\\,arg -> ,(pretty-expr body))"
    $ $ 'let var expr body
      #`"(let ,var = ,(pretty-expr expr) in ,(pretty-expr body))"
    $ $ ? pair?
      #`"(,(string-join (map prety-expr e)))"
    $ else
     $ x->string e
 
$ define $ generate-expr depth
  $ define var!
    $ let1 count -1
      $ ^ $ 
        $ inc! count
        $ number->name count
  $ let loop $ $ depth depth
               $ vars '()
    $ case $ cond
            $ $ < depth 0
              2
            $ $ and (= depth 0) (null? vars)
              1
            $ else
              $ random-integer $ if (null? vars) 2 3
      $ $ 0
        $ list $ loop (- depth 1) vars
               $ loop (- depth 1) vars
      $ $ 1
        $ let1 v $ var!
          $ if $ zero? $ random-integer 1
            $ list '^   v $ loop (- depth 1) $ cons v vars
            $ list 'let v $ loop (- depth 1) $ cons v vars
                          $ loop (- depth 1) $ cons v vars
      $ else
        $ ref vars $ random-integer $ length vars

文法の説明

$を開き括弧と考えた時、「普通こう字下げされてたらここで閉じるよな」というところで括弧が自動的に閉じます。

$式の字句構造はほぼS式と同様です。ただし、$を「開きカッコマーカー」と呼び、特別に扱います。

イメージとしては、$式用の(read)関数はこういう動作をします。

• アトムやカッコやクォートはそのままS式と同じように読み込む。
• $ があったらそれよりも見た目的に右側にある$式を繰り返し読み込み、リストにまとめて返す。

つまり、マーカはそこよりも右下に始点があるトークンをすべてカッコに囲みます。
トークンの始点とは、そのトークンを構成する最初の文字のことです。

構文糖の解釈後マーカ自身は消えてなくなり、代わりに開きカッコが置かれます。
それに対応する閉じカッコは、$よりも左下か真下に始点があるトークンが現れたとき、その手前に挿入されたものとして扱います。（←注意してください、ここが唯一のぼんやりしていない定義です）

感覚的には、「$から右下にテキストを選択して囲む」という感じです(始点だけ見るので、矩形選択ではなく普通の選択です)。

たとえば、以下の内容は

$ "foo
bar" $ baz
   quu
"qux"

次のように書いたのと同様です。

( "foo
bar" (baz)
  quu)
"qux"

何の役に立つの？

$式はCSSに対するSassやHTMLに対するHamlと違って、特に機能が増えるわけではありません。$式の表す構造はS式と同じです。

グラフィカルなS式エディタに魅力は感じるものの、プレーンなテキストエディタから離れる気はない、という人や、Emacsの加護を受けずにメモ帳でちまちまS式を編集しているような人のためのプリプロセッサとして役に立つかもしれません。

細かい仕様 + 突っ込みどころ

元がふわふわしたアイデアなので、細かい所にかなり抜けがあります。以下に変換器を書いてみようとして立ち止まった部分を列挙します。選択の判断の理由は長くなったので別ページにしました。逆変換器を作る時きっとこのリストは伸びると思います。

• カッコの内部は通常のS式としてパースされ、内部では$式の構文糖は無効になる。
• マーカー文字は $ でなければならない。
• 文字$は空白に囲まれた単独の場合でのみ有効。
• シンボルの$を使いたい時は|$|と書く。
• $hoge$や$$はそのまま$hoge$や$$のシンボルになる。
• '$や' $は(quote $)になる。
• $で開かれたカッコを)で閉じることはできない。
• シャープ構文の類は対応せず、アトムとしてそのまま読む。
• 行を途中で折り返す方法は$式には無い。そういう場合はカッコで囲んでS式に戻る。
• ドット対はS式のカッコの中でしか使えない。
• 字下げにPython的な一貫性はなくてもよい。

他にアイデアや突っ込みがあればぜひコメントをお願いします。

実装

シャープ構文やリーダマクロのことを考えると、「これが唯一の実装です」というものはそもそも作れません。それでも一応方針程度は考えてみます。

実装 ($式→S式)

字句解析と構文解析の間にやるなら、以下のようになると思います。

1. 字句解析器を改造し、各トークンのカラム番号(行頭から何文字目か)がわかるようにする。
   
   あるいは、カラム番号を示す特殊なトークンを新たに用意する。
2. 構文解析の前に、カラム番号の増減をもとに閉じ括弧を補う処理を挟む。

上は大雑把なまとめです。細かい実装の妄想はありますが、長いので別ページに分けました。

'をquoteに直す処理と$式の処理のどちらを先にやるかで'$の解釈が変わってきます。

実行するスクリプトを一応Gaucheで作りましたが、既存のreadを使ってだいぶ手抜きをしています。

実装 (S式→$式)

TODO。プリティプリンタをいじれば全ての(を$に置き換えてしまう物は書けると思います。ソースの形をなるべく残すことを考えると、やはりトークン単位の処理でやってしまうのがいいと思います。(GaucheではC言語のプリプロセッサと違って行数を無理やり書き換えたりができないので)

その他参考にしたもの

$について

この$という記号の由来は、もともとright-associating infix application operatorというHaskell標準の演算子です。定義的にはf $ x = f xという意味のないものですが、「右結合で優先度が最低」という不思議な設定によって括弧を省略するために使える構文糖としての役割を果たしています。一説には「縦棒に開き括弧と閉じ括弧が巻き付いた様子を表す記号である」という噂があります。

Gaucheの組み込みで$というマクロがあります。

• 始めの $ はマクロの開始を意味する
• 途中の $ は開き括弧を意味する
• 終わりの $ は部分適用を意味する

という具合に動作する、和洋折衷いちご大福という感じのとても綺麗な構文糖です。

インデントに意味がある文法

YAMLはよくわかりません。

Haskell。空白に意味を持たない{...}と;による文法を基礎として、構文糖としてインデントを元に区切り記号を補うという形で定義しています。この方法が好きなので$式もそれにならおうと思っています(出来ていませんが)。

Python。Haskellと違い完全にカッコを排除しています(SyntaxError: not a chance)。特別なトークンとしてINDENTとDEDENTを用意しています。カッコ内でインデントの制限がないことの便利さにPythonで気づいたので真似しました。

CoffeeScript。特別なトークンとしてINDENTとOUTDENTを用意しています。

PythonとCoffeeScriptは「ブロックの途中で半端にインデントを増減してはならない」というチェックがあるのが親切だと思います。しかし、letなどを考えると色々な特別ルールが必要そうです。$式はLisp/Schemeのための構文糖ではないので、別種のLintに任せてもよいと思います(たぶんありますし)。

SRFIに、SRFI 49: Indentation-sensitive syntax (I-expressions)とSRFI 110: Sweet-expressions（Readable Lisp S-expressions Project）があります。行頭の開きカッコを暗黙にしている点が$式と違うところです。

define factorial(n)
  if {n <= 1}
     1
     {n * factorial{n - 1}}

他にS式の構文糖(というよりプリプロセッサ？)を見つけたら教えていただけると嬉しいです。

参考記事

• Wiliki:Lisp:S式の理由

文法としてのS式について。

• C2 Wiki:Syntactically Significant Whitespace Considered Harmful

プログラムの文法にホワイトスペースを使うことについて。

TODO

• 実行器 だけでなく、逆変換機の実装
• 相互変換器の実装 (できればブラウザで動くお気軽な感じのもの)
• C言語の{ .. }などに応用