sjs/sectorlisp
1
0
Fork 0
mirror of https://github.com/samsonjs/sectorlisp.git synced 2026-03-25 09:05:48 +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) {
var c = ReadChar();
if (c <= 32) return ReadAtom(h);
return Intern(c, c > 41 && dx > 41 ?
if (c <= Ord(' ')) return ReadAtom(h);
return Intern(c, c > Ord(')') && dx > Ord(')') ?
ReadAtom(Hash(h, c)) : 0,
Hash(h, c) - Hash(0, 78));
Hash(h, c) - Hash(0, Ord('N')));
}
function PrintAtom(x) {
@ -73,31 +73,31 @@ function AddList(x) {
function ReadList() {
var t = ReadAtom(0);
if (Get(t) == 41) return 0;
if (Get(t) == Ord(')')) return -0;
return AddList(ReadObject(t));
}
function ReadObject(t) {
if (Get(t) != 40) return t;
if (Get(t) != Ord('(')) return t;
return ReadList();
}
function PrintList(x) {
PrintChar(40);
PrintChar(Ord('('));
if (x < 0) {
PrintObject(Car(x));
while ((x = Cdr(x))) {
if (x < 0) {
PrintChar(32);
PrintChar(Ord(' '));
PrintObject(Car(x));
} else {
PrintChar(8729);
PrintChar(0x2219);
PrintObject(x);
break;
}
}
}
PrintChar(41);
PrintChar(Ord(')'));
}
function PrintObject(x) {
@ -110,7 +110,7 @@ function PrintObject(x) {
function Print(e) {
PrintObject(e);
PrintChar(10);
PrintChar(Ord('\n'));
}
function Read() {
@ -154,7 +154,7 @@ function Copy(x, m, k) {
function Evlis(m, a) {
return m ? Cons(Eval(Car(m), a),
Evlis(Cdr(m), a)) : 0;
Evlis(Cdr(m), a)) : m;
}
function Pairlis(x, y, a) {
@ -226,6 +226,10 @@ function Lisp() {
}
}
Ord(c) {
return c;
}
Throw(x) {
longjmp(undefined, x);
}
@ -252,13 +256,13 @@ ReadChar() {
free(freeme);
freeme = 0;
line = 0;
c = 10;
c = Ord('\n');
}
t = dx;
dx = c;
return t;
} else {
PrintChar(10);
PrintChar(Ord('\n'));
exit(0);
}
}

32
lisp.lisp
View file

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