『括弧文字列』簡易パーサ実装例まとめ

【追記】当該記事および『リスト処理関数（cons,car,cdr,eq,atom）実装例まとめ』から抜粋・修正したものを利用した，簡易LISP処理系の各プログラミング言語実装例の記事を作成しました．

どんなパーサかというと，次のPythonの実行例のような処理を行うものです．

>>> p_syn(p_lex(input()))
((10 + 20)*(30 - 40))
[['10', '+', '20'], '*', ['30', '-', '40']]

>>> p_syn(p_lex(input()))
{ "color": [ "red", "green" ] }
[['color'], ':', [['red'], ',', ['green']]]

当方，諸般の理由で簡易S式パーサを様々なプログラミング言語で作成しているのですが，ちょっと修正すれば簡易JSONパーサとかにもなるんじゃ？と気がつきつつ，JSONパーサにもS式パーサにも，あるいは，括弧ベースの独自のデータ構造表現のパーサにも，少しの手直しと処理の追加で簡易実装できる記述例をまとめようと思った次第．括弧文字列限定の字句解析＋抽象構文木生成という構成で，字句解析部のみ，抽象構文木生成部のみの流用もできるかもしれません．

#仕様

##p_lex関数（字句解析部）
入力した文字列から，()[]{}",を字句として，空白を区切り記号として，文字列配列を生成する．

【例】{(10 + 20)*(30 - 40)}
⇒['{', '(', '10', '+', '20', ')', '*', '(', '30', '-', '40', ')', '}']

いわゆる電卓プログラムの例題に流用したい場合は，+ - * /などの演算子も字句として追加認識させるといいかもしれません．

##p_syn関数（抽象構文木生成部）
上記文字列配列から，()[]{}"の括りをリスト化したものを生成．

【例】['{', '(', '10', '+', '20', ')', '*', '(', '30', '-', '40', ')', '}']
⇒[['10', '+', '20'], '*', ['30', '-', '40']]

, : .等はリスト要素として残ったままなので，流用目的によっては，,は削除する，A:BやA . Bはキーと値のリストとする，といった追加処理が必要になるかもしれません．また，括弧の種類によって処理を変えたい時にも少し手直しが必要となるでしょう．

##その他

• エラーチェックなし
• モジュール化なし
• ガーベジコレクションなし

#Pythonの実装例
かなりの部分を，Peter Norvig氏の『lis.py』のtokenizeおよびread_from_tokensから流用．他言語の実装例との比較のしやすさから，popとappendを用いない記述に変更しています．

p_lex.py

def p_lex(p):
    for s in '()[]{}",':
        p = p.replace(s, ' ' + s + ' ')
    return p.split()

p_syn.py

def p_syn(p):
    t = p[0]
    del p[0]
    if t in '({["':
        r = []
        while p[0] != ')}]"'['({["'.find(t)]:
            r += [p_syn(p)]
        del p[0]
        return r
    else:
        return t

>>> p_syn(p_lex(input()))
{"a": [100, f], "b": {"a": [t, "c"], "b": "d"}}
[['a'], ':', ['100', ',', 'f'], ',', ['b'], ':', [['a'], ':', ['t', ',', ['c']], ',', ['b'], ':', ['d']]]

#C言語の実装例
Python版をモデルにして作成．字句解析部ではstrtokを使用．抽象構文木生成部では，当方の趣味（？）により，二分木でリスト構造を生成．そのこともあって，p_synでは文字列配列を後ろから走査しています．

p_lex.h

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#ifndef P_LEX_H_
#define P_LEX_H_

#define SSTR_MAX 256

int p_lex(const char *p, char* pl[]);

#endif

p_lex.c

#include "p_lex.h"

int p_lex(const char *p, char* pl[])
{
  char pf[SSTR_MAX * 3];
  int i, j = 0;
  for (i = 0; i < strlen(p); i++) {
    switch (p[i]) {
      case '(':
      case ')':
      case '[':
      case ']':
      case '{':
      case '}':
      case '"':
      case ',':
        pf[j++] = ' '; pf[j++] = p[i]; pf[j++] = ' ';
        break;
      case '\n': j++; break;
      default: pf[j++] = p[i];
    }
  }
  pf[j] = '\0';

  char *t;
  int len = 0;
  for (t = strtok(pf, " "); t != NULL; t = strtok(NULL, " "))
    pl[len++] = t;
  pl[len] = NULL;

  return (len);
}

