├── LICENSE.txt
├── README.md
├── core.gk
├── fib.gk
├── gherkin
├── pipeseq.sh
├── presentation.gk
├── read_profile.clj
└── simple_test.sh


/LICENSE.txt:
--------------------------------------------------------------------------------
 1 | Copyright (c) 2013, Alan Dipert <alan@dipert.org>
 2 | All rights reserved.
 3 | 
 4 | Redistribution and use in source and binary forms, with or without
 5 | modification, are permitted provided that the following conditions are met:
 6 | 
 7 |  * Redistributions of source code must retain the above copyright notice,
 8 |    this list of conditions and the following disclaimer.
 9 |  * Redistributions in binary form must reproduce the above copyright
10 |    notice, this list of conditions and the following disclaimer in the
11 |    documentation and/or other materials provided with the distribution.
12 |  * Neither the name of  nor the names of its contributors may be used to
13 |    endorse or promote products derived from this software without specific
14 |    prior written permission.
15 | 
16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
17 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
18 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
19 | ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
20 | LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
21 | CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
22 | SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
23 | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
24 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
25 | ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
26 | POSSIBILITY OF SUCH DAMAGE.
27 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | > **This project is dormant.**  I have not worked on it in years, and am unlikely to continue work on it anytime soon.  I encourage you to check out "mal" -- "Make a Lisp" -- by Joel Martin, a project inspired by this one, that includes implementations in dozens of languages, including Bash: https://github.com/kanaka/mal.  While it's missing garbage collection, mal's Bash Lisp is incredibly clean and easy to hack on. For additional historical perspective, see [this article on my homepage](https://tailrecursion.com/~alan/Lisp/GherkinHistory.html).
 2 | 
 3 | # gherkin
 4 | 
 5 | <img src="https://dl.dropboxusercontent.com/u/12379861/gherkin_logo.png" alt="gherkin logo" title="gherkin logo" align="right" width="96" />
 6 | 
 7 | gherkin is a functional programming language and interpreter written in [GNU Bash 4](http://www.gnu.org/software/bash/) designed for extreme portability across *nix platforms.  For rationale, see [Why gherkin?](https://github.com/alandipert/gherkin/wiki/Why-gherkin%3F)
 8 | 
 9 | gherkin is a dialect of [Lisp](http://en.wikipedia.org/wiki/Lisp), and like other Lisps such as [Clojure](http://clojure.org/) and [Scheme](http://en.wikipedia.org/wiki/Scheme_(programming_language) it features homoiconicity, first-class functions, and primitive functions for operating on a variety of data types such as strings, integers, symbols, and lists.  As a citizen of *nix and the shell environment, it also provides *nix and shell interoperation facilities.
10 | 
11 | gherkin is currently **alpha** status, but our hope is to continue feature development until gherkin can be used in place of Bash for general purpose *nix scripting.  If you're curious about our progress toward our first release, see [our milestones](https://github.com/alandipert/gherkin/issues/milestones).
12 | 
13 | ## Try gherkin
14 | 
15 | *gherkin requires GNU Bash version 4 or higher.  If you're on Linux, this is probably already your shell.  If you're on a Mac, we recommend you install a recent version of Bash with [Homebrew](http://brew.sh/).*
16 | 
17 | #### REPL
18 | 
19 | Start a Read-Evaluate-Print-Loop ([REPL](http://en.wikipedia.org/wiki/REPL)) and evaluate a simple expression:
20 | 
21 |     ./gherkin
22 |     > (+ 1 2)
23 |     3
24 | 
25 | You may exit the REPL with Ctrl-D.
26 | 
27 | #### Running a script
28 | 
29 | Run [fib.gk](fib.gk) to find the 60th [Fibonacci number](http://en.wikipedia.org/wiki/Fibonacci_number):
30 | 
31 |     ./gherkin -l fib.gk
32 |     
33 | #### Start a REPL and try a [core library](core.gk) function:
34 | 
35 |     ./gherkin
36 |     > (load-file "core")
37 |     nil
38 |     > (map inc '(1 2 3))
39 |     (2 3 4)
40 |     
41 | You may also load the core library and start a REPL with `./gherkin -l core.gk -r`.
42 | 
43 | ## Learning more & getting involved
44 | 
45 | gherkin is brand new, under active development, and not yet formally released.  As such, its usage is error-prone and its documentation spotty.  If you'd like to help us improve gherkin, its documentation, or have any questions, please join us: 
46 | 
47 | * In`#gherkin` on `irc.freenode.net`.
48 | * On the [gherkin-dev@googlegroups.com mailing list](https://groups.google.com/d/forum/gherkin-dev).
49 | 
50 | ## Related tools
51 | 
52 | * [gherkin-mode](https://github.com/candera/gherkin-mode) is an [Emacs](http://www.gnu.org/software/emacs/) mode for editing gherkin contributed by [Craig Andera](https://github.com/candera)
53 | 
54 | # Thanks
55 | 
56 | * to [Darius Bacon](http://wry.me/blog/) for his version of [awklisp](https://github.com/darius/awklisp) which was the basis for the original prototype
57 | 


--------------------------------------------------------------------------------
/core.gk:
--------------------------------------------------------------------------------
  1 | ;;(ns core)
  2 | 
  3 | (def first car)
  4 | 
  5 | (def rest cdr)
  6 | 
  7 | (def ffirst (fn (xs) (car (car xs))))
  8 | 
  9 | (def second (fn (xs) (car (cdr xs))))
 10 | 
 11 | (def last
 12 |   (fn (xs)
 13 |     (if (cdr xs)
 14 |       (recur (cdr xs))
 15 |       (first xs))))
 16 | 
 17 | (def inc
 18 |   (fn (n) (+ n 1)))
 19 | 
 20 | (def dec
 21 |   (fn (n) (- n 1)))
 22 | 
 23 | (def zero?
 24 |   (fn (n) (eq? 0 n)))
 25 | 
 26 | (def reduce
 27 |   (fn (f init xs)
 28 |     (if xs
 29 |       (recur f (f init (car xs)) (cdr xs))
 30 |       init)))
 31 | 
 32 | (def count
 33 |   (fn (lst)
 34 |     (reduce (fn (x y) (inc x)) 0 lst)))
 35 | 
 36 | (def identity (fn (x) x))
 37 | 
 38 | (def every?
 39 |   (fn (pred xs)
 40 |     (if xs
 41 |       (if (pred (car xs))
 42 |         (recur pred (cdr xs)))
 43 |       t)))
 44 | 
 45 | (def some
 46 |   (fn (pred xs)
 47 |     (if xs
 48 |       (if (pred (car xs))
 49 |         t
 50 |         (recur pred (cdr xs)))
 51 |       nil)))
 52 | 
 53 | (def or (fn (& xs) (some identity xs)))
 54 | 
 55 | (def and (fn (& xs) (every? identity xs)))
 56 | 
 57 | (def not (fn (x) (if x nil t)))
 58 | 
 59 | (def complement
 60 |   (fn (pred)
 61 |     (fn (x) (not (pred x)))))
 62 | 
 63 | (def even?
 64 |   (fn (n) (eq? 0 (mod n 2))))
 65 | 
 66 | (def odd?
 67 |   (complement even?))
 68 | 
 69 | (def drop
 70 |   (fn (n lst)
 71 |     (if (eq? 0 n)
 72 |       lst
 73 |       (recur (dec n) (cdr lst)))))
 74 | 
 75 | (def take
 76 |   (fn (n lst)
 77 |     (if (> n 0)
 78 |       (if lst
 79 |         (cons (car lst) (take (dec n) (cdr lst)))))))
 80 | 
 81 | (def nth
 82 |   (fn (n lst)
 83 |     (car (drop n lst))))
 84 | 
 85 | (def map
 86 |   (fn (f xs)
 87 |     (if xs
 88 |       (cons (f (car xs)) (map f (cdr xs))))))
 89 | 
 90 | (def reverse
 91 |   (fn (lst)
 92 |     (reduce (fn (xs y) (cons y xs)) nil lst)))
 93 | 
 94 | (def concat
 95 |   (fn (lst & more)
 96 |     (if lst
 97 |       (cons (car lst) (apply concat (cons (cdr lst) more)))
 98 |       (if more
 99 |         (apply concat more)))))
100 | 
101 | (def partial
102 |   (fn (f & args)
103 |     (fn (& more)
104 |       (apply f (concat args more)))))
105 | 
106 | (def juxt
107 |   (fn (& fns)
108 |     (fn (arg)
109 |       (map (fn (f) (f arg)) fns))))
110 | 
111 | (def repeat
112 |   (fn (n x)
113 |     (if (> n 0) (cons x (repeat (dec n) x)))))
114 | 
115 | (def interleave
116 |   (fn (& lst)
117 |     (if (every? identity lst)
118 |       (concat (map car lst) (apply interleave (map cdr lst))))))
119 | 
120 | (def interpose
121 |   (fn (sep lst)
122 |     (drop 1 (interleave (repeat (count lst) sep) lst))))
123 | 
124 | (def join
125 |   (fn (sep lst)
126 |     (apply str (interpose sep lst))))
127 | 
128 | (def filter
129 |   (fn (pred lst)
130 |     (if lst
131 |       (if (pred (car lst))
132 |         (cons (car lst) (filter pred (cdr lst)))
133 |         (recur pred (cdr lst))))))
134 | 
135 | (def remove
136 |   (fn (pred lst)
137 |     (filter (complement pred) lst)))
138 | 
139 | (def comp
140 |   (fn (& fns)
141 |     ((fn (rfns)
142 |       (fn (& args)
143 |         (reduce (fn (val f) (f val))
144 |                 (apply (car rfns) args)
145 |                 (cdr rfns)))) (reverse fns))))
146 | 


--------------------------------------------------------------------------------
/fib.gk:
--------------------------------------------------------------------------------
 1 | #!./gherkin
 2 | (def concat
 3 |   (fn (lst & more)
 4 |     (if lst
 5 |       (cons (car lst) (apply concat (cons (cdr lst) more)))
 6 |       (if more (apply concat more)))))
 7 | 
 8 | (def partial
 9 |   (fn (f & args)
10 |     (fn (& more)
11 |       (apply f (concat args more)))))
12 |       
13 | (def fib*
14 |   (fn (a b n)
15 |     (if (> n 0)
16 |       (recur b (+ a b) (- n 1))
17 |       a)))
18 | 
19 | (def fib (partial fib* 0 1))
20 |  
21 | (println (fib 60))
22 | 


--------------------------------------------------------------------------------
/gherkin:
--------------------------------------------------------------------------------
   1 | #!/usr/bin/env bash
   2 | # -*- mode: sh; sh-basic-offset: 2 -*-
   3 | 
   4 | usage() {
   5 |   echo "$0 [OPTION] FILE..."
   6 |   echo
   7 |   echo "Options:"
   8 |   echo "  -e|--eval STR    Evaluate STR"
   9 |   echo "  -l|--load FILE   Load and evaluate FILE"
  10 |   echo "  -r|--repl        Start a REPL"
  11 |   exit 2
  12 | }
  13 | 
  14 | if [[ -z "$BASH_VERSION" ]] || ((${BASH_VERSINFO[0]} < 4)); then
  15 |   echo "bash >= 4.0 required" >&2
  16 |   exit 1
  17 | fi
  18 | 
  19 | DEFAULT_IFS="$IFS"
  20 | 
  21 | # function return and error slots ##############################################
  22 | 
  23 | r=""
  24 | e=""
  25 | 
  26 | error() {
  27 |   [[ -z "$e" ]] && e="$1" || e="$1\n$e"
  28 |   r=$NIL
  29 |   return 1
  30 | }
  31 | 
  32 | # pushback reader ##############################################################
  33 | 
  34 | pb_max=100
  35 | pb_newline="$(printf '\034')"
  36 | pb_star="$(printf '\035')"
  37 | pb_get="^$"
  38 | pb_unget="^$"
  39 | history_flag=1
  40 | 
  41 | readline() {
  42 |   local IFS=$'\n\b' prompt="> " line
  43 |   set -f
  44 |   read -e -r -p "$prompt" line || exit 0
  45 |   pb_get="${pb_get:0:$((${#pb_get}-1))}${line}${pb_newline}$"
  46 |   set +f
  47 |   unset IFS
  48 |   if [[ "$line" =~ ^[[:space:]]*- ]]; then
  49 |     echo "warning: lines starting with - aren't stored in history" >&2
  50 |   elif [[ -n "$history_flag" ]]; then
  51 |     history -s "$line"
  52 |   fi
  53 | }
  54 | 
  55 | getc() {
  56 |   local ch
  57 |   if ((${#pb_get} == 2)); then
  58 |     readline
  59 |     getc
  60 |   else
  61 |     ch="${pb_get:1:1}"
  62 |     pb_get="^${pb_get:2}"
  63 |     if ((pb_max > 0)); then
  64 |       pb_unget="${pb_unget:0:$((${#pb_unget}-1))}"
  65 |       pb_unget="^${ch}${pb_unget:1:$((pb_max-1))}$"
  66 |     else
  67 |       pb_unget="^${ch}${pb_unget:1}"
  68 |     fi
  69 |     r="$ch"
  70 |   fi
  71 | }
  72 | 
  73 | ungetc() {
  74 |   if [[ "$pb_unget" == "^$" ]]; then
  75 |     echo "ungetc: nothing more to unget, \$pb_max=$pb_max" >&2 && return 1
  76 |   else
  77 |     pb_get="^${pb_unget:1:1}${pb_get:1}"
  78 |     pb_unget="^${pb_unget:2}"
  79 |   fi
  80 | }
  81 | 
  82 | has_shebangP() { [[ "$(head -1 $1)" =~ ^#! && "$(head -1 $1)" =~ gherkin ]]; }
  83 | 
  84 | strmap_file() {
  85 |   local f="$1" contents
  86 |   if has_shebangP "$f"; then
  87 |     contents="$(tail -n+2 "$f" | sed -e 's/^[[:space:]]*//' | tr -s '\n' $pb_newline)"
  88 |   else
  89 |     contents="$(cat "$f" | sed -e 's/^[[:space:]]*//' | tr -s '\n' $pb_newline)"
  90 |   fi
  91 |   mapped_file="(do $contents nil)"
  92 |   mapped_file_ptr=0
  93 | }
  94 | 
  95 | strmap_getc() {
  96 |   r="${mapped_file:$((mapped_file_ptr++)):1}"
  97 | }
  98 | 
  99 | strmap_ungetc() {
 100 |   let --mapped_file_ptr
 101 | }
 102 | 
 103 | _getc=getc
 104 | _ungetc=ungetc
 105 | 
 106 | # memory layout & gc ###########################################################
 107 | 
 108 | cons_ptr=0
 109 | symbol_ptr=0
 110 | 
 111 | protected_ptr=0
 112 | gensym_counter=0
 113 | array_cntr=0
 114 | 
 115 | declare -A interned_strings
 116 | declare -A car
 117 | declare -A cdr
 118 | declare -A environments
 119 | declare -A recur_frames
 120 | declare -A recur_fns
 121 | declare -A marks
 122 | declare -A global_bindings
 123 | 
 124 | declare -a symbols
 125 | declare -a protected
 126 | declare -a mark_acc
 127 | 
 128 | heap_increment=1500
 129 | cons_limit=$heap_increment
 130 | symbol_limit=$heap_increment
 131 | 
 132 | tag_marker="$(printf '\036')"
 133 | 
 134 | atag="${tag_marker}003"
 135 | 
 136 | declare -A type_tags=([000]=integer
 137 |                       [001]=symbol
 138 |                       [002]=cons
 139 |                       [003]=vector
 140 |                       [004]=keyword)
 141 | 
 142 | type() {
 143 |   if [[ "${1:0:1}" == "$tag_marker" ]]; then
 144 |     r="${type_tags[${1:1:3}]}"
 145 |   else
 146 |     r=string
 147 |   fi
 148 | }
 149 | 
 150 | strip_tag() { r="${1:4}"; }
 151 | 
 152 | typeP() {
 153 |   local obj="$1" tag="$2"
 154 |   type "$obj" && [[ $r == "$tag" ]]
 155 | }
 156 | 
 157 | make_integer() { r="${tag_marker}000${1}"; }
 158 | 
 159 | make_keyword() { r="${tag_marker}004${1:1}"; }
 160 | 
 161 | intern_symbol() {
 162 |   if [[ -n "${interned_strings[$1]}" ]]; then
 163 |     r="${interned_strings[$1]}"
 164 |   else
 165 |     symbol_ptr="$((symbol_ptr + 1))"
 166 |     interned_strings["$1"]="${tag_marker}001${symbol_ptr}"
 167 |     symbols["$symbol_ptr"]="$1"
 168 |     r="${tag_marker}001${symbol_ptr}"
 169 |   fi
 170 | }
 171 | 
 172 | defprim() {
 173 |   intern_symbol "$1" && sym_ptr="$r"
 174 |   intern_symbol "$(printf '#<primitive:%s>' "$1")" && prim_ptr="$r"
 175 |   global_bindings["$sym_ptr"]=$prim_ptr
 176 |   r="$prim_ptr"
 177 | }
 178 | 
 179 | cons() {
 180 |   local the_car="$1" the_cdr="$2"
 181 |   mark "$the_car"
 182 |   mark "$the_cdr"
 183 |   while [[ -n "${marks[${tag_marker}002${cons_ptr}]}" ]]; do
 184 |     unset marks["${tag_marker}002$((cons_ptr++))"]
 185 |   done
 186 |   if [[ $cons_ptr == $cons_limit ]]; then
 187 |     gc
 188 |   fi
 189 |   unset environments["${tag_marker}002${cons_ptr}"]
 190 |   unset recur_frames["${tag_marker}002${cons_ptr}"]
 191 |   unset recur_fns["${tag_marker}002${cons_ptr}"]
 192 |   car["${tag_marker}002${cons_ptr}"]="$the_car"
 193 |   cdr["${tag_marker}002${cons_ptr}"]="$the_cdr"
 194 |   r="${tag_marker}002${cons_ptr}"
 195 |   cons_ptr="$((cons_ptr + 1))"
 196 | }
 197 | 
 198 | gensym() {
 199 |   gensym_counter=$((gensym_counter + 1))
 200 |   intern_symbol "G__${gensym_counter}"
 201 | }
 202 | 
 203 | new_array() {
 204 |   r="arr$((array_cntr++))"
 205 |   declare -a $r
 206 |   r="${atag}${r}"
 207 | }
 208 | 
 209 | vset() {
 210 |   strip_tag "$1"
 211 |   eval "${r}[${2}]=\"${3}\""
 212 |   r="$1"
 213 | }
 214 | 
 215 | vget() {
 216 |   strip_tag "$1"
 217 |   eval "r=\${${r}[${2}]}"
 218 | }
 219 | 
 220 | count_array() {
 221 |   strip_tag "$1"
 222 |   eval "r=\${#${r}[@]}"
 223 | }
 224 | 
 225 | append() {
 226 |   local i
 227 |   strip_tag "$1"
 228 |   eval "i=\${#${r}[@]}"
 229 |   eval "${r}[${i}]=\"${2}\""
 230 |   r="$1"
 231 | }
 232 | 
 233 | append_all() {
 234 |   strip_tag "$1"
 235 |   local a1="$r"
 236 |   strip_tag "$2"
 237 |   local a2="$r"
 238 |   local len1 len2
 239 |   eval "len1=\${#${a1}[@]}"
 240 |   eval "len2=\${#${a2}[@]}"
 241 |   local i=0
 242 |   while ((i < len2)); do
 243 |     eval "${a1}[((${i} + ${len1}))]=\"\${${a2}[${i}]}\""
 244 |     ((i++))
 245 |   done
 246 |   r="$1"
 247 | }
 248 | 
 249 | prepend() {
 250 |   local i len
 251 |   strip_tag "$2"
 252 |   eval "len=\${#${r}[@]}"
 253 |   while ((len > 0)); do
 254 |     eval "${r}[${len}]=\"\${${r}[((len - 1))]}\""
 255 |     ((len--))
 256 |   done
 257 |   eval "${r}[0]=\"$1\""
 258 |   r="$2"
 259 | }
 260 | 
 261 | dup() {
 262 |   new_array
 263 |   local aptr="$r"
 264 |   strip_tag "$aptr"
 265 |   local narr="$r"
 266 |   strip_tag "$1"
 267 |   local len
 268 |   eval "len=\${#${r}[@]}"
 269 |   local i=0
 270 |   while ((i < len)); do
 271 |     eval "${narr}[${i}]=\"\${${r}[${i}]}\""
 272 |     ((i++))
 273 |   done
 274 |   r="$aptr"
 275 | }
 276 | 
 277 | concat() {
 278 |   dup "$1"
 279 |   append_all "$r" "$2"
 280 | }
 281 | 
 282 | vector() {
 283 |   local v="$2"
 284 |   if [[ "$EMPTY" == "$v" || -z "$v" || "$NIL" == "$v" ]]; then 
 285 |     new_array
 286 |     v="$r"
 287 |   fi
 288 |   prepend $1 $v
 289 | }
 290 | 
 291 | protect() {
 292 |   protected_ptr="$((protected_ptr + 1))"
 293 |   protected["$protected_ptr"]="$1"
 294 | }
 295 | 
 296 | unprotect() { protected_ptr="$((protected_ptr - 1))"; }
 297 | 
 298 | acc_count=0
 299 | 
 300 | mark_seq() {
 301 |   local object="$1"
 302 |   while typeP "$object" cons && [[ -z "${marks[$object]}" ]]; do
 303 |     marks["$object"]=1
 304 |     mark_acc[acc_count++]="${car[$object]}"
 305 |     object="${cdr[$object]}"
 306 |   done
 307 |   if typeP "$object" vector ; then
 308 |     count_array "$object"
 309 |     local i sz="$r"
 310 |     for ((i=0; i<sz; i++)); do
 311 |       vget "$object" $i
 312 |       mark_acc[acc_count++]="$r"
 313 |     done
 314 |   fi
 315 | }
 316 | 
 317 | mark() {
 318 |   acc_count=0
 319 |   mark_seq "$1"
 320 |   local i
 321 |   for ((i=0; i<${#mark_acc[@]}; i++)); do
 322 |     mark_seq "${mark_acc[$i]}"
 323 |   done
 324 |   mark_acc=()
 325 | }
 326 | 
 327 | gc() {
 328 |   echo "GC..." >&2
 329 |   IFS="$DEFAULT_IFS"
 330 |   mark "$current_env"
 331 |   for k in "${!environments[@]}";    do mark "${environments[$k]}";    done
 332 |   for k in "${!protected[@]}";       do mark "${protected[$k]}";       done
 333 |   for k in "${!stack[@]}";           do mark "${stack[$k]}";           done
 334 |   for k in "${!global_bindings[@]}"; do mark "${global_bindings[$k]}"; done
 335 |   cons_ptr=0
 336 |   while [[ -n "${marks[${tag_marker}002${cons_ptr}]}" ]]; do
 337 |     unset marks["${tag_marker}002$((cons_ptr++))"]
 338 |   done
 339 |   if [[ $cons_ptr == $cons_limit ]]; then
 340 |     echo "expanding heap..." >&2
 341 |     cons_limit=$((cons_limit + heap_increment))
 342 |   fi
 343 | }
 344 | 
 345 | # reader #######################################################################
 346 | 
 347 | interpret_token() {
 348 |   [[ "$1" =~ ^-?[[:digit:]]+$ ]] \
 349 |     && r=integer && return
 350 |   [[ "$1" =~ ^:([[:graph:]]|$pb_star)+$ ]] \
 351 |     && r=keyword && return
 352 |   [[ "$1" =~ ^([[:graph:]]|$pb_star)+$ ]] \
 353 |     && r=symbol && return
 354 |   return 1
 355 | }
 356 | 
 357 | read_token() {
 358 |   local token=""
 359 |   while $_getc; do
 360 |     if [[ "$r" =~ ('('|')'|'['|']'|[[:space:]]|$pb_newline|,) ]]; then
 361 |       $_ungetc && break
 362 |     else
 363 |       token="${token}${r/\*/${pb_star}}"
 364 |     fi
 365 |   done
 366 |   [ -z "$token" ] && return 1
 367 |   if interpret_token "$token"; then
 368 |     case "$r" in
 369 |       symbol)  intern_symbol "$token" && return ;;
 370 |       integer) make_integer "$token" && return ;;
 371 |       keyword) make_keyword "$token" && return ;;
 372 |       *) error "unknown token type: '$r'"
 373 |     esac
 374 |   else
 375 |     error "unknown token: '${token}'"
 376 |   fi
 377 | }
 378 | 
 379 | skip_blanks() {
 380 |   $_getc
 381 |   while [[ "$r" =~ ([[:space:]]|$pb_newline|,) ]]; do $_getc; done
 382 |   $_ungetc
 383 | }
 384 | 
 385 | skip_comment() {
 386 |   $_getc
 387 |   while [[ "$r" != "$pb_newline" ]]; do $_getc; done
 388 | }
 389 | 
 390 | read_list() {
 391 |   local ch read1 read2
 392 |   if lisp_read; then
 393 |     read1="$r"
 394 |   else
 395 |     $_getc
 396 |     r="$NIL"
 397 |     return
 398 |   fi
 399 |   $_getc && ch="$r"
 400 |   case "$ch" in
 401 |     ".")
 402 |       lisp_read && read2="$r"
 403 |       skip_blanks
 404 |       $_getc
 405 |       cons "$read1" "$read2"
 406 |       ;;
 407 |     ")") cons "$read1" $NIL ;;
 408 |     *)
 409 |       $_ungetc
 410 |       read_list
 411 |       cons "$read1" "$r"
 412 |   esac
 413 | }
 414 | 
 415 | read_vector() {
 416 |   local ch read1
 417 |   if lisp_read; then
 418 |     read1="$r"
 419 |   else
 420 |     getc
 421 |     r="$EMPTY"
 422 |     return
 423 |   fi
 424 |   skip_blanks
 425 |   getc
 426 |   if [[ "$r" == "]" ]]; then
 427 |     vector "$read1" "$EMPTY"
 428 |   else
 429 |     ungetc
 430 |     skip_blanks
 431 |     read_vector
 432 |     vector "$read1" "$r"
 433 |   fi
 434 | }
 435 | 
 436 | read_string() {
 437 |   local s=""
 438 |   while true; do
 439 |     $_getc
 440 |     if [[ "$r" == "\\" ]]; then
 441 |       $_getc
 442 |       if [[ "$r" == '"' ]]; then
 443 | 	s="${s}${r}"
 444 |       else
 445 | 	s="${s}\\${r}"
 446 |       fi
 447 |     elif [[ "$r" == '"' ]]; then
 448 |       break
 449 |     else
 450 |       s="${s}${r}"
 451 |     fi
 452 |   done
 453 |   r="$(echo "$s" | tr "$pb_star" '*')"
 454 | }
 455 | 
 456 | lisp_read() {
 457 |   local ch read1 read2 read3 read4
 458 |   skip_blanks; $_getc; ch="$r"
 459 |   case "$ch" in
 460 |     "\"")
 461 |       read_string
 462 |       ;;
 463 |     "(")
 464 |       read_list
 465 |       ;;
 466 |     "[")
 467 |       read_vector
 468 |       ;;
 469 |     "'")
 470 |       lisp_read && read1="$r"
 471 |       cons "$read1" $NIL && read2="$r"
 472 |       cons $QUOTE "$read2"
 473 |       ;;
 474 |     ";")
 475 |       skip_comment
 476 |       lisp_read
 477 |       ;;
 478 |     *)
 479 |       $_ungetc
 480 |       read_token
 481 |   esac
 482 | }
 483 | 
 484 | string_list() {
 485 |   local c="$1" ret
 486 |   shift
 487 |   if [[ "$1" == "" ]]; then
 488 |     cons $c $NIL && ret="$r"
 489 |   else
 490 |     string_list $*
 491 |     cons $c $r && ret="$r"
 492 |   fi
 493 |   r="$ret"
 494 | }
 495 | 
 496 | # printer ######################################################################
 497 | printing=
 498 | 
 499 | escape_str() {
 500 |   local i c
 501 |   r=""
 502 |   for ((i=0; i < ${#1}; i++)); do
 503 |     c="${1:$i:1}"
 504 |     case "$c" in
 505 |       \") r="${r}\\\"" ;;
 506 |       \\) r="${r}\\\\" ;;
 507 |       *) r="${r}${c}"
 508 |     esac
 509 |   done
 510 | }
 511 | 
 512 | str_arr() {
 513 |   local ret="["
 514 |   count_array "$1"
 515 |   local len=$r
 516 |   if (( 0 != len )); then
 517 |     vget $1 0
 518 |     str "$r"
 519 |     ret="${ret}${r}"
 520 |     for ((i=1 ; i < $len ; i++)); do
 521 |       vget $1 $i
 522 |       str "$r"
 523 |       ret="${ret} ${r}"
 524 |     done
 525 |   fi
 526 |   r="${ret}]"
 527 | }
 528 | 
 529 | str_list() {
 530 |   local lst="$1"
 531 |   local ret
 532 |   if [[ "${car[$lst]}" == $FN ]]; then
 533 |     strip_tag "$lst" && printf -v r '#<function:%s>' "$r"
 534 |   else
 535 |     ret="("
 536 |     str "${car[$lst]}"
 537 |     ret="${ret}${r}"
 538 |     lst="${cdr[$lst]}"
 539 |     while typeP "$lst" cons ; do
 540 |       str "${car[$lst]}"
 541 |       ret="${ret} ${r}"
 542 |       lst="${cdr[$lst]}"
 543 |     done
 544 |     if [[ "$lst" != $NIL ]]; then
 545 |       str "$lst"
 546 |       ret="${ret} . ${r}"
 547 |     fi
 548 |     r="${ret})"
 549 |   fi
 550 | }
 551 | 
 552 | str() {
 553 |   type "$1"
 554 |   case "$r" in
 555 |     integer) strip_tag "$1" && printf -v r '%d' "$r" ;;
 556 |     cons) str_list "$1" ;;
 557 |     vector) str_arr "$1" ;;
 558 |     symbol) strip_tag "$1" && printf -v r '%s' "$(echo "${symbols[$r]}" | tr $pb_star "*")" ;;
 559 |     keyword) strip_tag "$1" && printf -v r ':%s' "$r" ;;
 560 |     *)
 561 |       if [[ -n $printing ]]; then
 562 |         escape_str "$1"
 563 |         printf -v r '"%s"' "$r"
 564 |       else
 565 |         printf -v r '%s' "$1"
 566 |       fi
 567 |       ;;
 568 |   esac
 569 | }
 570 | 
 571 | prn() {
 572 |   printing=1
 573 |   str "$1"
 574 |   printing=
 575 |   printf '%s' "$r" && echo
 576 | }
 577 | 
 578 | # environment & control ########################################################
 579 | 
 580 | frame_ptr=0
 581 | stack_ptr=0
 582 | 
 583 | declare -a stack
 584 | 
 585 | intern_symbol '&'      && AMP="$r"
 586 | intern_symbol 'nil'    && NIL="$r"
 587 | intern_symbol 't'      && T="$r"
 588 | global_bindings[$NIL]="$NIL"
 589 | global_bindings[$T]="$T"
 590 | car[$NIL]="$NIL"
 591 | cdr[$NIL]="$NIL"
 592 | 
 593 | new_array && EMPTY="$r"
 594 | 
 595 | current_env="$NIL"
 596 | 
 597 | intern_symbol 'quote'   && QUOTE=$r
 598 | intern_symbol 'fn'      && FN=$r
 599 | intern_symbol 'if'      && IF=$r
 600 | intern_symbol 'set!'    && SET_BANG=$r
 601 | intern_symbol 'def'     && DEF=$r
 602 | intern_symbol 'do'      && DO=$r
 603 | intern_symbol 'recur'   && RECUR=$r
 604 | intern_symbol 'binding' && BINDING=$r
 605 | 
 606 | declare -A specials
 607 | 
 608 | specials[$QUOTE]=1
 609 | specials[$FN]=1
 610 | specials[$IF]=1
 611 | specials[$SET_BANG]=1
 612 | specials[$DEF]=1
 613 | specials[$DO]=1
 614 | specials[$RECUR]=1
 615 | specials[$BINDING]=1
 616 | 
 617 | defprim 'eq?'       && EQ=$r
 618 | defprim 'nil?'      && NILP=$r
 619 | defprim 'car'       && CAR=$r
 620 | defprim 'cdr'       && CDR=$r
 621 | defprim 'cons'      && CONS=$r
 622 | defprim 'list'      && LIST=$r
 623 | defprim 'vector'    && VECTOR=$r
 624 | defprim 'keyword'   && KEYWORD=$r
 625 | defprim 'eval'      && EVAL=$r
 626 | defprim 'apply'     && APPLY=$r
 627 | defprim 'read'      && READ=$r
 628 | defprim '+'         && ADD=$r
 629 | defprim '-'         && SUB=$r
 630 | defprim "$pb_star"  && MUL=$r
 631 | defprim '/'         && DIV=$r
 632 | defprim 'mod'       && MOD=$r
 633 | defprim '<'         && LT=$r
 634 | defprim '>'         && GT=$r
 635 | defprim 'cons?'     && CONSP=$r
 636 | defprim 'symbol?'   && SYMBOLP=$r
 637 | defprim 'number?'   && NUMBERP=$r
 638 | defprim 'string?'   && STRINGP=$r
 639 | defprim 'fn?'       && FNP=$r
 640 | defprim 'gensym'    && GENSYM=$r
 641 | defprim 'random'    && RAND=$r
 642 | defprim 'exit'      && EXIT=$r
 643 | defprim 'println'   && PRINTLN=$r
 644 | defprim 'sh'        && SH=$r
 645 | defprim 'sh!'       && SH_BANG=$r
 646 | defprim 'load-file' && LOAD_FILE=$r
 647 | defprim 'gc'        && GC=$r
 648 | defprim 'error'     && ERROR=$r
 649 | defprim 'type'      && TYPE=$r
 650 | defprim 'str'       && STR=$r
 651 | defprim 'split'     && SPLIT=$r
 652 | defprim 'getenv'    && GETENV=$r
 653 | 
 654 | eval_args() {
 655 |   local args="$1"
 656 |   type "$args"
 657 |   if [[ "$r" == cons ]]; then
 658 |     while [[ "$args" != $NIL ]]; do
 659 |       lisp_eval "${car[$args]}"
 660 |       stack[$((stack_ptr++))]="$r"
 661 |       args="${cdr[$args]}"
 662 |     done
 663 |   elif [[ "$r" == vector ]]; then
 664 |     count_array "$args"
 665 |     local i len="$r"
 666 |     for ((i=0; i<len; i++)); do
 667 |       vget "$args" "$i"
 668 |       lisp_eval "$r"
 669 |       stack[$((stack_ptr++))]="$r"
 670 |     done
 671 |   elif [[ "$1" != "$NIL" ]]; then
 672 |     str "$args"
 673 |     error "Unknown argument type: $r"
 674 |   fi
 675 | }
 676 | 
 677 | listify_args() {
 678 |   local p=$((stack_ptr - 1)) ret=$NIL stop
 679 |   [[ -z "$1" ]] && stop=$frame_ptr || stop="$1"
 680 |   while ((stop <= p)); do
 681 |     cons "${stack[$p]}" "$ret" && ret="$r"
 682 |     p=$((p - 1))
 683 |   done
 684 |   r="$ret"
 685 | }
 686 | 
 687 | vectify_args() {
 688 |   local stop=$((stack_ptr - 1)) ret
 689 |   new_array
 690 |   ret="$r"
 691 |   [[ -z "$1" ]] && p=$frame_ptr || p="$1"
 692 |   while ((p <= stop)); do
 693 |     append "$ret" "${stack[$((p++))]}"
 694 |   done
 695 |   r="$ret"
 696 | }
 697 | 
 698 | acons() {
 699 |   local key="$1" datum="$2" a_list="$3"
 700 |   cons "$key" "$datum" && cons "$r" "$a_list"
 701 | }
 702 | 
 703 | aget() {
 704 |   local key="$1" a_list="$2"
 705 |   while [[ "$a_list" != $NIL ]]; do
 706 |     if [[ "${car[${car[$a_list]}]}" == "$key" ]]; then
 707 |       r="${cdr[${car[$a_list]}]}" && return 0
 708 |     fi
 709 |     a_list="${cdr[$a_list]}"
 710 |   done
 711 |   r=$NIL && return 1
 712 | }
 713 | 
 714 | analyze() {
 715 |   local fn="$1" body="$2" env="$3"
 716 |   while [[ "$body" != "$NIL" ]]; do
 717 |     type "${car[$body]}"
 718 |     if [[ "$r" == cons ]]; then
 719 |       case "${car[${car[$body]}]}" in
 720 |         $FN) environments["${car[$body]}"]="$env" ;;
 721 |         $RECUR)
 722 |           recur_fns["${car[$body]}"]="$fn"
 723 |           recur_frames["${car[$body]}"]="$frame_ptr"
 724 |           ;;
 725 |         *) analyze "$fn" "${car[$body]}" "$env" ;;
 726 |       esac
 727 |     fi
 728 |     body="${cdr[$body]}"
 729 |   done
 730 | }
 731 | 
 732 | copy_list() {
 733 |   local lst="$1" copy="$NIL" prev="$NIL" curr="$NIL"
 734 |   while [[ "$lst" != "$NIL" ]]; do
 735 |     cons "${car[$lst]}" "$NIL" && curr="$r"
 736 |     if [[ "$copy" == "$NIL" ]]; then
 737 |       copy="$curr"
 738 |     else
 739 |       cdr["$prev"]="$curr"
 740 |     fi
 741 |     prev="$curr"
 742 |     lst="${cdr[$lst]}"
 743 |   done
 744 |   r="$copy"
 745 | }
 746 | 
 747 | apply_user() {
 748 |   local fn="$1"
 749 |   local body="${cdr[${cdr[$fn]}]}"
 750 |   local params="${car[${cdr[$fn]}]}"
 751 |   local p="$frame_ptr"
 752 |   local ret="$NIL"
 753 |   local old_env
 754 | 
 755 |   [[ -z "${environments[$fn]}" ]] && local env=$NIL || local env="${environments[$fn]}"
 756 | 
 757 |   type "$params"
 758 |   local ptype="$r"
 759 |   if [[ "$ptype" == "cons" ]]; then
 760 |     while [[ "$params" != $NIL && "${car[$params]}" != $AMP ]]; do
 761 |       acons "${car[$params]}" "${stack[$((p++))]}" "$env" && env="$r"
 762 |       params="${cdr[$params]}"
 763 |     done
 764 |     if [[ "${car[$params]}" == $AMP ]]; then
 765 |       listify_args "$p" && local more="$r"
 766 |       acons "${car[${cdr[$params]}]}" "$more" "$env" && env="$r"
 767 |     fi
 768 |   elif [[ "$ptype" == "vector" ]]; then
 769 |     local i=1 len
 770 |     count_array "$params"
 771 |     len="$r"
 772 |     vget $params 0
 773 |     while ((i <= len)) && [[ "$r" != $AMP ]]; do
 774 |       acons "$r" "${stack[$((p++))]}" "$env" && env="$r"
 775 |       vget $params $((i++))
 776 |     done
 777 |     if [[ "$r" == "$AMP" ]]; then
 778 |       listify_args "$p" && local more="$r"
 779 |       vget $params $i
 780 |       acons "$r" "$more" "$env" && env="$r"
 781 |     fi
 782 |   elif [[ "$params" != $NIL ]]; then
 783 |     error "Illegal type (${ptype}) for params in function"
 784 |     return 1
 785 |   fi
 786 | 
 787 | 
 788 |   analyze "$fn" "$body" "$env"
 789 | 
 790 |   old_env="$current_env"
 791 |   current_env="$env"
 792 |   do_ "$body" && ret="$r"
 793 |   current_env="$old_env"
 794 |   r="$ret"
 795 | }
 796 | 
 797 | eval_file() {
 798 |   strmap_file "$1"
 799 |   _getc=strmap_getc
 800 |   _ungetc=strmap_ungetc
 801 |   lisp_read
 802 |   _getc=getc
 803 |   _ungetc=ungetc
 804 |   protect "$r"
 805 |   lisp_eval "$r"
 806 |   unprotect
 807 | }
 808 | 
 809 | check_numbers() {
 810 |   while [[ -n "$1" ]]; do
 811 |     if ! typeP "$1" integer ; then
 812 |       str "$1"
 813 |       error "'$r' is not a number"
 814 |       return 1
 815 |     fi
 816 |     shift
 817 |   done
 818 | }
 819 | 
 820 | rev_str() {
 821 |   local i rev=""
 822 |   for ((i=0; i < ${#1}; i++)); do
 823 |     rev="${1:$i:1}${rev}"
 824 |   done
 825 |   r="$rev"
 826 | }
 827 | 
 828 | apply_primitive() {
 829 |   local primitive="$1"
 830 |   local arg0="${stack[$frame_ptr]}"
 831 |   local arg1="${stack[$((frame_ptr+1))]}"
 832 |   local arg2="${stack[$((frame_ptr+2))]}"
 833 | 
 834 |   r=$NIL
 835 |   case $primitive in
 836 |     $EQ)         [[ "$arg0" == "$arg1" ]] && r="$T" ;;
 837 |     $NILP)       [[ "$arg0" == $NIL ]] && r="$T"    ;;
 838 |     $CAR)        r="${car[$arg0]}"                  ;;
 839 |     $CDR)        r="${cdr[$arg0]}"                  ;;
 840 |     $CONS)       cons "$arg0" "$arg1"               ;;
 841 |     $LIST)       listify_args                       ;;
 842 |     $VECTOR)     vectify_args                       ;;
 843 |     $KEYWORD)
 844 |       type "$arg0"
 845 |       case $r in
 846 |         string) make_keyword "$arg0" ;;
 847 |         keyword) r="$arg0" ;;
 848 |         *)
 849 |           strip_tag "$arg0"
 850 |           error "Unable to make keyword from: $r"
 851 |           r="$NIL"
 852 |       esac
 853 |       ;;
 854 |     $STR)
 855 |       listify_args && strs="$r"
 856 |       local ret=""
 857 |       while [[ "$strs" != "$NIL" ]]; do
 858 |         str "${car[$strs]}"
 859 |         ret="${ret}$r"
 860 |         strs="${cdr[$strs]}"
 861 |       done
 862 |       r="$ret"
 863 |       ;;
 864 |     $SPLIT)
 865 |       local i ret="$NIL" last=0
 866 |       rev_str "$arg1" && local rev="$r"
 867 |       for ((i=0; i < ${#rev}; i++)); do
 868 |         if [[ "${rev:$i:1}" == "$arg0" ]]; then
 869 |           rev_str "${rev:$last:$((i - last))}"
 870 |           cons "$r" "$ret" && ret="$r"
 871 |           last="$((i + 1))"
 872 |         fi
 873 |       done
 874 |       if ((last != 0)); then
 875 |         rev_str "${rev:$last:$((${#rev} - last))}"
 876 |         cons "$r" "$ret" && ret="$r"
 877 |       fi
 878 |       r="$ret"
 879 |       ;;
 880 |     $GETENV)
 881 |       [[ -n "$arg0" ]] && eval "r=\$${arg0}"
 882 |       [[ -z "$r" ]] && r=$NIL
 883 |       ;;
 884 |     $EVAL)       lisp_eval "$arg0"    ;;
 885 |     $READ)       lisp_read            ;;
 886 |     $MOD)
 887 |       if check_numbers "$arg0" "$arg1" ; then
 888 |         strip_tag "$arg0" && local x="$r"
 889 |         strip_tag "$arg1" && local y="$r"
 890 |         make_integer $((x % y))
 891 |       fi
 892 |       ;;
 893 |     $LT)
 894 |       if check_numbers "$arg0" "$arg1" ; then
 895 |         strip_tag "$arg0" && local x="$r"
 896 |         strip_tag "$arg1" && local y="$r"
 897 |         ((x < y)) && r=$T || r=$NIL
 898 |       fi
 899 |       ;;
 900 |     $GT)
 901 |       if check_numbers "$arg0" "$arg1" ; then
 902 |         strip_tag "$arg0" && local x="$r"
 903 |         strip_tag "$arg1" && local y="$r"
 904 |         ((x > y)) && r=$T || r=$NIL
 905 |       fi
 906 |       ;;
 907 |     $CONSP)      typeP "$arg0" cons    && r=$T                                 ;;
 908 |     $SYMBOLP)    typeP "$arg0" symbol  && r=$T || r=$NIL                       ;;
 909 |     $NUMBERP)    typeP "$arg0" integer && r=$T || r=$NIL                       ;;
 910 |     $STRINGP)    typeP "$arg0" string  && r=$T || r=$NIL                       ;;
 911 |     $FNP)        typeP "$arg0" cons    && [[ "${car[$arg0]}" == $FN ]] && r=$T ;;
 912 |     $GC)         gc && r=$NIL                                                  ;;
 913 |     $GENSYM)     gensym                                                        ;;
 914 |     $ADD)
 915 |       if check_numbers "$arg0" "$arg1" ; then
 916 |         strip_tag "$arg0" && local x="$r"
 917 |         strip_tag "$arg1" && local y="$r"
 918 |         make_integer $((x + y))
 919 |       fi
 920 |       ;;
 921 |     $SUB)
 922 |       if check_numbers "$arg0" "$arg1" ; then
 923 |         strip_tag "$arg0" && local x="$r"
 924 |         strip_tag "$arg1" && local y="$r"
 925 |         make_integer $((x - y))
 926 |       fi
 927 |       ;;
 928 |     $APPLY)
 929 |       local old_frame_ptr=$frame_ptr
 930 |       frame_ptr=$stack_ptr
 931 |       type "$arg1"
 932 |       case $r in
 933 |         cons)
 934 |           while typeP "$arg1" cons; do
 935 |             stack[$((stack_ptr++))]="${car[$arg1]}"
 936 |             arg1="${cdr[$arg1]}"
 937 |           done
 938 |           [[ $arg1 != $NIL ]] && error "Bad argument to apply: not a proper list"
 939 |           ;;
 940 |         vector)
 941 |           count_array "$arg1"
 942 |           local len="$r"
 943 |           for ((i=0; i<len; i++)); do
 944 |             vget "$arg1" "$i"
 945 |             stack[$((stack_ptr++))]="$r"
 946 |           done
 947 |           ;;
 948 |         *) error "Bad argument to apply: not a list"
 949 |       esac
 950 |       if [[ -z "$e" ]]; then
 951 |         apply "$arg0"
 952 |       fi
 953 |       stack_ptr=$frame_ptr
 954 |       frame_ptr=$old_frame_ptr
 955 |       ;;
 956 |     $ERROR)
 957 |       printf 'lisp error: ' >&2
 958 |       prn "$arg0"           >&2
 959 |       ;;
 960 |     $TYPE)
 961 |       if [[ "$arg0" == $NIL ]]; then
 962 |         r=$NIL
 963 |       else
 964 |         type "$arg0"
 965 |         if [[ "$r" == cons ]] && [[ "${car[$arg0]}" == $FN ]]; then
 966 |           intern_symbol "function"
 967 |         else
 968 |           intern_symbol "$r"
 969 |         fi
 970 |       fi
 971 |       ;;
 972 |     $MUL)
 973 |       if check_numbers "$arg0" "$arg1" ; then
 974 |         strip_tag "$arg0" && local x="$r"
 975 |         strip_tag "$arg1" && local y="$r"
 976 |         make_integer $((x * y))
 977 |       fi
 978 |       ;;
 979 |     $DIV)
 980 |       local x y
 981 |       if check_numbers "$arg0" "$arg1" ; then
 982 |         strip_tag $arg0 && x=$r
 983 |         strip_tag $arg1 && y=$r
 984 |         make_integer $((x / y))
 985 |       fi
 986 |       ;;
 987 |     $RAND)
 988 |       if check_numbers "$arg0" ; then
 989 |         strip_tag $arg0
 990 |         make_integer "$((RANDOM % r))"
 991 |       fi
 992 |       ;;
 993 |     $PRINTLN)
 994 |       listify_args && local to_print="$r"
 995 |       while [[ "$to_print" != "$NIL" ]]; do
 996 |         type "${car[$to_print]}"
 997 |         case "$r" in
 998 |           string)
 999 |             echo -e "${car[$to_print]}"
