Go to Qiita Advent Calendar 2024 Top
LoginSignup
2
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

@ytaki0801(Yozo TAKIZAWA)

簡易LISP処理系の実装例（シェルスクリプト／大域変数版）

Last updated at Posted at 2020-10-18

【他言語版へのリンク記事】簡易LISP処理系の実装例【各言語版まとめ】

この記事は，下記拙作記事のシェルスクリプト／大域変数版を抜粋・修正したものを利用した，原初LISP処理系（"McCarthy's Original Lisp"）の実装例をまとめたものです．

最低限の機能をもったLISP処理系の実装の場合，本体である評価器（eval）実装はとても簡単であり，むしろ，字句・構文解析を行うS式入出力やリスト処理実装の方が開発言語ごとの手間が多く，それが敷居になっている人向けにまとめています．

処理系の概要

実行例は次の通り．下記の**ash＋sed＋tr（bash不要）**にて確認．
【追記】コメントでいただいたコードを用いると，sedおよびtrも不要．

$ ./jmclisp.ash "(car (cdr '(10 20 30)))"
20
$ ./jmclisp.ash "((lambda (x) (car (cdr x))) '(abc def ghi))"
def
$ ./jmclisp.ash "((lambda (f x y) (f x (f y '()))) 'cons '10 '20)"
(10 20)
$ ./jmclisp.ash "
> ((lambda (f x y) (f x (f y '())))
>  '(lambda (x y) (cons x (cons y '())))
>  '10 '20)
> "
(10 (20 ()))
$ ./jmclisp.ash "
> ((lambda (assoc k v) (assoc k v))
>  '(lambda (k v)
>     (cond ((eq v '()) nil)
>           ((eq (car (car v)) k)
>            (car v))
>           ('t (assoc k (cdr v)))))
>  'Orange
>  '((Apple . 120) (Orange . 210) (Lemon . 180)))
> "
(Orange . 210)

実装内容は次の通り．

  • "McCarthy's Original Lisp"をベースにした評価器
  • 数字を含むアトムは全てシンボルとし，変数の値とする場合はquote（'）を使用
  • 構文としてquoteの他，condとlambdaが使用可能
  • 組込関数：atom eq cons car cdr（内部でコンスセルを作成）
  • 真偽値はt（真）およびnil（偽）＝空リスト＝"nil"
  • エラーチェックなし，モジュール化なし，ガーベジコレクションなし

"McCarthy's Original Lisp"の詳細についてはまとめ記事を参照．ダイナミックスコープということもあり，実行例ではlambda式をletrec（Scheme）やlabels（Common Lisp）などの代わりに使用しています．

#実装例

##ソースコード一式

jmclisp.ash
#!/bin/sh
#
# JMC Lisp: defined in McCarthy's 1960 paper,
# with S-expression input/output and basic list processing
#


# basic list processing: cons, car, cdr, eq, atom

CNUM=0

cons () {
  eval CAR$CNUM=$1
  eval CDR$CNUM=$2
  CONSR=${CNUM}.conscell
  CNUM=$((CNUM+1))
}

car () { eval CARR="\$CAR${1%%.*}"; }
cdr () { eval CDRR="\$CDR${1%%.*}"; }

atom () {
  if [ ${1##*.} = conscell ]; then
    ATOMR=nil
  else
    ATOMR=t
  fi
}

eq () {
  atom $1 && eqat1=$ATOMR
  atom $2 && eqat2=$ATOMR
  if [ $eqat1 = nil -o $eqat2 = nil ]; then
    EQR=nil
  elif [ $1 = $2 ]; then
    EQR=t
  else
    EQR=nil
  fi
}


# S-expreesion output: s_display

s_strcons () {
  car $1 && s_display $CARR
  cdr $1
  eq $CDRR nil
  if [ $EQR = t ]; then
    echo -n
  else
    atom $CDRR
    if [ $ATOMR = t ]; then
      echo -n " . "$CDRR
    else
      echo -n " " && s_strcons $CDRR
    fi
  fi
}

s_display () {
  eq $1 nil
  if [ $EQR = t ]; then
    echo -n "()"
  else
    atom $1
    if [ $ATOMR = t ]; then
      echo -n $1
    else
      echo -n "("
      s_strcons $1
      echo -n ")"
    fi
  fi
}


# S-expression lexical analysis: s_lex

IFS=''

#s_lex0 () {
#  sl0INI=`echo " $1 "  | tr  -d "\n"`
#  sl0LPS=`echo $sl0INI | sed -e "s/(/ ( /g"`
#  sl0RPS=`echo $sl0LPS | sed -e "s/)/ ) /g"`
#  sl0RET=`echo $sl0RPS | sed -e "s/'/ ' /g"`
#}

# （コメントより）
s_lex0 () {
  sl0INI=`echo " $1 "  | tr  -d "\n"`
  sl0LPS=`echo $sl0INI | sed -e "s/(/ ( /g"`
  sl0RPS=`echo $sl0LPS | sed -e "s/)/ ) /g"`
  sl0RET=`echo $sl0RPS | sed -e "s/'/ ' /g"`
}

TNUM=0

s_lex1 () {
  sl1HEAD=${1%% *}
  sl1REST=${1#* }

  if [ ! ${sl1HEAD} = " " ]; then
    eval "TOKEN$TNUM=\$sl1HEAD"
    TNUM=$((TNUM+1))
  fi

  if [ ! ${sl1REST} = " " ]; then
    s_lex1 $sl1REST
  fi
}

s_lex () { s_lex0 $1 && s_lex1 $sl0RET; }


# S-expression syntax analysis: s_syn

s_quote () {
  if [ $SYNPOS -ge 0 ]; then
    eval "squox=\$TOKEN$SYNPOS"
    if [ $squox = "'" ]; then
      SYNPOS=$((SYNPOS-1))
      cons $1 nil
      cons quote $CONSR
      SQUOTER=$CONSR
    else
      SQUOTER=$1
    fi
  else
    SQUOTER=$1
  fi
}

s_syn0 () {
  eval "ss0t=\$TOKEN$SYNPOS"
  if [ $ss0t = "(" ]; then
    SYNPOS=$((SYNPOS-1))
    SSYN0R=$1
  elif [ $ss0t = "." ]; then
    SYNPOS=$((SYNPOS-1))
    s_syn
    car $1
    cons $SSYNR $CARR
    s_syn0 $CONSR
  else
    s_syn
    cons $SSYNR $1
    s_syn0 $CONSR
  fi
}

s_syn () {
  eval "ssyt=\$TOKEN$SYNPOS"
  SYNPOS=$((SYNPOS-1))
  if [ $ssyt = ")" ]; then
    s_syn0 nil
    s_quote $SSYN0R
    SSYNR=$SQUOTER
  else
    s_quote $ssyt
    SSYNR=$SQUOTER
  fi
}


# Stack implementation for recursive calls

stackpush () {
  eval STACK$STACKNUM=$1
  STACKNUM=$((STACKNUM+1))
}

stackpop ()
{
  STACKNUM=$((STACKNUM-1))
  eval STACKPOPR="\$STACK$STACKNUM"
}


# JMC Lisp evaluator: s_eval

caar () {
  car $1
  car $CARR
  CAARR=$CARR
}
cadr () {
  cdr $1
  car $CDRR
  CADRR=$CARR
}
cadar () {
  car $1
  cdr $CARR
  car $CDRR
  CADARR=$CARR
}
caddr () {
  cdr $1
  cdr $CDRR
  car $CDRR
  CADDRR=$CARR
}
caddar () {
  car $1
  cdr $CARR
  cdr $CDRR
  car $CDRR
  CADDARR=$CARR
}

s_null () { eq $1 nil && SNULLR=$EQR; }

s_append () {
  s_null $1
  if [ $SNULLR = "t" ]; then
    SAPPENDR=$2
  else
    cdr $1
    s_append $CDRR $2
    car $1
    cons $CARR $SAPPENDR
    SAPPENDR=$CONSR
  fi
}

s_list () {
  cons $2 nil
  cons $1 $CONSR
  SLISTR=$CONSR
}

s_pair () {
  s_null $1 && span1=$SNULLR
  s_null $2 && span2=$SNULLR
  if [ $span1 = t -a $span2 = t ]; then
    SPAIRR=nil
  else
    atom $1 && spaat1=$ATOMR
    atom $2 && spaat2=$ATOMR
    if [ $spaat1 = nil -a $spaat2 = nil ]; then
      cdr $1 && spad1=$CDRR
      cdr $2 && spad2=$CDRR
      s_pair $spad1 $spad2
      car $1 && spaa1=$CARR
      car $2 && spaa2=$CARR
      s_list $spaa1 $spaa2
      cons $SLISTR $SPAIRR
      SPAIRR=$CONSR
    else
      SPAIRR=nil
    fi
  fi
}

s_assoc () {
  caar $2
  eq $CAARR $1
  if [ $EQR = t ]; then
    cadar $2
    SASSOCR=$CADARR
  else
    cdr $2
    s_assoc $1 $CDRR
  fi
}

s_eval () {
  eq $1 t
  if [ $EQR = t ]; then
    SEVALR=t
  else
  eq $1 nil
  if [ $EQR = t ]; then
    SEVALR=nil
  else
  atom $1
  if [ $ATOMR = t ]; then
    s_assoc $1 $2 && SEVALR=$SASSOCR
  else
  car $1 && atom $CARR
  if [ $ATOMR = t ]; then
    car $1
    case $CARR in
      quote)
        cadr $1 && SEVALR=$CADRR
        ;;
      atom)
        cadr $1 && s_eval $CADRR $2
        atom $SEVALR && SEVALR=$ATOMR
        ;;
      eq)
        caddr $1 && s_eval $CADDRR $2
        stackpush $SEVALR
        cadr  $1 && s_eval $CADRR  $2
        stackpop
        eq $SEVALR $STACKPOPR && SEVALR=$EQR
        ;;
      car)
        cadr $1 && s_eval $CADRR $2
        car $SEVALR && SEVALR=$CARR
        ;;
      cdr)
        cadr $1 && s_eval $CADRR $2
        cdr $SEVALR && SEVALR=$CDRR
        ;;
      cons)
        caddr $1 && s_eval $CADDRR $2
        stackpush $SEVALR
        cadr  $1 && s_eval $CADRR  $2
        stackpop
        cons $SEVALR $STACKPOPR && SEVALR=$CONSR
        ;;
      cond)
        cdr $1 && evcon $CDRR $2
        SEVALR=$EVCONR
        ;;
      *)
        car $1 && s_assoc $CARR $2
        cdr $1 && cons $SASSOCR $CDRR
        s_eval $CONSR $2
        ;;
    esac
  else
    caar $1
    eq $CAARR lambda
    if [ $EQR = t ]; then
      cdr $1
      evlis $CDRR $2
      cadar $1
      s_pair $CADARR $EVLISR
      s_append $SPAIRR $2
      caddar $1
      s_eval $CADDARR $SAPPENDR
    else
      SEVALR=nil
    fi
  fi
  fi
  fi
  fi
}