p_syn.h

#include <stdio.h>
#include <stdlib.h>

#ifndef P_SYN_H_
#define P_SYN_H_

typedef unsigned int value_t;
enum NODE_TAG { NODE_STRG, NODE_BTRE };

typedef struct _node_t_ {
  value_t value;
  enum NODE_TAG tag;
} _node_t, *node_t;

node_t node(value_t value, enum NODE_TAG tag);

typedef struct _btree_t_ {
  node_t x;
  node_t y;
} _btree_t, *btree_t;

node_t btree(node_t x, node_t y);

#define str_to_node(p)  (node((value_t)(p), NODE_STRG))
#define node_to_str(p)  ((char *)(p->value))

#define bt_x(p)  (((btree_t)(p->value))->x)
#define bt_y(p)  (((btree_t)(p->value))->y)
#define n_str(p) (p->tag == NODE_STRG)
#define n_btr(p) (p->tag == NODE_BTRE)

node_t p_syn(char *p[], int *pos);

#endif

p_syn.c

#include "p_syn.h"

node_t node(value_t value, enum NODE_TAG tag)
{
  node_t n = (node_t)malloc(sizeof(_node_t));
  n->value = value; n->tag = tag;
  return (n);
}

node_t btree(node_t x, node_t y)
{
  btree_t c = (btree_t)malloc(sizeof(_btree_t));
  c->x = x; c->y = y;
  node_t n = node((value_t)c, NODE_BTRE);
  return (n);
}

char p_syn_rp(char lp)
{
  switch (lp) {
    case ')': return '(';
    case ']': return '[';
    case '}': return '{';
    case '"': return '"';
    default: return '\0';
  }
}

node_t p_syn(char *p[], int *pos)
{
  char *t = p[*pos];
  *pos = *pos - 1;

  switch (t[0]) {
    case ')':
    case ']':
    case '}':
    case '"': {
      node_t r = NULL;
      while (p[*pos][0] != p_syn_rp(t[0])) {
        r = btree(p_syn(p, pos), r);
      }
      *pos = *pos - 1;
      return (r);
    }
    default:
      return (str_to_node(t));
  }
}

p_sample.c

#include <stdio.h>
#include <stdlib.h>

#include "p_lex.h"
#include "p_syn.h"

void _p_print(node_t p)
{
  if (p == NULL) {
    printf("]");
  } else if (n_str(p)) {
    printf("'%s'", node_to_str(p));
  } else {
    if (n_btr(bt_x(p))) printf("[");
    _p_print(bt_x(p));
    if (bt_y(p) != NULL) printf(", ");
    _p_print(bt_y(p));
  }
}
void p_print(node_t p)
{
  if (n_btr(p)) { printf("["); _p_print(p); }
  else printf("'%s'", node_to_str(p));
}

int main(void)
{
  char p[SSTR_MAX], c = getchar();
  int i;
  for (i = 0; c != '\n'; i++, c = getchar()) p[i] = c;
  p[i] = '\0';

  char *pl[SSTR_MAX];
  int len = p_lex(p, pl) - 1;
  node_t r = p_syn(pl, &len);

  p_print(r); printf("\n");

  return (0);
}

$ ls
p_lex.c  p_lex.h  p_sample.c  p_syn.c  p_syn.h
$ cc -Wall -o p_sample *.c
$ ./p_sample
{"a": [100, f], "b": {"a": [t, "c"], "b": "d"}}
[['a'], ':', ['100', ',', 'f'], ',', ['b'], ':', [['a'], ':', ['t', ',', ['c']], ',', ['b'], ':', ['d']]]

#Rubyの実装例
Python版とほぼ同じ．

p_lex.rb

def p_lex(p)
  for s in ['(',')','[',']','{','}','"',','] do
    p = p.gsub(s, ' ' + s + ' ')
  end
  return p.split