1000 |             ;;
1001 |           *) prn "${car[$to_print]}"
1002 |             ;;
1003 |         esac
1004 |         to_print="${cdr[$to_print]}"
1005 |       done
1006 |       r="$NIL"
1007 |       ;;
1008 |     $SH)
1009 |       local ret
1010 |       eval "ret=\$(${arg0})"
1011 |       IFS=$'\n'
1012 |       string_list $(for i in $ret; do echo "$i"; done)
1013 |       IFS="$DEFAULT_IFS"
1014 |       ;;
1015 |     $SH_BANG)
1016 |       eval "${arg0}"
1017 |       [[ $? == 0 ]] && r=$T || r=$NIL
1018 |       ;;
1019 |     $LOAD_FILE)
1020 |       local f
1021 |       if [[ -r ${arg0} ]]; then
1022 |         f="${arg0}"
1023 |       elif [[ -r "${arg0}.gk" ]]; then
1024 |         f="${arg0}.gk"
1025 |       fi
1026 |       if [[ "$f" != "" ]]; then
1027 |         eval_file "$f"
1028 |       else
1029 |         echo "File not found: ${arg0}" >&2
1030 |         r="$NIL"
1031 |       fi
1032 |       ;;
1033 |     $EXIT)
1034 |       strip_tag $arg0
1035 |       exit "$r"
1036 |       ;;
1037 |     *) strip_tag "$1" && error "unknown primitive function type: ${symbols[$r]}"
1038 |       return 1
1039 |   esac
1040 | }
1041 | 
1042 | apply() {
1043 |   if [[ "${car[$1]}" == "$FN" ]]; then
1044 |     apply_user "$1"
1045 |   else
1046 |     apply_primitive "$1"
1047 |   fi
1048 | }
1049 | 
1050 | add_bindings() {
1051 |   type "$1"
1052 |   if [[ $r == cons ]]; then
1053 |     local pairs="$1" val
1054 |     while [[ "$pairs" != $NIL && "${cdr[$pairs]}" != $NIL ]]; do
1055 |       lisp_eval "${car[${cdr[$pairs]}]}" && val="$r"
1056 |       if [[ -n "$e" ]]; then return 1; fi
1057 |       acons "${car[$pairs]}" "$val" "$current_env" && current_env="$r"
1058 |       pairs="${cdr[${cdr[$pairs]}]}"
1059 |     done
1060 |     if [[ "$pairs" != $NIL ]]; then
1061 |       error "Bad bindings. Must be an even number of binding forms."
1062 |       return 1
1063 |     fi
1064 |   elif [[ "$r" == vector ]]; then
1065 |     count_array "$1"
1066 |     local i v len="$r"
1067 |     if (( len % 2 == 0 )); then
1068 |       for (( i=0; i<len; )); do
1069 |         vget "$1" $((i++))
1070 |         v="$r"
1071 |         vget "$1" $((i++))
1072 |         lisp_eval "$r"
1073 |         if [[ -n "$e" ]]; then return 1; fi
1074 |         acons "$v" "$r" "$current_env" && current_env="$r"
1075 |       done
1076 |     else
1077 |       error "Bad bindings. Must be an even number of binding forms."
1078 |     fi
1079 |   else
1080 |     error "bindings not available."
1081 |   fi
1082 | }
1083 | 
1084 | do_() {
1085 |   local body="$1" result="$NIL"
1086 |   while [[ "$body" != $NIL ]]; do
1087 |     lisp_eval "${car[$body]}" && result="$r"
1088 |     body="${cdr[$body]}"
1089 |   done
1090 |   if typeP "$result" cons && [[ "${car[$result]}" == "$FN" ]]; then
1091 |     copy_list "$result"
1092 |     environments["$r"]="$current_env"
1093 |   else
1094 |     r="$result"
1095 |   fi
1096 | }
1097 | 
1098 | eval_special() {
1099 |   local special="$1"
1100 |   local op="${car[$1]}"
1101 |   local args="${cdr[$1]}"
1102 |   local arg0="${car[$args]}"
1103 |   local arg1="${car[${cdr[$args]}]}"
1104 |   local arg2="${car[${cdr[${cdr[$args]}]}]}"
1105 |   case $op in
1106 |     $QUOTE)  r="$arg0"        ;;
1107 |     $DO)     do_ $args      ;;
1108 |     $FN)     r=$special     ;;
1109 |     $IF)
1110 |       lisp_eval "$arg0"
1111 |       [[ "$r" != "$NIL" ]] && lisp_eval "$arg1" || lisp_eval "$arg2"
1112 |       ;;
1113 |     $SET_BANG)
1114 |       if [[ -n "${global_bindings[$arg0]}" ]]; then
1115 |         lisp_eval "$arg1" && global_bindings[$arg0]="$r"
1116 |       else
1117 |         strip_tag "$arg0" && error "unbound variable: ${symbols[$r]}"
1118 |       fi
1119 |       ;;
1120 |     $RECUR)
1121 |       frame_ptr="${recur_frames[$1]}"
1122 |       stack_ptr=$frame_ptr
1123 |       while [[ "$args" != $NIL ]]; do
1124 |         lisp_eval "${car[$args]}"
1125 |         stack[$((stack_ptr++))]="$r"
1126 |         args="${cdr[$args]}"
1127 |       done
1128 |       current_env="${environments[$1]}"
1129 |       apply_user "${recur_fns[$1]}"
1130 |       ;;
1131 |     $DEF)
1132 |       lisp_eval "$arg1" && global_bindings["$arg0"]=$r
1133 |       r="$arg0"
1134 |       ;;
1135 |     $BINDING)
1136 |       local binding_body="${cdr[$args]}"
1137 |       local old_env="$current_env"
1138 |       add_bindings $arg0
1139 |       if [[ -z "$e" ]]; then
1140 |         do_ $binding_body
1141 |       fi
1142 |       current_env="$old_env"
1143 |       ;;
1144 |     *)
1145 |       strip_tag $op
1146 |       error "eval_special: unknown form: ${symbols[$r]}"
1147 |   esac
1148 | }
1149 | 
1150 | eval_function() {
1151 |   local op="${car[$1]}" eval_op
1152 |   local args="${cdr[$1]}"
1153 |   local old_frame_ptr=$frame_ptr
1154 |   frame_ptr=$stack_ptr
1155 |   lisp_eval "$op" && eval_op="$r"
1156 |   if [[ -z "$e" ]]; then
1157 |     protect "$eval_op"
1158 |     eval_args "$args"
1159 |     if [[ -z "$e" ]]; then
1160 |       apply "$eval_op"
1161 |     fi
1162 |     unprotect
1163 |   fi
1164 |   stack_ptr=$frame_ptr
1165 |   frame_ptr=$old_frame_ptr
1166 | }
1167 | 
1168 | lisp_eval() {
1169 |   type $1
1170 |   case $r in
1171 |     symbol)
1172 |       [[ "$1" == "$NIL" ]] && r="$NIL" && return
1173 |       [[ "$1" == "$T" ]] && r="$T" && return
1174 |       aget "$1" "$current_env" && return
1175 |       if [[ -n "${global_bindings[$1]}" ]]; then
1176 |         r="${global_bindings[$1]}"
1177 |       else
1178 |         strip_tag "$1" && error "unable to resolve ${symbols[$r]}"
1179 |       fi
1180 |       ;;
1181 |     cons)
1182 |       if [[ -n "${specials[${car[$1]}]}" ]]; then
1183 |         eval_special "$1"
1184 |       else
1185 |         eval_function "$1"
1186 |       fi
1187 |       ;;
1188 |     vector)
1189 |       local old_frame_ptr=$frame_ptr
1190 |       local old_stack_ptr=$stack_ptr
1191 |       frame_ptr=$stack_ptr
1192 |       eval_args "$1"
1193 |       if [[ -z "$e" ]]; then
1194 |         vectify_args
1195 |       fi
1196 |       stack_ptr=$old_stack_ptr
1197 |       frame_ptr=$old_frame_ptr
1198 |       ;;
1199 |     integer) r=$1   ;;
1200 |     string)  r="$1" ;;
1201 |     keyword) r="$1" ;;
1202 |     *)
1203 |       error "lisp_eval: unrecognized type"
1204 |       return 1
1205 |       ;;
1206 |   esac
1207 | }
1208 | 
1209 | # repl #########################################################################
1210 | 
1211 | init_history() {
1212 |   intern_symbol "${pb_star}1" && hist1="$r"
1213 |   intern_symbol "${pb_star}2" && hist2="$r"
1214 |   intern_symbol "${pb_star}3" && hist3="$r"
1215 |   global_bindings["$hist1"]="$NIL"
1216 |   global_bindings["$hist2"]="$NIL"
1217 |   global_bindings["$hist3"]="$NIL"
1218 | }
1219 | 
1220 | update_history() {
1221 |   global_bindings["$hist3"]="${global_bindings[$hist2]}"
1222 |   global_bindings["$hist2"]="${global_bindings[$hist1]}"
1223 |   global_bindings["$hist1"]="$r"
1224 | }
1225 | 
1226 | repl() {
1227 |   init_history
1228 |   while true; do
1229 |     e=   # clear existing error state
1230 |     lisp_read
1231 |     [[ -n "$e" ]] && printf "read error: $e\n" >&2
1232 |     protect "$r"
1233 |     lisp_eval "$r"
1234 |     update_history
1235 |     [[ -n "$e" ]]  && printf "eval error: $e\n" >&2
1236 |     prn "$r"
1237 |     [[ -n "$e" ]] && printf "print error: $e\n" >&2
1238 |     unprotect
1239 |   done
1240 | }
1241 | 
1242 | # start ########################################################################
1243 | 
1244 | eval_string() {
1245 |   local str="$1"
1246 |   lisp_read <<<"(do $str)"
1247 |   protect "$r"
1248 |   lisp_eval "$r"
1249 |   unprotect
1250 | }
1251 | 
1252 | # Start REPL if no arguments
1253 | [ -z "$*" ] && repl
1254 | 
1255 | ARGV="$*"
1256 | # Process parameters
1257 | while [ "$*" ]; do
1258 |   param=$1; shift; OPTARG=$1
1259 |   case $param in
1260 |     -e|--eval) eval_string "$OPTARG"; shift
1261 |                [[ $r != $NIL ]] && prn $r
1262 |                ;;
1263 |     -l|--load) eval_file "$OPTARG"; shift
1264 |                [[ $r != $NIL ]] && prn $r
1265 |                ;;
1266 |     -t|--test) ;;
1267 |     -r|--repl) repl ;;
1268 |     -*) usage ;;
1269 |     *)         [[ -f "$param" ]] && has_shebangP "$param" && eval_file "$param"
1270 |                [[ $r != $NIL ]] && prn $r
1271 |                ;;
1272 |   esac
1273 | done
1274 | 


