sjs/sectorlisp
1
0
Fork 0
mirror of https://github.com/samsonjs/sectorlisp.git synced 2026-04-27 14:57:41 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Make interning better

Browse source
This commit is contained in:
Justine Tunney 2021-11-29 02:52:33 -08:00
parent 626f71b9a3
commit 51d469be88
1 changed files with 57 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

100
lisp.c
View file

@ -28,25 +28,27 @@
#include <setjmp.h> #include <setjmp.h>
#endif #endif
jmp_buf undefined; #define Null 0100000
int cx, dx, M[0100000];
int Null = sizeof(M) / sizeof(M[0]) / 2;
char *line = "NIL T CAR CDR ATOM COND CONS QUOTE EQ ";
int kT, kEq, kNil, kCar, kCdr, kCond, kAtom, kCons, kQuote;
Get(i) { jmp_buf undefined;
return M[Null + i]; 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) { Set(i, x) {
M[Null + i] = x; M[Null + i] = x;
} }
Read() { Get(i) {
return ReadObject(ReadAtom(0)); return M[Null + i];
}
Hash(h, c) {
return h + c * 2;
} }
Intern(x, y, i) { Intern(x, y, i) {
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);
Set(i, x); Set(i, x);
@ -54,10 +56,17 @@ Intern(x, y, i) {
return i; return i;
} }
ReadAtom(i) { ReadAtom(h) {
int c = ReadChar(); int c = ReadChar();
if (c <= ' ') return ReadAtom(i); if (c <= 32) return ReadAtom(h);
return Intern(c, c > ')' && dx > ')' ? ReadAtom(0) : 0, i + c * 2); return Intern(c, c > 41 && dx > 41 ?
ReadAtom(Hash(h, c)) : 0,
Hash(h, c) - Hash(0, 78));
}
PrintAtom(x) {
do PrintChar(Get(x));
while ((x = Get(x + 1)));
} }
AddList(x) { AddList(x) {
@ -66,36 +75,31 @@ AddList(x) {
ReadList() { ReadList() {
int t = ReadAtom(0); int t = ReadAtom(0);
if (Get(t) == ')') return kNil; if (Get(t) == 41) return 0;
return AddList(ReadObject(t)); return AddList(ReadObject(t));
} }
ReadObject(t) { ReadObject(t) {
if (Get(t) != '(') return t; if (Get(t) != 40) return t;
return ReadList(); return ReadList();
} }
PrintAtom(x) {
do PrintChar(Get(x));
while ((x = Get(x + 1)));
}
PrintList(x) { PrintList(x) {
PrintChar('('); PrintChar(40);
if (x < 0) { if (x < 0) {
PrintObject(Car(x)); PrintObject(Car(x));
while ((x = Cdr(x)) != kNil) { while ((x = Cdr(x))) {
if (x < 0) { if (x < 0) {
PrintChar(' '); PrintChar(32);
PrintObject(Car(x)); PrintObject(Car(x));
} else { } else {
PrintChar(L'∙'); PrintChar(8729);
PrintObject(x); PrintObject(x);
break; break;
} }
} }
} }
PrintChar(')'); PrintChar(41);
} }
PrintObject(x) { PrintObject(x) {
@ -108,7 +112,11 @@ PrintObject(x) {
Print(e) { Print(e) {
PrintObject(e); PrintObject(e);
PrintChar('\n'); PrintChar(10);
}
Read() {
return ReadObject(ReadAtom(0));
} }
Car(x) { Car(x) {
@ -147,13 +155,13 @@ Copy(x, m, k) {
} }
Evlis(m, a) { Evlis(m, a) {
return m != kNil ? Cons(Eval(Car(m), a), return m ? Cons(Eval(Car(m), a),
Evlis(Cdr(m), a)) : kNil; Evlis(Cdr(m), a)) : 0;
} }
Pairlis(x, y, a) { Pairlis(x, y, a) {
return x != kNil ? 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) { Assoc(x, y) {
@ -163,9 +171,9 @@ Assoc(x, y) {
} }
Evcon(c, a) { Evcon(c, a) {
if (Eval(Car(Car(c)), a) != kNil) { if (Eval(Car(Car(c)), a)) {
return Eval(Car(Cdr(Car(c))), a); return Eval(Car(Cdr(Car(c))), a);
} else if (Cdr(c) != kNil) { } else if (Cdr(c)) {
return Evcon(Cdr(c), a); return Evcon(Cdr(c), a);
} else { } else {
longjmp(undefined, c); longjmp(undefined, c);
@ -174,9 +182,9 @@ Evcon(c, a) {
Apply(f, x, a) { 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 : kNil; 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)));
if (f == kAtom) return Car(x) < 0 ? kNil : kT; if (f == kAtom) return Car(x) < 0 ? 0 : kT;
if (f == kCar) return Car(Car(x)); if (f == kCar) return Car(Car(x));
if (f == kCdr) return Cdr(Car(x)); if (f == kCdr) return Cdr(Car(x));
return Apply(Assoc(f, a), x, a); return Apply(Assoc(f, a), x, a);
@ -184,8 +192,8 @@ Apply(f, x, a) {
Eval(e, a) { Eval(e, a) {
int A = cx; int A = cx;
if (e == kNil) return kNil; 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));
if (Car(e) == kCond) { if (Car(e) == kCond) {
e = Evcon(Cdr(e), a); e = Evcon(Cdr(e), a);
@ -195,11 +203,9 @@ Eval(e, a) {
return Gc(A, e); return Gc(A, e);
} }
main() { Lisp() {
int x, a; int x, a;
setlocale(LC_ALL, ""); ReadAtom(0);
bestlineSetXlatCallback(bestlineUppercase);
kNil = ReadAtom(0);
kT = ReadAtom(0); kT = ReadAtom(0);
kCar = ReadAtom(0); kCar = ReadAtom(0);
kCdr = ReadAtom(0); kCdr = ReadAtom(0);
@ -208,7 +214,7 @@ main() {
kCons = ReadAtom(0); kCons = ReadAtom(0);
kQuote = ReadAtom(0); kQuote = ReadAtom(0);
kEq = ReadAtom(0); kEq = ReadAtom(0);
for (a = kNil;;) { for (a = 0;;) {
if (!(x = setjmp(undefined))) { if (!(x = setjmp(undefined))) {
x = Read(); x = Read();
x = Eval(x, a); x = Eval(x, a);
@ -216,7 +222,7 @@ main() {
a = Cons(x, a); a = Cons(x, a);
} }
} else { } else {
PrintChar('?'); PrintChar(63);
} }
Print(x); Print(x);
} }
@ -243,13 +249,19 @@ ReadChar() {
free(freeme); free(freeme);
freeme = 0; freeme = 0;
line = 0; line = 0;
c = '\n'; c = 10;
} }
t = dx; t = dx;
dx = c; dx = c;
return t; return t;
} else { } else {
PrintChar('\n'); PrintChar(10);
exit(0); exit(0);
} }
} }
main() {
setlocale(LC_ALL, "");
bestlineSetXlatCallback(bestlineUppercase);
Lisp();
}