end

p_syn.rb

def p_syn_rp(lp)
  case lp
    when '(' then ')'
    when '[' then ']'
    when '{' then '}'
    when '"' then '"'
  end
end

def p_syn(p)
  t = p.shift
  if ['(','[','{','"'].include?(t) then
    r = []
    while p[0] != p_syn_rp(t) do
      r += [p_syn(p)]
    end
    p.shift
    return r
  else
    return t
  end
end

>> p_syn(p_lex(gets.chomp))
{"a": [100, f], "b": {"a": [t, "c"], "b": "d"}}
=> [["a"], ":", ["100", ",", "f"], ",", ["b"], ":", [["a"], ":", ["t", ",", ["c"]], ",", ["b"], ":", ["d"]]]

#JavaScriptの実装例
Python版とほぼ同じ．

p_lex.js

function p_lex(p) {
  p = p.replace(/(\(|\)|\[|\]|\{|\}|\"|\,)/g, ' $1 ');
  return p.split(/\s+/).filter(x => x != '');
}

p_syn.js

p_syn_rp = {'(':')','{':'}','[':']','"':'"'};
function p_syn(p) {
  var t = p.shift();
  if (['(','{','[','"'].includes(t)) {
    var r = [];
    while (p[0] != p_syn_rp[t]) {
      r = r.concat([p_syn(p)]);
    }
    p.shift();
    return r;
  } else {
    return t;
  }
}

> p_syn(p_lex('{"a": [100, f], "b": {"a": [t, "c"], "b": "d"}}'))
[ [ 'a' ],
  ':',
  [ '100', ',', 'f' ],
  ',',
  [ 'b' ],
  ':',
  [ [ 'a' ], ':', [ 't', ',', [Array] ], ',', [ 'b' ], ':', [ 'd' ] ] ]

#Haskellの実装例（参考）
p_lex関数（字句解析部）のみ実装．抽象構文木生成部の『簡易』実装は断念．詳細は備考欄を参照．
※コメントで頂いたサンプルコードを基に修正しました．また，抽象構文木生成部の実装例も頂いています．

p_lex.hs

p_replace :: String -> String
p_replace [] = ""
p_replace (c : s) =
  case c of
    '(' -> " ( "
    ')' -> " ) "
    '[' -> " [ "
    ']' -> " ] "
    '{' -> " { "
    '}' -> " } "
    ',' -> " , "
    '\"' -> " \" "
    _    -> [c]
  ++ p_replace(s)

-- p_lex0 :: String -> [String]
-- p_lex0 [] = [""]
-- p_lex0 (c : cs)
--   | c == ' '  = "" : ss
--   | otherwise = (c : head ss) : tail ss
--   where ss = p_lex0 cs

p_lex :: String -> [String]
-- p_lex p = filter (\ x -> x /= "") $ p_lex0 $ p_replace p
p_lex p = words $ p_replace p

main = do
  p <- getLine
  print $ p_lex p

*Main> main
{"a": [100, f], "b": {"a": [t, "c"], "b": "d"}}
["{","\"","a","\"",":","[","100",",","f","]",",","\"","b","\"",":","{","\"","a","\"",":","[","t",",","\"","c","\"","]",",","\"","b","\"",":","\"","d","\"","}","}"]

#Go言語の実装例
C言語版をモデルにして作成．字句解析部ではstringsライブラリのReplaceとSplitを使用．抽象構文木生成部は，拙作記事『リスト処理関数（cons,car,cdr,eq,atom）実装例まとめ』のGo言語版を組み込み，コンスセルによるリスト構造を生成．C言語版と同じく，p_synでは文字列配列を後ろから走査しています．

PSP.go

package main

import (
  "fmt"
  "bufio"
  "os"
  "strings"
)

// Cons cells are created by using interface and struct.
// All of atoms are string and the null value is nil.

type NODE interface{};
type CONS struct { x NODE; y NODE; };

func cons(x NODE, y NODE) NODE {
  var r CONS; r.x = x; r.y = y;
  return NODE(r);
}

func car(s NODE) NODE { return s.(CONS).x; }
func cdr(s NODE) NODE { return s.(CONS).y; }
func eq(s1 NODE, s2 NODE) bool { return s1 == s2; }

func atom(s NODE) bool {
  if (s == nil) {
    return true;
  } else {
    switch s.(type) {
      case string: return true;
      case bool:   return true;
      default:     return false;
    }
  }
}

// p_lex

func p_lex(p string) []string {
  for _, k := range "()[]{}\"," {
    ks := string(k);
    p = strings.Replace(p, ks, " " + ks + " ", -1);
  }
  r := []string{};
  for _, w := range strings.Split(p, " ") {
    if (w != "") { r = append(r, w); }
  }
  return r;
}

// p_syn

func p_syn_rp(lp string) string {
  switch (lp) {
    case ")":  return "(";
    case "]":  return "[";
    case "}":  return "{";
    case "\"": return "\"";
    default:   return "";
  }
}

func p_syn(p []string, pos *int) NODE {
  t := p[*pos]; *pos = *pos - 1;
  if t == ")" || t == "]" || t == "}" || t == "\"" {
    var r NODE = nil;
    for p[*pos] != p_syn_rp(t) {
      r = cons(p_syn(p, pos), r);
    }
    *pos = *pos - 1;
    return r;
  } else {
    return t;
  }
}

// p_print

func _p_print(p NODE) {
  if (p == nil) {
    fmt.Print("]");
  } else if (atom(p)) {
    fmt.Print("'", p, "'");
  } else {
    if !atom(car(p))  { fmt.Print("["); }
    _p_print(car(p));
    if (cdr(p) != nil) { fmt.Print(", "); }
    _p_print(cdr(p));
  }
}
func p_print(p NODE) {
  if !atom(p) {
    fmt.Print("[");
    _p_print(p);
  } else {
    fmt.Print("'", p, "'");
  }
}

// main

func main() {
  p := bufio.NewScanner(os.Stdin);
  p.Scan();
  pl := p_lex(p.Text());
  len := len(pl) - 1;
  r := p_syn(pl, &len);
  p_print(r);
  fmt.Println();
}

$ go run PSP.go
{"a": [100, f], "b": {"a": [t, "c"], "b": "d"}}
[['a'], ':', ['100', ',', 'f'], ',', ['b'], ':', [['a'], ':', ['t', ',', ['c']], ',', ['b'], ':', ['d']]]

#Rustの実装例
字句解析部ではreplaceとsplit_whitespaceを使用．抽象構文木生成部は，拙作記事『リスト処理関数（cons,car,cdr,eq,atom）実装例まとめ』のRust版を抜粋・修正し，コンスセルによるリスト構造を生成すると共に，Python風の表示も行う．実行例では，抽象構文木生成だけでなく，先頭の要素と残りの要素を分けて表示．C言語版と同じく，p_synでは文字列配列を後ろから走査しています．

main.rs

#![allow(non_snake_case)]

use std::fmt;
use std::io;
use std::collections::HashMap;


// Cons cells are created by using enum and struct.
// All of atoms are string and the null value is "nil".

enum CELL { ATOM(String), PAIR(CONS), }
struct CONS { x: Box<CELL>, y: Box<CELL>, }

impl fmt::Display for CONS {
  fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
    match &(*self.y) {
      CELL::ATOM(_) => { write!(f, "{}", self.x) },
      CELL::PAIR(s) => { write!(f, "{}, {}", self.x, s) },
    }
  }
}

impl fmt::Display for CELL {
  fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
    match self {
      CELL::ATOM(s)  => write!(f, "'{}'", s),
      CELL::PAIR(ss) => write!(f, "[{}]", ss),
    }
  }
}