--------------------------------------------------------------------------------
/pipeseq.sh:
--------------------------------------------------------------------------------
 1 | #!/bin/bash
 2 | 
 3 | command="printf 'a\nb\nc\n'"
 4 | mkfifo first
 5 | mkfifo rest0
 6 | (eval "$command" | tee >(head -1 > first) | tail -n +2 > rest0 &)
 7 | 
 8 | cat first
 9 | 
10 | mkfifo rest1
11 | (cat rest0 | tee >(head -1 > first) | tail -n +2 > rest1 &)
12 | 
13 | cat first
14 | 
15 | mkfifo rest2
16 | (cat rest1 | tee >(head -1 > first) | tail -n +2 > rest2 &)
17 | 
18 | cat first
19 | 
20 | mkfifo rest3
21 | (cat rest2 | tee >(head -1 > first) | tail -n +2 > rest3 &)
22 | 


--------------------------------------------------------------------------------
/presentation.gk:
--------------------------------------------------------------------------------
 1 | #!./gherkin -l
 2 | 
 3 | (def map
 4 |   (fn (f xs)
 5 |     (if xs
 6 |       (cons (f (car xs)) (map f (cdr xs))))))
 7 | 
 8 | (def bold
 9 |   (fn (s)
10 |     (str "\033[1m" s "\033[0m")))
11 | 
12 | (def blue
13 |   (fn (s)
14 |     (str "\033[1;34m" s "\033[0m")))
15 | 
16 | (def title
17 |   (fn (s)
18 |     (bold (blue (str s "\n\n")))))
19 | 
20 | (def conj-slides
21 |   (list
22 |    (list
23 |     (title "unix: ok, shell: $!@$#")
24 |     "- both are everywhere"
25 |     "- shell: the universal hypervisor?"
26 |     "- unix/shell support powerful primitives"
27 |     "  - 'buffered channels' via fifo"
28 |     "  - 'channels' via streams"
29 |     "  - 'processes' via job control"
30 |     "  - ... hidden behind reams of esoterica, syntax"
31 |     "how do we replace bash?")
32 |    (list
33 |     (title "gherkin - a lisp1 written in bash4")
34 |     "https://github.com/alandipert/gherkin"
35 |     "@alandipert")
36 |    (list
37 |     (title "things it has")
38 |     "- string, integer, symbol scalars"
39 |     "- symbols tagged, easily extensible"
40 |     "  - bignum/floats via promoting ops, contagion"
41 |     "  - shell out to bc(1)"
42 |     "- mark/sweep GC"
43 |     "- dynamic binding: def/setq/binding"
44 |     "- lexical binding: fn*"
45 |     "  - varargs: (fn (x y & more) ...)"
46 |     "- non-stack-consuming recursion"
47 |     "  - via recur in fn tail position"
48 |     "- namespaces (almost)")
49 |    (list
50 |     (title "things it will have")
51 |     "- deftype, extend"
52 |     "  - protocols for IFn, ISeq, Channel, etc."
53 |     "- first-class macros (fexpr)"
54 |     "- lazy seqs"
55 |     "- channels/core.async primitives, terse REPL mode a la eshell"
56 |     "- save-world/load-world"
57 |     "  - dump interp. state/env to executable .sh"
58 |     "  - save-world and slipstream to AMIs via user-data?"
59 |     )
60 |    (list
61 |     (title "things it might have")
62 |     "- clojure interpreter"
63 |     "- concurrent GC"
64 |     "- compiler"
65 |     "  - #lang gherkin in Racket"
66 |     "- static type checking via core.typed"
67 |     "- embedded prolog via make(1)?!")
68 |    (list
69 |     (title "things it will never have")
70 |     "- assoc. data other than alist/plist"
71 |     "  - no real array in bash"
72 |     "- numeric performance"
73 |     "  - any performance"
74 |     "  - of any conceivable kind"
75 |     "- suckiness")
76 |    (list
77 |     (title "thanks to:")
78 |     "Darius Bacon et al: awklisp"
79 |     "Spencer Tipping: for a contagious imagination"
80 |     "Aaron Brooks: early feedback on original reader"
81 |     "Aron Griffis: bash pro tips"
82 |     "Joel Martin: REPL readline support, bind(2) patch to Bash")))
83 | 
84 | (def present
85 |   (fn (slides)
86 |     (if slides
87 |       (do
88 |         (sh! "clear")
89 |         (apply println (map (fn (line) (str "\t" line)) (car slides)))
90 |         (read)
91 |         (recur (cdr slides))))))
92 | 
93 | (present conj-slides)
94 | (println (blue "Switching to REPL!"))
95 | 
96 | ((fn () (println (eval (read))) (recur)))
97 | 


