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 it friendlier

Browse source
This commit is contained in:
Justine Tunney 2021-11-29 10:05:05 -08:00
parent 512b1a5b87
commit 0f6b147099
2 changed files with 35 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
lisp.c
View file

@ -56,10 +56,10 @@ function Intern(x, y, i) {
function ReadAtom(h) { function ReadAtom(h) {
var c = ReadChar(); var c = ReadChar();
if (c <= 32) return ReadAtom(h); if (c <= Ord(' ')) return ReadAtom(h);
return Intern(c, c > 41 && dx > 41 ? return Intern(c, c > Ord(')') && dx > Ord(')') ?
ReadAtom(Hash(h, c)) : 0, ReadAtom(Hash(h, c)) : 0,
Hash(h, c) - Hash(0, 78)); Hash(h, c) - Hash(0, Ord('N')));
} }
function PrintAtom(x) { function PrintAtom(x) {
@ -73,31 +73,31 @@ function AddList(x) {
function ReadList() { function ReadList() {
var t = ReadAtom(0); var t = ReadAtom(0);
if (Get(t) == 41) return 0; if (Get(t) == Ord(')')) return -0;
return AddList(ReadObject(t)); return AddList(ReadObject(t));
} }
function ReadObject(t) { function ReadObject(t) {
if (Get(t) != 40) return t; if (Get(t) != Ord('(')) return t;
return ReadList(); return ReadList();
} }
function PrintList(x) { function PrintList(x) {
PrintChar(40); PrintChar(Ord('('));
if (x < 0) { if (x < 0) {
PrintObject(Car(x)); PrintObject(Car(x));
while ((x = Cdr(x))) { while ((x = Cdr(x))) {
if (x < 0) { if (x < 0) {
PrintChar(32); PrintChar(Ord(' '));
PrintObject(Car(x)); PrintObject(Car(x));
} else { } else {
PrintChar(8729); PrintChar(0x2219);
PrintObject(x); PrintObject(x);
break; break;
} }
} }
} }
PrintChar(41); PrintChar(Ord(')'));
} }
function PrintObject(x) { function PrintObject(x) {
@ -110,7 +110,7 @@ function PrintObject(x) {
function Print(e) { function Print(e) {
PrintObject(e); PrintObject(e);
PrintChar(10); PrintChar(Ord('\n'));
} }
function Read() { function Read() {
@ -154,7 +154,7 @@ function Copy(x, m, k) {
function 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)) : m;
} }
function Pairlis(x, y, a) { function Pairlis(x, y, a) {
@ -226,6 +226,10 @@ function Lisp() {
} }
} }
Ord(c) {
return c;
}
Throw(x) { Throw(x) {
longjmp(undefined, x); longjmp(undefined, x);
} }
@ -252,13 +256,13 @@ ReadChar() {
free(freeme); free(freeme);
freeme = 0; freeme = 0;
line = 0; line = 0;
c = 10; c = Ord('\n');
} }
t = dx; t = dx;
dx = c; dx = c;
return t; return t;
} else { } else {
PrintChar(10); PrintChar(Ord('\n'));
exit(0); exit(0);
} }
} }

32
lisp.lisp
View file

@ -61,7 +61,8 @@ NIL
;; FIND FIRST ATOM IN TREE ;; FIND FIRST ATOM IN TREE
;; CORRECT RESULT OF EXPRESSION IS `A` ;; CORRECT RESULT OF EXPRESSION IS `A`
;; RECURSIVE CONDITIONAL FUNCTION BINDING ;; RECURSIVE CONDITIONAL FUNCTION BINDING
((LAMBDA (FF X) (FF X)) ((LAMBDA (FF X)
(FF X))
(QUOTE (LAMBDA (X) (QUOTE (LAMBDA (X)
(COND ((ATOM X) X) (COND ((ATOM X) X)
((QUOTE T) (FF (CAR X)))))) ((QUOTE T) (FF (CAR X))))))
@ -76,28 +77,27 @@ NIL
;; NOTE: ((EQ (CAR E) ()) (QUOTE *UNDEFINED)) CAN HELP ;; NOTE: ((EQ (CAR E) ()) (QUOTE *UNDEFINED)) CAN HELP
;; NOTE: ((EQ (CAR E) (QUOTE LAMBDA)) E) IS NICE ;; NOTE: ((EQ (CAR E) (QUOTE LAMBDA)) E) IS NICE
((LAMBDA (ASSOC EVCON PAIRLIS EVLIS APPLY EVAL) ((LAMBDA (ASSOC EVCON PAIRLIS EVLIS APPLY EVAL)
(EVAL (QUOTE ((LAMBDA (FF X) (FF X)) (EVAL (QUOTE ((LAMBDA (FF X)
(QUOTE (LAMBDA (X) (FF X))
(COND ((ATOM X) X) (LAMBDA (X)
((QUOTE T) (FF (CAR X)))))) (COND ((ATOM X) X)
(T (FF (CAR X)))))
(QUOTE ((A) B C)))) (QUOTE ((A) B C))))
())) NIL))
(QUOTE (LAMBDA (X Y) (QUOTE (LAMBDA (X Y)
(COND ((EQ Y ()) ()) (COND ((EQ Y NIL) (QUOTE *UNDEFINED))
((EQ X (CAR (CAR Y))) ((EQ X (CAR (CAR Y))) (CDR (CAR Y)))
(CDR (CAR Y))) ((QUOTE T) (ASSOC X (CDR Y))))))
((QUOTE T)
(ASSOC X (CDR Y))))))
(QUOTE (LAMBDA (C A) (QUOTE (LAMBDA (C A)
(COND ((EVAL (CAR (CAR C)) A) (COND ((EVAL (CAR (CAR C)) A)
(EVAL (CAR (CDR (CAR C))) A)) (EVAL (CAR (CDR (CAR C))) A))
((QUOTE T) (EVCON (CDR C) A))))) ((QUOTE T) (EVCON (CDR C) A)))))
(QUOTE (LAMBDA (X Y A) (QUOTE (LAMBDA (X Y A)
(COND ((EQ X ()) A) (COND ((EQ X NIL) A)
((QUOTE T) (CONS (CONS (CAR X) (CAR Y)) ((QUOTE T) (CONS (CONS (CAR X) (CAR Y))
(PAIRLIS (CDR X) (CDR Y) A)))))) (PAIRLIS (CDR X) (CDR Y) A))))))
(QUOTE (LAMBDA (M A) (QUOTE (LAMBDA (M A)
(COND ((EQ M ()) ()) (COND ((EQ M NIL) M)
((QUOTE T) (CONS (EVAL (CAR M) A) ((QUOTE T) (CONS (EVAL (CAR M) A)
(EVLIS (CDR M) A)))))) (EVLIS (CDR M) A))))))
(QUOTE (LAMBDA (FN X A) (QUOTE (LAMBDA (FN X A)
@ -114,10 +114,14 @@ NIL
(PAIRLIS (CAR (CDR FN)) X A)))))) (PAIRLIS (CAR (CDR FN)) X A))))))
(QUOTE (LAMBDA (E A) (QUOTE (LAMBDA (E A)
(COND (COND
((ATOM E) (ASSOC E A)) ((ATOM E)
(COND ((EQ E NIL) E)
((EQ E (QUOTE T)) (QUOTE T))
((QUOTE T) (ASSOC E A))))
((ATOM (CAR E)) ((ATOM (CAR E))
(COND ((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E))) (COND ((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E)))
((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A)) ((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A))
((EQ (CAR E) (QUOTE LAMBDA)) E)
((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A)))) ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))
((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A)))))) ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))))