impl CELL {
  fn strg(c: &str) -> CELL { CELL::ATOM(String::from(c)) }
  fn cons(a: CELL, d: CELL) -> CELL {
    CELL::PAIR( CONS { x: Box::new(a), y: Box::new(d), })
  }
  fn uncons(s: CELL) -> (CELL, CELL) {
    match s {
      CELL::PAIR(CONS { x, y }) => {
        (::std::mem::replace(&mut *Box::leak(x), CELL::strg("nil")),
         ::std::mem::replace(&mut *Box::leak(y), CELL::strg("nil")))
      },
      CELL::ATOM(s) => (CELL::ATOM(s), CELL::strg("nil")),
    }
  }
}


// p_lex

fn p_lex(s: &str) -> Vec<String> {
  let r: String = s.replace("(", " ( ")
                   .replace(")", " ) ")
                   .replace("[", " [ ")
                   .replace("]", " ] ")
                   .replace("{", " { ")
                   .replace("}", " } ")
                   .replace(",", " , ")
                   .replace("\"", " \" ");
  r.split_whitespace()
   .map(|x| x.to_string())
   .collect()
}


// p_syn

fn p_syn0(r: CELL, mut s: Vec<String>, rp: &str)
  -> (CELL, Vec<String>) {
  let mut t = s.split_off(s.len() - 1);
  let mut lps = HashMap::new();
  lps.insert(")", "(");
  lps.insert("]", "[");
  lps.insert("}", "{");
  lps.insert("\"", "\"");
  if t[0] == lps[rp] {
    (r, s)
  } else {
    s.append(&mut t);
    let (rr, rs) = p_syn(s);
    let c = CELL::cons(rr, r);
    p_syn0(c, rs, rp)
  }
}

