├── examples
    ├── fact100.l
    ├── fib15.l
    ├── qsort.l
    ├── interp_in_thread.cs
    ├── eval-fib15.l
    └── eval-eval-fib15.l
├── lisp.csproj
├── LICENSE
├── README.md
├── IMPLEMENTATION-NOTES.md
├── arith.cs
└── lisp.cs


/examples/fact100.l:
--------------------------------------------------------------------------------
1 | (defun factorial (n)
2 |   (if (= n 0)
3 |       1
4 |     (* n (factorial (- n 1)))))
5 | 
6 | (print (factorial 100))
7 | 


--------------------------------------------------------------------------------
/examples/fib15.l:
--------------------------------------------------------------------------------
1 | (defun fib (n)
2 |   (if (< n 2)
3 |       1
4 |     (+ (fib (- n 1))
5 |        (fib (- n 2)))))
6 | (print (fib 15))
7 | 


--------------------------------------------------------------------------------
/lisp.csproj:
--------------------------------------------------------------------------------
 1 | <Project Sdk="Microsoft.NET.Sdk">
 2 | 
 3 |   <PropertyGroup>
 4 |     <OutputType>Exe</OutputType>
 5 |     <TargetFramework>net6.0</TargetFramework>
 6 |     <GenerateAssemblyInfo>False</GenerateAssemblyInfo>
 7 |     <Deterministic>False</Deterministic>
 8 |     <EnableDefaultCompileItems>false</EnableDefaultCompileItems>
 9 |   </PropertyGroup>
10 | 
11 |   <ItemGroup>
12 |     <Compile Include="./*.cs" />
13 |   </ItemGroup>
14 | 
15 | </Project>
16 | 


