|
@@ -19,35 +19,33 @@
|
|
#include "bestline.h"
|
|
#include "bestline.h"
|
|
|
|
|
|
#ifndef __COSMOPOLITAN__
|
|
#ifndef __COSMOPOLITAN__
|
|
-#include <ctype.h>
|
|
|
|
#include <stdio.h>
|
|
#include <stdio.h>
|
|
-#include <stdlib.h>
|
|
|
|
-#include <string.h>
|
|
|
|
#include <locale.h>
|
|
#include <locale.h>
|
|
-#include <limits.h>
|
|
|
|
#include <setjmp.h>
|
|
#include <setjmp.h>
|
|
#endif
|
|
#endif
|
|
|
|
|
|
|
|
+#define var int
|
|
|
|
+#define function
|
|
#define Null 0100000
|
|
#define Null 0100000
|
|
|
|
|
|
|
|
+var M[Null * 2];
|
|
jmp_buf undefined;
|
|
jmp_buf undefined;
|
|
-int cx, dx, M[Null * 2];
|
|
|
|
-int kT, kEq, kCar, kCdr, kCond, kAtom, kCons, kQuote;
|
|
|
|
-char *line = "NIL T CAR CDR ATOM COND CONS QUOTE EQ ";
|
|
|
|
|
|
|
|
-Set(i, x) {
|
|
|
|
|
|
+var cx, dx, kT, kEq, kCar, kCdr, kCond, kAtom, kCons, kQuote;
|
|
|
|
+
|
|
|
|
+function Set(i, x) {
|
|
M[Null + i] = x;
|
|
M[Null + i] = x;
|
|
}
|
|
}
|
|
|
|
|
|
-Get(i) {
|
|
|
|
|
|
+function Get(i) {
|
|
return M[Null + i];
|
|
return M[Null + i];
|
|
}
|
|
}
|
|
|
|
|
|
-Hash(h, c) {
|
|
|
|
|
|
+function Hash(h, c) {
|
|
return h + c * 2;
|
|
return h + c * 2;
|
|
}
|
|
}
|
|
|
|
|
|
-Intern(x, y, i) {
|
|
|
|
|
|
+function Intern(x, y, i) {
|
|
i &= Null - 1;
|
|
i &= Null - 1;
|
|
if (x == Get(i) && y == Get(i + 1)) return i;
|
|
if (x == Get(i) && y == Get(i + 1)) return i;
|
|
if (Get(i)) return Intern(x, y, i + 2);
|
|
if (Get(i)) return Intern(x, y, i + 2);
|
|
@@ -56,35 +54,35 @@ Intern(x, y, i) {
|
|
return i;
|
|
return i;
|
|
}
|
|
}
|
|
|
|
|
|
-ReadAtom(h) {
|
|
|
|
- int c = ReadChar();
|
|
|
|
|
|
+function ReadAtom(h) {
|
|
|
|
+ var c = ReadChar();
|
|
if (c <= 32) return ReadAtom(h);
|
|
if (c <= 32) return ReadAtom(h);
|
|
return Intern(c, c > 41 && dx > 41 ?
|
|
return Intern(c, c > 41 && dx > 41 ?
|
|
ReadAtom(Hash(h, c)) : 0,
|
|
ReadAtom(Hash(h, c)) : 0,
|
|
Hash(h, c) - Hash(0, 78));
|
|
Hash(h, c) - Hash(0, 78));
|
|
}
|
|
}
|
|
|
|
|
|
-PrintAtom(x) {
|
|
|
|
|
|
+function PrintAtom(x) {
|
|
do PrintChar(Get(x));
|
|
do PrintChar(Get(x));
|
|
while ((x = Get(x + 1)));
|
|
while ((x = Get(x + 1)));
|
|
}
|
|
}
|
|
|
|
|
|
-AddList(x) {
|
|
|
|
|
|
+function AddList(x) {
|
|
return Cons(x, ReadList());
|
|
return Cons(x, ReadList());
|
|
}
|
|
}
|
|
|
|
|
|
-ReadList() {
|
|
|
|
- int t = ReadAtom(0);
|
|
|
|
|
|
+function ReadList() {
|
|
|
|
+ var t = ReadAtom(0);
|
|
if (Get(t) == 41) return 0;
|
|
if (Get(t) == 41) return 0;
|
|
return AddList(ReadObject(t));
|
|
return AddList(ReadObject(t));
|
|
}
|
|
}
|
|
|
|
|
|
-ReadObject(t) {
|
|
|
|
|
|
+function ReadObject(t) {
|
|
if (Get(t) != 40) return t;
|
|
if (Get(t) != 40) return t;
|
|
return ReadList();
|
|
return ReadList();
|
|
}
|
|
}
|
|
|
|
|
|
-PrintList(x) {
|
|
|
|
|
|
+function PrintList(x) {
|
|
PrintChar(40);
|
|
PrintChar(40);
|
|
if (x < 0) {
|
|
if (x < 0) {
|
|
PrintObject(Car(x));
|
|
PrintObject(Car(x));
|
|
@@ -102,7 +100,7 @@ PrintList(x) {
|
|
PrintChar(41);
|
|
PrintChar(41);
|
|
}
|
|
}
|
|
|
|
|
|
-PrintObject(x) {
|
|
|
|
|
|
+function PrintObject(x) {
|
|
if (1./x < 0) {
|
|
if (1./x < 0) {
|
|
PrintList(x);
|
|
PrintList(x);
|
|
} else {
|
|
} else {
|
|
@@ -110,77 +108,77 @@ PrintObject(x) {
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
-Print(e) {
|
|
|
|
|
|
+function Print(e) {
|
|
PrintObject(e);
|
|
PrintObject(e);
|
|
PrintChar(10);
|
|
PrintChar(10);
|
|
}
|
|
}
|
|
|
|
|
|
-Read() {
|
|
|
|
|
|
+function Read() {
|
|
return ReadObject(ReadAtom(0));
|
|
return ReadObject(ReadAtom(0));
|
|
}
|
|
}
|
|
|
|
|
|
-Car(x) {
|
|
|
|
|
|
+function Car(x) {
|
|
if (x < 0) {
|
|
if (x < 0) {
|
|
return Get(x);
|
|
return Get(x);
|
|
} else {
|
|
} else {
|
|
- longjmp(undefined, x);
|
|
|
|
|
|
+ Throw(x);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
-Cdr(x) {
|
|
|
|
|
|
+function Cdr(x) {
|
|
if (x < 0) {
|
|
if (x < 0) {
|
|
return Get(x + 1);
|
|
return Get(x + 1);
|
|
} else {
|
|
} else {
|
|
- longjmp(undefined, x);
|
|
|
|
|
|
+ Throw(x);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
-Cons(car, cdr) {
|
|
|
|
|
|
+function Cons(car, cdr) {
|
|
Set(--cx, cdr);
|
|
Set(--cx, cdr);
|
|
Set(--cx, car);
|
|
Set(--cx, car);
|
|
return cx;
|
|
return cx;
|
|
}
|
|
}
|
|
|
|
|
|
-Gc(A, x) {
|
|
|
|
- int C, B = cx;
|
|
|
|
|
|
+function Gc(A, x) {
|
|
|
|
+ var C, B = cx;
|
|
x = Copy(x, A, A - B), C = cx;
|
|
x = Copy(x, A, A - B), C = cx;
|
|
while (C < B) Set(--A, Get(--B));
|
|
while (C < B) Set(--A, Get(--B));
|
|
cx = A;
|
|
cx = A;
|
|
return x;
|
|
return x;
|
|
}
|
|
}
|
|
|
|
|
|
-Copy(x, m, k) {
|
|
|
|
|
|
+function Copy(x, m, k) {
|
|
return x < m ? Cons(Copy(Car(x), m, k),
|
|
return x < m ? Cons(Copy(Car(x), m, k),
|
|
Copy(Cdr(x), m, k)) + k : x;
|
|
Copy(Cdr(x), m, k)) + k : x;
|
|
}
|
|
}
|
|
|
|
|
|
-Evlis(m, a) {
|
|
|
|
|
|
+function Evlis(m, a) {
|
|
return m ? Cons(Eval(Car(m), a),
|
|
return m ? Cons(Eval(Car(m), a),
|
|
Evlis(Cdr(m), a)) : 0;
|
|
Evlis(Cdr(m), a)) : 0;
|
|
}
|
|
}
|
|
|
|
|
|
-Pairlis(x, y, a) {
|
|
|
|
|
|
+function Pairlis(x, y, a) {
|
|
return x ? Cons(Cons(Car(x), Car(y)),
|
|
return x ? Cons(Cons(Car(x), Car(y)),
|
|
Pairlis(Cdr(x), Cdr(y), a)) : a;
|
|
Pairlis(Cdr(x), Cdr(y), a)) : a;
|
|
}
|
|
}
|
|
|
|
|
|
-Assoc(x, y) {
|
|
|
|
- if (y >= 0) longjmp(undefined, x);
|
|
|
|
|
|
+function Assoc(x, y) {
|
|
|
|
+ if (y >= 0) Throw(x);
|
|
if (x == Car(Car(y))) return Cdr(Car(y));
|
|
if (x == Car(Car(y))) return Cdr(Car(y));
|
|
return Assoc(x, Cdr(y));
|
|
return Assoc(x, Cdr(y));
|
|
}
|
|
}
|
|
|
|
|
|
-Evcon(c, a) {
|
|
|
|
|
|
+function Evcon(c, a) {
|
|
if (Eval(Car(Car(c)), a)) {
|
|
if (Eval(Car(Car(c)), a)) {
|
|
return Eval(Car(Cdr(Car(c))), a);
|
|
return Eval(Car(Cdr(Car(c))), a);
|
|
} else if (Cdr(c)) {
|
|
} else if (Cdr(c)) {
|
|
return Evcon(Cdr(c), a);
|
|
return Evcon(Cdr(c), a);
|
|
} else {
|
|
} else {
|
|
- longjmp(undefined, c);
|
|
|
|
|
|
+ Throw(c);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
-Apply(f, x, a) {
|
|
|
|
|
|
+function Apply(f, x, a) {
|
|
if (f < 0) return Eval(Car(Cdr(Cdr(f))), Pairlis(Car(Cdr(f)), x, a));
|
|
if (f < 0) return Eval(Car(Cdr(Cdr(f))), Pairlis(Car(Cdr(f)), x, a));
|
|
if (f == kEq) return Car(x) == Car(Cdr(x)) ? kT : 0;
|
|
if (f == kEq) return Car(x) == Car(Cdr(x)) ? kT : 0;
|
|
if (f == kCons) return Cons(Car(x), Car(Cdr(x)));
|
|
if (f == kCons) return Cons(Car(x), Car(Cdr(x)));
|
|
@@ -190,8 +188,8 @@ Apply(f, x, a) {
|
|
return Apply(Assoc(f, a), x, a);
|
|
return Apply(Assoc(f, a), x, a);
|
|
}
|
|
}
|
|
|
|
|
|
-Eval(e, a) {
|
|
|
|
- int A = cx;
|
|
|
|
|
|
+function Eval(e, a) {
|
|
|
|
+ var A = cx;
|
|
if (!e) return 0;
|
|
if (!e) return 0;
|
|
if (e > 0) return Assoc(e, a);
|
|
if (e > 0) return Assoc(e, a);
|
|
if (Car(e) == kQuote) return Car(Cdr(e));
|
|
if (Car(e) == kQuote) return Car(Cdr(e));
|
|
@@ -203,8 +201,8 @@ Eval(e, a) {
|
|
return Gc(A, e);
|
|
return Gc(A, e);
|
|
}
|
|
}
|
|
|
|
|
|
-Lisp() {
|
|
|
|
- int x, a;
|
|
|
|
|
|
+function Lisp() {
|
|
|
|
+ var x, a;
|
|
ReadAtom(0);
|
|
ReadAtom(0);
|
|
kT = ReadAtom(0);
|
|
kT = ReadAtom(0);
|
|
kCar = ReadAtom(0);
|
|
kCar = ReadAtom(0);
|
|
@@ -228,6 +226,10 @@ Lisp() {
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
|
|
+Throw(x) {
|
|
|
|
+ longjmp(undefined, x);
|
|
|
|
+}
|
|
|
|
+
|
|
PrintChar(b) {
|
|
PrintChar(b) {
|
|
fputwc(b, stdout);
|
|
fputwc(b, stdout);
|
|
}
|
|
}
|
|
@@ -235,6 +237,7 @@ PrintChar(b) {
|
|
ReadChar() {
|
|
ReadChar() {
|
|
int b, c, t;
|
|
int b, c, t;
|
|
static char *freeme;
|
|
static char *freeme;
|
|
|
|
+ static char *line = "NIL T CAR CDR ATOM COND CONS QUOTE EQ ";
|
|
if (line || (line = freeme = bestlineWithHistory("* ", "sectorlisp"))) {
|
|
if (line || (line = freeme = bestlineWithHistory("* ", "sectorlisp"))) {
|
|
if (*line) {
|
|
if (*line) {
|
|
c = *line++ & 0377;
|
|
c = *line++ & 0377;
|