fn p_syn(mut s: Vec<String>)
  -> (CELL, Vec<String>) {
  let t = s.split_off(s.len() - 1);
  let rps = vec![")", "]", "}", "\""];
  let rp = &&(*t[0]);
  if rps.contains(rp) {
    p_syn0(CELL::strg("nil"), s, rp)
  } else {
    (CELL::strg(&t[0]), s)
  }
}


// main

fn main() {
  let mut s = String::new();
  io::stdin().read_line(&mut s).ok();
  let r0 = s.trim();
  let (r, _) = p_syn(p_lex(r0));

  println!("r = {}", r);
  let (a, d) = CELL::uncons(r);
  println!("head r = {}", a);
  println!("tail r = {}", d);
}

$ cargo run
    Finished dev [unoptimized + debuginfo] target(s) in 0.05s
     Running `target/debug/PSP_rs`
{"a": [100, f], "b": {"a": [t, "c"], "b": "d"}}
r = [['a'], ':', ['100', ',', 'f'], ',', ['b'], ':', [['a'], ':', ['t', ',', ['c']], ',', ['b'], ':', ['d']]]
head r = ['a']
tail r = [':', ['100', ',', 'f'], ',', ['b'], ':', [['a'], ':', ['t', ',', ['c']], ',', ['b'], ':', ['d']]]

#Schemeの実装例
他言語実装との比較と処理系の違いの吸収を兼ね，基本関数のみで少し冗長に実装（Guile，Gaucheの双方で実行を確認）．字句解析部については，文字列と文字リストの間の変換を行うstring->list list->stringを使用し，一文字ずつ区切り記号や単語認識を処理．抽象構文木生成部は，文字列リスト持ち回りによる相互再帰によって実装．

PSP.scm