--------------------------------------------------------------------------------
/examples/qsort.l:
--------------------------------------------------------------------------------
 1 | ;; quick sort for a sequence
 2 | (defun qsort (seq) (_qsort seq nil))
 3 | 
 4 | (defun _qsort (left-seq right-sorted)
 5 |   (if (null left-seq)
 6 |       right-sorted
 7 |     (let ((pivot (car left-seq))
 8 |           (tail (cdr left-seq)))
 9 |       (let ((pair (_split pivot tail)))
10 |         (let ((left (car pair))
11 |               (right (cons pivot
12 |                            (_qsort (cadr pair) right-sorted))))
13 |           (_qsort left right))))))
14 | 
15 | (defun _split (pivot seq)               ; => (left-seq right-seq)
16 |   (if (null seq)
17 |       (list nil nil)
18 |     (let ((x (car seq))
19 |           (tail-pair (_split pivot (cdr seq))))
20 |       (if (< x pivot)
21 |           (list (cons x (car tail-pair))
22 |                 (cadr tail-pair))
23 |         (list (car tail-pair)
24 |               (cons x (cadr tail-pair)))))))
25 | 
26 | (print (qsort '(3 1 4 1 5 9 2 6 5 3 5 8 9 7 9)))
27 | ;;  => (1 1 2 3 3 4 5 5 5 6 7 8 9 9 9)
28 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | Copyright (c) 2017 OKI Software Co., Ltd.
 2 | Copyright (c) 2018 SUZUKI Hisao
 3 | 
 4 | Permission is hereby granted, free of charge, to any person obtaining a
 5 | copy of this software and associated documentation files (the "Software"),
 6 | to deal in the Software without restriction, including without limitation
 7 | the rights to use, copy, modify, merge, publish, distribute, sublicense,
 8 | and/or sell copies of the Software, and to permit persons to whom the
 9 | Software is furnished to do so, subject to the following conditions:
10 | 
11 | The above copyright notice and this permission notice shall be included in
12 | all copies or substantial portions of the Software.
13 | 
14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
17 | THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
20 | DEALINGS IN THE SOFTWARE.
21 | 


--------------------------------------------------------------------------------
/examples/interp_in_thread.cs:
--------------------------------------------------------------------------------
 1 | // An example of running Lisp in another thread
 2 | using System;
 3 | using System.Collections.Concurrent;
 4 | using System.IO;
 5 | using System.Text;
 6 | using System.Threading;
 7 | 
 8 | // csc -o -t:library -r:System.Numerics.dll ../lisp.cs ../arith.cs 
 9 | // csc -r:lisp.dll interp_in_thread.cs
10 | // mono interp_in_thread.exe
11 | 
12 | // Expected output:
13 | // => (1 . 2)
14 | // Reiwa
15 | // => Reiwa
16 | 
17 | public static class ThreadTest {
18 | 
19 |     // A simple substitute for Console.Out
20 |     class SendOut: TextWriter {
21 |         public BlockingCollection<object> Queue
22 |             = new BlockingCollection<object>();
23 | 
24 |         public override Encoding Encoding => Encoding.UTF8;
25 |         public override void Write(char value) {
26 |             Queue.Add(value);
27 |         }
28 |     }
29 | 
30 |     static readonly string EndSentinel = ":END";
31 | 
32 |     // A Read-Eval-Send Loop in another thread
33 |     static void RESLoop(SendOut so, BlockingCollection<string> receiveIn) {
34 |         var interp = NukataLisp.MakeInterp().Result;
35 |         interp.COut = so;
36 |         for (;;) {
37 |             string s = receiveIn.Take();
38 |             if (s == EndSentinel)
39 |                 break;
40 |             object x = NukataLisp.Run(interp, new StringReader(s)).Result;
41 |             so.Queue.Add(x);
42 |             so.Queue.Add(EndSentinel);
43 |         }
44 |         so.Queue.Add(EndSentinel);
45 |     }
46 | 
47 |     // Run Lisp in another thread and send it S-expression strings.
48 |     static void Main(string[] args) {
49 |         SendOut so = new SendOut();
50 |         var queue = new BlockingCollection<string>();
51 |         new Thread(() => RESLoop(so, queue)).Start();
52 |         foreach (string sExpression in new string[]{
53 |                 "(cons 1 2)",
54 |                 "(print 'Reiwa)",
55 |                 EndSentinel
56 |             }) {
57 |             queue.Add(sExpression);
58 |             for (;;) {
59 |                 object x = so.Queue.Take();
60 |                 if (x is string s && s == EndSentinel) {
61 |                     break;
62 |                 } else if (x is char ch) {
63 |                     Console.Write(ch);
64 |                 } else {
65 |                     Console.WriteLine("=> {0}", x);
66 |                 }
67 |             }
68 |         }
69 |     }
70 | }
71 | 


--------------------------------------------------------------------------------
/examples/eval-fib15.l:
--------------------------------------------------------------------------------
  1 | ;;; A circular Lisp interpreter in Common/Emacs/Nukata Lisp
  2 | ;;;    by SUZUKI Hisao on H28.8/10, H29.3/13
  3 | ;;;    cf. Zick Standard Lisp (https://github.com/zick/ZickStandardLisp)
  4 | 
  5 | (progn
  6 |   ;; Expr: (EXPR environment (symbol...) expression...)
  7 |   ;; Subr: (SUBR . function)
  8 |   ;; Environment: ((symbol . value)...)
  9 |   ;; N.B. Expr has its own environment since this Lisp is lexically scoped.
 10 | 
 11 |   ;; Language-specific Hacks
 12 |   (setq funcall (lambda (f x) (f x)))  ; for Nukata Lisp and this Lisp
 13 |   (setq max-lisp-eval-depth 10000)     ; for Emacs Lisp
 14 |   (setq max-specpdl-size 7000)         ; for Emacs Lisp
 15 | 
 16 |   ;; The global environment of this Lisp
 17 |   (setq global-env
 18 |         (list '(*version* . (1.2 "Lisp" "circlisp"))
 19 |               (cons 'car
 20 |                     (cons 'SUBR (lambda (x) (car (car x)))))
 21 |               (cons 'cdr
 22 |                     (cons 'SUBR (lambda (x) (cdr (car x)))))
 23 |               (cons 'cons
 24 |                     (cons 'SUBR (lambda (x) (cons (car x) (cadr% x)))))
 25 |               (cons 'eq
 26 |                     (cons 'SUBR (lambda (x) (eq (car x) (cadr% x)))))
 27 |               (cons 'atom
 28 |                     (cons 'SUBR (lambda (x) (atom (car x)))))
 29 |               (cons 'rplaca
 30 |                     (cons 'SUBR (lambda (x) (rplaca (car x) (cadr% x)))))
 31 |               (cons 'rplacd
 32 |                     (cons 'SUBR (lambda (x) (rplacd (car x) (cadr% x)))))
 33 |               (cons 'list
 34 |                     (cons 'SUBR (lambda (x) x)))
 35 |               (cons '+
 36 |                     (cons 'SUBR (lambda (x) (+ (car x) (cadr% x)))))
 37 |               (cons '*
 38 |                     (cons 'SUBR (lambda (x) (* (car x) (cadr% x)))))
 39 |               (cons '-
 40 |                     (cons 'SUBR (lambda (x) (- (car x) (cadr% x)))))
 41 |               (cons 'truncate
 42 |                     (cons 'SUBR (lambda (x) (truncate (car x) (cadr% x)))))
 43 |               (cons 'mod
 44 |                     (cons 'SUBR (lambda (x) (mod (car x) (cadr% x)))))
 45 |               (cons '=
 46 |                     (cons 'SUBR (lambda (x) (= (car x) (cadr% x)))))
 47 |               (cons '<
 48 |                     (cons 'SUBR (lambda (x) (< (car x) (cadr% x)))))
 49 |               (cons 'print
 50 |                     (cons 'SUBR (lambda (x) (print (car x)))))
 51 |               (cons 'apply
 52 |                     (cons 'SUBR (lambda (x) (apply% (car x) (cadr% x)))))
 53 |               (cons 'eval
 54 |                     (cons 'SUBR (lambda (x) (eval% (car x) global-env))))))
 55 | 
 56 |   (defun caar% (x) (car (car x)))
 57 |   (defun cadr% (x) (car (cdr x)))
 58 |   (defun cddr% (x) (cdr (cdr x)))
 59 |   (defun caddr% (x) (car (cdr (cdr x))))
 60 |   (defun cdddr% (x) (cdr (cdr (cdr x))))
 61 |   (defun cadddr% (x) (car (cdr (cdr (cdr x)))))
 62 | 
 63 |   (defun assq% (key alist)              ; cf. Emacs/Nukata Lisp
 64 |     (if alist
 65 |         (if (eq key (caar% alist))
 66 |             (car alist)
 67 |           (assq% key (cdr alist)))
 68 |       nil))
 69 | 
 70 |   (defun pairlis% (keys data alist)     ; cf. Common Lisp
 71 |     (if keys
 72 |         (cons (cons (car keys) (car data))
 73 |               (pairlis% (cdr keys) (cdr data) alist))
 74 |       alist))
 75 | 
 76 |   ;; Define symbol as value in the global environment.
 77 |   (defun global-def (sym val)
 78 |     (rplacd global-env
 79 |             (cons (car global-env)
 80 |                   (cdr global-env)))
 81 |     (rplaca global-env
 82 |             (cons sym val)))
 83 | 
 84 |   (defun eval% (e env)
 85 |     (if (atom e)
 86 |         ((lambda (var)
 87 |            (if var
 88 |                (cdr var)
 89 |              e))
 90 |          (assq% e env))
 91 |       (if (eq (car e) 'quote)           ; (quote e)
 92 |           (cadr% e)
 93 |         (if (eq (car e) 'if)            ; (if e e e)
 94 |             (if (eval% (cadr% e) env)
 95 |                 (eval% (caddr% e) env)
 96 |               (eval% (cadddr% e) env))
 97 |           (if (eq (car e) 'progn)       ; (progn e...)
 98 |               (eval-progn (cdr e) env nil)
 99 |             (if (eq (car e) 'lambda)    ; (lambda (v...) e...)
100 |                 (make-closure env (cdr e))
101 |               (if (eq (car e) 'defun)   ; (defun f (v...) e...)
102 |                   (global-def (cadr% e)
103 |                               (make-closure env (cddr% e)))
104 |                 (if (eq (car e) 'setq)  ; (setq v e)
105 |                     ((lambda (var value)
106 |                        (if var
107 |                            (rplacd var value)
108 |                          (global-def (cadr% e) value))
109 |                        value)
110 |                      (assq% (cadr% e) env)
111 |                      (eval% (caddr% e) env))
112 |                   (apply% (eval% (car e) env) ; (f e...)
113 |                           (evlis (cdr e) env))))))))))
114 | 
115 |   ;; (make-closure env '((v...) e...)) => (EXPR env (v...) e...)
116 |   (defun make-closure (env ve)
117 |     (cons 'EXPR
118 |           (cons env ve)))
119 | 
120 |   ;; (eval-progn '((+ 1 2) 3 (+ 4 5)) global-env nil) => 9
121 |   (defun eval-progn (x env result)
122 |     (if x
123 |         (if (cdr x)
124 |             (eval-progn (cdr x)
125 |                         env
126 |                         (eval% (car x) env))
127 |           (eval% (car x) env))
128 |       result))
129 | 
130 |   ;; (evlis '((+ 1 2) 3 (+ 4 5)) global-env) => (3 3 9)
131 |   (defun evlis (x env)
132 |     (if x
133 |         (cons (eval% (car x) env)
134 |               (evlis (cdr x) env))
135 |       nil))
136 | 
137 |   (defun apply% (fun arg)
138 |     (if (eq (car fun) 'EXPR)            ; (EXPR env (v...) e...)
139 |         (eval-progn (cdddr% fun)
140 |                     (pairlis% (caddr% fun)
141 |                               arg
142 |                               (cadr% fun))
143 |                     nil)
144 |       (if (eq (car fun) 'SUBR)          ; (SUBR . f)
145 |           (funcall (cdr fun) arg)
146 |         fun)))
147 | 
148 |   (defun global-eval (e)
149 |     (eval% e global-env))
150 | 
151 |   (global-eval (quote
152 | 
153 | ;; -- WRITE YOUR EXPRESSION HERE --
154 | (progn
155 |   (defun fib (n)
156 |     (if (< n 2)
157 |         1
158 |       (+ (fib (- n 1))
159 |          (fib (- n 2)))))
160 |   (print (fib 15)))
161 | ;; --------------------------------
162 | )))
163 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | # Lisp in C# 7
  2 | 
  3 | This is a Lisp interpreter compatible with
  4 | [lisp-in-dart](https://github.com/nukata/lisp-in-dart)
  5 | ~~except for numeric types:  all numbers are `double` in C#~~.
  6 | I wrote it in C# 6 and presented it under the MIT License at
  7 | <http://www.oki-osk.jp/esc/cs/lisp.html> (broken link)
  8 | until the spring of 2017 (H29).
  9 | I slightly modified it to match C# 7 in 2018 (H30).
 10 | 
 11 | Now in 2019 (R1),
 12 | I implemented a mixed mode arithmetic of `int`, `double` and `BigInteger`
 13 | in the same way as
 14 | [little-scheme-in-cs](https://github.com/nukata/little-scheme-in-cs).
 15 | 
 16 | 
 17 | 
 18 | The same as lisp-in-dart, [lisp-in-go](https://github.com/nukata/lisp-in-go)
 19 | and [lisp-in-typescript](https://github.com/nukata/lisp-in-typescript),
 20 | this is a Lisp-1 with tail call optimization
 21 | and partially hygienic macros but being a subset of Common Lisp
 22 | in a loose meaning.
 23 | It is easy to write a nontrivial script which runs both in this and in
 24 | Common Lisp (and also in Emacs Lisp).
 25 | Examples are found in the [`examples`](examples) folder.
 26 | 
 27 | See [IMPLEMENTATION-NOTES.md](IMPLEMENTATION-NOTES.md) for the implementation.
 28 | 
 29 | 
 30 | ## How to run
 31 | 
 32 | With [Mono](https://www.mono-project.com) 6.12.0:
 33 | 
 34 | ```
 35 | $ csc -o -r:System.Numerics.dll lisp.cs arith.cs
 36 | ....
 37 | $ mono lisp.exe
 38 | > (+ 5 6)
 39 | 11
 40 | > (exit 0)
 41 | $ 
 42 | ```
 43 | 
 44 | With [.NET](https://github.com/dotnet/core) 6.0:
 45 | 
 46 | ```
 47 | $ dotnet build -c Release
 48 | ....
 49 | $ ./bin/Release/net6.0/lisp
 50 | > (+ 5 6)
 51 | 11
 52 | > (exit 0)
 53 | $
 54 | ```
 55 | 
 56 | You can give it 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 examples/fib15.l
 62 | (defun fib (n)
 63 |   (if (< n 2)
 64 |       1
 65 |     (+ (fib (- n 1))
 66 |        (fib (- n 2)))))
 67 | (print (fib 15))
 68 | $ mono lisp.exe examples/fib15.l -
 69 | 987
 70 | > (fib 0)
 71 | 1
 72 | > (fib 15)
 73 | 987
 74 | > (fib 16)
 75 | 1597
 76 | > (exit 0)
 77 | $ 
 78 | ```
 79 | 
 80 | 
 81 | ## Examples
 82 | 
 83 | There are five files ending with `.l` under the `examples` folder.
 84 | These run also in Emacs Lisp and Common Lisp.
 85 | 
 86 | - [`qsort.l`](examples/qsort.l)
 87 |   performs a quick sort.
 88 | 
 89 | ```
 90 | $ mono lisp.exe examples/qsort.l
 91 | (1 1 2 3 3 4 5 5 5 6 7 8 9 9 9)
 92 | $ 
 93 | ```
 94 | 
 95 | ```
 96 | $ emacs -batch -l examples/qsort.l
 97 | 
 98 | (1 1 2 3 3 4 5 5 5 6 7 8 9 9 9)
 99 | $ 
100 | ```
101 | 
102 | ```
103 | $ clisp examples/qsort.l
104 | 
105 | (1 1 2 3 3 4 5 5 5 6 7 8 9 9 9)
106 | $ 
107 | ```
108 | 
109 | 
110 | - [`fact100.l`](examples/fact100.l)
111 |   calculates 100!.
112 | 
113 | ```
114 | $ mono lisp.exe examples/fact100.l 
115 | 93326215443944152681699238856266700490715968264381621468592963895217599993229915
116 | 608941463976156518286253697920827223758251185210916864000000000000000000000000
117 | $
118 | ```
119 | 
120 | - [`fib15.l`](examples/fib15.l)
121 |   calculates Fibonacci for 15.
122 | 
123 | - [`eval-fib15.l`](examples/eval-fib15.l)
124 |   calculates Fibonacci for 15 on a meta-circular Lisp evaluator.
125 | 
126 | - [`eval-eval-fib15.l`](examples/eval-eval-fib15.l)
127 |   calculates Fibonacci for 15 on a meta-circular Lisp evaluator 
128 |   on a meta-circular Lisp evaluator.
129 | 
130 | 
131 | 
132 | There is one more example:
133 | 
134 | - [`interp_in_thread.cs`](examples/interp_in_thread.cs)
135 |   runs a Lisp interpreter in another thread.
136 |   You can embed an interpreter within your application in the same way.
137 | 
138 | ```
139 | $ cd examples
140 | $ csc -o -t:library -r:System.Numerics.dll ../lisp.cs ../arith.cs
141 | ....
142 | $ csc -r:lisp.dll interp_in_thread.cs
143 | ...
144 | $ mono interp_in_thread.exe
145 | => (1 . 2)
146 | Reiwa
147 | => Reiwa
148 | $ 
149 | ```
150 | 
151 | The examples of `eval-fib15.l` and `eval-eval-fib15.l` are inspired 
152 | by <https://github.com/zick/ZickStandardLisp>.
153 | 
154 | 
155 | 
156 | ## Performance
157 | 
158 | The following is a result of a benchmark test: the time to execute [`eval-eval-fib15.l`](examples/eval-eval-fib15.l).
159 | I used MacBook Pro (15-inch, 2016), 2.6GHz Core i7, 16GB 2133MHz LPDDR3, macOS Mojave 10.14.6.
160 | 
161 | | Lisp                                                                          | Compiled/Executed on                                            | Executed in   | Executes    | Time [sec] | Rel. Speed  |
162 | |:------------------------------------------------------------------------------|:----------------------------------------------------------------|:--------------|:------------|-----------:|------------:| 
163 | | GNU CLISP 2.49                                                                |                                                                 | Mach-O        | *.fas       |     4.0    | 8.0
164 | | GNU Emacs Lisp 26.2                                                           |                                                                 | Mach-O        | *.elc       |     6.4    | 5.0
165 | | [l2lisp-in-java](https://github.com/nukata/l2lisp-in-java) 1.0.0-9.4          | [AdoptOpenJDK 11.0.5+10 HotSpot](http://adoptopenjdk.net/)      | *.jar         | source file |    12.8    | 2.5
166 | | GNU Emacs Lisp 26.2                                                           |                                                                 | Mach-O        | source file |    16.2    | 2.0
167 | | [lisp-in-dart](https://github.com/nukata/lisp-in-dart) 1.0.1                  | Dart VM 2.5.2                                                   | snapshot      | source file |    20.4    | 1.6
168 | | [lisp-in-dart](https://github.com/nukata/lisp-in-dart) 1.0.1                  | /Dart VM 2.5.2                                                  | source file   | source file |    21.4    | 1.5
169 | | [lisp-in-typescript](https://github.com/nukata/lisp-in-typescript) 1.0.0-1.27 | TS 3.6.4/Node.js 12.12.0                                        | *.js (ESNEXT) | source file |    23.9    | 1.3
170 | | [lisp-in-typescript](https://github.com/nukata/lisp-in-typescript) 1.0.0-1.27 | TS 3.6.4/Node.js 12.12.0                                        | *.js (ES5)    | source file |    25.4    | 1.3
171 | | lisp-in-cs 2.0.0                                                              | .NET Core SDK 3.0.100                                           | *.dll (.NET)  | source file |    31.8    | 1.0
172 | | [l2lisp-in-python](https://github.com/nukata/l2lisp-in-python) (7.2)          | /PyPy 7.1.1(Python 3.6.1)                                       | source file   | source file |    37.8    | 0.8
173 | | [l2lisp-in-python](https://github.com/nukata/l2lisp-in-python) (7.2)          | /PyPy 7.1.1(Python 2.7.13)                                      | source file   | source file |    41.7    | 0.8
174 | | lisp-in-cs 2.0.0                                                              | Mono 6.4.0.198                                                  | *.exe (.NET)  | source file |    43.9    | 0.7
175 | | [lisp-in-go](https://github.com/nukata/lisp-in-go) 2.0.1                      | Go 1.13.3/                                                      | Mach-O        | source file |    66.6    | 0.5
176 | | GNU CLISP 2.49                                                                |                                                                 | Mach-O        | source file |   575.8    | 0.1
177 | | [l2lisp-in-python](https://github.com/nukata/l2lisp-in-python) (7.2)          | /Python 3.7.4                                                   | source file   | source file |  1116.7    | 0.0
178 | 
179 | I am sorry to say that the performance of this Lisp (lisp-in-cs) is rather mediocre.
180 | Note that l2lisp-in-java, lisp-in-dart, lisp-in-typescript, lisp-in-cs and lisp-in-go are all written in largely the same way; l2lisp-in-python is a little old-fashioned.
181 | Therefore, *roughly speaking*, their speeds shown above reflect those of their respective implementation languages: Java, Dart, TypeScript, C# and Go (and Python).
182 | 
183 | 


--------------------------------------------------------------------------------
/examples/eval-eval-fib15.l:
--------------------------------------------------------------------------------
  1 | ;;; A circular Lisp interpreter in Common/Emacs/Nukata Lisp
  2 | ;;;    by SUZUKI Hisao on H28.8/10, H29.3/13
  3 | ;;;    cf. Zick Standard Lisp (https://github.com/zick/ZickStandardLisp)
  4 | 
  5 | (progn
  6 |   ;; Expr: (EXPR environment (symbol...) expression...)
  7 |   ;; Subr: (SUBR . function)
  8 |   ;; Environment: ((symbol . value)...)
  9 |   ;; N.B. Expr has its own environment since this Lisp is lexically scoped.
 10 | 
 11 |   ;; Language-specific Hacks
 12 |   (setq funcall (lambda (f x) (f x)))  ; for Nukata Lisp and this Lisp
 13 |   (setq max-lisp-eval-depth 10000)     ; for Emacs Lisp
 14 |   (setq max-specpdl-size 7000)         ; for Emacs Lisp
 15 | 
 16 |   ;; The global environment of this Lisp
 17 |   (setq global-env
 18 |         (list '(*version* . (1.2 "Lisp" "circlisp"))
 19 |               (cons 'car
 20 |                     (cons 'SUBR (lambda (x) (car (car x)))))
 21 |               (cons 'cdr
 22 |                     (cons 'SUBR (lambda (x) (cdr (car x)))))
 23 |               (cons 'cons
 24 |                     (cons 'SUBR (lambda (x) (cons (car x) (cadr% x)))))
 25 |               (cons 'eq
 26 |                     (cons 'SUBR (lambda (x) (eq (car x) (cadr% x)))))
 27 |               (cons 'atom
 28 |                     (cons 'SUBR (lambda (x) (atom (car x)))))
 29 |               (cons 'rplaca
 30 |                     (cons 'SUBR (lambda (x) (rplaca (car x) (cadr% x)))))
 31 |               (cons 'rplacd
 32 |                     (cons 'SUBR (lambda (x) (rplacd (car x) (cadr% x)))))
 33 |               (cons 'list
 34 |                     (cons 'SUBR (lambda (x) x)))
 35 |               (cons '+
 36 |                     (cons 'SUBR (lambda (x) (+ (car x) (cadr% x)))))
 37 |               (cons '*
 38 |                     (cons 'SUBR (lambda (x) (* (car x) (cadr% x)))))
 39 |               (cons '-
 40 |                     (cons 'SUBR (lambda (x) (- (car x) (cadr% x)))))
 41 |               (cons 'truncate
 42 |                     (cons 'SUBR (lambda (x) (truncate (car x) (cadr% x)))))
 43 |               (cons 'mod
 44 |                     (cons 'SUBR (lambda (x) (mod (car x) (cadr% x)))))
 45 |               (cons '=
 46 |                     (cons 'SUBR (lambda (x) (= (car x) (cadr% x)))))
 47 |               (cons '<
 48 |                     (cons 'SUBR (lambda (x) (< (car x) (cadr% x)))))
 49 |               (cons 'print
 50 |                     (cons 'SUBR (lambda (x) (print (car x)))))
 51 |               (cons 'apply
 52 |                     (cons 'SUBR (lambda (x) (apply% (car x) (cadr% x)))))
 53 |               (cons 'eval
 54 |                     (cons 'SUBR (lambda (x) (eval% (car x) global-env))))))
 55 | 
 56 |   (defun caar% (x) (car (car x)))
 57 |   (defun cadr% (x) (car (cdr x)))
 58 |   (defun cddr% (x) (cdr (cdr x)))
 59 |   (defun caddr% (x) (car (cdr (cdr x))))
 60 |   (defun cdddr% (x) (cdr (cdr (cdr x))))
 61 |   (defun cadddr% (x) (car (cdr (cdr (cdr x)))))
 62 | 
 63 |   (defun assq% (key alist)              ; cf. Emacs/Nukata Lisp
 64 |     (if alist
 65 |         (if (eq key (caar% alist))
 66 |             (car alist)
 67 |           (assq% key (cdr alist)))
 68 |       nil))
 69 | 
 70 |   (defun pairlis% (keys data alist)     ; cf. Common Lisp
 71 |     (if keys
 72 |         (cons (cons (car keys) (car data))
 73 |               (pairlis% (cdr keys) (cdr data) alist))
 74 |       alist))
 75 | 
 76 |   ;; Define symbol as value in the global environment.
 77 |   (defun global-def (sym val)
 78 |     (rplacd global-env
 79 |             (cons (car global-env)
 80 |                   (cdr global-env)))
 81 |     (rplaca global-env
 82 |             (cons sym val)))
 83 | 
 84 |   (defun eval% (e env)
 85 |     (if (atom e)
 86 |         ((lambda (var)
 87 |            (if var
 88 |                (cdr var)
 89 |              e))
 90 |          (assq% e env))
 91 |       (if (eq (car e) 'quote)           ; (quote e)
 92 |           (cadr% e)
 93 |         (if (eq (car e) 'if)            ; (if e e e)
 94 |             (if (eval% (cadr% e) env)
 95 |                 (eval% (caddr% e) env)
 96 |               (eval% (cadddr% e) env))
 97 |           (if (eq (car e) 'progn)       ; (progn e...)
 98 |               (eval-progn (cdr e) env nil)
 99 |             (if (eq (car e) 'lambda)    ; (lambda (v...) e...)
100 |                 (make-closure env (cdr e))
101 |               (if (eq (car e) 'defun)   ; (defun f (v...) e...)
102 |                   (global-def (cadr% e)
103 |                               (make-closure env (cddr% e)))
104 |                 (if (eq (car e) 'setq)  ; (setq v e)
105 |                     ((lambda (var value)
106 |                        (if var
107 |                            (rplacd var value)
108 |                          (global-def (cadr% e) value))
109 |                        value)
110 |                      (assq% (cadr% e) env)
111 |                      (eval% (caddr% e) env))
112 |                   (apply% (eval% (car e) env) ; (f e...)
113 |                           (evlis (cdr e) env))))))))))
114 | 
115 |   ;; (make-closure env '((v...) e...)) => (EXPR env (v...) e...)
116 |   (defun make-closure (env ve)
117 |     (cons 'EXPR
118 |           (cons env ve)))
119 | 
120 |   ;; (eval-progn '((+ 1 2) 3 (+ 4 5)) global-env nil) => 9
121 |   (defun eval-progn (x env result)
122 |     (if x
123 |         (if (cdr x)
124 |             (eval-progn (cdr x)
125 |                         env
126 |                         (eval% (car x) env))
127 |           (eval% (car x) env))
128 |       result))
129 | 
130 |   ;; (evlis '((+ 1 2) 3 (+ 4 5)) global-env) => (3 3 9)
131 |   (defun evlis (x env)
132 |     (if x
133 |         (cons (eval% (car x) env)
134 |               (evlis (cdr x) env))
135 |       nil))
136 | 
137 |   (defun apply% (fun arg)
138 |     (if (eq (car fun) 'EXPR)            ; (EXPR env (v...) e...)
139 |         (eval-progn (cdddr% fun)
140 |                     (pairlis% (caddr% fun)
141 |                               arg
142 |                               (cadr% fun))
143 |                     nil)
144 |       (if (eq (car fun) 'SUBR)          ; (SUBR . f)
145 |           (funcall (cdr fun) arg)
146 |         fun)))
147 | 
148 |   (defun global-eval (e)
149 |     (eval% e global-env))
150 | 
151 |   (global-eval (quote
152 | 
153 | ;; -- WRITE YOUR EXPRESSION HERE --
154 | ;;; A circular Lisp interpreter in Common/Emacs/Nukata Lisp
155 | ;;;    by SUZUKI Hisao on H28.8/10, H29.3/13
156 | ;;;    cf. Zick Standard Lisp (https://github.com/zick/ZickStandardLisp)
157 | 
158 | (progn
159 |   ;; Expr: (EXPR environment (symbol...) expression...)
160 |   ;; Subr: (SUBR . function)
161 |   ;; Environment: ((symbol . value)...)
162 |   ;; N.B. Expr has its own environment since this Lisp is lexically scoped.
163 | 
164 |   ;; Language-specific Hacks
165 |   (setq funcall (lambda (f x) (f x)))  ; for Nukata Lisp and this Lisp
166 |   (setq max-lisp-eval-depth 10000)     ; for Emacs Lisp
167 |   (setq max-specpdl-size 7000)         ; for Emacs Lisp
168 | 
169 |   ;; The global environment of this Lisp
170 |   (setq global-env
171 |         (list '(*version* . (1.2 "Lisp" "circlisp"))
172 |               (cons 'car
173 |                     (cons 'SUBR (lambda (x) (car (car x)))))
174 |               (cons 'cdr
175 |                     (cons 'SUBR (lambda (x) (cdr (car x)))))
176 |               (cons 'cons
177 |                     (cons 'SUBR (lambda (x) (cons (car x) (cadr% x)))))
178 |               (cons 'eq
179 |                     (cons 'SUBR (lambda (x) (eq (car x) (cadr% x)))))
180 |               (cons 'atom
181 |                     (cons 'SUBR (lambda (x) (atom (car x)))))
182 |               (cons 'rplaca
183 |                     (cons 'SUBR (lambda (x) (rplaca (car x) (cadr% x)))))
184 |               (cons 'rplacd
185 |                     (cons 'SUBR (lambda (x) (rplacd (car x) (cadr% x)))))
186 |               (cons 'list
187 |                     (cons 'SUBR (lambda (x) x)))
188 |               (cons '+
189 |                     (cons 'SUBR (lambda (x) (+ (car x) (cadr% x)))))
190 |               (cons '*
191 |                     (cons 'SUBR (lambda (x) (* (car x) (cadr% x)))))
192 |               (cons '-
193 |                     (cons 'SUBR (lambda (x) (- (car x) (cadr% x)))))
194 |               (cons 'truncate
195 |                     (cons 'SUBR (lambda (x) (truncate (car x) (cadr% x)))))
196 |               (cons 'mod
197 |                     (cons 'SUBR (lambda (x) (mod (car x) (cadr% x)))))
198 |               (cons '=
199 |                     (cons 'SUBR (lambda (x) (= (car x) (cadr% x)))))
200 |               (cons '<
201 |                     (cons 'SUBR (lambda (x) (< (car x) (cadr% x)))))
202 |               (cons 'print
203 |                     (cons 'SUBR (lambda (x) (print (car x)))))
204 |               (cons 'apply
205 |                     (cons 'SUBR (lambda (x) (apply% (car x) (cadr% x)))))
206 |               (cons 'eval
207 |                     (cons 'SUBR (lambda (x) (eval% (car x) global-env))))))
208 | 
209 |   (defun caar% (x) (car (car x)))
210 |   (defun cadr% (x) (car (cdr x)))
211 |   (defun cddr% (x) (cdr (cdr x)))
212 |   (defun caddr% (x) (car (cdr (cdr x))))
213 |   (defun cdddr% (x) (cdr (cdr (cdr x))))
214 |   (defun cadddr% (x) (car (cdr (cdr (cdr x)))))
215 | 
216 |   (defun assq% (key alist)              ; cf. Emacs/Nukata Lisp
217 |     (if alist
218 |         (if (eq key (caar% alist))
219 |             (car alist)
220 |           (assq% key (cdr alist)))
221 |       nil))
222 | 
223 |   (defun pairlis% (keys data alist)     ; cf. Common Lisp
224 |     (if keys
225 |         (cons (cons (car keys) (car data))
226 |               (pairlis% (cdr keys) (cdr data) alist))
227 |       alist))
228 | 
229 |   ;; Define symbol as value in the global environment.
230 |   (defun global-def (sym val)
231 |     (rplacd global-env
232 |             (cons (car global-env)
233 |                   (cdr global-env)))
234 |     (rplaca global-env
235 |             (cons sym val)))
236 | 
237 |   (defun eval% (e env)
238 |     (if (atom e)
239 |         ((lambda (var)
240 |            (if var
241 |                (cdr var)
242 |              e))
243 |          (assq% e env))
244 |       (if (eq (car e) 'quote)           ; (quote e)
245 |           (cadr% e)
246 |         (if (eq (car e) 'if)            ; (if e e e)
247 |             (if (eval% (cadr% e) env)
248 |                 (eval% (caddr% e) env)
249 |               (eval% (cadddr% e) env))
250 |           (if (eq (car e) 'progn)       ; (progn e...)
251 |               (eval-progn (cdr e) env nil)
252 |             (if (eq (car e) 'lambda)    ; (lambda (v...) e...)
253 |                 (make-closure env (cdr e))
254 |               (if (eq (car e) 'defun)   ; (defun f (v...) e...)
255 |                   (global-def (cadr% e)
256 |                               (make-closure env (cddr% e)))
257 |                 (if (eq (car e) 'setq)  ; (setq v e)
258 |                     ((lambda (var value)
259 |                        (if var
260 |                            (rplacd var value)
261 |                          (global-def (cadr% e) value))
262 |                        value)
263 |                      (assq% (cadr% e) env)
264 |                      (eval% (caddr% e) env))
265 |                   (apply% (eval% (car e) env) ; (f e...)
266 |                           (evlis (cdr e) env))))))))))
267 | 
268 |   ;; (make-closure env '((v...) e...)) => (EXPR env (v...) e...)
269 |   (defun make-closure (env ve)
270 |     (cons 'EXPR
271 |           (cons env ve)))
272 | 
273 |   ;; (eval-progn '((+ 1 2) 3 (+ 4 5)) global-env nil) => 9
274 |   (defun eval-progn (x env result)
275 |     (if x
276 |         (if (cdr x)
277 |             (eval-progn (cdr x)
278 |                         env
279 |                         (eval% (car x) env))
280 |           (eval% (car x) env))
281 |       result))
282 | 
283 |   ;; (evlis '((+ 1 2) 3 (+ 4 5)) global-env) => (3 3 9)
284 |   (defun evlis (x env)
285 |     (if x
286 |         (cons (eval% (car x) env)
287 |               (evlis (cdr x) env))
288 |       nil))
289 | 
290 |   (defun apply% (fun arg)
291 |     (if (eq (car fun) 'EXPR)            ; (EXPR env (v...) e...)
292 |         (eval-progn (cdddr% fun)
293 |                     (pairlis% (caddr% fun)
294 |                               arg
295 |                               (cadr% fun))
296 |                     nil)
297 |       (if (eq (car fun) 'SUBR)          ; (SUBR . f)
298 |           (funcall (cdr fun) arg)
299 |         fun)))
300 | 
301 |   (defun global-eval (e)
302 |     (eval% e global-env))
303 | 
304 |   (global-eval (quote
305 | 
306 | ;; -- WRITE YOUR EXPRESSION HERE --
307 | (progn
308 |   (defun fib (n)
309 |     (if (< n 2)
310 |         1
311 |       (+ (fib (- n 1))
312 |          (fib (- n 2)))))
313 |   (print (fib 15)))
314 | ;; --------------------------------
315 | )))
316 | ;; --------------------------------
317 | )))
318 | 


--------------------------------------------------------------------------------
/IMPLEMENTATION-NOTES.md:
--------------------------------------------------------------------------------
  1 | # Implementation Notes
  2 | 
  3 | 
  4 | <a name="1"></a>
  5 | ## 1. Overview
  6 | 
  7 | The Lisp implementation of [lisp.cs](lisp.cs) is a translation of lisp.dart 
  8 | at [lisp-in-dart](https://github.com/nukata/lisp-in-dart) into C# 7.
  9 | Below is an example of running lisp.cs with Mono 6.4.0 on macOS 10.14.6.
 10 | 
 11 | ```
 12 | $ csc -r:System.Numerics.dll arith.cs lisp.cs
 13 | Microsoft (R) Visual C# Compiler version 3.3.1-beta4-19462-11 (66a912c9)
 14 | Copyright (C) Microsoft Corporation. All rights reserved.
 15 | 
 16 | $ mono lisp.exe
 17 | > (+ 5 6)
 18 | 11
 19 | > `(a b ,(car '(c d)))
 20 | (a b c)
 21 | > (let ((x '(a b c d)))
 22 |      (setcar (cddr x) x)
 23 |      x)
 24 | (a b (a b (a ...) d) d)
 25 | > (princ "\t789\n")
 26 |         789
 27 | "\t789\n"
 28 | > (dump)
 29 | (dotimes dolist while nconc last nreverse _nreverse assoc assq member memq listp
 30 |  or mapcar and append _append letrec let when if equal /= <= >= > setcdr setcar 
 31 | null = identity print consp not cdddr cddar cdadr cdaar caddr cadar caadr caaar 
 32 | cddr cdar cadr caar defun defmacro *version* dump exit apply symbol-name intern 
 33 | make-symbol gensym *gensym-counter* terpri princ prin1 truncate / - * + mod % < 
 34 | eql numberp stringp length rplacd rplaca list eq atom cons cdr car t)
 35 | > *version*
 36 | (2.0 "C# 7" "Nukata Lisp")
 37 | > let
 38 | #<macro:-2:((#<lambda:2:((progn (setq #0:0:vars #<lambda:1:((cond (#0:0:x (cons 
 39 | (cond ((atom (car #0:0:x)) (car #0:0:x)) (t (caar #0:0:x))) (#1:0:vars (cdr #0:0
 40 | :x))))))>) '#0:0:vars) (progn (setq #0:1:vals #<lambda:1:((cond (#0:0:x (cons (c
 41 | ond ((atom (car #0:0:x)) nil) (t (cadar #0:0:x))) (#1:1:vals (cdr #0:0:x))))))>)
 42 |  '#0:1:vals) (cons (cons 'lambda (cons (#0:0:vars #1:0:args) #1:1:body)) (#0:1:v
 43 | als #1:0:args)))> nil nil))>
 44 | > (exit 0)
 45 | $ 
 46 | ```
 47 | 
 48 | Some features of lisp.cs and lisp.dart are
 49 | 
 50 | - It is basically a subset of Emacs Lisp.
 51 |   However, it is a Lisp-1 with static scoping.
 52 |   In short, it is a _Common Lisp-like Lisp-1_.
 53 | 
 54 | - It makes proper tail calls always.
 55 | 
 56 | - A quasi-quotation with backquote will be expanded when macros are expanded.
 57 | 
 58 | - A circular list is printed with `...` finitely.
 59 | 
 60 | - As an escape sequence within strings, you can use any of
 61 |   `\"`, `\\`, `\n`, `\r`, `\f`, `\b`, `\t`, `\v`.
 62 | 
 63 | - `(dump)` returns a list of all global variables.
 64 |   The list does not include special forms such as `lambda` and `setq`
 65 |   since they are not variables.
 66 | 
 67 | - `*version*` is a three-element list: 
 68 |   the version number, the implementing language, 
 69 |   and the name of implementation.
 70 | 
 71 | - (`macro` _args_ _body_) is a special form that evaluates to a sort of
 72 |   anonymous function, or _macro expression_.
 73 |   The global environment will be used whenever (`macro` ...) evaluates.
 74 |   When you apply the resultant macro expression to a list of actual arguments,
 75 |   the arguments will not be evaluated and the result of the application
 76 |   will be evaluated again.
 77 |   Thus a variable bound to a macro expression works as a _macro_.
 78 | 
 79 | - `defmacro` is a macro which binds a variable to a macro expression.
 80 | 
 81 | - `defun` is a macro which binds a variable to a lambda expression.
 82 | 
 83 | - `let` is a macro which applies a lambda expression to a list of initial
 84 |   values of variables.
 85 | 
 86 | - Macros are _partially hygienic_.
 87 |   Free symbols within a macro expression will not be captured when the
 88 |   expression is applied (i.e., when the macro is expanded).
 89 | 
 90 | 
 91 | The macro `let` is defined in the prelude as follows.
 92 | 
 93 | ```Lisp
 94 | (defmacro let (args &rest body)
 95 |   ((lambda (vars vals)
 96 |      (defun vars (x)
 97 |        (cond (x (cons (if (atom (car x))
 98 |                           (car x)
 99 |                         (caar x))
100 |                       (vars (cdr x))))))
101 |      (defun vals (x)
102 |        (cond (x (cons (if (atom (car x))
103 |                           nil
104 |                         (cadar x))
105 |                       (vals (cdr x))))))
106 |      `((lambda ,(vars args) ,@body) ,@(vals args)))
107 |    nil nil))
108 | ```
109 | 
110 | 
111 | Being _partially hygienic_, macros can avoid variable captures,
112 | provided that you always use the result of `(gensym)` for any symbol
113 | newly introduced to the expansion result.
114 | For example:
115 | 
116 | ```Lisp
117 | (defmacro while (test &rest body)
118 |   (let ((loop (gensym)))
119 |     `(letrec ((,loop (lambda () (cond (,test ,@body (,loop))))))
120 |        (,loop))))
121 | ```
122 | 
123 | See [lisp-in-dart/IMPLEMENTATION-NOTES §5](https://github.com/nukata/lisp-in-dart/blob/master/IMPLEMENTATION-NOTES.md#5) for details.
124 | 
125 | ----------------------------------------
126 | 
127 | **Note:**
128 | I believe partially hygienic macros have ideal usefulness.
129 | If you like, you can define
130 | [anaphoric macros (Japanese page)](http://www.asahi-net.or.jp/~kc7k-nd/onlispjhtml/anaphoricMacros.html)
131 | by introducing a symbol (`it` in the following example) to the 
132 | expansion result intentionally without `(gensym)`.
133 | 
134 | ```
135 | > (defmacro aif (test then else)
136 |     `(let ((it ,test))
137 |        (if it ,then ,else) ))
138 | aif
139 | > (aif (+ 7 8 9)
140 |      (print it)
141 |     (print "?"))
142 | 24
143 | 24
144 | > 
145 | ```
146 | 
147 | ----------------------------------------
148 | 
149 | 
150 | <a name="2"></a>
151 | ## 2. Internal Data Representation
152 | 
153 | To represent data of the implemented language (Lisp), native types of the 
154 | implementing language (C#) are used as they are, if possible.
155 | They are all treated as `object` uniformly.
156 | 
157 | 
158 | | Lisp Expression                     | Internal Representation                |
159 | |:------------------------------------|:---------------------------------------|
160 | | numbers `1`, `2.3`                  | `int`, `double`, `BigInteger`          |
161 | | strings `"abc"`, `"hello!\n"`       | `string`                               |
162 | | `t`                                 | `Sym` (user-defined)                   |
163 | | `nil`                               | `null`                                 |
164 | | symbols `x`, `+`                    | `Sym` (user-defined)                   |
165 | | keywords `lambda`, `cond`           | `Keyword` (derived from `Sym`)         |
166 | | lists `(x 1 "2")`, `(y . 3)`        | `Cell` (user-defined)                  |
167 | 
168 | Below is the definition of the `Cell` class.
169 | 
170 | ```CS
171 |     /// <summary>Cons cell</summary>
172 |     public sealed class Cell {
173 |         /// <summary>Head part of the cons cell</summary>
174 |         public object Car;
175 |         /// <summary>Tail part of the cons cell</summary>
176 |         public object Cdr;
177 | 
178 |         /// <summary>Construct a cons cell with its head and tail.</summary>
179 |         public Cell(object car, object cdr) {
180 |             Car = car;
181 |             Cdr = cdr;
182 |         }
183 | 
184 |         /// <summary>Make a simple string representation.</summary>
185 |         /// <remarks>Do not invoke this for any circular list.</remarks>
186 |         public override string ToString() =>
187 |             $"({Car ?? "null"} . {Cdr ?? "null"})";
188 | 
189 |         /// <summary>Length as a list</summary>
190 |         public int Length => FoldL(0, this, (i, e) => i + 1);
191 |     }
192 | ```
193 | 
194 | 
195 | Below is the definition of the `Sym` class.
196 | 
197 | ```CS
198 |     /// <summary>Lisp symbol</summary>
199 |     public class Sym {
200 |         /// <summary>The symbol's name</summary>
201 |         public string Name { get; }
202 |         
203 |         /// <summary>Construct a symbol that is not interned.</summary>
204 |         public Sym(string name) {
205 |             Name = name;
206 |         }
207 | 
208 |         /// <summary>Return the symbol's name</summary>
209 |         public override string ToString() => Name;
210 |         /// <summary>Return the hashcode of the symbol's name</summary>
211 |         public override int GetHashCode() => Name.GetHashCode();
212 | 
213 |         /// <summary>Table of interned symbols</summary>
214 |         protected static readonly Dictionary<string, Sym> Table =
215 |             new Dictionary<string, Sym>();
216 | 
217 |         /// <summary>Return an interned symbol for the name.</summary>
218 |         /// <remarks>If the name is not interned yet, such a symbol
219 |         /// will be constructed with <paramref name="make"/>.</remarks>
220 |         protected static Sym New(string name, Func<string, Sym> make) {
221 |             lock (Table) {
222 |                 if (! Table.TryGetValue(name, out Sym result)) {
223 |                     result = make(name);
224 |                     Table[name] = result;
225 |                 }
226 |                 return result;
227 |             }
228 |         }
229 | 
230 |         /// <summary>Construct an interned symbol.</summary>
231 |         public static Sym New(string name) => New(name, s => new Sym(s));
232 | 
233 |         /// <summary>Is it interned?</summary>
234 |         public bool IsInterned {
235 |             get {
236 |                 lock (Table) {
237 |                     return Table.TryGetValue(Name, out Sym s) &&
238 |                         Object.ReferenceEquals(this, s);
239 |                 }
240 |             }
241 |         }
242 |     }
243 | ```
244 | 
245 | Keywords of Lisp are defined as follows.
246 | 
247 | ```CS
248 |     // Expression keyword
249 |     sealed class Keyword: Sym {
250 |         Keyword(string name): base(name) {}
251 |         internal static new Sym New(string name)
252 |             => New(name, s => new Keyword(s));
253 |     }
254 | 
255 |     static readonly Sym CondSym = Keyword.New("cond");
256 |     static readonly Sym LambdaSym = Keyword.New("lambda");
257 |     static readonly Sym MacroSym = Keyword.New("macro");
258 |     static readonly Sym PrognSym = Keyword.New("progn");
259 |     static readonly Sym QuasiquoteSym = Keyword.New("quasiquote");
260 |     static readonly Sym QuoteSym = Keyword.New("quote");
261 |     static readonly Sym SetqSym = Keyword.New("setq");
262 | ```
263 | 
264 | Now, if you call `Sym.New("cond")` in `ReadToken()`,
265 | you will get `CondSym`, an instance of the `Keyword` class.
266 | 
267 | 
268 | <a name="3"></a>
269 | ## 3. Implementations of Lisp functions
270 | 
271 | The `Interp` class implements the core of the Lisp interpreter.
272 | It has a map for global variables and standard out for built-in functions.
273 | 
274 | ```CS
275 |     /// <summary>Core of the Lisp interpreter</summary>
276 |     public class Interp {
277 |         /// <summary>Table of the global values of symbols</summary>
278 |         protected readonly Dictionary<Sym, object> Globals =
279 |             new Dictionary<Sym, object>();
280 | 
281 |         /// <summary>Standard out</summary>
282 |         public TextWriter COut { get; set; } = Console.Out;
283 | ```
284 | 
285 | Each built-in function is defined with the `Def` method below.
286 | The `carity` argument takes the arity of the function to be defined.
287 | If the function has `&rest`, the `carity` 
288 | takes `-(`_number of fixed arguments_ ` + 1)`.
289 | 
290 | ```CS
291 |         /// <summary>Define a built-in function by a name, an arity,
292 |         /// and a body.</summary>
293 |         public void Def(string name, int carity, BuiltInFuncBody body) {
294 |             Globals[Sym.New(name)] = new BuiltInFunc(name, carity, body);
295 |         }
296 | ```
297 | 
298 | Below is an excerpt of the constructor of `Interp`.
299 | It shows the implementation of five elementary functions of Lisp.
300 | 
301 | ```CS
302 |         /// <summary>Set each built-in function/variable as the global value
303 |         /// of symbol.</summary>
304 |         public Interp() {
305 |             Globals[TSym] = TSym;
306 |             Def("car", 1, a => (a[0] as Cell)?.Car);
307 |             Def("cdr", 1, a => (a[0] as Cell)?.Cdr);
308 |             Def("cons", 2, a => new Cell(a[0], a[1]));
309 |             Def("atom", 1, a => (a[0] is Cell) ? null : TSym);
310 |             Def("eq", 2, a => (a[0] == a[1]) ? TSym : null);
311 | ```
312 | 
313 | The standard out `COut` is used as follows:
314 | 
315 | ```CS
316 |             Def("prin1", 1, a => {
317 |                     COut.Write(Str(a[0], true)); return a[0];
318 |                 });
319 |             Def("princ", 1, a => {
320 |                     COut.Write(Str(a[0], false)); return a[0];
321 |                 });
322 |             Def("terpri", 0, a => {
323 |                     COut.WriteLine(); return TSym;
324 |                 });
325 | ```
326 | 
327 | The function `dump` takes no arguments and returns a list of all global
328 | variables.
329 | Internally it reads the keys from `Globals` and constructs a list of them.
330 | 
331 | ```CS
332 |             Def("dump", 0, a =>
333 |                 Globals.Keys.Aggregate((Cell) null, (x, y) => new Cell(y, x)));
334 | ```
335 | 
336 | For an example of running `(dump)`, see [§1](#1).
337 | 
338 | 
339 | Several functions and macros of Lisp are defined in the initialization script
340 | `Prelude`, which runs in the task of `MakeInterp`.
341 | 
342 | ```CS
343 |     /// <summary>Make a Lisp interpreter initialized with Prelude.</summary>
344 |     public static async Task<Interp> MakeInterp() {
345 |         var interp = new Interp();
346 |         await Run(interp, new StringReader(Prelude));
347 |         return interp;
348 |     }
349 | ```
350 | 
351 | Below is the head of `Prelude`.
352 | 
353 | ```CS
354 |     /// <summary>Lisp initialization script</summary>
355 |     public static readonly string Prelude = @"
356 | (setq defmacro
357 |       (macro (name args &rest body)
358 |              `(progn (setq ,name (macro ,args ,@body))
359 |                      ',name)))
360 | 
361 | (defmacro defun (name args &rest body)
362 |   `(progn (setq ,name (lambda ,args ,@body))
363 |           ',name))
364 | 
365 | (defun caar (x) (car (car x)))
366 | (defun cadr (x) (car (cdr x)))
367 | (defun cdar (x) (cdr (car x)))
368 | (defun cddr (x) (cdr (cdr x)))
369 | ```
370 | 


--------------------------------------------------------------------------------
/arith.cs:
--------------------------------------------------------------------------------
  1 | // A little arithmetic in C# 7, R01.07.14/R01.10.27 by SUZUKI Hisao
  2 | //  derived from arith.cs at https://github.com/nukata/little-scheme-in-cs
  3 | using System;
  4 | using System.Numerics;          // This implies -r:System.Numerics.dll
  5 | 
  6 | // test: csc -d:TEST -o -r:System.Numerics.dll arith.cs && mono arith.exe
  7 | 
  8 | namespace LittleArith {
  9 | 
 10 |     /// <summary>Mixed mode arithmetic of int, double and BigInteger
 11 |     /// </summary><remarks>For values of other types, the methods of
 12 |     /// this class will throw ArgumentException.</remarks>
 13 |     public static class Arith {
 14 |         
 15 |         /// <summary>Convert a long into an int or a BigInteger.</summary>
 16 |         private static object Normalize(long x) {
 17 |             int i = (int) x;
 18 |             // NB: ((i == x) ? i : (BigInteger) x) will be a BigInteger.
 19 |             if (i == x) {
 20 |                 return i;
 21 |             } else {
 22 |                 return (BigInteger) x;
 23 |             }
 24 |         }
 25 | 
 26 |         /// <summary>Convert a BigInteger into an int if possible.</summary>
 27 |         private static object Normalize(BigInteger x) {
 28 |             try {
 29 |                 return (int) x;
 30 |             } catch (OverflowException) {
 31 |                 return x;
 32 |             }
 33 |         }
 34 | 
 35 |         /// <summary>Return true if x is a number.</summary>
 36 |         public static bool IsNumber(object x) {
 37 |             return x is int || x is double || x is BigInteger;
 38 |         }
 39 | 
 40 |         /// <summary>x + y</summary>
 41 |         public static object Add(object x, object y) {
 42 |             switch (x) {
 43 |             case int a:
 44 |                 switch (y) {
 45 |                 case int b:
 46 |                     return Normalize((long) a + (long) b);
 47 |                 case double b:
 48 |                     return a + b;
 49 |                 case BigInteger b:
 50 |                     return Normalize(a + b);
 51 |                 }
 52 |                 break;
 53 |             case double a:
 54 |                 switch (y) {
 55 |                 case int b:
 56 |                     return a + b;
 57 |                 case double b:
 58 |                     return a + b;
 59 |                 case BigInteger b:
 60 |                     return a + (double) b;
 61 |                 }
 62 |                 break;
 63 |             case BigInteger a:
 64 |                 switch (y) {
 65 |                 case int b:
 66 |                     return Normalize(a + b);
 67 |                 case double b:
 68 |                     return (double) a + b;
 69 |                 case BigInteger b:
 70 |                     return Normalize(a + b);
 71 |                 }
 72 |                 break;
 73 |             }
 74 |             throw new ArgumentException($"{x}, {y}");
 75 |         }
 76 | 
 77 |         /// <summary>x - y</summary>
 78 |         public static object Subtract(object x, object y) {
 79 |             switch (x) {
 80 |             case int a:
 81 |                 switch (y) {
 82 |                 case int b:
 83 |                     return Normalize((long) a - (long) b);
 84 |                 case double b:
 85 |                     return a - b;
 86 |                 case BigInteger b:
 87 |                     return Normalize(a - b);
 88 |                 }
 89 |                 break;
 90 |             case double a:
 91 |                 switch (y) {
 92 |                 case int b:
 93 |                     return a - b;
 94 |                 case double b:
 95 |                     return a - b;
 96 |                 case BigInteger b:
 97 |                     return a - (double) b;
 98 |                 }
 99 |                 break;
100 |             case BigInteger a:
101 |                 switch (y) {
102 |                 case int b:
103 |                     return Normalize(a - b);
104 |                 case double b:
105 |                     return (double) a - b;
106 |                 case BigInteger b:
107 |                     return Normalize(a - b);
108 |                 }
109 |                 break;
110 |             }
111 |             throw new ArgumentException($"{x}, {y}");
112 |         }
113 | 
114 |         /// <summary>x * y</summary>
115 |         public static object Multiply(object x, object y) {
116 |             switch (x) {
117 |             case int a:
118 |                 switch (y) {
119 |                 case int b:
120 |                     return Normalize((long) a * (long) b);
121 |                 case double b:
122 |                     return a * b;
123 |                 case BigInteger b:
124 |                     return Normalize(a * b);
125 |                 }
126 |                 break;
127 |             case double a:
128 |                 switch (y) {
129 |                 case int b:
130 |                     return a * b;
131 |                 case double b:
132 |                     return a * b;
133 |                 case BigInteger b:
134 |                     return a * (double) b;
135 |                 }
136 |                 break;
137 |             case BigInteger a:
138 |                 switch (y) {
139 |                 case int b:
140 |                     return Normalize(a * b);
141 |                 case double b:
142 |                     return (double) a * b;
143 |                 case BigInteger b:
144 |                     return Normalize(a * b);
145 |                 }
146 |                 break;
147 |             }
148 |             throw new ArgumentException($"{x}, {y}");
149 |         }
150 | 
151 |         /// <summary>The rounded quotient of x and y.</summary>
152 |         public static double RoundedQuotient(object x, object y) {
153 |             switch (x) {
154 |             case int a:
155 |                 switch (y) {
156 |                 case int b:
157 |                     return (double) a / (double) b;
158 |                 case double b:
159 |                     return (double) a / b;
160 |                 case BigInteger b:
161 |                     return (double) a / (double) b;
162 |                 }
163 |                 break;
164 |             case double a:
165 |                 switch (y) {
166 |                 case int b:
167 |                     return a / (double) b;
168 |                 case double b:
169 |                     return a / b;
170 |                 case BigInteger b:
171 |                     return a / (double) b;
172 |                 }
173 |                 break;
174 |             case BigInteger a:
175 |                 switch (y) {
176 |                 case int b:
177 |                     return (double) a / (double) b;
178 |                 case double b:
179 |                     return (double) a / b;
180 |                 case BigInteger b:
181 |                     return (double) a / (double) b;
182 |                 }
183 |                 break;
184 |             }
185 |             throw new ArgumentException($"{x}, {y}");
186 |         }
187 | 
188 |         private static object Truncate(double a) {
189 |             BigInteger b = new BigInteger(a);
190 |             return Normalize(b);
191 |         }
192 | 
193 |         /// <summary>The quotient of x and y.</summary>
194 |         public static object Quotient(object x, object y) {
195 |             switch (x) {
196 |             case int a:
197 |                 switch (y) {
198 |                 case int b:
199 |                     return a / b;
200 |                 case double b:
201 |                     return Truncate((double) a / b);
202 |                 case BigInteger b:
203 |                     return Normalize(a / b);
204 |                 }
205 |                 break;
206 |             case double a:
207 |                 switch (y) {
208 |                 case int b:
209 |                     return Truncate(a / (double) b);
210 |                 case double b:
211 |                     return Truncate(a / b);
212 |                 case BigInteger b:
213 |                     return Truncate(a / (double) b);
214 |                 }
215 |                 break;
216 |             case BigInteger a:
217 |                 switch (y) {
218 |                 case int b:
219 |                     return Normalize(a / b);
220 |                 case double b:
221 |                     return Truncate((double) a / b);
222 |                 case BigInteger b:
223 |                     return Normalize(a / b);
224 |                 }
225 |                 break;
226 |             }
227 |             throw new ArgumentException($"{x}, {y}");
228 |         }
229 | 
230 |         /// <summary>x % y</summary>
231 |         public static object Remainder(object x, object y) {
232 |             switch (x) {
233 |             case int a:
234 |                 switch (y) {
235 |                 case int b:
236 |                     return a % b;
237 |                 case double b:
238 |                     return (double) a % b;
239 |                 case BigInteger b:
240 |                     return Normalize(a % b);
241 |                 }
242 |                 break;
243 |             case double a:
244 |                 switch (y) {
245 |                 case int b:
246 |                     return a % (double) b;
247 |                 case double b:
248 |                     return a % b;
249 |                 case BigInteger b:
250 |                     return a % (double) b;
251 |                 }
252 |                 break;
253 |             case BigInteger a:
254 |                 switch (y) {
255 |                 case int b:
256 |                     return Normalize(a % b);
257 |                 case double b:
258 |                     return (double) a % b;
259 |                 case BigInteger b:
260 |                     return Normalize(a % b);
261 |                 }
262 |                 break;
263 |             }
264 |             throw new ArgumentException($"{x}, {y}");
265 |         }
266 | 
267 |         /// <summary>Compare x and y.</summary>
268 |         /// <returns>-1, 0 or 1 as x is less than, equal to, or greater than y.
269 |         /// </returns>
270 |         public static int Compare(object x, object y) {
271 |             switch (x) {
272 |             case int a:
273 |                 switch (y) {
274 |                 case int b:
275 |                     return Math.Sign((long) a - (long) b);
276 |                 case double b:
277 |                     return Math.Sign(a - b);
278 |                 case BigInteger b:
279 |                     return (a - b).Sign;
280 |                 }
281 |                 break;
282 |             case double a:
283 |                 switch (y) {
284 |                 case int b:
285 |                     return Math.Sign(a - b);
286 |                 case double b:
287 |                     return Math.Sign(a - b);
288 |                 case BigInteger b:
289 |                     return Math.Sign(a - (double) b);
290 |                 }
291 |                 break;
292 |             case BigInteger a:
293 |                 switch (y) {
294 |                 case int b:
295 |                     return (a - b).Sign;
296 |                 case double b:
297 |                     return Math.Sign((double) a - b);
298 |                 case BigInteger b:
299 |                     return (a - b).Sign;
300 |                 }
301 |                 break;
302 |             }
303 |             throw new ArgumentException($"{x}, {y}");
304 |         }
305 | 
306 |         /// <summary>Try to parse a string as an int, a BigInteger or a double.
307 |         /// </summary>
308 |         /// <returns>true if s was parsed successfully; otherwise, false.
309 |         /// </returns>
310 |         public static bool TryParse(string s, out object result) {
311 |             if (int.TryParse(s, out int i)) {
312 |                 result = i;
313 |                 return true;
314 |             } else if (BigInteger.TryParse(s, out BigInteger b)) {
315 |                 result = b;
316 |                 return true;
317 |             } else if (double.TryParse(s, out double d)) {
318 |                 result = d;
319 |                 return true;
320 |             } else {
321 |                 result = double.NaN;
322 |                 return false;
323 |             }
324 |         }
325 | 
326 | #if TEST
327 |         private static void Main() {
328 |             object x = Normalize(3L);
329 |             Console.WriteLine("{0}, {1}", x, x.GetType());
330 |             // -> 3, System.Int32
331 |             x = Normalize(555_000_555_000);
332 |             Console.WriteLine("{0}, {1}", x, x.GetType());
333 |             // -> 555000555000, System.Numerics.BigInteger
334 | 
335 |             x = Normalize((BigInteger) 3);
336 |             Console.WriteLine("{0}, {1}", x, x.GetType());
337 |             // -> 3, System.Int32
338 |             x = Normalize((BigInteger) 555_000_555_000);
339 |             Console.WriteLine("{0}, {1}", x, x.GetType());
340 |             // -> 555000555000, System.Numerics.BigInteger
341 | 
342 |             try {
343 |                 x = Add("123", 4);
344 |             } catch (ArgumentException ex) {
345 |                 Console.WriteLine(ex.Message); // -> 123, 4
346 |             }
347 |             x = Add(2, 7.89);
348 |             Console.WriteLine("{0}, {1}", x, x.GetType());
349 |             // -> 9.89, System.Double
350 |             x = Add(2, (BigInteger) 12345678901234567890);
351 |             Console.WriteLine("{0}, {1}", x, x.GetType());
352 |             // -> 12345678901234567892, Sysmtem.Numerics.BigInteger
353 |             x = Add((BigInteger) 12345678901234567890, 1.0);
354 |             Console.WriteLine("{0}, {1}", x, x.GetType());
355 |             // -> 1.23456789012346E+19, Sysmtem.Double
356 |             x = Add(1_000_111_000, 2_000_222_000);
357 |             Console.WriteLine("{0}, {1}", x, x.GetType());
358 |             // -> 3000333000, Sysmtem.Numerics.BigInteger
359 |             x = Add((BigInteger) 3_000_333_000, (BigInteger)(-2_000_222_000));
360 |             Console.WriteLine("{0}, {1}", x, x.GetType());
361 |             // -> 1000111000, Sysmtem.Int32
362 | 
363 |             x = Subtract((BigInteger)3_000_333_000, (BigInteger)2_000_222_000);
364 |             Console.WriteLine("{0}, {1}", x, x.GetType());
365 |             // -> 1000111000, Sysmtem.Int32
366 | 
367 |             x = Multiply(2.2, (BigInteger) 3);
368 |             Console.WriteLine("{0}, {1}", x, x.GetType());
369 |             // -> 6.6, Sysmtem.Double
370 | 
371 |             x = RoundedQuotient((BigInteger) 99, 3);
372 |             Console.WriteLine("{0}, {1}", x, x.GetType());
373 |             // -> 33, System.Double
374 | 
375 |             x = Quotient((BigInteger) 99, 3);
376 |             Console.WriteLine("{0}, {1}", x, x.GetType());
377 |             // -> 33, System.Int32
378 |             x = Quotient(-99.9, 3);
379 |             Console.WriteLine("{0}, {1}", x, x.GetType());
380 |             // -> -33, System.Int32
381 | 
382 |             x = Remainder(101.0, 3);
383 |             Console.WriteLine("{0}, {1}", x, x.GetType());
384 |             // -> 2, System.Double
385 |             x = Remainder((BigInteger) (-101), 3);
386 |             Console.WriteLine("{0}, {1}", x, x.GetType());
387 |             // -> -2, System.Int32
388 |             x = Remainder(-101.0, 3);
389 |             Console.WriteLine("{0}, {1}", x, x.GetType());
390 |             // -> -2, System.Double
391 | 
392 |             Console.WriteLine("{0}", Compare(2.2, (BigInteger) 3));
393 |             // -> -1
394 | 
395 |             bool b = TryParse("123", out x);
396 |             Console.WriteLine("{0}, {1}", x, x.GetType());
397 |             // -> 123, Sysmtem.Int32
398 |             b = TryParse("123.4", out x);
399 |             Console.WriteLine("{0}, {1}", x, x.GetType());
400 |             // -> 123.4, Sysmtem.Double
401 |             b = TryParse("-12345678901234567890", out x);
402 |             Console.WriteLine("{0}, {1}", x, x.GetType());
403 |             // -> -12345678901234567890, Sysmtem.Numerics.BigInteger
404 |         }
405 | #endif
406 |     }
407 | }
408 | 


--------------------------------------------------------------------------------
/lisp.cs:
--------------------------------------------------------------------------------
   1 | // H29.03.01/R01.10.27 by SUZUKI Hisao
   2 | using System;
   3 | using System.Collections.Generic;
   4 | using System.Diagnostics;
   5 | using System.IO;
   6 | using System.Linq;
   7 | using System.Reflection;
   8 | using System.Text;
   9 | using System.Text.RegularExpressions;
  10 | using System.Threading.Tasks;
  11 | using LittleArith;
  12 | 
  13 | // lisp.exe: csc -doc:lisp.xml -o -r:System.Numerics.dll lisp.cs arith.cs
  14 | // doc: mdoc update -i lisp.xml -o xml lisp.exe; mdoc export-html -o html xml
  15 | 
  16 | [assembly: AssemblyProduct("Nukata Lisp")]
  17 | [assembly: AssemblyVersion("2.0.0.*")]
  18 | [assembly: AssemblyTitle("A Lisp interpreter in C# 7")]
  19 | [assembly: AssemblyCopyright("© 2017 Oki Software Co., Ltd.; " + 
  20 |                              "© 2018 SUZUKI Hisao [MIT License]")]
  21 | 
  22 | /// <summary>
  23 | ///  A Lisp interpreter written in C# 7
  24 | /// </summary><remarks>
  25 | ///  This is ported from Nuka Lisp in Dart
  26 | ///  (https://github.com/nukata/lisp-in-dart).
  27 | ///  It is named after ex-Nukata Town in Japan.
  28 | /// </remarks>
  29 | public static class NukataLisp {
  30 | 
  31 |     /// <summary>Cons cell</summary>
  32 |     public sealed class Cell {
  33 |         /// <summary>Head part of the cons cell</summary>
  34 |         public object Car;
  35 |         /// <summary>Tail part of the cons cell</summary>
  36 |         public object Cdr;
  37 | 
  38 |         /// <summary>Construct a cons cell with its head and tail.</summary>
  39 |         public Cell(object car, object cdr) {
  40 |             Car = car;
  41 |             Cdr = cdr;
  42 |         }
  43 | 
  44 |         /// <summary>Make a simple string representation.</summary>
  45 |         /// <remarks>Do not invoke this for any circular list.</remarks>
  46 |         public override string ToString() =>
  47 |             $"({Car ?? "null"} . {Cdr ?? "null"})";
  48 | 
  49 |         /// <summary>Length as a list</summary>
  50 |         public int Length => FoldL(0, this, (i, e) => i + 1);
  51 |     }
  52 | 
  53 | 
  54 |     // MapCar((a b c), fn) => (fn(a) fn(b) fn(c))
  55 |     static Cell MapCar(Cell j, Func<object, object> fn) {
  56 |         if (j == null)
  57 |             return null;
  58 |         object a = fn(j.Car);
  59 |         object d = j.Cdr;
  60 |         if (d is Cell dc)
  61 |             d = MapCar(dc, fn);
  62 |         if (j.Car == a && j.Cdr == d)
  63 |             return j;
  64 |         return new Cell(a, d);
  65 |     }
  66 | 
  67 |     // FoldL(x, (a b c), fn) => fn(fn(fn(x, a), b), c)
  68 |     static T FoldL<T> (T x, Cell j, Func<T, object, T> fn) {
  69 |         while (j != null) {
  70 |             x = fn(x, j.Car);
  71 |             j = (Cell) j.Cdr;
  72 |         }
  73 |         return x;
  74 |     }
  75 | 
  76 | 
  77 |     /// <summary>Lisp symbol</summary>
  78 |     public class Sym {
  79 |         /// <summary>The symbol's name</summary>
  80 |         public string Name { get; }
  81 |         
  82 |         /// <summary>Construct a symbol that is not interned.</summary>
  83 |         public Sym(string name) {
  84 |             Name = name;
  85 |         }
  86 | 
  87 |         /// <summary>Return the symbol's name</summary>
  88 |         public override string ToString() => Name;
  89 |         /// <summary>Return the hashcode of the symbol's name</summary>
  90 |         public override int GetHashCode() => Name.GetHashCode();
  91 | 
  92 |         /// <summary>Table of interned symbols</summary>
  93 |         protected static readonly Dictionary<string, Sym> Table =
  94 |             new Dictionary<string, Sym>();
  95 | 
  96 |         /// <summary>Return an interned symbol for the name.</summary>
  97 |         /// <remarks>If the name is not interned yet, such a symbol
  98 |         /// will be constructed with <paramref name="make"/>.</remarks>
  99 |         protected static Sym New(string name, Func<string, Sym> make) {
 100 |             lock (Table) {
 101 |                 if (! Table.TryGetValue(name, out Sym result)) {
 102 |                     result = make(name);
 103 |                     Table[name] = result;
 104 |                 }
 105 |                 return result;
 106 |             }
 107 |         }
 108 | 
 109 |         /// <summary>Construct an interned symbol.</summary>
 110 |         public static Sym New(string name) => New(name, s => new Sym(s));
 111 | 
 112 |         /// <summary>Is it interned?</summary>
 113 |         public bool IsInterned {
 114 |             get {
 115 |                 lock (Table) {
 116 |                     return Table.TryGetValue(Name, out Sym s) &&
 117 |                         Object.ReferenceEquals(this, s);
 118 |                 }
 119 |             }
 120 |         }
 121 |     }
 122 | 
 123 | 
 124 |     // Expression keyword
 125 |     sealed class Keyword: Sym {
 126 |         Keyword(string name): base(name) {}
 127 |         internal static new Sym New(string name)
 128 |             => New(name, s => new Keyword(s));
 129 |     }
 130 | 
 131 |     static readonly Sym CondSym = Keyword.New("cond");
 132 |     static readonly Sym LambdaSym = Keyword.New("lambda");
 133 |     static readonly Sym MacroSym = Keyword.New("macro");
 134 |     static readonly Sym PrognSym = Keyword.New("progn");
 135 |     static readonly Sym QuasiquoteSym = Keyword.New("quasiquote");
 136 |     static readonly Sym QuoteSym = Keyword.New("quote");
 137 |     static readonly Sym SetqSym = Keyword.New("setq");
 138 | 
 139 |     static readonly Sym BackQuoteSym = Sym.New("`");
 140 |     static readonly Sym CommaAtSym = Sym.New(",@");
 141 |     static readonly Sym CommaSym = Sym.New(",");
 142 |     static readonly Sym DotSym = Sym.New(".");
 143 |     static readonly Sym LeftParenSym = Sym.New("(");
 144 |     static readonly Sym RightParenSym = Sym.New(")");
 145 |     static readonly Sym SingleQuoteSym = Sym.New("'");
 146 | 
 147 |     static readonly Sym AppendSym = Sym.New("append");
 148 |     static readonly Sym ConsSym = Sym.New("cons");
 149 |     static readonly Sym ListSym = Sym.New("list");
 150 |     static readonly Sym RestSym = Sym.New("&rest");
 151 |     static readonly Sym UnquoteSym = Sym.New("unquote");
 152 |     static readonly Sym UnquoteSplicingSym = Sym.New("unquote-splicing");
 153 | 
 154 |     /// <summary>The symbol of <c>t</c></summary>
 155 |     public static readonly Sym TSym = Sym.New("t");
 156 | 
 157 | 
 158 |     //------------------------------------------------------------------
 159 | 
 160 |     // Get cdr of list x as a Cell or null.
 161 |     static Cell CdrCell(Cell x) {
 162 |         var k = x.Cdr;
 163 |         if (k == null) {
 164 |             return null;
 165 |         } else {
 166 |             if (k is Cell c)
 167 |                 return c;
 168 |             else
 169 |                 throw new EvalException("proper list expected", x);
 170 |         }
 171 |     }
 172 | 
 173 | 
 174 |     /// <summary>Common base class of Lisp functions</summary>
 175 |     public abstract class LispFunc {
 176 |         /// <summary>Number of arguments, made negative if the function
 177 |         /// has &amp;rest</summary>
 178 |         public int Carity { get; }
 179 | 
 180 |         int Arity => (Carity < 0) ? -Carity : Carity;
 181 |         bool HasRest => (Carity < 0);
 182 | 
 183 |         // Number of fixed arguments
 184 |         int FixedArgs => (Carity < 0) ? -Carity - 1 : Carity;
 185 | 
 186 |         /// <summary>Construct with Carity.</summary>
 187 |         protected LispFunc(int carity) {
 188 |             Carity = carity;
 189 |         }
 190 | 
 191 |         /// <summary>Make a frame for local variables from a list of
 192 |         /// actual arguments.</summary>
 193 |         public object[] MakeFrame(Cell arg) {
 194 |             var frame = new object[Arity];
 195 |             int n = FixedArgs;
 196 |             int i;
 197 |             for (i = 0; i < n && arg != null; i++) {
 198 |                 // Set the list of fixed arguments.
 199 |                 frame[i] = arg.Car;
 200 |                 arg = CdrCell(arg);
 201 |             }
 202 |             if (i != n || (arg != null && !HasRest))
 203 |                 throw new EvalException("arity not matched", this);
 204 |             if (HasRest)
 205 |                 frame[n] = arg;
 206 |             return frame;
 207 |         }
 208 | 
 209 |         /// <summary>Evaluate each expression in a frame.</summary>
 210 |         public void EvalFrame(object[] frame, Interp interp, Cell env) {
 211 |             int n = FixedArgs;
 212 |             for (int i = 0; i < n; i++)
 213 |                 frame[i] = interp.Eval(frame[i], env);
 214 |             if (HasRest) {
 215 |                 if (frame[n] is Cell j) {
 216 |                     Cell z = null;
 217 |                     Cell y = null;
 218 |                     do {
 219 |                         var e = interp.Eval(j.Car, env);
 220 |                         Cell x = new Cell(e, null);
 221 |                         if (z == null)
 222 |                             z = x;
 223 |                         else
 224 |                             y.Cdr = x;
 225 |                         y = x;
 226 |                         j = CdrCell(j);
 227 |                     } while (j != null);
 228 |                     frame[n] = z;
 229 |                 }
 230 |             }
 231 |         }
 232 |     }
 233 | 
 234 | 
 235 |     // Common base class of functions which are defined with Lisp expressions
 236 |     abstract class DefinedFunc: LispFunc {
 237 |         // Lisp list as the function body
 238 |         public readonly Cell Body;
 239 | 
 240 |         protected DefinedFunc(int carity, Cell body): base(carity) {
 241 |             Body = body;
 242 |         }
 243 |     }
 244 | 
 245 | 
 246 |     // Common function type which represents any factory method of DefinedFunc
 247 |     delegate DefinedFunc FuncFactory(int carity, Cell body, Cell env);
 248 | 
 249 | 
 250 |     // Compiled macro expression
 251 |     sealed class Macro: DefinedFunc {
 252 |         Macro(int carity, Cell body): base(carity, body) {}
 253 |         public override string ToString() => $"#<macro:{Carity}:{Str(Body)}>";
 254 | 
 255 |         // Expand the macro with a list of actual arguments.
 256 |         public object ExpandWith(Interp interp, Cell arg) {
 257 |             object[] frame = MakeFrame(arg);
 258 |             Cell env = new Cell(frame, null);
 259 |             object x = null;
 260 |             for (Cell j = Body; j != null; j = CdrCell(j))
 261 |                 x = interp.Eval(j.Car, env);
 262 |             return x;
 263 |         }
 264 | 
 265 |         public static DefinedFunc Make(int carity, Cell body, Cell env) {
 266 |             Debug.Assert(env == null);
 267 |             return new Macro(carity, body);
 268 |         }
 269 |     }
 270 | 
 271 | 
 272 |     // Compiled lambda expression (Within another function)
 273 |     sealed class Lambda: DefinedFunc {
 274 |         Lambda(int carity, Cell body): base(carity, body) {}
 275 |         public override string ToString() => $"#<lambda:{Carity}:{Str(Body)}>";
 276 | 
 277 |         public static DefinedFunc Make(int carity, Cell body, Cell env) {
 278 |             Debug.Assert(env == null);
 279 |             return new Lambda(carity, body);
 280 |         }
 281 |     }
 282 | 
 283 | 
 284 |     // Compiled lambda expression (Closure with environment)
 285 |     sealed class Closure: DefinedFunc {
 286 |         // The environment of the closure
 287 |         public readonly Cell Env;
 288 | 
 289 |         Closure(int carity, Cell body, Cell env): base(carity, body) {
 290 |             Env = env;
 291 |         }
 292 | 
 293 |         public Closure(Lambda x, Cell env): this(x.Carity, x.Body, env) {}
 294 | 
 295 |         public override string ToString() =>
 296 |             $"#<closure:{Carity}:{Str(Env)}:{Str(Body)}>";
 297 | 
 298 |         // Make an environment to evaluate the body from a list of actual args.
 299 |         public Cell MakeEnv(Interp interp, Cell arg, Cell interpEnv) {
 300 |             object[] frame = MakeFrame(arg);
 301 |             EvalFrame(frame, interp, interpEnv);
 302 |             return new Cell(frame, Env); // Prepend the frame to this Env.
 303 |         }
 304 | 
 305 |         public static DefinedFunc Make(int carity, Cell body, Cell env) =>
 306 |             new Closure(carity, body, env);
 307 |     }
 308 | 
 309 | 
 310 |     /// <summary>Function type which represents any built-in function body
 311 |     /// </summary>
 312 |     public delegate object BuiltInFuncBody(object[] frame);
 313 | 
 314 |     /// <summary>Built-in function</summary>
 315 |     public sealed class BuiltInFunc: LispFunc {
 316 |         /// <summary>Name of this function</summary>
 317 |         public string Name { get; }
 318 |         /// <summary>C# function as the body of this function</summary>
 319 |         public BuiltInFuncBody Body { get; }
 320 | 
 321 |         /// <summary>Construct with Name, Carity and Body.</summary>
 322 |         public BuiltInFunc(string name, int carity, BuiltInFuncBody body)
 323 |             : base(carity) {
 324 |             Name = name;
 325 |             Body = body;
 326 |         }
 327 | 
 328 |         /// <summary>Return a string representation in Lisp.</summary>
 329 |         public override string ToString() => $"#<{Name}:{Carity}>";
 330 | 
 331 |         /// <summary>Invoke the built-in function with a list of
 332 |         /// actual arguments.</summary>
 333 |         public object EvalWith(Interp interp, Cell arg, Cell interpEnv) {
 334 |             object[] frame = MakeFrame(arg);
 335 |             EvalFrame(frame, interp, interpEnv);
 336 |             try {
 337 |                 return Body(frame);
 338 |             } catch (EvalException) {
 339 |                 throw;
 340 |             } catch (Exception ex) {
 341 |                 throw new EvalException($"{ex} -- {Name}", frame);
 342 |             }
 343 |         }
 344 |     }
 345 | 
 346 | 
 347 |     // Bound variable in a compiled lambda/macro expression
 348 |     sealed class Arg {
 349 |         public readonly int Level;
 350 |         public readonly int Offset;
 351 |         public readonly Sym Symbol;
 352 | 
 353 |         public Arg(int level, int offset, Sym symbol) {
 354 |             Level = level;
 355 |             Offset = offset;
 356 |             Symbol = symbol;
 357 |         }
 358 |         
 359 |         public override string ToString() => $"#{Level}:{Offset}:{Symbol}";
 360 | 
 361 |         // Set a value x to the location corresponding to the variable in env.
 362 |         public void SetValue(object x, Cell env) {
 363 |             for (int i = 0; i < Level; i++)
 364 |                 env = (Cell) env.Cdr;
 365 |             object[] frame = (object[]) env.Car;
 366 |             frame[Offset] = x;
 367 |         }
 368 | 
 369 |         // Get a value from the location corresponding to the variable in env.
 370 |         public object GetValue(Cell env) {
 371 |             for (int i = 0; i < Level; i++)
 372 |                 env = (Cell) env.Cdr;
 373 |             object[] frame = (object[]) env.Car;
 374 |             return frame[Offset];
 375 |         }
 376 |     }
 377 | 
 378 | 
 379 |     /// <summary>Exception in evaluation</summary>
 380 |     public class EvalException: Exception {
 381 |         /// <summary>Stack trace of Lisp evaluation</summary>
 382 |         public List<string> Trace { get; } = new List<string>();
 383 | 
 384 |         /// <summary>Construct with a base message, cause, and
 385 |         /// a flag whether to quote strings in the cause.</summary>
 386 |         public EvalException(string msg, object x, bool quoteString=true)
 387 |             : base(msg + ": " + Str(x, quoteString)) {}
 388 | 
 389 |         /// <summary>Return a string representation which contains
 390 |         /// the message and the stack trace.</summary>
 391 |         public override string ToString() {
 392 |             var sb = new StringBuilder($"EvalException: {Message}", 0);
 393 |             foreach (string line in Trace)
 394 |                 sb.Append($"\n\t{line}");
 395 |             return sb.ToString();
 396 |         }
 397 |     }
 398 | 
 399 | 
 400 |     // Exception which indicates on absense of a variable
 401 |     sealed class NotVariableException: EvalException {
 402 |         public NotVariableException(object x): base("variable expected", x) {}
 403 |     }
 404 | 
 405 | 
 406 |     //------------------------------------------------------------------
 407 | 
 408 |     /// <summary>Core of the Lisp interpreter</summary>
 409 |     public class Interp {
 410 |         /// <summary>Table of the global values of symbols</summary>
 411 |         protected readonly Dictionary<Sym, object> Globals =
 412 |             new Dictionary<Sym, object>();
 413 | 
 414 |         /// <summary>Standard out</summary>
 415 |         public TextWriter COut { get; set; } = Console.Out;
 416 | 
 417 |         /// <summary>Set each built-in function/variable as the global value
 418 |         /// of symbol.</summary>
 419 |         public Interp() {
 420 |             Globals[TSym] = TSym;
 421 |             Def("car", 1, a => (a[0] as Cell)?.Car);
 422 |             Def("cdr", 1, a => (a[0] as Cell)?.Cdr);
 423 |             Def("cons", 2, a => new Cell(a[0], a[1]));
 424 |             Def("atom", 1, a => (a[0] is Cell) ? null : TSym);
 425 |             Def("eq", 2, a => (a[0] == a[1]) ? TSym : null);
 426 | 
 427 |             Def("list", -1, a => a[0]);
 428 |             Def("rplaca", 2, a => { ((Cell) a[0]).Car = a[1]; return a[1]; });
 429 |             Def("rplacd", 2, a => { ((Cell) a[0]).Cdr = a[1]; return a[1]; });
 430 |             Def("length", 1, a => {
 431 |                     dynamic x = a[0];
 432 |                     if (x == null)
 433 |                         return 0;
 434 |                     return x.Length;
 435 |                 });
 436 |             Def("stringp", 1, a => (a[0] is string) ? TSym : null);
 437 | 
 438 |             Def("numberp", 1, a => (Arith.IsNumber(a[0])) ? TSym : null);
 439 |             Def("eql", 2, a => {
 440 |                     var x = a[0];
 441 |                     var y = a[1];
 442 |                     if (x == null)
 443 |                         return (y == null) ? TSym : null;
 444 |                     else if (x.Equals(y))
 445 |                         return TSym;
 446 |                     else if (Arith.IsNumber(x) && Arith.IsNumber(y))
 447 |                         return (Arith.Compare(x, y) == 0) ? TSym : null;
 448 |                     else
 449 |                         return null;
 450 |                 });
 451 |             Def("<", 2, a => (Arith.Compare(a[0], a[1]) < 0) ? TSym : null);
 452 | 
 453 |             Def("%", 2, a => Arith.Remainder(a[0], a[1]));
 454 |             Def("mod", 2, a => {
 455 |                     var x = a[0];
 456 |                     var y = a[1];
 457 |                     int xs = Arith.Compare(x, 0);
 458 |                     int ys = Arith.Compare(y, 0);
 459 |                     var q = Arith.Remainder(x, y);
 460 |                     if ((xs < 0 && ys > 0) || (xs > 0 && ys < 0))
 461 |                         return Arith.Add(q, y);
 462 |                     return q;
 463 |                 });
 464 | 
 465 |             Def("+", -1, a => FoldL((object) 0, (Cell) a[0],
 466 |                                     (i, j) => Arith.Add(i, j)));
 467 |             Def("*", -1, a => FoldL((object) 1, (Cell) a[0],
 468 |                                     (i, j) => Arith.Multiply(i, j)));
 469 |             Def("-", -2, a => {
 470 |                     var x = a[0];
 471 |                     var y = (Cell) a[1];
 472 |                     if (y == null)
 473 |                         return Arith.Subtract(0, x);
 474 |                     return FoldL(x, y, (i, j) => Arith.Subtract(i, j));
 475 |                 });
 476 |             Def("/", -3, a => FoldL(Arith.RoundedQuotient(a[0], a[1]),
 477 |                                     (Cell) a[2],
 478 |                                     (i, j) => Arith.RoundedQuotient(i, j)));
 479 |             Def("truncate", -2, a => {
 480 |                     var x = a[0];
 481 |                     var y = (Cell) a[1];
 482 |                     if (y == null)
 483 |                         return Arith.Quotient(x, 1);
 484 |                     else if (y.Cdr == null)
 485 |                         return Arith.Quotient(x, y.Car);
 486 |                     else
 487 |                         throw new ArgumentException
 488 |                             ("one or two arguments expected");
 489 |                 });
 490 | 
 491 |             Def("prin1", 1, a => {
 492 |                     COut.Write(Str(a[0], true)); return a[0];
 493 |                 });
 494 |             Def("princ", 1, a => {
 495 |                     COut.Write(Str(a[0], false)); return a[0];
 496 |                 });
 497 |             Def("terpri", 0, a => {
 498 |                     COut.WriteLine(); return TSym;
 499 |                 });
 500 | 
 501 |             var gensymCounterSym = Sym.New("*gensym-counter*");
 502 |             Globals[gensymCounterSym] = 1;
 503 |             Def("gensym", 0, a => {
 504 |                     int x = (int) Globals[gensymCounterSym];
 505 |                     Globals[gensymCounterSym] = x + 1;
 506 |                     return new Sym($"G{(int) x}");
 507 |                 });
 508 | 
 509 |             Def("make-symbol", 1, a => new Sym((string) a[0]));
 510 |             Def("intern", 1, a => Sym.New((string) a[0]));
 511 |             Def("symbol-name", 1, a => ((Sym) a[0]).Name);
 512 | 
 513 |             Def("apply", 2, a =>
 514 |                 Eval(new Cell(a[0], MapCar((Cell) a[1], QqQuote)), null));
 515 | 
 516 |             Def("exit", 1, a => {
 517 |                     Environment.Exit((int) a[0]);
 518 |                     return null;
 519 |                 });
 520 |             Def("dump", 0, a =>
 521 |                 Globals.Keys.Aggregate((Cell) null, (x, y) => new Cell(y, x)));
 522 | 
 523 |             var assembly = Assembly.GetExecutingAssembly();
 524 |             var product = (AssemblyProductAttribute)
 525 |                 Attribute.GetCustomAttribute
 526 |                 (assembly, typeof(AssemblyProductAttribute));
 527 |             var version = assembly.GetName().Version;
 528 |             double iversion = version.Major + 0.1 * version.Minor +
 529 |                 0.01 * version.Build;
 530 |             Globals[Sym.New("*version*")] =
 531 |                 new Cell(iversion,
 532 |                          new Cell("C# 7", new Cell(product.Product, null)));
 533 |         }
 534 | 
 535 |         /// <summary>Define a built-in function by a name, an arity,
 536 |         /// and a body.</summary>
 537 |         public void Def(string name, int carity, BuiltInFuncBody body) {
 538 |             Globals[Sym.New(name)] = new BuiltInFunc(name, carity, body);
 539 |         }
 540 | 
 541 |         /// <summary>Evaluate a Lisp expression in an environment.</summary>
 542 |         public object Eval(object x, Cell env) {
 543 |             try {
 544 |                 for (;;) {
 545 |                     switch (x) {
 546 |                     case Arg xarg:
 547 |                         return xarg.GetValue(env);
 548 |                     case Sym xsym:
 549 |                         try {
 550 |                             return Globals[xsym];
 551 |                         } catch (KeyNotFoundException) {
 552 |                             throw new EvalException("void variable", x);
 553 |                         }
 554 |                     case Cell xcell:
 555 |                         var fn = xcell.Car;
 556 |                         Cell arg = CdrCell(xcell);
 557 |                         if (fn is Keyword) {
 558 |                             if (fn == QuoteSym) {
 559 |                                 if (arg != null && arg.Cdr == null)
 560 |                                     return arg.Car;
 561 |                                 throw new EvalException("bad quote", x);
 562 |                             } else if (fn == PrognSym) {
 563 |                                 x = EvalProgN(arg, env);
 564 |                             } else if (fn == CondSym) {
 565 |                                 x = EvalCond(arg, env);
 566 |                             } else if (fn == SetqSym) {
 567 |                                 return EvalSetQ(arg, env);
 568 |                             } else if (fn == LambdaSym) {
 569 |                                 return Compile(arg, env, Closure.Make);
 570 |                             } else if (fn == MacroSym) {
 571 |                                 if (env != null)
 572 |                                     throw new EvalException("nested macro", x);
 573 |                                 return Compile(arg, null, Macro.Make);
 574 |                             } else if (fn == QuasiquoteSym) {
 575 |                                 if (arg != null && arg.Cdr == null)
 576 |                                     x = QqExpand(arg.Car);
 577 |                                 else
 578 |                                     throw new EvalException ("bad quasiquote",
 579 |                                                              x);
 580 |                             } else {
 581 |                                 throw new EvalException("bad keyword", fn);
 582 |                             }
 583 |                         } else { // Application of a function
 584 |                             if (fn is Sym fnsym) {
 585 |                                 // Expand fn = Eval(fn, env) here for speed.
 586 |                                 try {
 587 |                                     fn = Globals[fnsym];
 588 |                                 } catch (KeyNotFoundException) {
 589 |                                     throw new EvalException("undefined",
 590 |                                                             fnsym);
 591 |                                 }
 592 |                             } else {
 593 |                                 fn = Eval(fn, env);
 594 |                             }
 595 |                             switch (fn) {
 596 |                             case Closure fnclosure:
 597 |                                 env = fnclosure.MakeEnv(this, arg, env);
 598 |                                 x = EvalProgN(fnclosure.Body, env);
 599 |                                 break;
 600 |                             case Macro fnmacro:
 601 |                                 x = fnmacro.ExpandWith(this, arg);
 602 |                                 break;
 603 |                             case BuiltInFunc fnbulitin:
 604 |                                 return fnbulitin.EvalWith(this, arg, env);
 605 |                             default:
 606 |                                 throw new EvalException("not appliable", fn);
 607 |                             }
 608 |                         }
 609 |                         break;
 610 |                     case Lambda xlambda:
 611 |                         return new Closure(xlambda, env);
 612 |                     default:
 613 |                         return x; // numbers, strings, null etc.
 614 |                     }
 615 |                 }
 616 |             } catch (EvalException ex) {
 617 |                 if (ex.Trace.Count < 10)
 618 |                     ex.Trace.Add(Str(x));
 619 |                 throw ex;
 620 |             }
 621 |         }
 622 | 
 623 |         // (progn E1 ... En) => Evaluate E1, ... except for En and return it.
 624 |         object EvalProgN(Cell j, Cell env) {
 625 |             if (j == null)
 626 |                 return null;
 627 |             for (;;) {
 628 |                 var x = j.Car;
 629 |                 j = CdrCell(j);
 630 |                 if (j == null)
 631 |                     return x; // The tail expression to be evaluated later
 632 |                 Eval(x, env);
 633 |             }
 634 |         }
 635 | 
 636 |         // Evaluate a conditional expression and return the selection.
 637 |         object EvalCond(Cell j, Cell env) {
 638 |             for (; j != null; j = CdrCell(j)) {
 639 |                 var clause = j.Car;
 640 |                 if (clause != null) {
 641 |                     if (clause is Cell k) {
 642 |                         var result = Eval(k.Car, env);
 643 |                         if (result != null) { // If the condition holds
 644 |                             Cell body = CdrCell(k);
 645 |                             if (body == null)
 646 |                                 return QqQuote(result);
 647 |                             else
 648 |                                 return EvalProgN(body, env);
 649 |                         }
 650 |                     } else {
 651 |                         throw new EvalException("cond test expected", clause);
 652 |                     }
 653 |                 }
 654 |             }
 655 |             return null;        // No clause holds.
 656 |         }
 657 | 
 658 |         // (setq V1 E1 ..) => Evaluate Ei and assign it to Vi; return the last.
 659 |         object EvalSetQ(Cell j, Cell env) {
 660 |             object result = null;
 661 |             for (; j != null; j = CdrCell(j)) {
 662 |                 var lval = j.Car;
 663 |                 if (lval == TSym)
 664 |                     throw new EvalException("not assignable", lval);
 665 |                 j = CdrCell(j);
 666 |                 if (j == null)
 667 |                     throw new EvalException("right value expected", lval);
 668 |                 result = Eval(j.Car, env);
 669 |                 switch (lval) {
 670 |                 case Arg arg:
 671 |                     arg.SetValue(result, env);
 672 |                     break;
 673 |                 case Sym sym when !(sym is Keyword):
 674 |                     Globals[sym] = result;
 675 |                     break;
 676 |                 default:
 677 |                     throw new NotVariableException(lval);
 678 |                 }
 679 |             }
 680 |             return result;
 681 |         }
 682 | 
 683 |         // Compile a Lisp list (macro ...) or (lambda ...).
 684 |         DefinedFunc Compile(Cell arg, Cell env, FuncFactory make) {
 685 |             if (arg == null)
 686 |                 throw new EvalException("arglist and body expected", arg);
 687 |             var table = new Dictionary<Sym, Arg>();
 688 |             bool hasRest = MakeArgTable(arg.Car, table);
 689 |             int arity = table.Count;
 690 |             Cell body = CdrCell(arg);
 691 |             body = ScanForArgs(body, table) as Cell;
 692 |             body = ExpandMacros(body, 20) as Cell; // Expand up to 20 nestings.
 693 |             body = CompileInners(body) as Cell;
 694 |             return make(hasRest ? -arity : arity, body, env);
 695 |         }
 696 | 
 697 |         // Expand macros and quasi-quotations in an expression.
 698 |         object ExpandMacros(object j, int count) {
 699 |             if ((j is Cell cell) && count > 0) {
 700 |                 var k = cell.Car;
 701 |                 if (k == QuoteSym || k == LambdaSym || k == MacroSym) {
 702 |                     return cell;
 703 |                 } else if (k == QuasiquoteSym) {
 704 |                     Cell d = CdrCell(cell);
 705 |                     if (d != null && d.Cdr == null) {
 706 |                         var z = QqExpand(d.Car);
 707 |                         return ExpandMacros(z, count);
 708 |                     }
 709 |                     throw new EvalException("bad quasiquote", cell);
 710 |                 } else {
 711 |                     if (k is Sym sym)
 712 |                         k = Globals.ContainsKey(sym) ? Globals[sym] : null;
 713 |                     if (k is Macro macro) {
 714 |                         Cell d = CdrCell(cell);
 715 |                         var z = macro.ExpandWith(this, d);
 716 |                         return ExpandMacros(z, count - 1);
 717 |                     } else {
 718 |                         return MapCar(cell, x => ExpandMacros(x, count));
 719 |                     }
 720 |                 }
 721 |             } else {
 722 |                 return j;
 723 |             }
 724 |         }
 725 | 
 726 |         // Replace inner lambda-expressions with Lambda instances.
 727 |         object CompileInners(object j) {
 728 |             if (j is Cell cell) {
 729 |                 var k = cell.Car;
 730 |                 if (k == QuoteSym) {
 731 |                     return cell;
 732 |                 } else if (k == LambdaSym) {
 733 |                     Cell d = CdrCell(cell);
 734 |                     return Compile(d, null, Lambda.Make);
 735 |                 } else if (k == MacroSym) {
 736 |                     throw new EvalException("nested macro", cell);
 737 |                 } else {
 738 |                     return MapCar(cell, x => CompileInners(x));
 739 |                 }
 740 |             } else {
 741 |                 return j;
 742 |             }
 743 |         }
 744 |     }
 745 | 
 746 | 
 747 |     //------------------------------------------------------------------
 748 | 
 749 |     // Make an argument-table; return true if there is a rest argument.
 750 |     static bool MakeArgTable(object arg, IDictionary<Sym, Arg> table) {
 751 |         if (arg == null) {
 752 |             return false;
 753 |         } else if (arg is Cell argcell) {
 754 |             int offset = 0;     // offset value within the call-frame
 755 |             bool hasRest = false;
 756 |             for (; argcell != null; argcell = CdrCell(argcell)) {
 757 |                 var j = argcell.Car;
 758 |                 if (hasRest)
 759 |                     throw new EvalException("2nd rest", j);
 760 |                 if (j == RestSym) { // &rest var
 761 |                     argcell = CdrCell(argcell);
 762 |                     if (argcell == null)
 763 |                         throw new NotVariableException(argcell);
 764 |                     j = argcell.Car;
 765 |                     if (j == RestSym)
 766 |                         throw new NotVariableException(j);
 767 |                     hasRest = true;
 768 |                 }
 769 |                 Sym sym = j as Sym;
 770 |                 if (sym == null) {
 771 |                     Arg jarg = j as Arg;
 772 |                     if (jarg != null)
 773 |                         sym = jarg.Symbol;
 774 |                     else
 775 |                         throw new NotVariableException(j);
 776 |                 }
 777 |                 if (sym == TSym)
 778 |                     throw new EvalException("not assignable", sym);
 779 |                 if (table.ContainsKey(sym))
 780 |                     throw new EvalException("duplicated argument name", sym);
 781 |                 table[sym] = new Arg(0, offset, sym);
 782 |                 offset++;
 783 |             }
 784 |             return hasRest;
 785 |         } else {
 786 |             throw new EvalException("arglist expected", arg);
 787 |         }
 788 |     }
 789 | 
 790 |     // Scan 'j' for formal arguments in 'table' and replace them with Args.
 791 |     // And scan 'j' for free Args not in 'table' and promote their levels.
 792 |     static object ScanForArgs(object j, IDictionary<Sym, Arg> table) {
 793 |         switch (j) {
 794 |         case Sym sym:
 795 |             return ((table.TryGetValue(sym, out Arg a)) ? a :
 796 |                     j);
 797 |         case Arg arg:
 798 |             return ((table.TryGetValue(arg.Symbol, out Arg k)) ? k :
 799 |                     new Arg(arg.Level + 1, arg.Offset, arg.Symbol));
 800 |         case Cell cell:
 801 |             if (cell.Car == QuoteSym)
 802 |                 return j;
 803 |             else if (cell.Car == QuasiquoteSym)
 804 |                 return new Cell(QuasiquoteSym, 
 805 |                                 ScanForQQ(cell.Cdr, table, 0));
 806 |             else
 807 |                 return MapCar(cell, x => ScanForArgs(x, table));
 808 |         default:
 809 |             return j;
 810 |         }
 811 |     }
 812 | 
 813 |     // Scan for quasi-quotes and ScanForArgs them depending on the nesting
 814 |     // level.
 815 |     static object ScanForQQ(object j, IDictionary<Sym, Arg> table, int level) {
 816 |         if (j is Cell cell) {
 817 |             var car = cell.Car;
 818 |             var cdr = cell.Cdr;
 819 |             if (car == QuasiquoteSym) {
 820 |                 return new Cell(car, ScanForQQ(cdr, table, level + 1));
 821 |             } else if (car == UnquoteSym || car == UnquoteSplicingSym) {
 822 |                 var d = ((level == 0) ? ScanForArgs(cdr, table) :
 823 |                          ScanForQQ(cdr, table, level - 1));
 824 |                 if (d == cdr)
 825 |                     return j;
 826 |                 return new Cell(car, d);
 827 |             } else {
 828 |                 return MapCar(cell, x => ScanForQQ(x, table, level));
 829 |             }
 830 |         } else {
 831 |             return j;
 832 |         }
 833 |     }
 834 | 
 835 | 
 836 |     //------------------------------------------------------------------
 837 |     // Quasi-Quotation
 838 | 
 839 |     /// <summary>Expand <c>x</c> of any quqsi-quotation <c>`x</c> into
 840 |     /// the equivalent S-expression.</summary>
 841 |     public static object QqExpand(object x) =>
 842 |         QqExpand0(x, 0);        // Begin with the nesting level 0.
 843 | 
 844 |     /// <summary>Quote <c>x</c> so that the result evaluates to <c>x</c>.
 845 |     /// </summary>
 846 |     public static object QqQuote(object x) =>
 847 |         (x is Sym || x is Cell) ? new Cell(QuoteSym, new Cell(x, null)) : x;
 848 | 
 849 |     static object QqExpand0(object x, int level) {
 850 |         if (x is Cell cell) {
 851 |             if (cell.Car == UnquoteSym) { // ,a
 852 |                 if (level == 0)
 853 |                     return CdrCell(cell).Car; // ,a => a
 854 |             }
 855 |             Cell t = QqExpand1(cell, level);
 856 |             if ((t.Car is Cell k) && t.Cdr == null) {
 857 |                 if (k.Car == ListSym || k.Car == ConsSym)
 858 |                     return k;
 859 |             }
 860 |             return new Cell(AppendSym, t);
 861 |         } else {
 862 |             return QqQuote(x);
 863 |         }
 864 |     }
 865 | 
 866 |     // Expand x of `x so that the result can be used as an argument of append.
 867 |     // Example 1: (,a b) => h=(list a) t=((list 'b)) => ((list a 'b))
 868 |     // Example 2: (,a ,@(cons 2 3)) => h=(list a) t=((cons 2 3))
 869 |     //                              => ((cons a (cons 2 3)))
 870 |     static Cell QqExpand1(object x, int level) {
 871 |         if (x is Cell cell) {
 872 |             if (cell.Car == UnquoteSym) { // ,a
 873 |                 if (level == 0)
 874 |                     return CdrCell(cell); // ,a => (a)
 875 |                 level--;
 876 |             } else if (cell.Car == QuasiquoteSym) { // `a
 877 |                 level++;
 878 |             }
 879 |             var h = QqExpand2(cell.Car, level);
 880 |             Cell t = QqExpand1(cell.Cdr, level); // != null
 881 |             if (t.Car == null && t.Cdr == null) {
 882 |                 return new Cell(h, null);
 883 |             } else if (h is Cell hcell) {
 884 |                 if (hcell.Car == ListSym) {
 885 |                     if (t.Car is Cell tcar) {
 886 |                         if (tcar.Car == ListSym) {
 887 |                             var hh = QqConcat(hcell, tcar.Cdr);
 888 |                             return new Cell(hh, t.Cdr);
 889 |                         }
 890 |                     }
 891 |                     if (hcell.Cdr != null) {
 892 |                         var hh = QqConsCons(CdrCell(hcell), t.Car);
 893 |                         return new Cell(hh, t.Cdr);
 894 |                     }
 895 |                 }
 896 |             }
 897 |             return new Cell(h, t);
 898 |         } else {
 899 |             return new Cell(QqQuote(x), null);
 900 |         }
 901 |     }
 902 | 
 903 |     // (1 2), (3 4) => (1 2 3 4)
 904 |     static object QqConcat(Cell x, object y) =>
 905 |         (x == null) ? y :
 906 |         new Cell(x.Car, QqConcat(CdrCell(x), y));
 907 | 
 908 |     // (1 2 3), "a" => (cons 1 (cons 2 (cons 3 "a")))
 909 |     static object QqConsCons(Cell x, object y) =>
 910 |         (x == null) ? y :
 911 |         new Cell(ConsSym,
 912 |                  new Cell(x.Car,
 913 |                           new Cell(QqConsCons(CdrCell(x), y), null)));
 914 | 
 915 |     // Expand x.car of `x so that the result can be used as an arg of append.
 916 |     // Example: ,a => (list a); ,@(foo 1 2) => (foo 1 2); b => (list 'b)
 917 |     static object QqExpand2(object y, int level) { // Let y be x.car.
 918 |         if (y is Cell cell) {
 919 |             if (cell.Car == UnquoteSym) { // ,a
 920 |                 if (level == 0)
 921 |                     return new Cell(ListSym, cell.Cdr); // ,a => (list a)
 922 |                 level--;
 923 |             } else if (cell.Car == UnquoteSplicingSym) { // ,@a
 924 |                 if (level == 0)
 925 |                     return CdrCell(cell).Car; // ,@a => a
 926 |                 level--;
 927 |             } else if (cell.Car == QuasiquoteSym) { // `a
 928 |                 level++;
 929 |             }
 930 |         }
 931 |         return new Cell(ListSym, new Cell(QqExpand0(y, level), null));
 932 |     }
 933 | 
 934 | 
 935 |     //------------------------------------------------------------------
 936 | 
 937 |     /// <summary>Reader of Lisp expressions</summary>
 938 |     public class Reader {
 939 |         readonly TextReader TReader;
 940 |         object Token;
 941 |         IEnumerator<string> Tokens =
 942 |             ((IEnumerable<string>) new string[0]).GetEnumerator();
 943 |         int LineNo = 0;
 944 |         string Line = "";
 945 |         bool Erred = false;
 946 | 
 947 |         /// <summary>Token of "End Of File"</summary>
 948 |         public static object EOF = new Sym("#EOF");
 949 | 
 950 |         /// <summary>Construct a Lisp reader.</summary>
 951 |         /// <param name="tr">Text reader from which Lisp expressions will
 952 |         /// be read</param>
 953 |          public Reader(TextReader tr) {
 954 |              TReader = tr;
 955 |          }
 956 |  
 957 |         /// <summary>Read a Lisp expression and return it.</summary>
 958 |         /// <remarks>Return EOF if the input runs out.</remarks>
 959 |         public async Task<object> Read() {
 960 |             try {
 961 |                 await ReadToken();
 962 |                 return await ParseExpression();
 963 |             } catch (FormatException ex) {
 964 |                 throw new EvalException("syntax error",
 965 |                                         $"{ex.Message} -- {LineNo}: {Line}",
 966 |                                         false);
 967 |             }
 968 |         }
 969 | 
 970 |         async Task<object> ParseExpression() {
 971 |             if (Token == LeftParenSym) { // (a b c)
 972 |                 await ReadToken();
 973 |                 return await ParseListBody();
 974 |             } else if (Token == SingleQuoteSym) { // 'a => (quote a)
 975 |                 await ReadToken();
 976 |                 return new Cell(QuoteSym,
 977 |                                 new Cell(await ParseExpression(), null));
 978 |             } else if (Token == BackQuoteSym) { // `a => (quasiquote a)
 979 |                 await ReadToken();
 980 |                 return new Cell(QuasiquoteSym,
 981 |                                 new Cell(await ParseExpression(), null));
 982 |             } else if (Token == CommaSym) { // ,a => (unquote a)
 983 |                 await ReadToken();
 984 |                 return new Cell(UnquoteSym,
 985 |                                 new Cell(await ParseExpression(), null));
 986 |             } else if (Token == CommaAtSym) { // ,@a => (unquote-splicing a)
 987 |                 await ReadToken();
 988 |                 return new Cell(UnquoteSplicingSym,
 989 |                                 new Cell(await ParseExpression(), null));
 990 |             } else if (Token == DotSym || Token == RightParenSym) {
 991 |                 throw new FormatException($"unexpected {Token}");
 992 |             } else {
 993 |                 return Token;
 994 |             }
 995 |         }
 996 | 
 997 |         async Task<Cell> ParseListBody() {
 998 |             if (Token == EOF) {
 999 |                 throw new FormatException("unexpected EOF");
1000 |             } else if (Token == RightParenSym) {
1001 |                 return null;
1002 |             } else {
1003 |                 var e1 = await ParseExpression();
1004 |                 await ReadToken();
1005 |                 object e2;
1006 |                 if (Token == DotSym) { // (a . b)
1007 |                     await ReadToken();
1008 |                     e2 = await ParseExpression();
1009 |                     await ReadToken();
1010 |                     if (Token != RightParenSym) 
1011 |                         throw new FormatException($"\")\" expected: {Token}");
1012 |                 } else {
1013 |                     e2 = await ParseListBody();
1014 |                 }
1015 |                 return new Cell(e1, e2);
1016 |             }
1017 |         }
1018 | 
1019 |         // Read the next token and set it to Token.
1020 |         async Task ReadToken() {
1021 |             while (!Tokens.MoveNext() || Erred) { // line ends or erred
1022 |                 Erred = false;
1023 |                 LineNo++;
1024 |                 Line = await TReader.ReadLineAsync();
1025 |                 if (Line == null) {
1026 |                     Token = EOF;
1027 |                     return;
1028 |                 }
1029 |                 Tokens = ToTypedMatches(TokenPat.Matches(Line))
1030 |                     .Select((Match m) => m.Groups[1].Value)
1031 |                     .Where((string s) => s != "")
1032 |                     .GetEnumerator();
1033 |             }
1034 |             string t = Tokens.Current;
1035 |             if (t[0] == '"') {
1036 |                 int n = t.Length - 1;
1037 |                 if (n < 1 || t[n] != '"')
1038 |                     throw new FormatException($"bad string: {t}");
1039 |                 t = t.Substring(1, n - 1);
1040 |                 t = EscapePat.Replace(t, (Match m) => {
1041 |                         String key = m.Groups[1].Value;
1042 |                         return (Escapes.ContainsKey(key) ? Escapes[key] :
1043 |                                 $"\\{key}");
1044 |                     });
1045 |                 Token = t;
1046 |                 return;
1047 |             }
1048 |             if (Arith.TryParse(t, out object num))
1049 |                 Token = num;
1050 |             else if (t == "nil")
1051 |                 Token = null;
1052 |             else
1053 |                 Token = Sym.New(t);
1054 |         }
1055 |     }
1056 | 
1057 |     static IEnumerable<Match> ToTypedMatches(MatchCollection matches) {
1058 |         foreach (Match match in matches) {
1059 |             yield return match;
1060 |         }
1061 |     }
1062 | 
1063 |     // Regular expression to split a line into Lisp tokens
1064 |     static readonly Regex TokenPat =
1065 |         new Regex(@"\s+|;.*$|(""(\\.?|.)*?""|,@?|[^()'`~""; \t]+|.)");
1066 | 
1067 |     // Regular expression to take an escape sequence out of a string
1068 |     static readonly Regex EscapePat = new Regex(@"\\(.)");
1069 | 
1070 |     // Mapping from a character of escape sequence to its string value
1071 |     static readonly Dictionary<string, string> Escapes =
1072 |         new Dictionary<string, string> {
1073 |         ["\\"] = "\\",
1074 |         ["\""] = "\"",
1075 |         ["n"] = "\n",
1076 |         ["r"] = "\r",
1077 |         ["f"] = "\f",
1078 |         ["b"] = "\b",
1079 |         ["t"] = "\t",
1080 |         ["v"] = "\v"
1081 |     };
1082 | 
1083 | 
1084 |     //------------------------------------------------------------------
1085 | 
1086 |     /// <summary>Make a string representation of Lisp expression.</summary>
1087 |     /// <param name="x">Lisp expression</param>
1088 |     /// <param name="quoteString">flag whether to quote string</param>
1089 |     public static string Str(object x, bool quoteString=true) {
1090 |         // 4 is the threshold of ellipsis for circular lists
1091 |         return Str4(x, quoteString, 4, null);
1092 |     }
1093 | 
1094 |     // Mapping from a quote symbol to its string representation
1095 |     static readonly Dictionary<Sym, string> Quotes =
1096 |          new Dictionary<Sym, string> {
1097 |         [QuoteSym] = "'",
1098 |         [QuasiquoteSym] = "`",
1099 |         [UnquoteSym] = ",",
1100 |         [UnquoteSplicingSym] = ",@"
1101 |     };
1102 | 
1103 |     static string Str4(object x, bool quoteString, int count,
1104 |                        HashSet<Cell> printed) {
1105 |         switch (x) {
1106 |         case null:
1107 |             return "nil";
1108 |         case Cell cell:
1109 |             if ((cell.Car is Sym csym) && Quotes.ContainsKey(csym)) {
1110 |                 if ((cell.Cdr is Cell xcdr) && xcdr.Cdr == null)
1111 |                     return Quotes[csym]
1112 |                         + Str4(xcdr.Car, true, count, printed);
1113 |             }
1114 |             return "(" + StrListBody(cell, count, printed) + ")";
1115 |         case string st:
1116 |             if (! quoteString)
1117 |                 return st;
1118 |             var bf = new StringBuilder();
1119 |             bf.Append('"');
1120 |             foreach (char ch in st) {
1121 |                 switch (ch) {
1122 |                 case '\b': bf.Append(@"\b"); break;
1123 |                 case '\t': bf.Append(@"\t"); break;
1124 |                 case '\n': bf.Append(@"\n"); break;
1125 |                 case '\v': bf.Append(@"\v"); break;
1126 |                 case '\f': bf.Append(@"\f"); break;
1127 |                 case '\r': bf.Append(@"\r"); break;
1128 |                 case '"':  bf.Append("\\\""); break;
1129 |                 case '\\': bf.Append(@"\\"); break;
1130 |                 default: bf.Append(ch); break;
1131 |                 }
1132 |             }
1133 |             bf.Append('"');
1134 |             return bf.ToString();
1135 |         case Sym sym:
1136 |             return (sym.IsInterned) ? sym.Name : $"#:{x}";
1137 |         case double d:          // 123.0 => "123.0"
1138 |             string lds = ((long) d).ToString();
1139 |             if (lds == d.ToString())
1140 |                 return lds + ".0";
1141 |             break;
1142 |         }
1143 |         return x.ToString();
1144 |     }
1145 | 
1146 |     // Make a string representation of list omitting its "(" and ")".
1147 |     static string StrListBody(Cell x, int count, HashSet<Cell> printed) {
1148 |         if (printed == null)
1149 |             printed = new HashSet<Cell>();
1150 |         var s = new List<string>();
1151 |         object y;
1152 |         for (y = x; y is Cell cell; y = cell.Cdr) {
1153 |             if (printed.Add(cell)) {
1154 |                 count = 4;
1155 |             } else {
1156 |                 count--;
1157 |                 if (count < 0) {
1158 |                     s.Add("..."); // an ellipsis for a circular list
1159 |                     return String.Join(" ", s);
1160 |                 }
1161 |             }
1162 |             s.Add(Str4(cell.Car, true, count, printed));
1163 |         }
1164 |         if (y != null) {
1165 |             s.Add(".");
1166 |             s.Add(Str4(y, true, count, printed));
1167 |         }
1168 |         for (y = x; y is Cell cell; y = cell.Cdr)
1169 |             printed.Remove(cell);
1170 |         return String.Join(" ", s);
1171 |     }
1172 | 
1173 | 
1174 |     //------------------------------------------------------------------
1175 | 
1176 |     /// <summary>Run Read-Eval-Print Loop.</summary>
1177 |     /// <remarks>Exceptions are handled here and not thrown.</remarks>
1178 |     public static async Task RunREPL(Interp interp, TextReader input = null) {
1179 |         if (input == null)
1180 |             input = Console.In;
1181 |         var reader = new Reader(input);
1182 |         for (;;) {
1183 |             interp.COut.Write("> ");
1184 |             try {
1185 |                 var sExp = await reader.Read();
1186 |                 if (sExp == Reader.EOF)
1187 |                     return;
1188 |                 var x = interp.Eval(sExp, null);
1189 |                 interp.COut.WriteLine(Str(x));
1190 |             } catch (Exception ex) {
1191 |                 interp.COut.WriteLine(ex);
1192 |             }
1193 |         }
1194 |     }
1195 | 
1196 |     /// <summary>Run Read-Eval Loop.</summary>
1197 |     public static async Task<object> Run(Interp interp, TextReader input) {
1198 |         var reader = new Reader(input);
1199 |         object lastResult = Reader.EOF;
1200 |         for (;;) {
1201 |             var sExp = await reader.Read();
1202 |             if (sExp == Reader.EOF)
1203 |                 return lastResult;
1204 |             lastResult = interp.Eval(sExp, null);
1205 |         }
1206 |     }
1207 | 
1208 |     /// <summary>Make a Lisp interpreter initialized with Prelude.</summary>
1209 |     public static async Task<Interp> MakeInterp() {
1210 |         var interp = new Interp();
1211 |         await Run(interp, new StringReader(Prelude));
1212 |         return interp;
1213 |     }
1214 | 
1215 |     static int Main(string[] args) {
1216 |         var interp = MakeInterp().Result;
1217 |         if (args.Length == 0) {
1218 |             args = new string[] {"-"};
1219 |         }
1220 |         foreach (var fileName in args) {
1221 |             if (fileName == "-") {
1222 |                 RunREPL(interp).Wait();
1223 |                 interp.COut.WriteLine("Goodbye");
1224 |             } else {
1225 |                 var input = new StreamReader(fileName);
1226 |                 Run(interp, input).Wait();
1227 |             }
1228 |         }
1229 |         return 0;
1230 |     }
1231 | 
1232 | 
1233 |     /// <summary>Lisp initialization script</summary>
1234 |     public static readonly string Prelude = @"
1235 | (setq defmacro
1236 |       (macro (name args &rest body)
1237 |              `(progn (setq ,name (macro ,args ,@body))
1238 |                      ',name)))
1239 | 
1240 | (defmacro defun (name args &rest body)
1241 |   `(progn (setq ,name (lambda ,args ,@body))
1242 |           ',name))
1243 | 
1244 | (defun caar (x) (car (car x)))
1245 | (defun cadr (x) (car (cdr x)))
1246 | (defun cdar (x) (cdr (car x)))
1247 | (defun cddr (x) (cdr (cdr x)))
1248 | (defun caaar (x) (car (car (car x))))
1249 | (defun caadr (x) (car (car (cdr x))))
1250 | (defun cadar (x) (car (cdr (car x))))
1251 | (defun caddr (x) (car (cdr (cdr x))))
1252 | (defun cdaar (x) (cdr (car (car x))))
1253 | (defun cdadr (x) (cdr (car (cdr x))))
1254 | (defun cddar (x) (cdr (cdr (car x))))
1255 | (defun cdddr (x) (cdr (cdr (cdr x))))
1256 | (defun not (x) (eq x nil))
1257 | (defun consp (x) (not (atom x)))
1258 | (defun print (x) (prin1 x) (terpri) x)
1259 | (defun identity (x) x)
1260 | 
1261 | (setq
1262 |  = eql
1263 |  null not
1264 |  setcar rplaca
1265 |  setcdr rplacd)
1266 | 
1267 | (defun > (x y) (< y x))
1268 | (defun >= (x y) (not (< x y)))
1269 | (defun <= (x y) (not (< y x)))
1270 | (defun /= (x y) (not (= x y)))
1271 | 
1272 | (defun equal (x y)
1273 |   (cond ((atom x) (eql x y))
1274 |         ((atom y) nil)
1275 |         ((equal (car x) (car y)) (equal (cdr x) (cdr y)))))
1276 | 
1277 | (defmacro if (test then &rest else)
1278 |   `(cond (,test ,then)
1279 |          ,@(cond (else `((t ,@else))))))
1280 | 
1281 | (defmacro when (test &rest body)
1282 |   `(cond (,test ,@body)))
1283 | 
1284 | (defmacro let (args &rest body)
1285 |   ((lambda (vars vals)
1286 |      (defun vars (x)
1287 |        (cond (x (cons (if (atom (car x))
1288 |                           (car x)
1289 |                         (caar x))
1290 |                       (vars (cdr x))))))
1291 |      (defun vals (x)
1292 |        (cond (x (cons (if (atom (car x))
1293 |                           nil
1294 |                         (cadar x))
1295 |                       (vals (cdr x))))))
1296 |      `((lambda ,(vars args) ,@body) ,@(vals args)))
1297 |    nil nil))
1298 | 
1299 | (defmacro letrec (args &rest body)      ; (letrec ((v e) ...) body...)
1300 |   (let (vars setqs)
1301 |     (defun vars (x)
1302 |       (cond (x (cons (caar x)
1303 |                      (vars (cdr x))))))
1304 |     (defun sets (x)
1305 |       (cond (x (cons `(setq ,(caar x) ,(cadar x))
1306 |                      (sets (cdr x))))))
1307 |     `(let ,(vars args) ,@(sets args) ,@body)))
1308 | 
1309 | (defun _append (x y)
1310 |   (if (null x)
1311 |       y
1312 |     (cons (car x) (_append (cdr x) y))))
1313 | (defmacro append (x &rest y)
1314 |   (if (null y)
1315 |       x
1316 |     `(_append ,x (append ,@y))))
1317 | 
1318 | (defmacro and (x &rest y)
1319 |   (if (null y)
1320 |       x
1321 |     `(cond (,x (and ,@y)))))
1322 | 
1323 | (defun mapcar (f x)
1324 |   (and x (cons (f (car x)) (mapcar f (cdr x)))))
1325 | 
1326 | (defmacro or (x &rest y)
1327 |   (if (null y)
1328 |       x
1329 |     `(cond (,x)
1330 |            ((or ,@y)))))
1331 | 
1332 | (defun listp (x)
1333 |   (or (null x) (consp x)))    ; NB (listp (lambda (x) (+ x 1))) => nil
1334 | 
1335 | (defun memq (key x)
1336 |   (cond ((null x) nil)
1337 |         ((eq key (car x)) x)
1338 |         (t (memq key (cdr x)))))
1339 | 
1340 | (defun member (key x)
1341 |   (cond ((null x) nil)
1342 |         ((equal key (car x)) x)
1343 |         (t (member key (cdr x)))))
1344 | 
1345 | (defun assq (key alist)
1346 |   (cond (alist (let ((e (car alist)))
1347 |                  (if (and (consp e) (eq key (car e)))
1348 |                      e
1349 |                    (assq key (cdr alist)))))))
1350 | 
1351 | (defun assoc (key alist)
1352 |   (cond (alist (let ((e (car alist)))
1353 |                  (if (and (consp e) (equal key (car e)))
1354 |                      e
1355 |                    (assoc key (cdr alist)))))))
1356 | 
1357 | (defun _nreverse (x prev)
1358 |   (let ((next (cdr x)))
1359 |     (setcdr x prev)
1360 |     (if (null next)
1361 |         x
1362 |       (_nreverse next x))))
1363 | (defun nreverse (list)            ; (nreverse '(a b c d)) => (d c b a)
1364 |   (cond (list (_nreverse list nil))))
1365 | 
1366 | (defun last (list)
1367 |   (if (atom (cdr list))
1368 |       list
1369 |     (last (cdr list))))
1370 | 
1371 | (defun nconc (&rest lists)
1372 |   (if (null (cdr lists))
1373 |       (car lists)
1374 |     (if (null (car lists))
1375 |         (apply nconc (cdr lists))
1376 |       (setcdr (last (car lists))
1377 |               (apply nconc (cdr lists)))
1378 |       (car lists))))
1379 | 
1380 | (defmacro while (test &rest body)
1381 |   (let ((loop (gensym)))
1382 |     `(letrec ((,loop (lambda () (cond (,test ,@body (,loop))))))
1383 |        (,loop))))
1384 | 
1385 | (defmacro dolist (spec &rest body) ; (dolist (name list [result]) body...)
1386 |   (let ((name (car spec))
1387 |         (list (gensym)))
1388 |     `(let (,name
1389 |            (,list ,(cadr spec)))
1390 |        (while ,list
1391 |          (setq ,name (car ,list))
1392 |          ,@body
1393 |          (setq ,list (cdr ,list)))
1394 |        ,@(if (cddr spec)
1395 |              `((setq ,name nil)
1396 |                ,(caddr spec))))))
1397 | 
1398 | (defmacro dotimes (spec &rest body) ; (dotimes (name count [result]) body...)
1399 |   (let ((name (car spec))
1400 |         (count (gensym)))
1401 |     `(let ((,name 0)
1402 |            (,count ,(cadr spec)))
1403 |        (while (< ,name ,count)
1404 |          ,@body
1405 |          (setq ,name (+ ,name 1)))
1406 |        ,@(if (cddr spec)
1407 |              `(,(caddr spec))))))
1408 | ";
1409 | }
1410 | 


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