evcon () {
  caar $1 && s_eval $CAARR $2
  if [ $SEVALR = t ]; then
    cadar $1 && s_eval $CADARR $2
    EVCONR=$SEVALR
  else
    cdr $1 && evcon $CDRR $2
  fi
}

evlis () {
  s_null $1
  if [ $SNULLR = "t" ]; then
    EVLISR=nil
  else
    cdr $1 && evlis  $CDRR $2
    car $1 && s_eval $CARR $2
    cons $SEVALR $EVLISR
    EVLISR=$CONSR
  fi
}


# REP (no Loop)

s_lex $1
SYNPOS=$((TNUM-1))
s_syn
s_eval $SSYNR nil
s_display $SEVALR
echo

##解説

  • リスト処理：cons car cdr eq atom，S式出力：s_display
    先の記事の大域変数版をそのまま流用．CAR＋連番変数，CDR＋連番変数の大域変数による疑似配列にてコンスセルを生成．

  • S式入力：
    新規に作成．字句解析部s_lexは，sedを用いて( ) 'の前後に空白を挿入，trを用いて改行を削除，ashの文字列パターン処理を用いて空白区切りを行い，TOKEN＋連番変数の大域変数による疑似配列にトークン列を格納．抽象構文木生成部s_synは括弧ネスト・ドット対・クォート記号対応とし，リスト処理関数でコンスセルによる構文木を生成．

  • 評価器：s_eval＋ユーティリティ関数
    "McCarthy's Original Lisp"をベースにs_eval関数およびユーティリティ関数を作成．ただし，大域変数のみで実装している都合上，consなどの二変数関数のeval処理に不具合あり．【2020-10-22追記】同じく大域変数を用いたスタックを実装することで解決しました．

  • REP (no Loop)
    第1引数として指定したS式文字列について，s_lex→s_syn→s_eval→s_displayを順次実行．

