├── go.mod
├── go.sum
├── README.md
├── IMPLEMENTATION-NOTES.md
└── lisp.go


/go.mod:
--------------------------------------------------------------------------------
1 | module github.com/nukata/lisp-in-go
2 | 
3 | require github.com/nukata/goarith v0.3.0
4 | 
5 | go 1.13
6 | 


--------------------------------------------------------------------------------
/go.sum:
--------------------------------------------------------------------------------
1 | github.com/nukata/goarith v0.3.0 h1:pN35k2IrPTFUPdwsj3wPV6x+stsNhEKhmWYkKPPCktw=
2 | github.com/nukata/goarith v0.3.0/go.mod h1:yoyUvSZi0V+6o8F1Kopk96LaxvQ0OPtFAse+P/NVy/w=
3 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # Lisp in Go
 2 | 
 3 | This is a Lisp interpreter compatible with
 4 | [lisp-in-dart](https://github.com/nukata/lisp-in-dart) and
 5 | [lisp-in-cs](https://github.com/nukata/lisp-in-cs).
 6 | 
 7 | In 2016, I wrote the original version in Go 1.6 and 1.7.
 8 | It had been presented under the MIT License at
 9 | <http://www.oki-osk.jp/esc/golang/lisp4-en.html> (broken link) until 2017.
10 | In 2018, I made the repository in GitHub.
11 | Now, in 2019, I revised it to make use of
12 | [goarith](https://github.com/nukata/goarith), which
13 | implements mixed mode arithmetic of `int32`, `int64`, `float64` and `*big.Int`.
14 | 
15 | Just as `lisp-in-dart` and `lisp-in-cs`,
16 | this is a Lisp-1 with TCO (tail call optimization)
17 | and partially hygienic macros but being a subset of Common Lisp
18 | in a loose meaning.
19 | It is easy to write a nontrivial script which runs both in this and in
20 | Common Lisp.
21 | Examples are found in 
22 | [lisp-in-cs#examples](https://github.com/nukata/lisp-in-cs#examples).
23 | 
24 | 
25 | In addition, this has two concurrent constructs implemented with _goroutine_,
26 | `future` and `force`, which I reported in 2013 at
27 | <http://www.oki-osk.jp/esc/golang/future.html> (broken link).
28 | Thanks to pkelchte, you can get the reported implementation
29 | (that is another Lisp I wrote in Go) at
30 | [pkelchte/tiny-lisp](https://github.com/pkelchte/tiny-lisp) now.
31 | 
32 | See [IMPLEMENTATION-NOTES.md](IMPLEMENTATION-NOTES.md) for the implementation.
33 | 
34 | 
35 | ## How to run
36 | 
37 | ```
38 | $ pwd
39 | /Users/suzuki/tmp/lisp-in-go
40 | $ go build
41 | go: downloading github.com/nukata/goarith v0.3.0
42 | go: extracting github.com/nukata/goarith v0.3.0
43 | go: finding github.com/nukata/goarith v0.3.0
44 | $ ./lisp-in-go
45 | > (+ 5 6)
46 | 11
47 | > *version*
48 | (2.0 "go1.13.3 darwin/amd64" "Nukata Lisp")
49 | > (exit 0)
50 | $
51 | ```
52 | 
53 | The value of `*version*` will vary depending on the Go compiler.
54 | See [lisp.go L698-L707](lisp.go#L698-L707).
55 | 
56 | You can give the `lisp` command a file name of your Lisp script.
57 | If you put a "`-`" after the file name, it will
58 | begin an interactive session after running the file.
59 | 
60 | ```
61 | $ cat fib.l
62 | (defun fib (n)
63 |   (if (<= n 1)
64 |       n
65 |     (+ (fib (- n 1))
66 |        (fib (- n 2)))))
67 | $ ./lisp-in-go fib.l -
68 | > (fib 10)
69 | 55
70 | > (fib 20)
71 | 6765
72 | > (setq f (future (fib 30)))
73 | #<future:0xc000060060:(<nil> . <nil>):&{0 0}>
74 | > (force f)
75 | 832040
76 | > (exit 0)
77 | $ 
78 | ```
79 | 
80 | Here `(fib 30)` was evaluated concurrently in a new goroutine
81 | and the result was retrieved by `force`.
82 | 
83 | ## License
84 | 
85 | This is under the MIT License.
86 | See [`lisp.go L1769-L1790`](lisp.go#L1769-L1790).
87 | 


--------------------------------------------------------------------------------
/IMPLEMENTATION-NOTES.md:
--------------------------------------------------------------------------------
  1 | # Implementation Notes
  2 | 
  3 | 
  4 | <a name="1"></a>
  5 | ## 1. Overview
  6 | 
  7 | The Lisp implementation of [lisp.go](lisp.go) is a translation of lisp.dart 
  8 | at [lisp-in-dart](https://github.com/nukata/lisp-in-dart).
  9 | It provides `future` and `force` for concurrent computation with _goroutines_.
 10 | 
 11 | Below is an example of running lisp.go.
 12 | 
 13 | ```
 14 | $ pwd
 15 | /Users/suzuki/tmp/lisp-in-go
 16 | $ go build
 17 | go: finding github.com/nukata/goarith v0.2.0
 18 | go: downloading github.com/nukata/goarith v0.2.0
 19 | $ ./lisp-in-go
 20 | > (+ 5 6)
 21 | 11
 22 | > (exit 0)
 23 | $ 
 24 | ```
 25 | 
 26 | Some features common to lisp.go and lisp.dart are
 27 | 
 28 | - It is basically a subset of Emacs Lisp.
 29 |   However, it is a Lisp-1 with static scoping.
 30 |   In short, it is a _Common Lisp-like Lisp-1_.
 31 | 
 32 | - It makes proper tail calls always.
 33 | 
 34 | - A quasi-quotation with backquote will be expanded when macros are expanded.
 35 | 
 36 | - A circular list is printed with `...` finitely.
 37 | 
 38 | - As an escape sequence within strings, you can use any of
 39 |   `\"`, `\\`, `\n`, `\r`, `\f`, `\b`, `\t`, `\v`.
 40 | 
 41 | - `(dump)` returns a list of all global variables.
 42 |   The list does not include special forms such as `lambda` and `setq`
 43 |   since they are not variables.
 44 | 
 45 | - `*version*` is a three-element list: 
 46 |   the (internal) version number, the implementing language, 
 47 |   and the name of implementation.
 48 | 
 49 | - (`macro` _args_ _body_) is a special form that evaluates to a sort of
 50 |   anonymous function, or _macro expression_.
 51 |   The global environment will be used whenever (`macro` ...) evaluates.
 52 |   When you apply the resultant macro expression to a list of actual arguments,
 53 |   the arguments will not be evaluated and the result of the application
 54 |   will be evaluated again.
 55 |   Thus a variable bound to a macro expression works as a _macro_.
 56 | 
 57 | - `defmacro` is a macro which binds a variable to a macro expression.
 58 | 
 59 | - `defun` is a macro which binds a variable to a lambda expression.
 60 | 
 61 | - `let` is a macro which applies a lambda expression to a list of initial
 62 |   values of variables.
 63 | 
 64 | - Free symbols within a macro expression will not be captured when the
 65 |   expression is applied (i.e., when the macro is expanded).
 66 | 
 67 | 
 68 | By the last feature above, you can avoid variable captures in any macro
 69 | definitions, provided that you use the result of `(gensym)` for any symbol
 70 | newly introduced to the expansion result.
 71 | See [lisp-in-dart/IMPLEMENTATION-NOTES §5](https://github.com/nukata/lisp-in-dart/blob/master/IMPLEMENTATION-NOTES.md#5).
 72 | 
 73 | ----------------------------------------
 74 | 
 75 | **Note:**
 76 | I believe the last feature makes the behavior of traditional macros ideal.
 77 | As macros being _partially hygienic_, you can define
 78 | [anaphoric macros](http://www.asahi-net.or.jp/~kc7k-nd/onlispjhtml/anaphoricMacros.html)
 79 | (Japanese) by introducing a symbol (`it` in the following example) to the 
 80 | expansion result intentionally without using `(gensym)`.
 81 | 
 82 | ```
 83 | > (defmacro aif (test then else)
 84 |     `(let ((it ,test))
 85 |        (if it ,then ,else) ))
 86 | aif
 87 | > (aif (+ 7 8 9)
 88 |      (print it)
 89 |     (print "?"))
 90 | 24
 91 | 24
 92 | > 
 93 | ```
 94 | 
 95 | ----------------------------------------
 96 | 
 97 | In addition, there is a feature inherited from
 98 | [my first Go Lisp in 2013](https://github.com/pkelchte/tiny-lisp):
 99 | 
100 | - Concurrent computations with goroutines are delivered by the special form 
101 |   (`future` _expression_) and the function (`force` _future_).
102 |   See ["Futures and promises" at Wikipedia](https://en.wikipedia.org/wiki/Futures_and_promises).
103 | 
104 | The following example calculates 
105 | [Fibonacci numbers](https://oeis.org/A000045)
106 | concurrently, though it may be too fine-grained to be efficient.
107 | 
108 | ```
109 | > (defun fib (n)
110 |     (if (<= n 1)
111 |         n
112 |       (let ((a (future (fib (- n 1))))
113 |             (b (future (fib (- n 2)))))
114 |         (+ (force a)
115 |            (force b) ))))
116 | fib
117 | > (fib 10)
118 | 55
119 | > (fib 20)
120 | 6765
121 | > (fib 30)
122 | 832040
123 | > 
124 | ```
125 | 
126 | `fib` computes `(fib (- n 1))` and `(fib (- n 2))` 
127 | in each goroutine separately and adds the results 
128 | by `(+ (force a) (force b))`.
129 | 
130 | 
131 | 
132 | <a name="2"></a>
133 | ## 2. Internal Data Representation
134 | 
135 | To represent data of the implemented language (Lisp), native types of the 
136 | implementing language (Go) are used as they are, if possible.
137 | They are all treated as `interface{}` uniformly.
138 | 
139 | 
140 | | Lisp Expression                     | Internal Representation                |
141 | |:------------------------------------|:---------------------------------------|
142 | | numbers `1`, `2.3`                  | [`goarith.Number`](https://github.com/nukata/goarith) |
143 | | strings `"abc"`, `"hello!\n"`       | `string`                               |
144 | | `t`                                 | `true`                                 |
145 | | `nil`                               | `nil` of `*Cell`                       |
146 | | symbols `x`, `+`                    | `Sym` (user-defined)                   |
147 | | keywords `lambda`, `cond`           | `Sym` (`IsKeyword` flag is `true`)     |
148 | | lists `(x 1 "2")`, `(y . 3)`        | `Cell` (user-defined)                  |
149 | 
150 | Below is the definition of the type `Cell`.
151 | 
152 | ```Go
153 | // Cell represents a cons cell.
154 | // &Cell{car, cdr} works as the "cons" operation.
155 | type Cell struct {
156 | 	Car interface{}
157 | 	Cdr interface{}
158 | }
159 | 
160 | // Nil is a nil of type *Cell and it represents the empty list.
161 | var Nil *Cell = nil
162 | ```
163 | 
164 | Below is the definition of the type `Sym`.
165 | 
166 | ```Go
167 | // Sym represents a symbol (or an expression keyword) in Lisp.
168 | // &Sym{name, false} constructs a symbol which is not interned yet.
169 | type Sym struct {
170 | 	Name      string
171 | 	IsKeyword bool
172 | }
173 | ```
174 | 
175 | The map `symbols` is used to intern symbols.
176 | The mutex `symLock` guards access to `symbols` in
177 | concurrent computations with goroutines.
178 | 
179 | ```Go
180 | // NewSym constructs an interned symbol for name.
181 | func NewSym(name string) *Sym {
182 | 	return NewSym2(name, false)
183 | }
184 | 
185 | // symbols is a table of interned symbols.
186 | var symbols = make(map[string]*Sym)
187 | 
188 | // symLock is an exclusive lock for the table.
189 | var symLock sync.RWMutex
190 | 
191 | // NewSym2 constructs an interned symbol (or an expression keyword
192 | // if isKeyword is true on its first construction) for name.
193 | func NewSym2(name string, isKeyword bool) *Sym {
194 | 	symLock.Lock()
195 | 	sym, ok := symbols[name]
196 | 	if !ok {
197 | 		sym = &Sym{name, isKeyword}
198 | 		symbols[name] = sym
199 | 	}
200 | 	symLock.Unlock()
201 | 	return sym
202 | }
203 | ```
204 | 
205 | 
206 | <a name="3"></a>
207 | ## 3. Implementations of Lisp functions
208 | 
209 | The core of Lisp interpreter is represented by the structure `Interp`.
210 | It consists of a map for global variables and an exclusive lock for the map.
211 | 
212 | ```Go
213 | // Interp represents a core of the interpreter.
214 | type Interp struct {
215 | 	globals map[*Sym]interface{}
216 | 	lock    sync.RWMutex
217 | }
218 | ```
219 | 
220 | Each built-in Lisp function is defined with the utility function below.
221 | The `carity` argument takes the arity of the function to be defined.
222 | If the function has `&rest`, the `carity` 
223 | takes `-(`_number of fixed arguments_ ` + 1)`.
224 | 
225 | ```Go
226 | // Def defines a built-in function by giving a name, arity, and body.
227 | func (interp *Interp) Def(name string, carity int,
228 | 	body func([]interface{}) interface{}) {
229 | 	sym := NewSym(name)
230 | 	fnc := NewBuiltInFunc(name, carity, body)
231 | 	interp.SetGlobalVar(sym, fnc)
232 | }
233 | ```
234 | 
235 | Below is an excerpt of the function `NewInterp` corresponding to the 
236 | constructor of `Interp`.
237 | It shows the implementation of five elementary functions of Lisp.
238 | 
239 | ```Go
240 | // NewInterp constructs an interpreter and sets built-in functions etc. as
241 | // the global values of symbols within the interpreter.
242 | func NewInterp() *Interp {
243 | 	interp := &Interp{globals: make(map[*Sym]interface{})}
244 | 
245 | 	interp.Def("car", 1, func(a []interface{}) interface{} {
246 | 		if a[0] == Nil {
247 | 			return Nil
248 | 		}
249 | 		return a[0].(*Cell).Car
250 | 	})
251 | 
252 | 	interp.Def("cdr", 1, func(a []interface{}) interface{} {
253 | 		if a[0] == Nil {
254 | 			return Nil
255 | 		}
256 | 		return a[0].(*Cell).Cdr
257 | 	})
258 | 
259 | 	interp.Def("cons", 2, func(a []interface{}) interface{} {
260 | 		return &Cell{a[0], a[1]}
261 | 	})
262 | 
263 | 	interp.Def("atom", 1, func(a []interface{}) interface{} {
264 | 		if j, ok := a[0].(*Cell); ok && j != Nil {
265 | 			return Nil
266 | 		}
267 | 		return true
268 | 	})
269 | 
270 | 	interp.Def("eq", 2, func(a []interface{}) interface{} {
271 | 		if a[0] == a[1] { // Cells are compared by address.
272 | 			return true
273 | 		}
274 | 		return Nil
275 | 	})
276 | ```
277 | 
278 | The function `dump` takes no arguments and returns a list of all global
279 | variables.
280 | Within read-lock of `interp.lock`, `dump` reads the keys from `interp.globals`
281 | and constructs a list of them.
282 | 
283 | ```Go
284 | 	interp.Def("dump", 0, func(a []interface{}) interface{} {
285 | 		interp.lock.RLock()
286 | 		defer interp.lock.RUnlock()
287 | 		r := Nil
288 | 		for key := range interp.globals {
289 | 			r = &Cell{key, r}
290 | 		}
291 | 		return r
292 | 	})
293 | ```
294 | 
295 | Below is an example of running `(dump)`.
296 | 
297 | ```
298 | > (dump)
299 | (append > cdaar + last or symbol-name prin1 / stringp assoc assq consp caddr def
300 | macro princ < when setcdr truncate - list eq dump apply intern equal not caar fo
301 | rce nreverse _nreverse caadr make-symbol dolist listp * member setcar *version* 
302 | cdr dotimes cdddr cdadr cdar car while _append if >= print exit *gensym-counter*
303 |  length let /= = and letrec <= cons nconc cddr cadr gensym memq defun % cadar ca
304 | aar mod mapcar eql rplaca terpri numberp rplacd atom null identity cddar)
305 | > 
306 | ```
307 | 
308 | Several functions and macros of Lisp are defined in the initialization script
309 | `Prelude`.
310 | It runs at the beginning of the `Main` function:
311 | 
312 | ```Go
313 | // Main runs each element of args as a name of Lisp script file.
314 | // It ignores args[0].
315 | // If it does not have args[1] or some element is "-", it begins REPL.
316 | func Main(args []string) int {
317 | 	interp := NewInterp()
318 | 	ss := strings.NewReader(Prelude)
319 | 	if !Run(interp, ss) {
320 | 		return 1
321 | 	}
322 | 	if len(args) < 2 {
323 | 		args = []string{args[0], "-"}
324 | 	}
325 | 	for i, fileName := range args {
326 | 		if i == 0 {
327 | 			continue
328 | 		}
329 | 		if fileName == "-" {
330 | 			Run(interp, nil)
331 | 			fmt.Println("Goodbye")
332 | 		} else {
333 | 			file, err := os.Open(fileName)
334 | 			if err != nil {
335 | 				fmt.Println(err)
336 | 				return 1
337 | 			}
338 | 			if !Run(interp, file) {
339 | 				return 1
340 | 			}
341 | 		}
342 | 	}
343 | 	return 0
344 | }
345 | 
346 | func main() {
347 | 	os.Exit(Main(os.Args))
348 | }
349 | ```
350 | 
351 | Below is the head of `Prelude`.
352 | 
353 | ```Lisp
354 | // Prelude is an initialization script of Lisp.
355 | // Each "~" is replaced by "`" at runtime.
356 | var Prelude = strings.Replace(`
357 | (setq defmacro
358 |       (macro (name args &rest body)
359 |              ~(progn (setq ,name (macro ,args ,@body))
360 |                      ',name)))
361 | 
362 | (defmacro defun (name args &rest body)
363 |   ~(progn (setq ,name (lambda ,args ,@body))
364 |           ',name))
365 | 
366 | (defun caar (x) (car (car x)))
367 | (defun cadr (x) (car (cdr x)))
368 | (defun cdar (x) (cdr (car x)))
369 | (defun cddr (x) (cdr (cdr x)))
370 | ```
371 | 
372 | The tail of `Prelude` is as follows:
373 | 
374 | ```Lisp
375 | (defmacro dotimes (spec &rest body) ; (dotimes (name count [result]) body...)
376 |   (let ((name (car spec))
377 |         (count (gensym)))
378 |     ~(let ((,name 0)
379 |            (,count ,(cadr spec)))
380 |        (while (< ,name ,count)
381 |          ,@body
382 |          (setq ,name (+ ,name 1)))
383 |        ,@(if (cddr spec)
384 |              ~(,(caddr spec))))))
385 | `, "~", "`", -1)
386 | ```
387 | 
388 | Since "``` ` ```" cannot occur within a raw string literal of Go,
389 | "`~`" substitues for it.
390 | Each  "`~`" will be replaced by "``` ` ```" at runtime with `strings.Replace`.
391 | 


--------------------------------------------------------------------------------
/lisp.go:
--------------------------------------------------------------------------------
   1 | /*
   2 |   Nukata Lisp 2.0 in Go 1.11 by SUZUKI Hisao (H27.05.11/H31.2.13)
   3 | 
   4 |   This is a Lisp interpreter written in Go.
   5 |   It is intended to implement the same language as Lisp in Dart(*1)
   6 |   except that it has also two concurrent constructs, future and force.
   7 |   Numbers are represented by the Number type in *2.
   8 | 
   9 |   *1: http://github.com/nukata/lisp-in-dart
  10 |   *2: http://github.com/nukata/goarith
  11 | */
  12 | package main
  13 | 
  14 | import (
  15 | 	"bufio"
  16 | 	"errors"
  17 | 	"fmt"
  18 | 	"github.com/nukata/goarith"
  19 | 	"io"
  20 | 	"math/big"
  21 | 	"os"
  22 | 	"regexp"
  23 | 	"runtime"
  24 | 	"strconv"
  25 | 	"strings"
  26 | 	"sync"
  27 | 	"unicode/utf8"
  28 | )
  29 | 
  30 | // Cell represents a cons cell.
  31 | // &Cell{car, cdr} works as the "cons" operation.
  32 | type Cell struct {
  33 | 	Car interface{}
  34 | 	Cdr interface{}
  35 | }
  36 | 
  37 | // Nil is a nil of type *Cell and it represents the empty list.
  38 | var Nil *Cell = nil
  39 | 
  40 | // CdrCell returns cdr of the cell as a *Cell or Nil.
  41 | func (j *Cell) CdrCell() *Cell {
  42 | 	if c, ok := j.Cdr.(*Cell); ok {
  43 | 		return c
  44 | 	}
  45 | 	panic(NewEvalError("proper list expected", j))
  46 | }
  47 | 
  48 | // (a b c).FoldL(x, fn) returns fn(fn(fn(x, a), b), c)
  49 | func (j *Cell) FoldL(x interface{},
  50 | 	fn func(interface{}, interface{}) interface{}) interface{} {
  51 | 	for j != Nil {
  52 | 		x = fn(x, j.Car)
  53 | 		j = j.CdrCell()
  54 | 	}
  55 | 	return x
  56 | }
  57 | 
  58 | // Len returns the length of list j
  59 | func (j *Cell) Len() int {
  60 | 	return j.FoldL(0, func(i, e interface{}) interface{} {
  61 | 		return i.(int) + 1
  62 | 	}).(int)
  63 | }
  64 | 
  65 | // (a b c).MapCar(fn) returns (fn(a) fn(b) fn(c))
  66 | func (j *Cell) MapCar(fn func(interface{}) interface{}) interface{} {
  67 | 	if j == Nil {
  68 | 		return Nil
  69 | 	}
  70 | 	a := fn(j.Car)
  71 | 	d := j.Cdr
  72 | 	if cdr, ok := d.(*Cell); ok {
  73 | 		d = cdr.MapCar(fn)
  74 | 	}
  75 | 	if j.Car == a && j.Cdr == d {
  76 | 		return j
  77 | 	}
  78 | 	return &Cell{a, d}
  79 | }
  80 | 
  81 | // String returns a raw textual representation of j for debugging.
  82 | func (j *Cell) String() string {
  83 | 	return fmt.Sprintf("(%v . %v)", j.Car, j.Cdr)
  84 | }
  85 | 
  86 | //----------------------------------------------------------------------
  87 | 
  88 | // Sym represents a symbol (or an expression keyword) in Lisp.
  89 | // &Sym{name, false} constructs a symbol which is not interned yet.
  90 | type Sym struct {
  91 | 	Name      string
  92 | 	IsKeyword bool
  93 | }
  94 | 
  95 | // NewSym constructs an interned symbol for name.
  96 | func NewSym(name string) *Sym {
  97 | 	return NewSym2(name, false)
  98 | }
  99 | 
 100 | // symbols is a table of interned symbols.
 101 | var symbols = make(map[string]*Sym)
 102 | 
 103 | // symLock is an exclusive lock for the table.
 104 | var symLock sync.RWMutex
 105 | 
 106 | // NewSym2 constructs an interned symbol (or an expression keyword
 107 | // if isKeyword is true on its first construction) for name.
 108 | func NewSym2(name string, isKeyword bool) *Sym {
 109 | 	symLock.Lock()
 110 | 	sym, ok := symbols[name]
 111 | 	if !ok {
 112 | 		sym = &Sym{name, isKeyword}
 113 | 		symbols[name] = sym
 114 | 	}
 115 | 	symLock.Unlock()
 116 | 	return sym
 117 | }
 118 | 
 119 | // IsInterned returns true if sym is interned.
 120 | func (sym *Sym) IsInterned() bool {
 121 | 	symLock.RLock()
 122 | 	s, ok := symbols[sym.Name]
 123 | 	symLock.RUnlock()
 124 | 	return ok && s == sym
 125 | }
 126 | 
 127 | // String returns a textual representation of sym.
 128 | func (sym *Sym) String() string {
 129 | 	return sym.Name
 130 | }
 131 | 
 132 | // Defined symbols
 133 | 
 134 | var BackQuoteSym = NewSym("`")
 135 | var CommaAtSym = NewSym(",@")
 136 | var CommaSym = NewSym(",")
 137 | var DotSym = NewSym(".")
 138 | var LeftParenSym = NewSym("(")
 139 | var RightParenSym = NewSym(")")
 140 | var SingleQuoteSym = NewSym("'")
 141 | 
 142 | var AppendSym = NewSym("append")
 143 | var ConsSym = NewSym("cons")
 144 | var ListSym = NewSym("list")
 145 | var RestSym = NewSym("&rest")
 146 | var UnquoteSym = NewSym("unquote")
 147 | var UnquoteSplicingSym = NewSym("unquote-splicing")
 148 | 
 149 | // Expression keywords
 150 | 
 151 | var CondSym = NewSym2("cond", true)
 152 | var FutureSym = NewSym2("future", true)
 153 | var LambdaSym = NewSym2("lambda", true)
 154 | var MacroSym = NewSym2("macro", true)
 155 | var ProgNSym = NewSym2("progn", true)
 156 | var QuasiquoteSym = NewSym2("quasiquote", true)
 157 | var QuoteSym = NewSym2("quote", true)
 158 | var SetqSym = NewSym2("setq", true)
 159 | 
 160 | //----------------------------------------------------------------------
 161 | 
 162 | // Func is a common base type of Lisp functions.
 163 | type Func struct {
 164 | 	// Carity is a number of arguments, made negative if the func has &rest.
 165 | 	Carity int
 166 | }
 167 | 
 168 | // hasRest returns true if fn has &rest.
 169 | func (fn *Func) hasRest() bool {
 170 | 	return fn.Carity < 0
 171 | }
 172 | 
 173 | // fixedArgs returns the number of fixed arguments.
 174 | func (fn *Func) fixedArgs() int {
 175 | 	if c := fn.Carity; c < 0 {
 176 | 		return -c - 1
 177 | 	} else {
 178 | 		return c
 179 | 	}
 180 | }
 181 | 
 182 | // MakeFrame makes a call-frame from a list of actual arguments.
 183 | // Argument x will be used instead of fn only in error messages.
 184 | func (fn *Func) MakeFrame(arg *Cell, x interface{}) []interface{} {
 185 | 	arity := fn.Carity // number of arguments, counting the whole rests as one
 186 | 	if arity < 0 {
 187 | 		arity = -arity
 188 | 	}
 189 | 	frame := make([]interface{}, arity)
 190 | 	n := fn.fixedArgs()
 191 | 	i := 0
 192 | 	for i < n && arg != Nil { // Set the list of fixed arguments.
 193 | 		frame[i] = arg.Car
 194 | 		arg = arg.CdrCell()
 195 | 		i++
 196 | 	}
 197 | 	if i != n || (arg != Nil && !fn.hasRest()) {
 198 | 		panic(NewEvalError("arity not matched", x))
 199 | 	}
 200 | 	if fn.hasRest() {
 201 | 		frame[n] = arg
 202 | 	}
 203 | 	return frame
 204 | }
 205 | 
 206 | // EvalFrame evaluates each expression of frame with interp in env.
 207 | func (fn *Func) EvalFrame(frame []interface{}, interp *Interp, env *Cell) {
 208 | 	n := fn.fixedArgs()
 209 | 	for i := 0; i < n; i++ {
 210 | 		frame[i] = interp.Eval(frame[i], env)
 211 | 	}
 212 | 	if fn.hasRest() {
 213 | 		if j, ok := frame[n].(*Cell); ok {
 214 | 			z := Nil
 215 | 			y := Nil
 216 | 			for j != Nil {
 217 | 				e := interp.Eval(j.Car, env)
 218 | 				x := &Cell{e, Nil}
 219 | 				if z == Nil {
 220 | 					z = x
 221 | 				} else {
 222 | 					y.Cdr = x
 223 | 				}
 224 | 				y = x
 225 | 				j = j.CdrCell()
 226 | 			}
 227 | 			frame[n] = z
 228 | 		}
 229 | 	}
 230 | }
 231 | 
 232 | //----------------------------------------------------------------------
 233 | 
 234 | // Macro represents a compiled macro expression.
 235 | type Macro struct {
 236 | 	Func
 237 | 	// body is a list which will be used as the function body.
 238 | 	body *Cell
 239 | }
 240 | 
 241 | // NewMacro constructs a Macro.
 242 | func NewMacro(carity int, body *Cell, env *Cell) interface{} {
 243 | 	return &Macro{Func{carity}, body}
 244 | }
 245 | 
 246 | // ExpandWith expands the macro with a list of actual arguments.
 247 | func (x *Macro) ExpandWith(interp *Interp, arg *Cell) interface{} {
 248 | 	frame := x.MakeFrame(arg, x)
 249 | 	env := &Cell{frame, Nil}
 250 | 	var y interface{} = Nil
 251 | 	for j := x.body; j != Nil; j = j.CdrCell() {
 252 | 		y = interp.Eval(j.Car, env)
 253 | 	}
 254 | 	return y
 255 | }
 256 | 
 257 | // String returns a textual representation of the macro.
 258 | func (x *Macro) String() string {
 259 | 	return fmt.Sprintf("#<macro:%d:%s>", x.Carity, Str(x.body))
 260 | }
 261 | 
 262 | // Lambda represents a compiled lambda expression (within another function).
 263 | type Lambda struct {
 264 | 	Func
 265 | 	// Body is a list which will be used as the function body.
 266 | 	Body *Cell
 267 | }
 268 | 
 269 | // NewLambda constructs a Lambda.
 270 | func NewLambda(carity int, body *Cell, env *Cell) interface{} {
 271 | 	return &Lambda{Func{carity}, body}
 272 | }
 273 | 
 274 | // String returns a textual representation of the lambda.
 275 | func (x *Lambda) String() string {
 276 | 	return fmt.Sprintf("#<lambda:%d:%s>", x.Carity, Str(x.Body))
 277 | }
 278 | 
 279 | // Closure represents a compiled lambda expression with its own environment.
 280 | type Closure struct {
 281 | 	Lambda
 282 | 	// Env is the closure's own environment.
 283 | 	Env *Cell
 284 | }
 285 | 
 286 | // NewClosure constructs a Closure.
 287 | func NewClosure(carity int, body *Cell, env *Cell) interface{} {
 288 | 	return &Closure{Lambda{Func{carity}, body}, env}
 289 | }
 290 | 
 291 | // MakeEnv makes a new environment from a list of acutual arguments,
 292 | // which will be used in evaluation of the body of the closure.
 293 | func (x *Closure) MakeEnv(interp *Interp, arg *Cell, interpEnv *Cell) *Cell {
 294 | 	frame := x.MakeFrame(arg, x)
 295 | 	x.EvalFrame(frame, interp, interpEnv)
 296 | 	return &Cell{frame, x.Env} // Prepend the frame to Env of the closure.
 297 | }
 298 | 
 299 | // String returns a textual representation of the closure.
 300 | func (x *Closure) String() string {
 301 | 	return fmt.Sprintf("#<closure:%d:%s:%s>",
 302 | 		x.Carity, Str(x.Env), Str(x.Body))
 303 | }
 304 | 
 305 | //----------------------------------------------------------------------
 306 | 
 307 | // BuiltInFunc represents a built-in function.
 308 | type BuiltInFunc struct {
 309 | 	Func
 310 | 	name string
 311 | 	body func([]interface{}) interface{}
 312 | }
 313 | 
 314 | // NewBuiltInFunc constructs a BuiltInFunc.
 315 | func NewBuiltInFunc(name string, carity int,
 316 | 	body func([]interface{}) interface{}) *BuiltInFunc {
 317 | 	return &BuiltInFunc{Func{carity}, name, body}
 318 | }
 319 | 
 320 | // EvalWith invokes the built-in function with a list of actual arguments.
 321 | func (x *BuiltInFunc) EvalWith(interp *Interp, arg *Cell,
 322 | 	interpEnv *Cell) interface{} {
 323 | 	frame := x.MakeFrame(arg, x)
 324 | 	x.EvalFrame(frame, interp, interpEnv)
 325 | 	defer func() {
 326 | 		if err := recover(); err != nil {
 327 | 			if _, ok := err.(*EvalError); ok {
 328 | 				panic(err)
 329 | 			} else {
 330 | 				msg := fmt.Sprintf("%v -- %s", err, x.name)
 331 | 				panic(NewEvalError(msg, frame))
 332 | 			}
 333 | 		}
 334 | 	}()
 335 | 	return x.body(frame)
 336 | }
 337 | 
 338 | // String returns a textual representation of the BuiltInFunc.
 339 | func (x *BuiltInFunc) String() string {
 340 | 	return fmt.Sprintf("#<%s:%d>", x.name, x.Carity)
 341 | }
 342 | 
 343 | //----------------------------------------------------------------------
 344 | 
 345 | // Arg represents a bound variable in a compiled lambda/macro expression.
 346 | // It is constructed with &Arg{level, offset, symbol}.
 347 | type Arg struct {
 348 | 	// Level is a nesting level of the lexical scope.
 349 | 	// 0 for the innermost scope.
 350 | 	Level int
 351 | 
 352 | 	// Offset is an offset of the variable within the frame of the Level.
 353 | 	// 0 for the first variable within the frame.
 354 | 	Offset int
 355 | 
 356 | 	// Sym is a symbol which represented the variable before compilation.
 357 | 	Symbol *Sym
 358 | }
 359 | 
 360 | // GetValue gets a value from the location corresponding to the variable x
 361 | // within an environment env.
 362 | func (x *Arg) GetValue(env *Cell) interface{} {
 363 | 	for i := 0; i < x.Level; i++ {
 364 | 		env = env.Cdr.(*Cell)
 365 | 	}
 366 | 	return (env.Car.([]interface{}))[x.Offset]
 367 | }
 368 | 
 369 | // SetValue sets a value y to the location corresponding to the variable x
 370 | // within an environment env.
 371 | func (x *Arg) SetValue(y interface{}, env *Cell) {
 372 | 	for i := 0; i < x.Level; i++ {
 373 | 		env = env.Cdr.(*Cell)
 374 | 	}
 375 | 	(env.Car.([]interface{}))[x.Offset] = y
 376 | }
 377 | 
 378 | // String returns a textual representation of the Arg.
 379 | func (x *Arg) String() string {
 380 | 	return fmt.Sprintf("#%d:%d:%v", x.Level, x.Offset, x.Symbol)
 381 | }
 382 | 
 383 | //----------------------------------------------------------------------
 384 | 
 385 | // EvalError represents an error in evaluation.
 386 | type EvalError struct {
 387 | 	Message string
 388 | 	Trace   []string
 389 | }
 390 | 
 391 | // NewEvalError constructs an EvalError.
 392 | func NewEvalError(msg string, x interface{}) *EvalError {
 393 | 	return &EvalError{msg + ": " + Str(x), nil}
 394 | }
 395 | 
 396 | // NewNotVariableError constructs an EvalError which indicates an absence
 397 | // of variable.
 398 | func NewNotVariableError(x interface{}) *EvalError {
 399 | 	return NewEvalError("variable expected", x)
 400 | }
 401 | 
 402 | // Error returns a textual representation of the error.
 403 | // It is defined in compliance with the error type.
 404 | func (err *EvalError) Error() string {
 405 | 	s := "EvalError: " + err.Message
 406 | 	for _, line := range err.Trace {
 407 | 		s += "\n\t" + line
 408 | 	}
 409 | 	return s
 410 | }
 411 | 
 412 | // EofToken is a token which represents the end of file.
 413 | var EofToken error = errors.New("end of file")
 414 | 
 415 | //----------------------------------------------------------------------
 416 | 
 417 | // Interp represents a core of the interpreter.
 418 | type Interp struct {
 419 | 	globals map[*Sym]interface{}
 420 | 	lock    sync.RWMutex
 421 | }
 422 | 
 423 | // Future represents a "promise" for future/force.
 424 | type Future struct {
 425 | 	// Chan is a channel which transmits a pair of result and error.
 426 | 	// The pair is represented by Cell.
 427 | 	Chan <-chan Cell
 428 | 
 429 | 	// Result is a pair of the result (in a narrow meaning) and the error.
 430 | 	Result Cell
 431 | 
 432 | 	// Lock is an exclusive lock to receive the result at "force".
 433 | 	Lock sync.Mutex
 434 | }
 435 | 
 436 | // String returns a textual representation of the Future.
 437 | func (fu *Future) String() string {
 438 | 	return fmt.Sprintf("#<future:%v:%s:%v>",
 439 | 		fu.Chan, Str(&fu.Result), &fu.Lock)
 440 | }
 441 | 
 442 | // GetGlobalVar gets a global value of symbol sym within the interpreter.
 443 | func (interp *Interp) GetGlobalVar(sym *Sym) (interface{}, bool) {
 444 | 	interp.lock.RLock()
 445 | 	val, ok := interp.globals[sym]
 446 | 	interp.lock.RUnlock()
 447 | 	return val, ok
 448 | }
 449 | 
 450 | // SetGlobalVar sets a global value of symbol sym within the interpreter.
 451 | func (interp *Interp) SetGlobalVar(sym *Sym, val interface{}) {
 452 | 	interp.lock.Lock()
 453 | 	interp.globals[sym] = val
 454 | 	interp.lock.Unlock()
 455 | }
 456 | 
 457 | var Number0 = goarith.AsNumber(0)
 458 | var Number1 = goarith.AsNumber(1)
 459 | 
 460 | // NewInterp constructs an interpreter and sets built-in functions etc. as
 461 | // the global values of symbols within the interpreter.
 462 | func NewInterp() *Interp {
 463 | 	interp := &Interp{globals: make(map[*Sym]interface{})}
 464 | 
 465 | 	interp.Def("car", 1, func(a []interface{}) interface{} {
 466 | 		if a[0] == Nil {
 467 | 			return Nil
 468 | 		}
 469 | 		return a[0].(*Cell).Car
 470 | 	})
 471 | 
 472 | 	interp.Def("cdr", 1, func(a []interface{}) interface{} {
 473 | 		if a[0] == Nil {
 474 | 			return Nil
 475 | 		}
 476 | 		return a[0].(*Cell).Cdr
 477 | 	})
 478 | 
 479 | 	interp.Def("cons", 2, func(a []interface{}) interface{} {
 480 | 		return &Cell{a[0], a[1]}
 481 | 	})
 482 | 
 483 | 	interp.Def("atom", 1, func(a []interface{}) interface{} {
 484 | 		if j, ok := a[0].(*Cell); ok && j != Nil {
 485 | 			return Nil
 486 | 		}
 487 | 		return true
 488 | 	})
 489 | 
 490 | 	interp.Def("eq", 2, func(a []interface{}) interface{} {
 491 | 		if a[0] == a[1] { // Cells are compared by address.
 492 | 			return true
 493 | 		}
 494 | 		return Nil
 495 | 	})
 496 | 
 497 | 	interp.Def("list", -1, func(a []interface{}) interface{} {
 498 | 		return a[0]
 499 | 	})
 500 | 
 501 | 	interp.Def("rplaca", 2, func(a []interface{}) interface{} {
 502 | 		a[0].(*Cell).Car = a[1]
 503 | 		return a[1]
 504 | 	})
 505 | 
 506 | 	interp.Def("rplacd", 2, func(a []interface{}) interface{} {
 507 | 		a[0].(*Cell).Cdr = a[1]
 508 | 		return a[1]
 509 | 	})
 510 | 
 511 | 	interp.Def("length", 1, func(a []interface{}) interface{} {
 512 | 		switch x := a[0].(type) {
 513 | 		case *Cell:
 514 | 			return goarith.AsNumber(x.Len())
 515 | 		case string: // Each multi-bytes character counts 1.
 516 | 			return goarith.AsNumber(utf8.RuneCountInString(x))
 517 | 		default:
 518 | 			panic(NewEvalError("list or string expected", x))
 519 | 		}
 520 | 	})
 521 | 
 522 | 	interp.Def("stringp", 1, func(a []interface{}) interface{} {
 523 | 		if _, ok := a[0].(string); ok {
 524 | 			return true
 525 | 		}
 526 | 		return Nil
 527 | 	})
 528 | 
 529 | 	interp.Def("numberp", 1, func(a []interface{}) interface{} {
 530 | 		if goarith.AsNumber(a[0]) != nil {
 531 | 			return true
 532 | 		}
 533 | 		return Nil
 534 | 	})
 535 | 
 536 | 	interp.Def("eql", 2, func(a []interface{}) interface{} {
 537 | 		if a[0] == a[1] {
 538 | 			return true
 539 | 		}
 540 | 		if x := goarith.AsNumber(a[0]); x != nil {
 541 | 			if y := goarith.AsNumber(a[1]); y != nil {
 542 | 				if x.Cmp(y) == 0 {
 543 | 					return true
 544 | 				}
 545 | 			}
 546 | 		}
 547 | 		return Nil
 548 | 	})
 549 | 
 550 | 	interp.Def("<", 2, func(a []interface{}) interface{} {
 551 | 		if goarith.AsNumber(a[0]).Cmp(goarith.AsNumber(a[1])) < 0 {
 552 | 			return true
 553 | 		}
 554 | 		return Nil
 555 | 	})
 556 | 
 557 | 	interp.Def("%", 2, func(a []interface{}) interface{} {
 558 | 		_, q := goarith.AsNumber(a[0]).QuoRem(goarith.AsNumber(a[1]))
 559 | 		return q
 560 | 	})
 561 | 
 562 | 	interp.Def("mod", 2, func(a []interface{}) interface{} {
 563 | 		x, y := goarith.AsNumber(a[0]), goarith.AsNumber(a[1])
 564 | 		xs, ys := x.Cmp(Number0), y.Cmp(Number0)
 565 | 		_, q := x.QuoRem(y)
 566 | 		if (xs < 0 && ys > 0) || (xs > 0 && ys < 0) {
 567 | 			return q.Add(y)
 568 | 		}
 569 | 		return q
 570 | 	})
 571 | 
 572 | 	interp.Def("+", -1, func(a []interface{}) interface{} {
 573 | 		return a[0].(*Cell).FoldL(Number0,
 574 | 			func(x, y interface{}) interface{} {
 575 | 				return goarith.AsNumber(x).Add(goarith.AsNumber(y))
 576 | 			})
 577 | 	})
 578 | 
 579 | 	interp.Def("*", -1, func(a []interface{}) interface{} {
 580 | 		return a[0].(*Cell).FoldL(Number1,
 581 | 			func(x, y interface{}) interface{} {
 582 | 				return goarith.AsNumber(x).Mul(goarith.AsNumber(y))
 583 | 			})
 584 | 	})
 585 | 
 586 | 	interp.Def("-", -2, func(a []interface{}) interface{} {
 587 | 		if a[1] == Nil {
 588 | 			return Number0.Sub(goarith.AsNumber(a[0]))
 589 | 		} else {
 590 | 			return a[1].(*Cell).FoldL(goarith.AsNumber(a[0]),
 591 | 				func(x, y interface{}) interface{} {
 592 | 					return goarith.AsNumber(x).Sub(goarith.AsNumber(y))
 593 | 				})
 594 | 		}
 595 | 	})
 596 | 
 597 | 	interp.Def("/", -3, func(a []interface{}) interface{} {
 598 | 		q := goarith.AsNumber(a[0]).RQuo(goarith.AsNumber(a[1]))
 599 | 		return a[2].(*Cell).FoldL(q,
 600 | 			func(x, y interface{}) interface{} {
 601 | 				return goarith.AsNumber(x).RQuo(goarith.AsNumber(y))
 602 | 			})
 603 | 	})
 604 | 
 605 | 	interp.Def("truncate", -2, func(a []interface{}) interface{} {
 606 | 		x, y := goarith.AsNumber(a[0]), a[1].(*Cell)
 607 | 		if y == Nil {
 608 | 			q, _ := x.QuoRem(Number1)
 609 | 			return q
 610 | 		} else if y.Cdr == Nil {
 611 | 			q, _ := x.QuoRem(goarith.AsNumber(y.Car))
 612 | 			return q
 613 | 		} else {
 614 | 			panic("one or two arguments expected")
 615 | 		}
 616 | 	})
 617 | 
 618 | 	interp.Def("prin1", 1, func(a []interface{}) interface{} {
 619 | 		fmt.Print(Str2(a[0], true))
 620 | 		return a[0]
 621 | 	})
 622 | 
 623 | 	interp.Def("princ", 1, func(a []interface{}) interface{} {
 624 | 		fmt.Print(Str2(a[0], false))
 625 | 		return a[0]
 626 | 	})
 627 | 
 628 | 	interp.Def("terpri", 0, func(a []interface{}) interface{} {
 629 | 		fmt.Println()
 630 | 		return true
 631 | 	})
 632 | 
 633 | 	gensymCounterSym := NewSym("*gensym-counter*")
 634 | 	interp.SetGlobalVar(gensymCounterSym, Number1)
 635 | 	interp.Def("gensym", 0, func(a []interface{}) interface{} {
 636 | 		interp.lock.Lock()
 637 | 		defer interp.lock.Unlock()
 638 | 		x := goarith.AsNumber(interp.globals[gensymCounterSym])
 639 | 		interp.globals[gensymCounterSym] = x.Add(Number1)
 640 | 		return &Sym{fmt.Sprintf("G%s", x.String()), false}
 641 | 	})
 642 | 
 643 | 	interp.Def("make-symbol", 1, func(a []interface{}) interface{} {
 644 | 		return &Sym{a[0].(string), false}
 645 | 	})
 646 | 
 647 | 	interp.Def("intern", 1, func(a []interface{}) interface{} {
 648 | 		return NewSym(a[0].(string))
 649 | 	})
 650 | 
 651 | 	interp.Def("symbol-name", 1, func(a []interface{}) interface{} {
 652 | 		return a[0].(*Sym).Name
 653 | 	})
 654 | 
 655 | 	interp.Def("apply", 2, func(a []interface{}) interface{} {
 656 | 		args := a[1].(*Cell).MapCar(QqQuote)
 657 | 		return interp.Eval(&Cell{a[0], args}, Nil)
 658 | 	})
 659 | 
 660 | 	interp.Def("exit", 1, func(a []interface{}) interface{} {
 661 | 		n, exact := goarith.AsNumber(a[0]).Int()
 662 | 		if !exact {
 663 | 			panic("int expected")
 664 | 		}
 665 | 		os.Exit(int(n))
 666 | 		return Nil // *not reached*
 667 | 	})
 668 | 
 669 | 	interp.Def("dump", 0, func(a []interface{}) interface{} {
 670 | 		interp.lock.RLock()
 671 | 		defer interp.lock.RUnlock()
 672 | 		r := Nil
 673 | 		for key := range interp.globals {
 674 | 			r = &Cell{key, r}
 675 | 		}
 676 | 		return r
 677 | 	})
 678 | 
 679 | 	// Wait until the "promise" of Future is delivered.
 680 | 	interp.Def("force", 1, func(a []interface{}) interface{} {
 681 | 		if fu, ok := a[0].(*Future); ok {
 682 | 			fu.Lock.Lock()
 683 | 			defer fu.Lock.Unlock()
 684 | 			if fu.Chan != nil {
 685 | 				fu.Result = <-fu.Chan
 686 | 				fu.Chan = nil
 687 | 			}
 688 | 			if err := fu.Result.Cdr; err != nil {
 689 | 				fu.Result.Cdr = nil
 690 | 				panic(err) // Transmit the error.
 691 | 			}
 692 | 			return fu.Result.Car
 693 | 		} else {
 694 | 			return a[0]
 695 | 		}
 696 | 	})
 697 | 
 698 | 	interp.SetGlobalVar(NewSym("*version*"),
 699 | 		&Cell{
 700 | 			goarith.AsNumber(2.0),
 701 | 			&Cell{
 702 | 				fmt.Sprintf("%s %s/%s",
 703 | 					runtime.Version(), runtime.GOOS, runtime.GOARCH),
 704 | 				&Cell{
 705 | 					"Nukata Lisp",
 706 | 					Nil}}})
 707 | 	// named after Nukata-gun (額田郡) in Tōkai-dō Mikawa-koku (東海道 三河国)
 708 | 
 709 | 	return interp
 710 | }
 711 | 
 712 | // Def defines a built-in function by giving a name, arity, and body.
 713 | func (interp *Interp) Def(name string, carity int,
 714 | 	body func([]interface{}) interface{}) {
 715 | 	sym := NewSym(name)
 716 | 	fnc := NewBuiltInFunc(name, carity, body)
 717 | 	interp.SetGlobalVar(sym, fnc)
 718 | }
 719 | 
 720 | // Eval evaluates a Lisp expression in a given environment env.
 721 | func (interp *Interp) Eval(expression interface{}, env *Cell) interface{} {
 722 | 	defer func() {
 723 | 		if err := recover(); err != nil {
 724 | 			if ex, ok := err.(*EvalError); ok {
 725 | 				if ex.Trace == nil {
 726 | 					ex.Trace = make([]string, 0, 10)
 727 | 				}
 728 | 				if len(ex.Trace) < 10 {
 729 | 					ex.Trace = append(ex.Trace, Str(expression))
 730 | 				}
 731 | 			}
 732 | 			panic(err)
 733 | 		}
 734 | 	}()
 735 | 	for {
 736 | 		switch x := expression.(type) {
 737 | 		case *Arg:
 738 | 			return x.GetValue(env)
 739 | 		case *Sym:
 740 | 			r, ok := interp.GetGlobalVar(x)
 741 | 			if ok {
 742 | 				return r
 743 | 			}
 744 | 			panic(NewEvalError("void variable", x))
 745 | 		case *Cell:
 746 | 			if x == Nil {
 747 | 				return x // an empty list
 748 | 			}
 749 | 			fn := x.Car
 750 | 			arg := x.CdrCell()
 751 | 			sym, ok := fn.(*Sym)
 752 | 			if ok && sym.IsKeyword {
 753 | 				switch sym {
 754 | 				case QuoteSym:
 755 | 					if arg != Nil && arg.Cdr == Nil {
 756 | 						return arg.Car
 757 | 					}
 758 | 					panic(NewEvalError("bad quote", x))
 759 | 				case ProgNSym:
 760 | 					expression = interp.evalProgN(arg, env)
 761 | 				case CondSym:
 762 | 					expression = interp.evalCond(arg, env)
 763 | 				case SetqSym:
 764 | 					return interp.evalSetQ(arg, env)
 765 | 				case LambdaSym:
 766 | 					return interp.compile(arg, env, NewClosure)
 767 | 				case MacroSym:
 768 | 					if env != Nil {
 769 | 						panic(NewEvalError("nested macro", x))
 770 | 					}
 771 | 					return interp.compile(arg, Nil, NewMacro)
 772 | 				case QuasiquoteSym:
 773 | 					if arg != Nil && arg.Cdr == Nil {
 774 | 						expression = QqExpand(arg.Car)
 775 | 					} else {
 776 | 						panic(NewEvalError("bad quasiquote", x))
 777 | 					}
 778 | 				case FutureSym:
 779 | 					ch := make(chan Cell)
 780 | 					go interp.futureTask(arg, env, ch)
 781 | 					return &Future{Chan: ch}
 782 | 				default:
 783 | 					panic(NewEvalError("bad keyword", fn))
 784 | 				}
 785 | 			} else { // Apply fn to arg.
 786 | 				// Expand fn = interp.Eval(fn, env) here on Sym for speed.
 787 | 				if ok {
 788 | 					fn, ok = interp.GetGlobalVar(sym)
 789 | 					if !ok {
 790 | 						panic(NewEvalError("undefined", x.Car))
 791 | 					}
 792 | 				} else {
 793 | 					fn = interp.Eval(fn, env)
 794 | 				}
 795 | 				switch f := fn.(type) {
 796 | 				case *Closure:
 797 | 					env = f.MakeEnv(interp, arg, env)
 798 | 					expression = interp.evalProgN(f.Body, env)
 799 | 				case *Macro:
 800 | 					expression = f.ExpandWith(interp, arg)
 801 | 				case *BuiltInFunc:
 802 | 					return f.EvalWith(interp, arg, env)
 803 | 				default:
 804 | 					panic(NewEvalError("not applicable", fn))
 805 | 				}
 806 | 			}
 807 | 		case *Lambda:
 808 | 			return &Closure{*x, env}
 809 | 		default:
 810 | 			return x // numbers, strings etc.
 811 | 		}
 812 | 	}
 813 | }
 814 | 
 815 | // SafeEval evaluates a Lisp expression in a given environment env and
 816 | // returns the result and nil.
 817 | // If an error happens, it returns Nil and the error
 818 | func (interp *Interp) SafeEval(expression interface{}, env *Cell) (
 819 | 	result interface{}, err interface{}) {
 820 | 	defer func() {
 821 | 		if e := recover(); e != nil {
 822 | 			result, err = Nil, e
 823 | 		}
 824 | 	}()
 825 | 	return interp.Eval(expression, env), nil
 826 | }
 827 | 
 828 | // evalProgN evaluates E1, E2, .., E(n-1) and returns the tail expression En.
 829 | func (interp *Interp) evalProgN(j *Cell, env *Cell) interface{} {
 830 | 	if j == Nil {
 831 | 		return Nil
 832 | 	}
 833 | 	for {
 834 | 		x := j.Car
 835 | 		j = j.CdrCell()
 836 | 		if j == Nil {
 837 | 			return x // The tail expression will be evaluated at the caller.
 838 | 		}
 839 | 		interp.Eval(x, env)
 840 | 	}
 841 | }
 842 | 
 843 | // futureTask is a task for goroutine to deliver the "promise" of Future.
 844 | // It returns the En value of (future E1 E2 .. En) via the channel and
 845 | // closes the channel.
 846 | func (interp *Interp) futureTask(j *Cell, env *Cell, ch chan<- Cell) {
 847 | 	defer close(ch)
 848 | 	result, err := interp.safeProgN(j, env)
 849 | 	ch <- Cell{result, err}
 850 | }
 851 | 
 852 | // safeProgN evaluates E1, E2, .. En and returns the value of En and nil.
 853 | // If an error happens, it returns Nil and the error.
 854 | func (interp *Interp) safeProgN(j *Cell, env *Cell) (result interface{},
 855 | 	err interface{}) {
 856 | 	defer func() {
 857 | 		if e := recover(); e != nil {
 858 | 			result, err = Nil, e
 859 | 		}
 860 | 	}()
 861 | 	x := interp.evalProgN(j, env)
 862 | 	return interp.Eval(x, env), nil
 863 | }
 864 | 
 865 | // evalCond evaluates a conditional expression and returns the selection
 866 | // unevaluated.
 867 | func (interp *Interp) evalCond(j *Cell, env *Cell) interface{} {
 868 | 	for j != Nil {
 869 | 		clause, ok := j.Car.(*Cell)
 870 | 		if ok {
 871 | 			if clause != Nil {
 872 | 				result := interp.Eval(clause.Car, env)
 873 | 				if result != Nil { // If the condition holds...
 874 | 					body := clause.CdrCell()
 875 | 					if body == Nil {
 876 | 						return QqQuote(result)
 877 | 					} else {
 878 | 						return interp.evalProgN(body, env)
 879 | 					}
 880 | 				}
 881 | 			}
 882 | 		} else {
 883 | 			panic(NewEvalError("cond test expected", j.Car))
 884 | 		}
 885 | 		j = j.CdrCell()
 886 | 	}
 887 | 	return Nil // No clause holds.
 888 | }
 889 | 
 890 | // evalSeqQ evaluates each Ei of (setq .. Vi Ei ..) and assigns it to Vi
 891 | // repectively.  It returns the value of the last expression En.
 892 | func (interp *Interp) evalSetQ(j *Cell, env *Cell) interface{} {
 893 | 	var result interface{} = Nil
 894 | 	for j != Nil {
 895 | 		lval := j.Car
 896 | 		j = j.CdrCell()
 897 | 		if j == Nil {
 898 | 			panic(NewEvalError("right value expected", lval))
 899 | 		}
 900 | 		result = interp.Eval(j.Car, env)
 901 | 		switch v := lval.(type) {
 902 | 		case *Arg:
 903 | 			v.SetValue(result, env)
 904 | 		case *Sym:
 905 | 			if v.IsKeyword {
 906 | 				panic(NewNotVariableError(lval))
 907 | 			}
 908 | 			interp.SetGlobalVar(v, result)
 909 | 		default:
 910 | 			panic(NewNotVariableError(lval))
 911 | 		}
 912 | 		j = j.CdrCell()
 913 | 	}
 914 | 	return result
 915 | }
 916 | 
 917 | // compile compiles a Lisp list (macro ...) or (lambda ...).
 918 | func (interp *Interp) compile(arg *Cell, env *Cell,
 919 | 	factory func(int, *Cell, *Cell) interface{}) interface{} {
 920 | 	if arg == Nil {
 921 | 		panic(NewEvalError("arglist and body expected", arg))
 922 | 	}
 923 | 	table := make(map[*Sym]*Arg)
 924 | 	hasRest := makeArgTable(arg.Car, table)
 925 | 	arity := len(table)
 926 | 	body := arg.CdrCell()
 927 | 	body = scanForArgs(body, table).(*Cell)
 928 | 	body = interp.expandMacros(body, 20).(*Cell) // Expand up to 20 nestings.
 929 | 	body = interp.compileInners(body).(*Cell)
 930 | 	if hasRest {
 931 | 		arity = -arity
 932 | 	}
 933 | 	return factory(arity, body, env)
 934 | }
 935 | 
 936 | // expandMacros expands macros and quasi-quotes in x up to count nestings.
 937 | func (interp *Interp) expandMacros(x interface{}, count int) interface{} {
 938 | 	if count > 0 {
 939 | 		if j, ok := x.(*Cell); ok {
 940 | 			if j == Nil {
 941 | 				return Nil
 942 | 			}
 943 | 			switch k := j.Car; k {
 944 | 			case QuoteSym, LambdaSym, MacroSym:
 945 | 				return j
 946 | 			case QuasiquoteSym:
 947 | 				d := j.CdrCell()
 948 | 				if d != Nil && d.Cdr == Nil {
 949 | 					z := QqExpand(d.Car)
 950 | 					return interp.expandMacros(z, count)
 951 | 				}
 952 | 				panic(NewEvalError("bad quasiquote", j))
 953 | 			default:
 954 | 				if sym, ok := k.(*Sym); ok {
 955 | 					if v, ok := interp.GetGlobalVar(sym); ok {
 956 | 						k = v
 957 | 					}
 958 | 				}
 959 | 				if f, ok := k.(*Macro); ok {
 960 | 					d := j.CdrCell()
 961 | 					z := f.ExpandWith(interp, d)
 962 | 					return interp.expandMacros(z, count-1)
 963 | 				} else {
 964 | 					return j.MapCar(func(y interface{}) interface{} {
 965 | 						return interp.expandMacros(y, count)
 966 | 					})
 967 | 				}
 968 | 			}
 969 | 		}
 970 | 	}
 971 | 	return x
 972 | }
 973 | 
 974 | // compileInners replaces inner lambda-expressions with Lambda instances.
 975 | func (interp *Interp) compileInners(x interface{}) interface{} {
 976 | 	if j, ok := x.(*Cell); ok {
 977 | 		if j == Nil {
 978 | 			return Nil
 979 | 		}
 980 | 		switch k := j.Car; k {
 981 | 		case QuoteSym:
 982 | 			return j
 983 | 		case LambdaSym:
 984 | 			d := j.CdrCell()
 985 | 			return interp.compile(d, Nil, NewLambda)
 986 | 		case MacroSym:
 987 | 			panic(NewEvalError("nested macro", j))
 988 | 		default:
 989 | 			return j.MapCar(func(y interface{}) interface{} {
 990 | 				return interp.compileInners(y)
 991 | 			})
 992 | 		}
 993 | 	}
 994 | 	return x
 995 | }
 996 | 
 997 | //----------------------------------------------------------------------
 998 | 
 999 | // makeArgTable makes an argument-table.  It returns true if x has &rest.
1000 | func makeArgTable(x interface{}, table map[*Sym]*Arg) bool {
1001 | 	arg, ok := x.(*Cell)
1002 | 	if !ok {
1003 | 		panic(NewEvalError("arglist expected", x))
1004 | 	}
1005 | 	if arg == Nil {
1006 | 		return false
1007 | 	} else {
1008 | 		offset := 0 // offset value within the call-frame
1009 | 		hasRest := false
1010 | 		for arg != Nil {
1011 | 			j := arg.Car
1012 | 			if hasRest {
1013 | 				panic(NewEvalError("2nd rest", j))
1014 | 			}
1015 | 			if j == RestSym { // &rest var
1016 | 				arg = arg.CdrCell()
1017 | 				if arg == Nil {
1018 | 					panic(NewNotVariableError(arg))
1019 | 				}
1020 | 				j = arg.Car
1021 | 				if j == RestSym {
1022 | 					panic(NewNotVariableError(j))
1023 | 				}
1024 | 				hasRest = true
1025 | 			}
1026 | 			var sym *Sym
1027 | 			switch v := j.(type) {
1028 | 			case *Sym:
1029 | 				sym = v
1030 | 			case *Arg:
1031 | 				sym = v.Symbol
1032 | 			default:
1033 | 				panic(NewNotVariableError(j))
1034 | 			}
1035 | 			if _, ok := table[sym]; ok {
1036 | 				panic(NewEvalError("duplicated argument name", sym))
1037 | 			}
1038 | 			table[sym] = &Arg{0, offset, sym}
1039 | 			offset++
1040 | 			arg = arg.CdrCell()
1041 | 		}
1042 | 		return hasRest
1043 | 	}
1044 | }
1045 | 
1046 | // scanForArgs scans x for formal arguments in table and replaces them
1047 | // with Args.
1048 | // Also it scans x for free Args not in table and promotes their levels.
1049 | func scanForArgs(x interface{}, table map[*Sym]*Arg) interface{} {
1050 | 	switch j := x.(type) {
1051 | 	case *Sym:
1052 | 		if a, ok := table[j]; ok {
1053 | 			return a
1054 | 		}
1055 | 		return j
1056 | 	case *Arg:
1057 | 		if a, ok := table[j.Symbol]; ok {
1058 | 			return a
1059 | 		}
1060 | 		return &Arg{j.Level + 1, j.Offset, j.Symbol}
1061 | 	case *Cell:
1062 | 		if j == Nil {
1063 | 			return Nil
1064 | 		}
1065 | 		switch j.Car {
1066 | 		case QuoteSym:
1067 | 			return j
1068 | 		case QuasiquoteSym:
1069 | 			return &Cell{QuasiquoteSym, scanForQQ(j.Cdr, table, 0)}
1070 | 		default:
1071 | 			return j.MapCar(func(y interface{}) interface{} {
1072 | 				return scanForArgs(y, table)
1073 | 			})
1074 | 		}
1075 | 	default:
1076 | 		return j
1077 | 	}
1078 | }
1079 | 
1080 | // scanForQQ scans x for quasi-quotes and executes scanForArgs on the
1081 | // nesting level of quotes.
1082 | func scanForQQ(x interface{}, table map[*Sym]*Arg,
1083 | 	level int) interface{} {
1084 | 	j, ok := x.(*Cell)
1085 | 	if ok {
1086 | 		if j == Nil {
1087 | 			return Nil
1088 | 		}
1089 | 		switch k := j.Car; k {
1090 | 		case QuasiquoteSym:
1091 | 			return &Cell{k, scanForQQ(j.Cdr, table, level+1)}
1092 | 		case UnquoteSym, UnquoteSplicingSym:
1093 | 			var d interface{}
1094 | 			if level == 0 {
1095 | 				d = scanForArgs(j.Cdr, table)
1096 | 			} else {
1097 | 				d = scanForQQ(j.Cdr, table, level-1)
1098 | 			}
1099 | 			if d == j.Cdr {
1100 | 				return j
1101 | 			}
1102 | 			return &Cell{k, d}
1103 | 		default:
1104 | 			return j.MapCar(func(y interface{}) interface{} {
1105 | 				return scanForQQ(y, table, level)
1106 | 			})
1107 | 		}
1108 | 	} else {
1109 | 		return x
1110 | 	}
1111 | }
1112 | 
1113 | //----------------------------------------------------------------------
1114 | // Quasi-Quotation
1115 | 
1116 | // QqExpand expands x of any quasi-quote `x into the equivalent S-expression.
1117 | func QqExpand(x interface{}) interface{} {
1118 | 	return qqExpand0(x, 0) // Begin with the nesting level 0.
1119 | }
1120 | 
1121 | // QqQuote quotes x so that the result evaluates to x.
1122 | func QqQuote(x interface{}) interface{} {
1123 | 	if x == Nil {
1124 | 		return Nil
1125 | 	}
1126 | 	switch x.(type) {
1127 | 	case *Sym, *Cell:
1128 | 		return &Cell{QuoteSym, &Cell{x, Nil}}
1129 | 	default:
1130 | 		return x
1131 | 	}
1132 | }
1133 | 
1134 | func qqExpand0(x interface{}, level int) interface{} {
1135 | 	if j, ok := x.(*Cell); ok {
1136 | 		if j == Nil {
1137 | 			return Nil
1138 | 		}
1139 | 		if j.Car == UnquoteSym { // ,a
1140 | 			if level == 0 {
1141 | 				return j.CdrCell().Car // ,a => a
1142 | 			}
1143 | 		}
1144 | 		t := qqExpand1(j, level)
1145 | 		if t.Cdr == Nil {
1146 | 			if k, ok := t.Car.(*Cell); ok {
1147 | 				if k.Car == ListSym || k.Car == ConsSym {
1148 | 					return k
1149 | 				}
1150 | 			}
1151 | 		}
1152 | 		return &Cell{AppendSym, t}
1153 | 	} else {
1154 | 		return QqQuote(x)
1155 | 	}
1156 | }
1157 | 
1158 | // qqExpand1 expands x of `x so that the result can be used as an argument of
1159 | // append.  Example 1: (,a b) => ((list a 'b))
1160 | //          Example 2: (,a ,@(cons 2 3)) => ((cons a (cons 2 3)))
1161 | func qqExpand1(x interface{}, level int) *Cell {
1162 | 	if j, ok := x.(*Cell); ok {
1163 | 		if j == Nil {
1164 | 			return &Cell{Nil, Nil}
1165 | 		}
1166 | 		switch j.Car {
1167 | 		case UnquoteSym: // ,a
1168 | 			if level == 0 {
1169 | 				return j.CdrCell() // ,a => (a)
1170 | 			}
1171 | 			level--
1172 | 		case QuasiquoteSym: // `a
1173 | 			level++
1174 | 		}
1175 | 		h := qqExpand2(j.Car, level)
1176 | 		t := qqExpand1(j.Cdr, level) // != Nil
1177 | 		if t.Car == Nil && t.Cdr == Nil {
1178 | 			return &Cell{h, Nil}
1179 | 		} else if hc, ok := h.(*Cell); ok {
1180 | 			if hc.Car == ListSym {
1181 | 				if tcar, ok := t.Car.(*Cell); ok {
1182 | 					if tcar.Car == ListSym {
1183 | 						hh := qqConcat(hc, tcar.Cdr)
1184 | 						return &Cell{hh, t.Cdr}
1185 | 					}
1186 | 				}
1187 | 				if hcdr, ok := hc.Cdr.(*Cell); ok {
1188 | 					hh := qqConsCons(hcdr, t.Car)
1189 | 					return &Cell{hh, t.Cdr}
1190 | 				}
1191 | 			}
1192 | 		}
1193 | 		return &Cell{h, t}
1194 | 	} else {
1195 | 		return &Cell{QqQuote(x), Nil}
1196 | 	}
1197 | }
1198 | 
1199 | // (1 2), (3 4) => (1 2 3 4)
1200 | func qqConcat(x *Cell, y interface{}) interface{} {
1201 | 	if x == Nil {
1202 | 		return y
1203 | 	} else {
1204 | 		return &Cell{x.Car, qqConcat(x.CdrCell(), y)}
1205 | 	}
1206 | }
1207 | 
1208 | // (1 2 3), "a" => (cons 1 (cons 2 (cons 3 "a")))
1209 | func qqConsCons(x *Cell, y interface{}) interface{} {
1210 | 	if x == Nil {
1211 | 		return y
1212 | 	} else {
1213 | 		return &Cell{ConsSym, &Cell{x.Car,
1214 | 			&Cell{qqConsCons(x.CdrCell(), y), Nil}}}
1215 | 	}
1216 | }
1217 | 
1218 | // qqExpand2 expands x.car (= y) of `x so that the result can be used as an
1219 | // argument of append.
1220 | // Examples: ,a => (list a); ,@(foo 1 2) => (foo 1 2); b => (list 'b)
1221 | func qqExpand2(y interface{}, level int) interface{} {
1222 | 	if j, ok := y.(*Cell); ok {
1223 | 		if j == Nil {
1224 | 			return &Cell{ListSym, &Cell{Nil, Nil}} // (list nil)
1225 | 		}
1226 | 		switch j.Car {
1227 | 		case UnquoteSym: // ,a
1228 | 			if level == 0 {
1229 | 				return &Cell{ListSym, j.Cdr} // ,a => (list a)
1230 | 			}
1231 | 			level--
1232 | 		case UnquoteSplicingSym: // ,@a
1233 | 			if level == 0 {
1234 | 				return j.CdrCell().Car // ,@a => a
1235 | 			}
1236 | 			level--
1237 | 		case QuasiquoteSym: // `a
1238 | 			level++
1239 | 		}
1240 | 	}
1241 | 	return &Cell{ListSym, &Cell{qqExpand0(y, level), Nil}}
1242 | }
1243 | 
1244 | //----------------------------------------------------------------------
1245 | 
1246 | // Reader represents a reader of Lisp expressions.
1247 | type Reader struct {
1248 | 	scanner *bufio.Scanner
1249 | 	token   interface{} // the current token
1250 | 	tokens  []string    // tokens read from the current line
1251 | 	index   int         // the next index of tokens
1252 | 	line    string      // the current line
1253 | 	lineNo  int         // the current line number
1254 | 	erred   bool        // a flag if an error has happened
1255 | }
1256 | 
1257 | // NewReader constructs a reader which will read Lisp expressions from r.
1258 | func NewReader(r io.Reader) *Reader {
1259 | 	scanner := bufio.NewScanner(r)
1260 | 	return &Reader{scanner, nil, nil, 0, "", 0, false}
1261 | }
1262 | 
1263 | // Read reads a Lisp expression and returns the expression and nil.
1264 | // If the input runs out, it returns EofToken and nil.
1265 | // If an error happens, it returns Nil and the error.
1266 | func (rr *Reader) Read() (result interface{}, err interface{}) {
1267 | 	defer func() {
1268 | 		if e := recover(); e != nil {
1269 | 			result, err = Nil, e
1270 | 		}
1271 | 	}()
1272 | 	rr.readToken()
1273 | 	return rr.parseExpression(), nil
1274 | }
1275 | 
1276 | func (rr *Reader) newSynatxError(msg string, arg interface{}) *EvalError {
1277 | 	rr.erred = true
1278 | 	s := fmt.Sprintf("syntax error: %s -- %d: %s",
1279 | 		fmt.Sprintf(msg, arg), rr.lineNo, rr.line)
1280 | 	return &EvalError{s, nil}
1281 | }
1282 | 
1283 | func (rr *Reader) parseExpression() interface{} {
1284 | 	switch rr.token {
1285 | 	case LeftParenSym: // (a b c)
1286 | 		rr.readToken()
1287 | 		return rr.parseListBody()
1288 | 	case SingleQuoteSym: // 'a => (quote a)
1289 | 		rr.readToken()
1290 | 		return &Cell{QuoteSym, &Cell{rr.parseExpression(), Nil}}
1291 | 	case BackQuoteSym: // `a => (quasiquote a)
1292 | 		rr.readToken()
1293 | 		return &Cell{QuasiquoteSym, &Cell{rr.parseExpression(), Nil}}
1294 | 	case CommaSym: // ,a => (unquote a)
1295 | 		rr.readToken()
1296 | 		return &Cell{UnquoteSym, &Cell{rr.parseExpression(), Nil}}
1297 | 	case CommaAtSym: // ,@a => (unquote-splicing a)
1298 | 		rr.readToken()
1299 | 		return &Cell{UnquoteSplicingSym, &Cell{rr.parseExpression(), Nil}}
1300 | 	case DotSym, RightParenSym:
1301 | 		panic(rr.newSynatxError("unexpected \"%v\"", rr.token))
1302 | 	default:
1303 | 		return rr.token
1304 | 	}
1305 | }
1306 | 
1307 | func (rr *Reader) parseListBody() *Cell {
1308 | 	if rr.token == EofToken {
1309 | 		panic(rr.newSynatxError("unexpected EOF%s", ""))
1310 | 	} else if rr.token == RightParenSym {
1311 | 		return Nil
1312 | 	} else {
1313 | 		e1 := rr.parseExpression()
1314 | 		rr.readToken()
1315 | 		var e2 interface{}
1316 | 		if rr.token == DotSym { // (a . b)
1317 | 			rr.readToken()
1318 | 			e2 = rr.parseExpression()
1319 | 			rr.readToken()
1320 | 			if rr.token != RightParenSym {
1321 | 				panic(rr.newSynatxError("\")\" expected: %v", rr.token))
1322 | 			}
1323 | 		} else {
1324 | 			e2 = rr.parseListBody()
1325 | 		}
1326 | 		return &Cell{e1, e2}
1327 | 	}
1328 | }
1329 | 
1330 | // readToken reads the next token and set it to rr.token.
1331 | func (rr *Reader) readToken() {
1332 | 	// Read the next line if the line ends or an error happened last time.
1333 | 	for len(rr.tokens) <= rr.index || rr.erred {
1334 | 		rr.erred = false
1335 | 		if rr.scanner.Scan() {
1336 | 			rr.line = rr.scanner.Text()
1337 | 			rr.lineNo++
1338 | 		} else {
1339 | 			if err := rr.scanner.Err(); err != nil {
1340 | 				panic(err)
1341 | 			}
1342 | 			rr.token = EofToken
1343 | 			return
1344 | 		}
1345 | 		mm := tokenPat.FindAllStringSubmatch(rr.line, -1)
1346 | 		tt := make([]string, 0, len(mm)*3/5) // Estimate 40% will be spaces.
1347 | 		for _, m := range mm {
1348 | 			if m[1] != "" {
1349 | 				tt = append(tt, m[1])
1350 | 			}
1351 | 		}
1352 | 		rr.tokens = tt
1353 | 		rr.index = 0
1354 | 	}
1355 | 	// Read the next token.
1356 | 	s := rr.tokens[rr.index]
1357 | 	rr.index++
1358 | 	if s[0] == '"' {
1359 | 		n := len(s) - 1
1360 | 		if n < 1 || s[n] != '"' {
1361 | 			panic(rr.newSynatxError("bad string: '%s'", s))
1362 | 		}
1363 | 		s = s[1:n]
1364 | 		s = escapePat.ReplaceAllStringFunc(s, func(t string) string {
1365 | 			r, ok := escapes[t] // r, err := strconv.Unquote("'" + t + "'")
1366 | 			if !ok {
1367 | 				r = t // Leave any invalid escape sequence as it is.
1368 | 			}
1369 | 			return r
1370 | 		})
1371 | 		rr.token = s
1372 | 		return
1373 | 	}
1374 | 	if f, ok := tryToReadNumber(s); ok {
1375 | 		rr.token = f
1376 | 		return
1377 | 	}
1378 | 	if s == "nil" {
1379 | 		rr.token = Nil
1380 | 		return
1381 | 	} else if s == "t" {
1382 | 		rr.token = true
1383 | 		return
1384 | 	}
1385 | 	rr.token = NewSym(s)
1386 | 	return
1387 | }
1388 | 
1389 | func tryToReadNumber(s string) (goarith.Number, bool) {
1390 | 	z := new(big.Int)
1391 | 	if _, ok := z.SetString(s, 0); ok {
1392 | 		return goarith.AsNumber(z), true
1393 | 	}
1394 | 	if f, err := strconv.ParseFloat(s, 64); err == nil {
1395 | 		return goarith.AsNumber(f), true
1396 | 	}
1397 | 	return nil, false
1398 | }
1399 | 
1400 | // tokenPat is a regular expression to split a line to Lisp tokens.
1401 | var tokenPat = regexp.MustCompile(`\s+|;.*$|("(\\.?|.)*?"|,@?|[^()'` +
1402 | 	"`" + `~"; \t]+|.)`)
1403 | 
1404 | // escapePat is a reg. expression to take an escape sequence out of a string.
1405 | var escapePat = regexp.MustCompile(`\\(.)`)
1406 | 
1407 | // escapes is a mapping from an escape sequence to its string value.
1408 | var escapes = map[string]string{
1409 | 	`\\`: `\`,
1410 | 	`\"`: `"`,
1411 | 	`\n`: "\n", `\r`: "\r", `\f`: "\f", `\b`: "\b", `\t`: "\t", `\v`: "\v",
1412 | }
1413 | 
1414 | //----------------------------------------------------------------------
1415 | 
1416 | // Str returns a textual representation of any Lisp expression x.
1417 | func Str(x interface{}) string {
1418 | 	return Str2(x, true)
1419 | }
1420 | 
1421 | // Str2 returns a textual representation of any Lisp expression x.
1422 | // If quoteString is true, any strings in the expression are represented
1423 | // with enclosing quotes respectively.
1424 | func Str2(x interface{}, quoteString bool) string {
1425 | 	return str4(x, quoteString, -1, nil)
1426 | }
1427 | 
1428 | // quotes is a mapping from a quote symbol to its string representation.
1429 | var quotes = map[*Sym]string{
1430 | 	QuoteSym:           "'",
1431 | 	QuasiquoteSym:      "`",
1432 | 	UnquoteSym:         ",",
1433 | 	UnquoteSplicingSym: ",@",
1434 | }
1435 | 
1436 | func str4(a interface{}, quoteString bool, count int,
1437 | 	printed map[*Cell]bool) string {
1438 | 	if a == true {
1439 | 		return "t"
1440 | 	}
1441 | 	switch x := a.(type) {
1442 | 	case *Cell:
1443 | 		if x == Nil {
1444 | 			return "nil"
1445 | 		}
1446 | 		if s, ok := x.Car.(*Sym); ok {
1447 | 			if q, ok := quotes[s]; ok {
1448 | 				if d, ok := x.Cdr.(*Cell); ok {
1449 | 					if d.Cdr == Nil {
1450 | 						return q + str4(d.Car, true, count, printed)
1451 | 					}
1452 | 				}
1453 | 			}
1454 | 		}
1455 | 		return "(" + strListBody(x, count, printed) + ")"
1456 | 	case string:
1457 | 		if quoteString {
1458 | 			return strconv.Quote(x)
1459 | 		}
1460 | 		return x
1461 | 	case []interface{}:
1462 | 		s := make([]string, len(x))
1463 | 		for i, e := range x {
1464 | 			s[i] = str4(e, true, count, printed)
1465 | 		}
1466 | 		return "[" + strings.Join(s, ", ") + "]"
1467 | 	case *Sym:
1468 | 		if x.IsInterned() {
1469 | 			return x.Name
1470 | 		}
1471 | 		return "#:" + x.Name
1472 | 	}
1473 | 	return fmt.Sprintf("%v", a)
1474 | }
1475 | 
1476 | // strListBody makes a string representation of a list, omitting its parens.
1477 | func strListBody(x *Cell, count int, printed map[*Cell]bool) string {
1478 | 	if printed == nil {
1479 | 		printed = make(map[*Cell]bool)
1480 | 	}
1481 | 	if count < 0 {
1482 | 		count = 4 // threshold of ellipsis for circular lists
1483 | 	}
1484 | 	s := make([]string, 0, 10)
1485 | 	y := x
1486 | 	for y != Nil {
1487 | 		if _, ok := printed[y]; ok {
1488 | 			count--
1489 | 			if count < 0 {
1490 | 				s = append(s, "...") // ellipsis for a circular list
1491 | 				return strings.Join(s, " ")
1492 | 			}
1493 | 		} else {
1494 | 			printed[y] = true
1495 | 			count = 4
1496 | 		}
1497 | 		s = append(s, str4(y.Car, true, count, printed))
1498 | 		if cdr, ok := y.Cdr.(*Cell); ok {
1499 | 			y = cdr
1500 | 		} else {
1501 | 			s = append(s, ".")
1502 | 			s = append(s, str4(y.Cdr, true, count, printed))
1503 | 			break
1504 | 		}
1505 | 	}
1506 | 	y = x
1507 | 	for y != Nil {
1508 | 		delete(printed, y)
1509 | 		if cdr, ok := y.Cdr.(*Cell); ok {
1510 | 			y = cdr
1511 | 		} else {
1512 | 			break
1513 | 		}
1514 | 	}
1515 | 	return strings.Join(s, " ")
1516 | }
1517 | 
1518 | //----------------------------------------------------------------------
1519 | 
1520 | // Run executes REPL (Read-Eval-Print Loop).
1521 | // It returns false if REPL was ceased by an error.
1522 | // It returns true if REPL was finished normally.
1523 | func Run(interp *Interp, input io.Reader) bool {
1524 | 	interactive := (input == nil)
1525 | 	if interactive {
1526 | 		input = os.Stdin
1527 | 	}
1528 | 	reader := NewReader(input)
1529 | 	for {
1530 | 		if interactive {
1531 | 			os.Stdout.WriteString("> ")
1532 | 		}
1533 | 		x, err := reader.Read()
1534 | 		if err == nil {
1535 | 			if x == EofToken {
1536 | 				return true // Finished normally.
1537 | 			}
1538 | 			x, err = interp.SafeEval(x, Nil)
1539 | 			if err == nil {
1540 | 				if interactive {
1541 | 					fmt.Println(Str(x))
1542 | 				}
1543 | 			}
1544 | 		}
1545 | 		if err != nil {
1546 | 			fmt.Println(err)
1547 | 			if !interactive {
1548 | 				return false // Ceased by an error.
1549 | 			}
1550 | 		}
1551 | 	}
1552 | }
1553 | 
1554 | // Main runs each element of args as a name of Lisp script file.
1555 | // It ignores args[0].
1556 | // If it does not have args[1] or some element is "-", it begins REPL.
1557 | func Main(args []string) int {
1558 | 	interp := NewInterp()
1559 | 	ss := strings.NewReader(Prelude)
1560 | 	if !Run(interp, ss) {
1561 | 		return 1
1562 | 	}
1563 | 	if len(args) < 2 {
1564 | 		args = []string{args[0], "-"}
1565 | 	}
1566 | 	for i, fileName := range args {
1567 | 		if i == 0 {
1568 | 			continue
1569 | 		}
1570 | 		if fileName == "-" {
1571 | 			Run(interp, nil)
1572 | 			fmt.Println("Goodbye")
1573 | 		} else {
1574 | 			file, err := os.Open(fileName)
1575 | 			if err != nil {
1576 | 				fmt.Println(err)
1577 | 				return 1
1578 | 			}
1579 | 			if !Run(interp, file) {
1580 | 				return 1
1581 | 			}
1582 | 		}
1583 | 	}
1584 | 	return 0
1585 | }
1586 | 
1587 | func main() {
1588 | 	os.Exit(Main(os.Args))
1589 | }
1590 | 
1591 | // Prelude is an initialization script of Lisp.
1592 | // Each "~" is replaced by "`" at runtime.
1593 | var Prelude = strings.Replace(`
1594 | (setq defmacro
1595 |       (macro (name args &rest body)
1596 |              ~(progn (setq ,name (macro ,args ,@body))
1597 |                      ',name)))
1598 | 
1599 | (defmacro defun (name args &rest body)
1600 |   ~(progn (setq ,name (lambda ,args ,@body))
1601 |           ',name))
1602 | 
1603 | (defun caar (x) (car (car x)))
1604 | (defun cadr (x) (car (cdr x)))
1605 | (defun cdar (x) (cdr (car x)))
1606 | (defun cddr (x) (cdr (cdr x)))
1607 | (defun caaar (x) (car (car (car x))))
1608 | (defun caadr (x) (car (car (cdr x))))
1609 | (defun cadar (x) (car (cdr (car x))))
1610 | (defun caddr (x) (car (cdr (cdr x))))
1611 | (defun cdaar (x) (cdr (car (car x))))
1612 | (defun cdadr (x) (cdr (car (cdr x))))
1613 | (defun cddar (x) (cdr (cdr (car x))))
1614 | (defun cdddr (x) (cdr (cdr (cdr x))))
1615 | (defun not (x) (eq x nil))
1616 | (defun consp (x) (not (atom x)))
1617 | (defun print (x) (prin1 x) (terpri) x)
1618 | (defun identity (x) x)
1619 | 
1620 | (setq
1621 |  = eql
1622 |  null not
1623 |  setcar rplaca
1624 |  setcdr rplacd)
1625 | 
1626 | (defun > (x y) (< y x))
1627 | (defun >= (x y) (not (< x y)))
1628 | (defun <= (x y) (not (< y x)))
1629 | (defun /= (x y) (not (= x y)))
1630 | 
1631 | (defun equal (x y)
1632 |   (cond ((atom x) (eql x y))
1633 |         ((atom y) nil)
1634 |         ((equal (car x) (car y)) (equal (cdr x) (cdr y)))))
1635 | 
1636 | (defmacro if (test then &rest else)
1637 |   ~(cond (,test ,then)
1638 |          ,@(cond (else ~((t ,@else))))))
1639 | 
1640 | (defmacro when (test &rest body)
1641 |   ~(cond (,test ,@body)))
1642 | 
1643 | (defmacro let (args &rest body)
1644 |   ((lambda (vars vals)
1645 |      (defun vars (x)
1646 |        (cond (x (cons (if (atom (car x))
1647 |                           (car x)
1648 |                         (caar x))
1649 |                       (vars (cdr x))))))
1650 |      (defun vals (x)
1651 |        (cond (x (cons (if (atom (car x))
1652 |                           nil
1653 |                         (cadar x))
1654 |                       (vals (cdr x))))))
1655 |      ~((lambda ,(vars args) ,@body) ,@(vals args)))
1656 |    nil nil))
1657 | 
1658 | (defmacro letrec (args &rest body)      ; (letrec ((v e) ...) body...)
1659 |   (let (vars setqs)
1660 |     (defun vars (x)
1661 |       (cond (x (cons (caar x)
1662 |                      (vars (cdr x))))))
1663 |     (defun sets (x)
1664 |       (cond (x (cons ~(setq ,(caar x) ,(cadar x))
1665 |                      (sets (cdr x))))))
1666 |     ~(let ,(vars args) ,@(sets args) ,@body)))
1667 | 
1668 | (defun _append (x y)
1669 |   (if (null x)
1670 |       y
1671 |     (cons (car x) (_append (cdr x) y))))
1672 | (defmacro append (x &rest y)
1673 |   (if (null y)
1674 |       x
1675 |     ~(_append ,x (append ,@y))))
1676 | 
1677 | (defmacro and (x &rest y)
1678 |   (if (null y)
1679 |       x
1680 |     ~(cond (,x (and ,@y)))))
1681 | 
1682 | (defun mapcar (f x)
1683 |   (and x (cons (f (car x)) (mapcar f (cdr x)))))
1684 | 
1685 | (defmacro or (x &rest y)
1686 |   (if (null y)
1687 |       x
1688 |     ~(cond (,x)
1689 |            ((or ,@y)))))
1690 | 
1691 | (defun listp (x)
1692 |   (or (null x) (consp x)))    ; NB (listp (lambda (x) (+ x 1))) => nil
1693 | 
1694 | (defun memq (key x)
1695 |   (cond ((null x) nil)
1696 |         ((eq key (car x)) x)
1697 |         (t (memq key (cdr x)))))
1698 | 
1699 | (defun member (key x)
1700 |   (cond ((null x) nil)
1701 |         ((equal key (car x)) x)
1702 |         (t (member key (cdr x)))))
1703 | 
1704 | (defun assq (key alist)
1705 |   (cond (alist (let ((e (car alist)))
1706 |                  (if (and (consp e) (eq key (car e)))
1707 |                      e
1708 |                    (assq key (cdr alist)))))))
1709 | 
1710 | (defun assoc (key alist)
1711 |   (cond (alist (let ((e (car alist)))
1712 |                  (if (and (consp e) (equal key (car e)))
1713 |                      e
1714 |                    (assoc key (cdr alist)))))))
1715 | 
1716 | (defun _nreverse (x prev)
1717 |   (let ((next (cdr x)))
1718 |     (setcdr x prev)
1719 |     (if (null next)
1720 |         x
1721 |       (_nreverse next x))))
1722 | (defun nreverse (list)            ; (nreverse '(a b c d)) => (d c b a)
1723 |   (cond (list (_nreverse list nil))))
1724 | 
1725 | (defun last (list)
1726 |   (if (atom (cdr list))
1727 |       list
1728 |     (last (cdr list))))
1729 | 
1730 | (defun nconc (&rest lists)
1731 |   (if (null (cdr lists))
1732 |       (car lists)
1733 |     (if (null (car lists))
1734 |         (apply nconc (cdr lists))
1735 |       (setcdr (last (car lists))
1736 |               (apply nconc (cdr lists)))
1737 |       (car lists))))
1738 | 
1739 | (defmacro while (test &rest body)
1740 |   (let ((loop (gensym)))
1741 |     ~(letrec ((,loop (lambda () (cond (,test ,@body (,loop))))))
1742 |        (,loop))))
1743 | 
1744 | (defmacro dolist (spec &rest body) ; (dolist (name list [result]) body...)
1745 |   (let ((name (car spec))
1746 |         (list (gensym)))
1747 |     ~(let (,name
1748 |            (,list ,(cadr spec)))
1749 |        (while ,list
1750 |          (setq ,name (car ,list))
1751 |          ,@body
1752 |          (setq ,list (cdr ,list)))
1753 |        ,@(if (cddr spec)
1754 |              ~((setq ,name nil)
1755 |                ,(caddr spec))))))
1756 | 
1757 | (defmacro dotimes (spec &rest body) ; (dotimes (name count [result]) body...)
1758 |   (let ((name (car spec))
1759 |         (count (gensym)))
1760 |     ~(let ((,name 0)
1761 |            (,count ,(cadr spec)))
1762 |        (while (< ,name ,count)
1763 |          ,@body
1764 |          (setq ,name (+ ,name 1)))
1765 |        ,@(if (cddr spec)
1766 |              ~(,(caddr spec))))))
1767 | `, "~", "`", -1)
1768 | 
1769 | /*
1770 |   Copyright (c) 2015, 2016 OKI Software Co., Ltd.
1771 |   Copyright (c) 2019 SUZUKI Hisao
1772 | 
1773 |   Permission is hereby granted, free of charge, to any person obtaining a
1774 |   copy of this software and associated documentation files (the "Software"),
1775 |   to deal in the Software without restriction, including without limitation
1776 |   the rights to use, copy, modify, merge, publish, distribute, sublicense,
1777 |   and/or sell copies of the Software, and to permit persons to whom the
1778 |   Software is furnished to do so, subject to the following conditions:
1779 | 
1780 |   The above copyright notice and this permission notice shall be included in
1781 |   all copies or substantial portions of the Software.
1782 | 
1783 |   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
1784 |   IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
1785 |   FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
1786 |   THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
1787 |   LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
1788 |   FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
1789 |   DEALINGS IN THE SOFTWARE.
1790 | */
1791 | 


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