(define p_lex
  (lambda (p)
    (let loop ((s (string->list p)) (w '()) (sl '()))
      (cond ((null? s) sl)
            ((member (car s) (string->list " ()[]{}\","))
             (let ((slr (cond ((null? w) sl)
                              (else
                               (cons (list->string (reverse w)) sl)))))
               (loop (cdr s) '()
                     (cond ((equal? (car s) #\space) slr)
                           (else (cons (list->string (list (car s))) slr))))))
            (else (loop (cdr s) (cons (car s) w) sl))))))

(define p_syn1
  (lambda (s rp r)
    (let ((lps '((")"  . "(")
                 ("]"  . "[")
                 ("}"  . "{")
                 ("\"" . "\""))))
      (cond ((equal? (car s) (cdr (assoc rp lps)))
             (cons r (cdr s)))
            (else
             (let ((rr (p_syn0 s)))
               (p_syn1 (cdr rr) rp (cons (car rr) r))))))))

(define p_syn0
  (lambda (s)
    (let ((rps '(")" "]" "}" "\"")))
      (cond ((member (car s) rps)
             (p_syn1 (cdr s) (car s) '()))
            (else
             (cons (car s) (cdr s)))))))

(define p_read (lambda (s) (car (p_syn0 (p_lex s)))))

$ guile -l ./PSP.scm
;(起動時のメッセージは省略）
guile> (p_read (readline))
{"a": [100, f], "b": {"a": [t, "c"], "b": "d"}}
(("a") ":" ("100" "," "f") "," ("b") ":" (("a") ":" ("t" "," ("c")) "," ("b") ":" ("d")))

$ gosh -l ./PSP.scm
gosh> (p_read (read-line))
{"a": [100, f], "b": {"a": [t, "c"], "b": "d"}}
(("a") ":" ("100" "," "f") "," ("b") ":" (("a") ":" ("t" "," ("c")) "," ("b") ":" ("d")))

#R言語の実装例
字句解析部ではgsubとstrsplitを使用．抽象構文木生成部については，Scheme版を参考に，文字列ベクトル持ち回りによる相互再帰によって実装．構文木生成にはリストを使用．ただし，R言語の場合は基本的にリスト要素の直接結合は想定されず，ベクトル変換を経由して結合するのが一般的であること，しかし，ベクトル変換を行うと（特に要素数1の）リストが平坦化されてしまうことから，要素数2のリスト構造による連結リスト（すなわち，コンスセル方式）にて実装．この構文木をそのまま表示すると大変見にくいため，Python風の表示を行うp_stringを併せて作成．

PSP.r

p_lex <- function(p) {
  for (d in c("\\(", "\\)", "\\{", "\\}", "\\[", "\\]", "\"", ",")) {
    p = gsub(d, paste(" ", d, " ", sep=""), p)
  }
  strsplit(p, " +")
  rp = strsplit(p, " +")
  rp[[1]][-which(rp[[1]] %in% "")]
}

p_syn1 <- function(s, rp, r) {
  v <- c('(', '[', '{', '"')
  names(v) <- c(')', ']', '}', '"')
  if (s[1] == v[rp]) {
    list(r, s[-1])
  } else {
    rr <- p_syn0(s)
    p_syn1(rr[[2]], rp, list(rr[[1]], r))
  }
}

p_syn0 <- function(s) {
  rps <- c(")", "]", "}", "\"")
  if (s[1] %in% rps) {
    p_syn1(s[-1], s[1], NULL)
  } else {
    list(s[1], s[-1])
  }
}

p_read <- function(s) { p_syn0(rev(p_lex(s)))[[1]] }


p_strlist <- function(s) {
  sa_r = p_string(s[[1]])
  sd = s[[2]]
  if (is.null(sd)) {
    sa_r
  } else {
    paste(sa_r, ", ", p_strlist(sd), sep="")
  }
}

p_string <- function(s) {
  if (is.character(s) || is.null(s)) {
    paste("'", s, "'", sep="")
  } else {
    paste("[", p_strlist(s), "]", sep="")
  }
}

$ R
#（起動時のメッセージは省略）
> source("PSP.r")
> r = p_read(readline())
{"a": [100, f], "b": {"a": [t, "c"], "b": "d"}}
> p_string(r)
[1] "[['a'], ':', ['100', ',', 'f'], ',', ['b'], ':', [['a'], ':', ['t', ',', ['c']], ',', ['b'], ':', ['d']]]"
> r[[1]]
[[1]]
[1] "a"

[[2]]
NULL

> r[[1]][[1]]
[1] "a"

#Prologの実装例（SWI Prolog）
字句解析部ではget_charを用いて入力文字列を一文字ずつ処理．文字リストからの文字列生成はatomics_to_stringを使用．抽象構文木生成部は，LISP同様のコンスセル操作が可能ということもあり，Scheme版を参考に，文字列リスト持ち回りによる相互再帰によって実装．

PSP.swi

% p_lex

p_lchp(C) :- member(C, ['(', ')', '[', ']', '{', '}', '"', ',']), !.
p_lwa(CS, WS0, WS1) :- atomics_to_string(CS, T), append(WS0, [T], WS1).

p_lex0('\n', [], WS, WS).
p_lex0('\n', CS, WS, SL) :- p_lwa(CS, WS, SL).
p_lex0(' ',  [], WS, SL) :- get_char(C), p_lex0(C, [], WS, SL).
p_lex0(' ',  CS, WS, SL) :- p_lwa(CS, WS, WS1),
                            get_char(C), p_lex0(C, [], WS1, SL).
p_lex0(C,    [], WS, SL) :- p_lchp(C),
                            p_lwa([C], WS, WS1),
                            get_char(N), p_lex0(N, [], WS1, SL).
p_lex0(C,    CS, WS, SL) :- p_lchp(C),
                            p_lwa(CS, WS, WS1),
                            p_lwa([C], WS1, WS2),
                            get_char(N), p_lex0(N, [], WS2, SL).
p_lex0(C,    CS, WS, SL) :- append(CS, [C], CS1),
                            get_char(C1), p_lex0(C1, CS1, WS, SL).

p_lex(SL) :- get_char(C), p_lex0(C, [], [], SL), !.


% p_syn

p_slp(")", "(").
p_slp("]", "[").
p_slp("}", "{").
p_slp("\"", "\"").
p_syn0([LP|L], RP, R, [R|L]) :- p_slp(RP, LP).
p_syn0(S, RP, R, SL) :- p_syn(S, [A|D]), p_syn0(D, RP, [A|R], SL).

p_srp(C) :- member(C, [")", "]", "}", "\""]), !.
p_syn([X|L], SL) :- p_srp(X), p_syn0(L, X, [], SL), !.
p_syn(SL, SL).


% p_read

p_read(R) :- p_lex(X), reverse(X, S), p_syn(S, [R|_]).

$ swipl -s PSP.swi
%（起動時のメッセージは省略）
?- p_read(X).
|: {"a": [100, f], "b": {"a": [t, "c"], "b": "d"}}
X = [["a"], ":", ["100", ",", "f"], ",", ["b"], ":", [["a"], ":"|...]].

?- p_read([_,_,_,_,_,_|[X]]).
|: {"a": [100, f], "b": {"a": [t, "c"], "b": "d"}}
X = [["a"], ":", ["t", ",", ["c"]], ",", ["b"], ":", ["d"]].

#備考

##記事に関する補足

• 『括弧文字列』を指す用語があったような記憶があるのだけれども，どうしても思い出せない…．あと，抽象構文木生成部のアルゴリズムを指す用語もなぜか思い出せない…．『操車場アルゴリズム』は違うし．【追記】単に，括弧対応の構文規則＆それに沿った再帰アルゴリズムじゃないのかというツッコミあり．真相は不明．
• Haskellについては，リストが同じ型の要素しか扱えないベクタ相当で，括弧構造格納のための多次元配列を扱うにもライブラリが必要であること，抽象構文木生成のためには別途データ構築子を含むデータ構造を新たに定義し，なおかつ，モナドなどを活用して大域的な副作用を伴う文字列配列走査（スキャン）を実現する必要があるため，『簡易』実装を断念．Webで検索すると，パーサライブラリParsecを利用したJSONの簡易パーサ実装例が結構あるけど，型シグネチャやエラー処理を除いても，かなりガッツリした実装を要する模様．ということで，リスト処理と抱き合わせで，簡易S式パーサのみ実装する予定．【追記】コメントにて，モナド不要の実装例のコードを頂きました．ありがとうございました．

##更新履歴

• 2020-10-06：Prolog（SWI Prolog）の実装例を追加
• 2020-10-04：R言語の実装例を追加
• 2020-09-29：Schemeの実装例を追加
• 2020-09-28：Rustの実装例を追加
• 2020-09-19：Go言語の実装例を追加
• 2020-09-17：Haskellの字句解析部修正＆補足修正（コメントより）
• 2020-09-15：Haskellの字句解析部の実装例を追加
• 2020-09-03：Ruby，JavaScriptの実装例を追加
• 2020-09-03：初版公開（Python，C言語の実装例）