--------------------------------------------------------------------------------
/read_profile.clj:
--------------------------------------------------------------------------------
1 | (use 'clojure.pprint)
2 | 
3 | (defn read-profile [f]
4 |   (let [stats (read-string (str "[" (slurp f) "]"))
5 |         called (into #{} (map second stats))
6 |         call-time (fn call-time [x] (partition 2 (filter #(= (second %) x) ents)))
7 |         total-time (fn [x] (reduce + (map (fn [[[_ _ start] [_ _ end]]] (- end start)) (call-time x))))]
8 |     (pprint (into (sorted-map) (map #(vector (total-time %) %) called)))))
9 | 


--------------------------------------------------------------------------------
/simple_test.sh:
--------------------------------------------------------------------------------
 1 | #!/bin/bash
 2 | expected=$(
 3 | cat << "EOF"
 4 | ("#!/usr/bin/env bash" "  echo \"bash >= 4.0 required\" >&2" "#!/bin/bash" "    \"how do we replace bash?\")" "    (title \"gherkin - a lisp1 written in bash4\")" "    \"  - no real array in bash\"" "    \"Aron Griffis: bash pro tips\"")
 5 | EOF
 6 | )
 7 | 
 8 | actual=$(./gherkin -e '(load-file "core") (sh (str "grep -h bash " (join " " (remove (fn [x] (or (eq? "simple_test.sh" x) (eq? "README.md" x))) (sh "ls")))))')
 9 | 
10 | if [[ "$expected" == "$actual" ]]; then
11 |   echo "test 1/1 passed"
12 | else
13 |   echo "test 1/1 failed"
14 |   echo "EXPECTED: $expected"
15 |   echo "RECEIVED: $actual"
16 | fi
17 | 


--------------------------------------------------------------------------------