#備考

##記事に関する補足

  • さすがにテキストファイル版と比べると速い速い．冒頭の実行例程度なら，他のスクリプト系言語の実装と全く変わらない感じ．とはいえ，大域変数＋再帰処理特有の問題がまだ残ってるし，字句／構文解析のしやすさからbash脱却（ash系などの軽量シェルによる実行）に至らず．もっとも，前者はともかく後者は，コンスセル実装同様の大域変数による疑似配列を使えば実現できそうな気が．目指せ，BusyBox稼働．
  • 【2020-10-19】字句解析部のash＋sed＋trによる実装し直しによりbash脱却に成功．本当はsedからも脱却したかったけど，BusyBoxで動くようになったので満足満足．しかしこうなると，REPL＋レキシカルスコープを備えたSchemeサブセット処理系に発展させたくなってきたなあ．【追記】コメントでいただいたコードを用いて，sedおよびtrからも脱却．マジすげえ．
  • ということで（？），~~二変数関数のeval処理に不具合が残ってはいるものの，~~シェルスクリプト版については可搬性が高いと判断し，REPLを備えたPure LISPインタプリタとしてGitHub開発・公開に移行．https://github.com/ytaki0801/jmclisp.sh
    【2020-10-22追記】同大域変数を用いたスタックを実装することで解決しました．

##更新履歴

  • 2020-10-22：二変数関数のeval処理の不具合の解消を追記．
  • 2020-10-21：REPLを備えたGitHub開発・公開に移行の旨補足欄に追記
  • 2020-10-21：字句解析のreplace_all相当をシェル記述のみに変更・追記（コメントより）
  • 2020-10-19：bash版からash＋sed＋tr版に変更
  • 2020-10-18：初版公開
2
1
4

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
2
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?