2581 lines
56 KiB
Plaintext
2581 lines
56 KiB
Plaintext
// -------------------------------------------------------------
|
|
//
|
|
// njlisp.nj -- Ninja LISP
|
|
//
|
|
// This is a re-implementation of the old muLISP-80 system,
|
|
// developed in 1980 by Albert D. Rich and David Stoutemyer
|
|
// of The Soft Warehouse in Honolulu, Hawaii.
|
|
//
|
|
// -------------------------------------------------------------
|
|
|
|
// -------------------------------------------------------------
|
|
// Cell Definition
|
|
// -------------------------------------------------------------
|
|
|
|
type Cell = record {
|
|
Integer typ; // one of NAME, NUMBER, or NODE
|
|
Cell car; // valid for typ in { NAME, NUMBER, NODE }
|
|
// typ = NAME : the name's value
|
|
// typ = NUMBER : the number itself
|
|
// typ = NODE : the node's left subtree
|
|
Cell cdr; // valid for typ in { NAME, NUMBER, NODE }
|
|
// typ = NAME : the name's property list
|
|
// typ = NUMBER : the number's sign
|
|
// typ = NODE : the node's right subtree
|
|
Cell func; // valid only for typ = NAME
|
|
// the name's functional binding
|
|
String name; // valid only for typ = NAME
|
|
// the name's external representation
|
|
Integer val; // valid only for typ = NUMBER
|
|
// the number's value (signed integer)
|
|
};
|
|
|
|
// -------------------------------------------------------------
|
|
// Global Constants
|
|
// -------------------------------------------------------------
|
|
|
|
global Integer NAME; // name cell
|
|
global Integer NUMBER; // number cell
|
|
global Integer NODE; // node cell
|
|
|
|
global Boolean[] RAS; // ratom separator character
|
|
global Boolean[] RAB; // ratom break character
|
|
global Boolean[] RES; // read separator character
|
|
global Boolean[] REB; // read break character
|
|
global Boolean[] OSP; // other special character (% and ")
|
|
|
|
// -------------------------------------------------------------
|
|
// Global Variables
|
|
// -------------------------------------------------------------
|
|
|
|
global Cell objectList;
|
|
global Cell argStack;
|
|
|
|
global Cell nilAtom;
|
|
global Cell tAtom;
|
|
global Cell subrAtom;
|
|
global Cell nsubrAtom;
|
|
global Cell lambdaAtom;
|
|
global Cell nlambdaAtom;
|
|
global Cell carAtom;
|
|
global Cell cdrAtom;
|
|
global Cell caarAtom;
|
|
global Cell cadrAtom;
|
|
global Cell cdarAtom;
|
|
global Cell cddrAtom;
|
|
global Cell caaarAtom;
|
|
global Cell caadrAtom;
|
|
global Cell cadarAtom;
|
|
global Cell caddrAtom;
|
|
global Cell cdaarAtom;
|
|
global Cell cdadrAtom;
|
|
global Cell cddarAtom;
|
|
global Cell cdddrAtom;
|
|
global Cell consAtom;
|
|
global Cell listAtom;
|
|
global Cell reverseAtom;
|
|
global Cell oblistAtom;
|
|
global Cell rplacaAtom;
|
|
global Cell rplacdAtom;
|
|
global Cell nconcAtom;
|
|
global Cell nameAtom;
|
|
global Cell numberpAtom;
|
|
global Cell atomAtom;
|
|
global Cell nullAtom;
|
|
global Cell pluspAtom;
|
|
global Cell minuspAtom;
|
|
global Cell zeropAtom;
|
|
global Cell evenAtom;
|
|
global Cell eqAtom;
|
|
global Cell equalAtom;
|
|
global Cell memberAtom;
|
|
global Cell greaterpAtom;
|
|
global Cell lesspAtom;
|
|
global Cell orderpAtom;
|
|
global Cell orderedAtom;
|
|
global Cell notAtom;
|
|
global Cell andAtom;
|
|
global Cell orAtom;
|
|
global Cell setAtom;
|
|
global Cell setqAtom;
|
|
global Cell popAtom;
|
|
global Cell pushAtom;
|
|
global Cell assocAtom;
|
|
global Cell getAtom;
|
|
global Cell putAtom;
|
|
global Cell rempropAtom;
|
|
global Cell flagpAtom;
|
|
global Cell flagAtom;
|
|
global Cell remflagAtom;
|
|
global Cell getdAtom;
|
|
global Cell putdAtom;
|
|
global Cell movdAtom;
|
|
global Cell packAtom;
|
|
global Cell unpackAtom;
|
|
global Cell lengthAtom;
|
|
global Cell minusAtom;
|
|
global Cell plusAtom;
|
|
global Cell differenceAtom;
|
|
global Cell timesAtom;
|
|
global Cell quotientAtom;
|
|
global Cell remainderAtom;
|
|
global Cell divideAtom;
|
|
global Cell rdsAtom;
|
|
global Cell ratomAtom;
|
|
global Cell readAtom;
|
|
global Cell readchAtom;
|
|
global Cell echoAtom;
|
|
global Cell wrsAtom;
|
|
global Cell printAtom;
|
|
global Cell prin1Atom;
|
|
global Cell terpriAtom;
|
|
global Cell spacesAtom;
|
|
global Cell linelengthAtom;
|
|
global Cell radixAtom;
|
|
global Cell quoteAtom;
|
|
global Cell evalAtom;
|
|
global Cell applyAtom;
|
|
global Cell condAtom;
|
|
global Cell loopAtom;
|
|
global Cell prog1Atom;
|
|
global Cell driverAtom;
|
|
global Cell reclaimAtom;
|
|
global Cell saveAtom;
|
|
global Cell loadAtom;
|
|
global Cell systemAtom;
|
|
global Cell xchgpnameAtom;
|
|
global Cell purgenameAtom;
|
|
|
|
global Integer cursPos;
|
|
global Integer lineLen;
|
|
global Integer numBase;
|
|
|
|
// -------------------------------------------------------------
|
|
// Debugging
|
|
// -------------------------------------------------------------
|
|
|
|
void debug(Integer n) {
|
|
writeString("DEBUG: ");
|
|
writeInteger(n);
|
|
writeString("\n");
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// Library Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Boolean isAlpha(Character ch) {
|
|
return ch >= 'A' && ch <= 'Z' ||
|
|
ch >= 'a' && ch <= 'z';
|
|
}
|
|
|
|
Boolean isDigit(Character ch) {
|
|
return ch >= '0' && ch <= '9';
|
|
}
|
|
|
|
Character toLower(Character ch) {
|
|
if (ch >= 'A' && ch <= 'Z') {
|
|
ch = int2char(char2int(ch) + 0x20);
|
|
}
|
|
return ch;
|
|
}
|
|
|
|
Character toUpper(Character ch) {
|
|
if (ch >= 'a' && ch <= 'z') {
|
|
ch = int2char(char2int(ch) - 0x20);
|
|
}
|
|
return ch;
|
|
}
|
|
|
|
String toString(Character ch) {
|
|
local String str;
|
|
str = new(Character[1]);
|
|
str[0] = ch;
|
|
return str;
|
|
}
|
|
|
|
Integer stringCompare(String s1, String s2) {
|
|
local Integer n1;
|
|
local Integer n2;
|
|
local Integer i;
|
|
n1 = sizeof(s1);
|
|
n2 = sizeof(s2);
|
|
i = 0;
|
|
while (i < n1 && i < n2) {
|
|
if (s1[i] != s2[i]) {
|
|
return char2int(s1[i]) - char2int(s2[i]);
|
|
}
|
|
i = i + 1;
|
|
}
|
|
return n1 - n2;
|
|
}
|
|
|
|
type StringBuffer = record {
|
|
String str;
|
|
Integer len;
|
|
};
|
|
|
|
StringBuffer newStringBuffer(Integer size) {
|
|
local StringBuffer strBuf;
|
|
strBuf = new(StringBuffer);
|
|
strBuf.str = new(Character[size]);
|
|
strBuf.len = 0;
|
|
return strBuf;
|
|
}
|
|
|
|
void addCharToStringBuffer(StringBuffer strBuf, Character ch) {
|
|
local String newStr;
|
|
local Integer i;
|
|
if (strBuf.len + 1 > sizeof(strBuf.str)) {
|
|
newStr = new(Character[2 * sizeof(strBuf.str)]);
|
|
i = 0;
|
|
while (i < strBuf.len) {
|
|
newStr[i] = strBuf.str[i];
|
|
i = i + 1;
|
|
}
|
|
strBuf.str = newStr;
|
|
}
|
|
strBuf.str[strBuf.len] = ch;
|
|
strBuf.len = strBuf.len + 1;
|
|
}
|
|
|
|
void addStringToStringBuffer(StringBuffer strBuf, String str) {
|
|
local Integer n;
|
|
local Integer i;
|
|
n = sizeof(str);
|
|
i = 0;
|
|
while (i < n) {
|
|
addCharToStringBuffer(strBuf, str[i]);
|
|
i = i + 1;
|
|
}
|
|
}
|
|
|
|
String stringBufferToString(StringBuffer strBuf) {
|
|
local String str;
|
|
local Integer i;
|
|
str = new(Character[strBuf.len]);
|
|
i = 0;
|
|
while (i < strBuf.len) {
|
|
str[i] = strBuf.str[i];
|
|
i = i + 1;
|
|
}
|
|
return str;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// Auxiliary Functions
|
|
// -------------------------------------------------------------
|
|
|
|
void error(String message, Boolean fatal) {
|
|
writeString("\n");
|
|
writeString(message);
|
|
writeString("\n\n");
|
|
if (fatal) {
|
|
exit();
|
|
}
|
|
}
|
|
|
|
Cell makeNil() {
|
|
local Cell aux;
|
|
aux = new(Cell);
|
|
aux.typ = NAME; // NAME
|
|
aux.car = aux; // auto-quoting
|
|
aux.cdr = aux; // empty property list
|
|
aux.func = aux; // no functional binding
|
|
aux.name = "NIL"; // name is NIL
|
|
return aux;
|
|
}
|
|
|
|
Cell makeName(String name) {
|
|
local Cell aux;
|
|
aux = new(Cell);
|
|
aux.typ = NAME; // NAME
|
|
aux.car = aux; // auto-quoting
|
|
aux.cdr = nilAtom; // empty property list
|
|
aux.func = nilAtom; // no functional binding
|
|
aux.name = name; // name as given in parameter
|
|
return aux;
|
|
}
|
|
|
|
Cell makeNumber(Integer n) {
|
|
local Cell aux;
|
|
aux = new(Cell);
|
|
aux.typ = NUMBER; // NUMBER
|
|
aux.car = aux; // auto-quoting
|
|
if (n < 0) {
|
|
aux.cdr = tAtom; // number is negative
|
|
} else {
|
|
aux.cdr = nilAtom; // number is non-negative
|
|
}
|
|
aux.val = n; // value as given in parameter
|
|
return aux;
|
|
}
|
|
|
|
Cell makeNode(Cell x, Cell y) {
|
|
local Cell aux;
|
|
aux = new(Cell);
|
|
aux.typ = NODE; // NODE
|
|
aux.car = x; // car as given in parameter
|
|
aux.cdr = y; // cdr as given in parameter
|
|
return aux;
|
|
}
|
|
|
|
void addOblist(Cell x) {
|
|
objectList = makeNode(x, objectList);
|
|
}
|
|
|
|
Cell makeObject(String name) {
|
|
local Cell aux;
|
|
aux = makeName(name);
|
|
addOblist(aux);
|
|
return aux;
|
|
}
|
|
|
|
Cell makeBuiltin(String name, Cell kind, Integer n) {
|
|
local Cell aux;
|
|
aux = makeObject(name);
|
|
aux.func = makeNode(kind, makeNumber(n));
|
|
return aux;
|
|
}
|
|
|
|
Cell searchOblist(String name) {
|
|
local Cell aux;
|
|
aux = objectList;
|
|
while (aux.typ == NODE) {
|
|
if (stringCompare(aux.car.name, name) == 0) {
|
|
return aux.car;
|
|
}
|
|
aux = aux.cdr;
|
|
}
|
|
return makeObject(name);
|
|
}
|
|
|
|
Cell copyTree(Cell x) {
|
|
local Cell anchor;
|
|
local Cell aux;
|
|
anchor = makeNode(nilAtom, nilAtom);
|
|
anchor.car = anchor;
|
|
while (x.typ == NODE) {
|
|
aux = copyTree(x.car);
|
|
anchor.car.cdr = makeNode(aux, nilAtom);
|
|
anchor.car = anchor.car.cdr;
|
|
x = x.cdr;
|
|
}
|
|
anchor.car.cdr = x;
|
|
return anchor.cdr;
|
|
}
|
|
|
|
Cell execErr(Integer funcNum) {
|
|
writeString("exec: function ");
|
|
writeInteger(funcNum);
|
|
writeString(" not implemented\n");
|
|
exit();
|
|
// never reached
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell exec(Integer n, Cell x, Cell y, Cell z) {
|
|
if (n < 0 || n >= 128) {
|
|
error("Internal Exec Error", false);
|
|
return nilAtom;
|
|
}
|
|
if (n < 64) {
|
|
if (n < 32) {
|
|
if (n < 16) {
|
|
if (n < 8) {
|
|
if (n < 4) {
|
|
if (n < 2) {
|
|
if (n < 1) {
|
|
// n = 0
|
|
return car(x);
|
|
} else {
|
|
// n = 1
|
|
return cdr(x);
|
|
}
|
|
} else {
|
|
if (n < 3) {
|
|
// n = 2
|
|
return caar(x);
|
|
} else {
|
|
// n = 3
|
|
return cadr(x);
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 6) {
|
|
if (n < 5) {
|
|
// n = 4
|
|
return cdar(x);
|
|
} else {
|
|
// n = 5
|
|
return cddr(x);
|
|
}
|
|
} else {
|
|
if (n < 7) {
|
|
// n = 6
|
|
return caaar(x);
|
|
} else {
|
|
// n = 7
|
|
return caadr(x);
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 12) {
|
|
if (n < 10) {
|
|
if (n < 9) {
|
|
// n = 8
|
|
return cadar(x);
|
|
} else {
|
|
// n = 9
|
|
return caddr(x);
|
|
}
|
|
} else {
|
|
if (n < 11) {
|
|
// n = 10
|
|
return cdaar(x);
|
|
} else {
|
|
// n = 11
|
|
return cdadr(x);
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 14) {
|
|
if (n < 13) {
|
|
// n = 12
|
|
return cddar(x);
|
|
} else {
|
|
// n = 13
|
|
return cdddr(x);
|
|
}
|
|
} else {
|
|
if (n < 15) {
|
|
// n = 14
|
|
return cons(x, y);
|
|
} else {
|
|
// n = 15
|
|
return list(x);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 24) {
|
|
if (n < 20) {
|
|
if (n < 18) {
|
|
if (n < 17) {
|
|
// n = 16
|
|
return reverse(x, y);
|
|
} else {
|
|
// n = 17
|
|
return oblist();
|
|
}
|
|
} else {
|
|
if (n < 19) {
|
|
// n = 18
|
|
return rplaca(x, y);
|
|
} else {
|
|
// n = 19
|
|
return rplacd(x, y);
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 22) {
|
|
if (n < 21) {
|
|
// n = 20
|
|
return nconc(x, y);
|
|
} else {
|
|
// n = 21
|
|
return name(x);
|
|
}
|
|
} else {
|
|
if (n < 23) {
|
|
// n = 22
|
|
return numberp(x);
|
|
} else {
|
|
// n = 23
|
|
return atom(x);
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 28) {
|
|
if (n < 26) {
|
|
if (n < 25) {
|
|
// n = 24
|
|
return null(x);
|
|
} else {
|
|
// n = 25
|
|
return plusp(x);
|
|
}
|
|
} else {
|
|
if (n < 27) {
|
|
// n = 26
|
|
return minusp(x);
|
|
} else {
|
|
// n = 27
|
|
return zerop(x);
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 30) {
|
|
if (n < 29) {
|
|
// n = 28
|
|
return even(x);
|
|
} else {
|
|
// n = 29
|
|
return eq(x, y);
|
|
}
|
|
} else {
|
|
if (n < 31) {
|
|
// n = 30
|
|
return equal(x, y);
|
|
} else {
|
|
// n = 31
|
|
return member(x, y);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 48) {
|
|
if (n < 40) {
|
|
if (n < 36) {
|
|
if (n < 34) {
|
|
if (n < 33) {
|
|
// n = 32
|
|
return greaterp(x, y);
|
|
} else {
|
|
// n = 33
|
|
return lessp(x, y);
|
|
}
|
|
} else {
|
|
if (n < 35) {
|
|
// n = 34
|
|
return orderp(x, y);
|
|
} else {
|
|
// n = 35
|
|
return not(x);
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 38) {
|
|
if (n < 37) {
|
|
// n = 36
|
|
return and(x);
|
|
} else {
|
|
// n = 37
|
|
return or(x);
|
|
}
|
|
} else {
|
|
if (n < 39) {
|
|
// n = 38
|
|
return set(x, y);
|
|
} else {
|
|
// n = 39
|
|
return setq(x);
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 44) {
|
|
if (n < 42) {
|
|
if (n < 41) {
|
|
// n = 40
|
|
return pop(x);
|
|
} else {
|
|
// n = 41
|
|
return push(x);
|
|
}
|
|
} else {
|
|
if (n < 43) {
|
|
// n = 42
|
|
return assoc(x, y);
|
|
} else {
|
|
// n = 43
|
|
return get(x, y);
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 46) {
|
|
if (n < 45) {
|
|
// n = 44
|
|
return put(x, y, z);
|
|
} else {
|
|
// n = 45
|
|
return remprop(x, y);
|
|
}
|
|
} else {
|
|
if (n < 47) {
|
|
// n = 46
|
|
return flagp(x, y);
|
|
} else {
|
|
// n = 47
|
|
return flag(x, y);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 56) {
|
|
if (n < 52) {
|
|
if (n < 50) {
|
|
if (n < 49) {
|
|
// n = 48
|
|
return remflag(x, y);
|
|
} else {
|
|
// n = 49
|
|
return getd(x);
|
|
}
|
|
} else {
|
|
if (n < 51) {
|
|
// n = 50
|
|
return putd(x, y);
|
|
} else {
|
|
// n = 51
|
|
return movd(x, y);
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 54) {
|
|
if (n < 53) {
|
|
// n = 52
|
|
return pack(x);
|
|
} else {
|
|
// n = 53
|
|
return unpack(x);
|
|
}
|
|
} else {
|
|
if (n < 55) {
|
|
// n = 54
|
|
return length(x);
|
|
} else {
|
|
// n = 55
|
|
return minus(x);
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 60) {
|
|
if (n < 58) {
|
|
if (n < 57) {
|
|
// n = 56
|
|
return plus(x, y);
|
|
} else {
|
|
// n = 57
|
|
return difference(x, y);
|
|
}
|
|
} else {
|
|
if (n < 59) {
|
|
// n = 58
|
|
return times(x, y);
|
|
} else {
|
|
// n = 59
|
|
return quotient(x, y);
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 62) {
|
|
if (n < 61) {
|
|
// n = 60
|
|
return remainder(x, y);
|
|
} else {
|
|
// n = 61
|
|
return divide(x, y);
|
|
}
|
|
} else {
|
|
if (n < 63) {
|
|
// n = 62
|
|
return rds(x, y, z);
|
|
} else {
|
|
// n = 63
|
|
return ratom();
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 96) {
|
|
if (n < 80) {
|
|
if (n < 72) {
|
|
if (n < 68) {
|
|
if (n < 66) {
|
|
if (n < 65) {
|
|
// n = 64
|
|
return read();
|
|
} else {
|
|
// n = 65
|
|
return readch();
|
|
}
|
|
} else {
|
|
if (n < 67) {
|
|
// n = 66
|
|
return wrs(x, y, z);
|
|
} else {
|
|
// n = 67
|
|
return print(x);
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 70) {
|
|
if (n < 69) {
|
|
// n = 68
|
|
return prin1(x);
|
|
} else {
|
|
// n = 69
|
|
return terpri(x);
|
|
}
|
|
} else {
|
|
if (n < 71) {
|
|
// n = 70
|
|
return spaces(x);
|
|
} else {
|
|
// n = 71
|
|
return linelength(x);
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 76) {
|
|
if (n < 74) {
|
|
if (n < 73) {
|
|
// n = 72
|
|
return radix(x);
|
|
} else {
|
|
// n = 73
|
|
return quote(x);
|
|
}
|
|
} else {
|
|
if (n < 75) {
|
|
// n = 74
|
|
return eval(x);
|
|
} else {
|
|
// n = 75
|
|
return apply(x, y);
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 78) {
|
|
if (n < 77) {
|
|
// n = 76
|
|
return cond(x);
|
|
} else {
|
|
// n = 77
|
|
return loop(x);
|
|
}
|
|
} else {
|
|
if (n < 79) {
|
|
// n = 78
|
|
return prog1(x);
|
|
} else {
|
|
// n = 79
|
|
return driver();
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 88) {
|
|
if (n < 84) {
|
|
if (n < 82) {
|
|
if (n < 81) {
|
|
// n = 80
|
|
return reclaim();
|
|
} else {
|
|
// n = 81
|
|
return save(x, y);
|
|
}
|
|
} else {
|
|
if (n < 83) {
|
|
// n = 82
|
|
return load(x, y);
|
|
} else {
|
|
// n = 83
|
|
return system();
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 86) {
|
|
if (n < 85) {
|
|
// n = 84
|
|
return xchgpname(x, y);
|
|
} else {
|
|
// n = 85
|
|
return purgename(x);
|
|
}
|
|
} else {
|
|
if (n < 87) {
|
|
// n = 86
|
|
return execErr(86);
|
|
} else {
|
|
// n = 87
|
|
return execErr(87);
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 92) {
|
|
if (n < 90) {
|
|
if (n < 89) {
|
|
// n = 88
|
|
return execErr(88);
|
|
} else {
|
|
// n = 89
|
|
return execErr(89);
|
|
}
|
|
} else {
|
|
if (n < 91) {
|
|
// n = 90
|
|
return execErr(90);
|
|
} else {
|
|
// n = 91
|
|
return execErr(91);
|
|
}
|
|
}
|
|
} else {
|
|
if (n < 94) {
|
|
if (n < 93) {
|
|
// n = 92
|
|
return execErr(92);
|
|
} else {
|
|
// n = 93
|
|
return execErr(93);
|
|
}
|
|
} else {
|
|
if (n < 95) {
|
|
// n = 94
|
|
return execErr(94);
|
|
} else {
|
|
// n = 95
|
|
return execErr(95);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
// n = 96..127
|
|
execErr(n);
|
|
}
|
|
}
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// A. Selector Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell car(Cell x) {
|
|
return x.car;
|
|
}
|
|
|
|
Cell cdr(Cell x) {
|
|
return x.cdr;
|
|
}
|
|
|
|
Cell caar(Cell x) {
|
|
return x.car.car;
|
|
}
|
|
|
|
Cell cadr(Cell x) {
|
|
return x.cdr.car;
|
|
}
|
|
|
|
Cell cdar(Cell x) {
|
|
return x.car.cdr;
|
|
}
|
|
|
|
Cell cddr(Cell x) {
|
|
return x.cdr.cdr;
|
|
}
|
|
|
|
Cell caaar(Cell x) {
|
|
return x.car.car.car;
|
|
}
|
|
|
|
Cell caadr(Cell x) {
|
|
return x.cdr.car.car;
|
|
}
|
|
|
|
Cell cadar(Cell x) {
|
|
return x.car.cdr.car;
|
|
}
|
|
|
|
Cell caddr(Cell x) {
|
|
return x.cdr.cdr.car;
|
|
}
|
|
|
|
Cell cdaar(Cell x) {
|
|
return x.car.car.cdr;
|
|
}
|
|
|
|
Cell cdadr(Cell x) {
|
|
return x.cdr.car.cdr;
|
|
}
|
|
|
|
Cell cddar(Cell x) {
|
|
return x.car.cdr.cdr;
|
|
}
|
|
|
|
Cell cdddr(Cell x) {
|
|
return x.cdr.cdr.cdr;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// B. Constructor Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell cons(Cell x, Cell y) {
|
|
return makeNode(x, y);
|
|
}
|
|
|
|
Cell list(Cell x) {
|
|
// ATTENTION: CBN
|
|
local Cell anchor;
|
|
local Cell aux;
|
|
anchor = makeNode(nilAtom, nilAtom);
|
|
anchor.car = anchor;
|
|
while (x.typ == NODE) {
|
|
aux = eval(x.car);
|
|
anchor.car.cdr = makeNode(aux, nilAtom);
|
|
anchor.car = anchor.car.cdr;
|
|
x = x.cdr;
|
|
}
|
|
anchor.car.cdr = x;
|
|
return anchor.cdr;
|
|
}
|
|
|
|
Cell reverse(Cell x, Cell y) {
|
|
local Cell aux;
|
|
aux = y;
|
|
while (x.typ == NODE) {
|
|
aux = makeNode(x.car, aux);
|
|
x = x.cdr;
|
|
}
|
|
return aux;
|
|
}
|
|
|
|
Cell oblist() {
|
|
return copyTree(objectList);
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// C. Modifier Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell rplaca(Cell x, Cell y) {
|
|
x.car = y;
|
|
return x;
|
|
}
|
|
|
|
Cell rplacd(Cell x, Cell y) {
|
|
x.cdr = y;
|
|
return x;
|
|
}
|
|
|
|
Cell nconc(Cell x, Cell y) {
|
|
local Cell t;
|
|
if (x.typ != NODE) {
|
|
return y;
|
|
}
|
|
t = x;
|
|
while (t.cdr.typ == NODE) {
|
|
t = t.cdr;
|
|
}
|
|
t.cdr = y;
|
|
return x;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// D. Recognizer Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell name(Cell x) {
|
|
if (x.typ == NAME) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell numberp(Cell x) {
|
|
if (x.typ == NUMBER) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell atom(Cell x) {
|
|
if (x.typ != NODE) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell null(Cell x) {
|
|
if (x == nilAtom) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell plusp(Cell x) {
|
|
if (x.typ == NUMBER && x.val > 0) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell minusp(Cell x) {
|
|
if (x.typ == NUMBER && x.val < 0) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell zerop(Cell x) {
|
|
if (x.typ == NUMBER && x.val == 0) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell even(Cell x) {
|
|
if (x.typ == NUMBER && x.val % 2 == 0) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// E. Comparator Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell eq(Cell x, Cell y) {
|
|
if (x == y) {
|
|
return tAtom;
|
|
}
|
|
if (x.typ == NUMBER && y.typ == NUMBER && x.val == y.val) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell equal(Cell x, Cell y) {
|
|
while (x.typ == NODE && y.typ == NODE) {
|
|
if (equal(x.car, y.car) == nilAtom) {
|
|
return nilAtom;
|
|
}
|
|
x = x.cdr;
|
|
y = y.cdr;
|
|
}
|
|
return eq(x, y);
|
|
}
|
|
|
|
Cell member(Cell x, Cell y) {
|
|
while (y.typ == NODE) {
|
|
if (equal(x, y.car) == tAtom) {
|
|
return tAtom;
|
|
}
|
|
y = y.cdr;
|
|
}
|
|
return y;
|
|
}
|
|
|
|
Cell greaterp(Cell x, Cell y) {
|
|
if (x.typ == NUMBER && y.typ == NUMBER && x.val > y.val) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell lessp(Cell x, Cell y) {
|
|
if (x.typ == NUMBER && y.typ == NUMBER && x.val < y.val) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell orderp(Cell x, Cell y) {
|
|
local Cell aux;
|
|
if (x.typ == NODE) {
|
|
return nilAtom;
|
|
}
|
|
if (y.typ == NODE) {
|
|
return tAtom;
|
|
}
|
|
if (x.typ == NUMBER && y.typ == NUMBER) {
|
|
if (x.val < y.val) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
if (x.typ == NUMBER) {
|
|
return tAtom;
|
|
}
|
|
if (y.typ == NUMBER) {
|
|
return nilAtom;
|
|
}
|
|
// both x and y are names
|
|
aux = objectList;
|
|
while (aux.typ == NODE) {
|
|
if (aux.car == x) {
|
|
return nilAtom;
|
|
}
|
|
if (aux.car == y) {
|
|
return tAtom;
|
|
}
|
|
aux = aux.cdr;
|
|
}
|
|
// this should never be reached
|
|
return nilAtom;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// F. Logical Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell not(Cell x) {
|
|
if (x == nilAtom) {
|
|
return tAtom;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell and(Cell x) {
|
|
// ATTENTION: CBN
|
|
while (x.typ == NODE) {
|
|
if (eval(x.car) == nilAtom) {
|
|
return nilAtom;
|
|
}
|
|
x = x.cdr;
|
|
}
|
|
return tAtom;
|
|
}
|
|
|
|
Cell or(Cell x) {
|
|
// ATTENTION: CBN
|
|
while (x.typ == NODE) {
|
|
if (eval(x.car) != nilAtom) {
|
|
return tAtom;
|
|
}
|
|
x = x.cdr;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// G. Assignment Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell set(Cell x, Cell y) {
|
|
x.car = y;
|
|
return y;
|
|
}
|
|
|
|
Cell setq(Cell x) {
|
|
// ATTENTION: CBN
|
|
local Cell aux;
|
|
aux = eval(x.cdr.car);
|
|
x.car.car = aux;
|
|
return aux;
|
|
}
|
|
|
|
Cell pop(Cell x) {
|
|
// ATTENTION: CBN
|
|
local Cell aux;
|
|
aux = eval(x.car);
|
|
x.car.car = aux.cdr;
|
|
return aux.car;
|
|
}
|
|
|
|
Cell push(Cell x) {
|
|
// ATTENTION: CBN
|
|
local Cell aux1;
|
|
local Cell aux2;
|
|
local Cell aux3;
|
|
aux1 = eval(x.car);
|
|
aux2 = eval(x.cdr.car);
|
|
aux3 = makeNode(aux1, aux2);
|
|
x.cdr.car.car = aux3;
|
|
return aux3;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// H. Property Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell assoc(Cell x, Cell y) {
|
|
while (y.typ == NODE) {
|
|
if (y.car.typ == NODE && equal(y.car.car, x) == tAtom) {
|
|
return y.car;
|
|
}
|
|
y = y.cdr;
|
|
}
|
|
return y;
|
|
}
|
|
|
|
Cell get(Cell x, Cell y) {
|
|
local Cell aux;
|
|
aux = assoc(y, x.cdr);
|
|
if (aux.typ != NODE) {
|
|
return nilAtom;
|
|
}
|
|
return aux.cdr;
|
|
}
|
|
|
|
Cell put(Cell x, Cell y, Cell z) {
|
|
local Cell aux;
|
|
aux = assoc(y, x.cdr);
|
|
if (aux.typ != NODE) {
|
|
aux = makeNode(y, z);
|
|
x.cdr = makeNode(aux, x.cdr);
|
|
return z;
|
|
}
|
|
aux.cdr = z;
|
|
return z;
|
|
}
|
|
|
|
Cell remprop(Cell x, Cell y) {
|
|
while (x.cdr.typ == NODE) {
|
|
if (equal(x.cdr.car.car, y) == tAtom) {
|
|
y = x.cdr.car.cdr;
|
|
x.cdr = x.cdr.cdr;
|
|
return y;
|
|
}
|
|
x = x.cdr;
|
|
}
|
|
return x.cdr;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// I. Flag Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell flagp(Cell x, Cell y) {
|
|
return member(y, x.cdr);
|
|
}
|
|
|
|
Cell flag(Cell x, Cell y) {
|
|
if (member(y, x.cdr) == tAtom) {
|
|
return y;
|
|
}
|
|
x.cdr = makeNode(y, x.cdr);
|
|
return y;
|
|
}
|
|
|
|
Cell remflag(Cell x, Cell y) {
|
|
while (x.cdr.typ == NODE) {
|
|
if (equal(y, x.cdr.car) == tAtom) {
|
|
x.cdr = x.cdr.cdr;
|
|
return y;
|
|
}
|
|
x = x.cdr;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// J. Definition Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell getd(Cell x) {
|
|
if (x.typ != NAME) {
|
|
return nilAtom;
|
|
}
|
|
return copyTree(x.func);
|
|
}
|
|
|
|
Cell putd(Cell x, Cell y) {
|
|
if (x.typ != NAME) {
|
|
return nilAtom;
|
|
}
|
|
x.func = copyTree(y);
|
|
return y;
|
|
}
|
|
|
|
Cell movd(Cell x, Cell y) {
|
|
if (x.typ != NAME || y.typ != NAME) {
|
|
return nilAtom;
|
|
}
|
|
y.func = x.func;
|
|
return copyTree(y.func);
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// K. Sub-atomic Functions
|
|
// -------------------------------------------------------------
|
|
|
|
//
|
|
// auxiliary stuff
|
|
//
|
|
|
|
void addNumberToStringBuffer(StringBuffer strBuf, Integer n) {
|
|
local Integer a;
|
|
local Integer b;
|
|
if (n < 0) {
|
|
addCharToStringBuffer(strBuf, '-');
|
|
n = -n;
|
|
}
|
|
a = n / numBase;
|
|
if (a != 0) {
|
|
addNumberToStringBuffer(strBuf, a);
|
|
}
|
|
b = n % numBase;
|
|
if (b < 10) {
|
|
addCharToStringBuffer(strBuf, int2char(char2int('0') + b));
|
|
} else {
|
|
if (a == 0) {
|
|
// this is the first digit printed, and it is >= 10
|
|
// prepend a single zero to distinguish number from name
|
|
addCharToStringBuffer(strBuf, '0');
|
|
}
|
|
addCharToStringBuffer(strBuf, int2char(char2int('A') + (b - 10)));
|
|
}
|
|
}
|
|
|
|
Integer countName(String s) {
|
|
local Integer k;
|
|
local Integer n;
|
|
local Integer i;
|
|
local Character ch;
|
|
local Boolean quoted;
|
|
k = 0;
|
|
n = sizeof(s);
|
|
i = 0;
|
|
quoted = false;
|
|
while (i < n) {
|
|
ch = s[i];
|
|
if (prin1Atom.car == nilAtom && isSpecial(ch) && !quoted) {
|
|
quoted = true;
|
|
k = k + 1;
|
|
}
|
|
k = k + 1;
|
|
if (ch == '\"' && quoted) {
|
|
k = k + 1;
|
|
}
|
|
i = i + 1;
|
|
}
|
|
if (quoted) {
|
|
k = k + 1;
|
|
}
|
|
return k;
|
|
}
|
|
|
|
Integer countNumber(Integer n) {
|
|
local Integer k;
|
|
local Integer a;
|
|
local Integer b;
|
|
k = 0;
|
|
if (n < 0) {
|
|
k = k + 1;
|
|
n = -n;
|
|
}
|
|
a = n / numBase;
|
|
if (a != 0) {
|
|
k = k + countNumber(a);
|
|
}
|
|
b = n % numBase;
|
|
if (a == 0 && b >= 10) {
|
|
// leading zero, see printNumber()
|
|
k = k + 1;
|
|
}
|
|
k = k + 1;
|
|
return k;
|
|
}
|
|
|
|
//
|
|
// end of auxiliary stuff
|
|
//
|
|
|
|
Cell pack(Cell x) {
|
|
local StringBuffer strBuf;
|
|
local String str;
|
|
strBuf = newStringBuffer(20);
|
|
while (x.typ == NODE) {
|
|
if (x.car.typ == NAME) {
|
|
addStringToStringBuffer(strBuf, x.car.name);
|
|
} else
|
|
if (x.car.typ == NUMBER) {
|
|
addNumberToStringBuffer(strBuf, x.car.val);
|
|
}
|
|
x = x.cdr;
|
|
}
|
|
str = stringBufferToString(strBuf);
|
|
return searchOblist(str);
|
|
}
|
|
|
|
Cell unpack(Cell x) {
|
|
local StringBuffer strBuf;
|
|
local String str;
|
|
local Integer i;
|
|
local Cell anchor;
|
|
local Cell aux;
|
|
strBuf = newStringBuffer(20);
|
|
if (x.typ == NAME) {
|
|
addStringToStringBuffer(strBuf, x.name);
|
|
} else
|
|
if (x.typ == NUMBER) {
|
|
addNumberToStringBuffer(strBuf, x.val);
|
|
} else {
|
|
return nilAtom;
|
|
}
|
|
str = stringBufferToString(strBuf);
|
|
anchor = makeNode(nilAtom, nilAtom);
|
|
anchor.car = anchor;
|
|
i = 0;
|
|
while (i < sizeof(str)) {
|
|
aux = searchOblist(toString(str[i]));
|
|
anchor.car.cdr = makeNode(aux, nilAtom);
|
|
anchor.car = anchor.car.cdr;
|
|
i = i + 1;
|
|
}
|
|
return anchor.cdr;
|
|
}
|
|
|
|
Cell length(Cell x) {
|
|
local Integer n;
|
|
if (x.typ == NAME) {
|
|
return makeNumber(countName(x.name));
|
|
}
|
|
if (x.typ == NUMBER) {
|
|
return makeNumber(countNumber(x.val));
|
|
}
|
|
n = 0;
|
|
while (x.typ == NODE) {
|
|
n = n + 1;
|
|
x = x.cdr;
|
|
}
|
|
return makeNumber(n);
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// L. Numerical Functions
|
|
// -------------------------------------------------------------
|
|
|
|
//
|
|
// auxiliary stuff
|
|
//
|
|
|
|
void zeroDivideError() {
|
|
error("ZERO Divide Error", false);
|
|
}
|
|
|
|
//
|
|
// end of auxiliary stuff
|
|
//
|
|
|
|
Cell minus(Cell x) {
|
|
if (x.typ != NUMBER) {
|
|
return nilAtom;
|
|
}
|
|
return makeNumber(-x.val);
|
|
}
|
|
|
|
Cell plus(Cell x, Cell y) {
|
|
if (x.typ != NUMBER || y.typ != NUMBER) {
|
|
return nilAtom;
|
|
}
|
|
return makeNumber(x.val + y.val);
|
|
}
|
|
|
|
Cell difference(Cell x, Cell y) {
|
|
if (x.typ != NUMBER || y.typ != NUMBER) {
|
|
return nilAtom;
|
|
}
|
|
return makeNumber(x.val - y.val);
|
|
}
|
|
|
|
Cell times(Cell x, Cell y) {
|
|
if (x.typ != NUMBER || y.typ != NUMBER) {
|
|
return nilAtom;
|
|
}
|
|
return makeNumber(x.val * y.val);
|
|
}
|
|
|
|
Cell quotient(Cell x, Cell y) {
|
|
local Integer q;
|
|
local Integer r;
|
|
if (x.typ != NUMBER || y.typ != NUMBER) {
|
|
return nilAtom;
|
|
}
|
|
if (y.val == 0) {
|
|
zeroDivideError();
|
|
return nilAtom;
|
|
}
|
|
q = x.val / y.val;
|
|
r = x.val % y.val;
|
|
if (r < 0) {
|
|
if (q < 0) {
|
|
q = q - 1;
|
|
} else {
|
|
q = q + 1;
|
|
}
|
|
}
|
|
return makeNumber(q);
|
|
}
|
|
|
|
Cell remainder(Cell x, Cell y) {
|
|
local Integer q;
|
|
local Integer r;
|
|
if (x.typ != NUMBER || y.typ != NUMBER) {
|
|
return nilAtom;
|
|
}
|
|
if (y.val == 0) {
|
|
zeroDivideError();
|
|
return nilAtom;
|
|
}
|
|
q = x.val / y.val;
|
|
r = x.val % y.val;
|
|
if (r < 0) {
|
|
if (q < 0) {
|
|
r = r + y.val;
|
|
} else {
|
|
r = r - y.val;
|
|
}
|
|
}
|
|
return makeNumber(r);
|
|
}
|
|
|
|
Cell divide(Cell x, Cell y) {
|
|
local Integer q;
|
|
local Integer r;
|
|
if (x.typ != NUMBER || y.typ != NUMBER) {
|
|
return nilAtom;
|
|
}
|
|
if (y.val == 0) {
|
|
zeroDivideError();
|
|
return nilAtom;
|
|
}
|
|
q = x.val / y.val;
|
|
r = x.val % y.val;
|
|
if (r < 0) {
|
|
if (q < 0) {
|
|
q = q - 1;
|
|
r = r + y.val;
|
|
} else {
|
|
q = q + 1;
|
|
r = r - y.val;
|
|
}
|
|
}
|
|
return makeNode(makeNumber(q), makeNumber(r));
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// M. Reader Functions and Control Variables
|
|
// -------------------------------------------------------------
|
|
|
|
//
|
|
// auxiliary stuff
|
|
//
|
|
|
|
global Boolean singleBreak;
|
|
|
|
global Boolean unreadPresent;
|
|
global Character unreadChar;
|
|
|
|
void unread(Character ch) {
|
|
unreadPresent = true;
|
|
unreadChar = ch;
|
|
}
|
|
|
|
Character readChar() {
|
|
local Character ch;
|
|
if (unreadPresent) {
|
|
unreadPresent = false;
|
|
return unreadChar;
|
|
}
|
|
if (rdsAtom.car == nilAtom) {
|
|
if (readchAtom.car == nilAtom) {
|
|
ch = readCharacter();
|
|
} else {
|
|
ch = readCharacter();
|
|
}
|
|
} else {
|
|
// file input not implemented
|
|
ch = ' ';
|
|
if (echoAtom.car != nilAtom) {
|
|
printChar(ch);
|
|
}
|
|
}
|
|
if (readAtom.car == nilAtom) {
|
|
ch = toUpper(ch);
|
|
}
|
|
return ch;
|
|
}
|
|
|
|
String readToken(Boolean[] sep, Boolean[] brk) {
|
|
local Boolean quoted;
|
|
local Character ch;
|
|
local StringBuffer strBuf;
|
|
quoted = false;
|
|
ch = readChar();
|
|
while (ch == '%' || sep[char2int(ch)]) {
|
|
if (ch == '%') {
|
|
while (readChar() != '%') ;
|
|
}
|
|
ch = readChar();
|
|
}
|
|
if (brk[char2int(ch)]) {
|
|
singleBreak = true;
|
|
return toString(ch);
|
|
}
|
|
strBuf = newStringBuffer(20);
|
|
while (true) {
|
|
if (quoted) {
|
|
if (ch == '\"') {
|
|
ch = readChar();
|
|
if (ch == '\"') {
|
|
addCharToStringBuffer(strBuf, ch);
|
|
ch = readChar();
|
|
} else {
|
|
quoted = false;
|
|
}
|
|
} else {
|
|
addCharToStringBuffer(strBuf, ch);
|
|
ch = readChar();
|
|
}
|
|
} else {
|
|
if (ch == '\"') {
|
|
quoted = true;
|
|
ch = readChar();
|
|
} else
|
|
if (ch == '%') {
|
|
while (readChar() != '%') ;
|
|
ch = readChar();
|
|
} else
|
|
if (sep[char2int(ch)] || brk[char2int(ch)]) {
|
|
unread(ch);
|
|
singleBreak = false;
|
|
return stringBufferToString(strBuf);
|
|
} else {
|
|
addCharToStringBuffer(strBuf, ch);
|
|
ch = readChar();
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
Cell tokenToAtom(String token) {
|
|
local Boolean couldConvert;
|
|
local Boolean isNegative;
|
|
local Integer number;
|
|
local Integer i;
|
|
local Character ch;
|
|
local Integer d;
|
|
local Cell aux;
|
|
couldConvert = true;
|
|
isNegative = false;
|
|
number = 0;
|
|
i = 0;
|
|
if (i < sizeof(token) && token[i] == '-') {
|
|
isNegative = true;
|
|
i = i + 1;
|
|
}
|
|
if (i < sizeof(token) && isDigit(token[i])) {
|
|
while (i < sizeof(token)) {
|
|
ch = token[i];
|
|
i = i + 1;
|
|
if (isDigit(ch)) {
|
|
d = char2int(ch) - char2int('0');
|
|
if (d < numBase) {
|
|
number = number * numBase + d;
|
|
} else {
|
|
couldConvert = false;
|
|
break;
|
|
}
|
|
} else
|
|
if (isAlpha(ch)) {
|
|
ch = toUpper(ch);
|
|
d = char2int(ch) - char2int('A');
|
|
if (d < numBase) {
|
|
number = number * numBase + d;
|
|
} else {
|
|
couldConvert = false;
|
|
break;
|
|
}
|
|
} else {
|
|
couldConvert = false;
|
|
break;
|
|
}
|
|
}
|
|
} else {
|
|
couldConvert = false;
|
|
}
|
|
if (couldConvert) {
|
|
if (isNegative) {
|
|
number = -number;
|
|
}
|
|
aux = makeNumber(number);
|
|
} else {
|
|
aux = searchOblist(token);
|
|
}
|
|
ratomAtom.car = aux;
|
|
return aux;
|
|
}
|
|
|
|
Cell read0(String token) {
|
|
local Character ch;
|
|
while (true) {
|
|
if (!singleBreak) {
|
|
return tokenToAtom(token);
|
|
}
|
|
ch = token[0];
|
|
if (ch == '(') {
|
|
token = readToken(RES, REB);
|
|
return readList(token);
|
|
} else
|
|
if (ch == '[') {
|
|
token = readToken(RES, REB);
|
|
return readBracket(token);
|
|
} else
|
|
if (ch == ')' || ch == ']' || ch == '.') {
|
|
token = readToken(RES, REB);
|
|
} else {
|
|
error("internal read0 error", true);
|
|
}
|
|
}
|
|
}
|
|
|
|
Cell readList(String token) {
|
|
local Cell anchor;
|
|
local Cell aux;
|
|
anchor = makeNode(nilAtom, nilAtom);
|
|
anchor.car = anchor;
|
|
while (true) {
|
|
if (singleBreak && token[0] == ')') {
|
|
return anchor.cdr;
|
|
} else
|
|
if (singleBreak && token[0] == ']') {
|
|
unread(']');
|
|
return anchor.cdr;
|
|
} else
|
|
if (singleBreak && token[0] == '.') {
|
|
token = readToken(RES, REB);
|
|
aux = read0(token);
|
|
token = readToken(RES, REB);
|
|
if (singleBreak && token[0] == ')') {
|
|
anchor.car.cdr = aux;
|
|
return anchor.cdr;
|
|
} else
|
|
if (singleBreak && token[0] == ']') {
|
|
unread(']');
|
|
anchor.car.cdr = aux;
|
|
return anchor.cdr;
|
|
} else {
|
|
anchor.car.cdr = makeNode(aux, nilAtom);
|
|
anchor.car = anchor.car.cdr;
|
|
}
|
|
} else {
|
|
aux = read0(token);
|
|
anchor.car.cdr = makeNode(aux, nilAtom);
|
|
anchor.car = anchor.car.cdr;
|
|
token = readToken(RES, REB);
|
|
}
|
|
}
|
|
}
|
|
|
|
Cell readBracket(String token) {
|
|
local Cell aux1;
|
|
local Cell aux2;
|
|
aux1 = readList(token);
|
|
while (true) {
|
|
token = readToken(RES, REB);
|
|
if (singleBreak && token[0] == ')') {
|
|
return aux1;
|
|
} else
|
|
if (singleBreak && token[0] == ']') {
|
|
return aux1;
|
|
} else {
|
|
aux2 = readList(token);
|
|
aux1 = makeNode(aux1, aux2);
|
|
}
|
|
}
|
|
}
|
|
|
|
//
|
|
// end of auxiliary stuff
|
|
//
|
|
|
|
Cell rds(Cell x, Cell y, Cell z) {
|
|
// file handling not implemented
|
|
// error("RDS not implemented", false);
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell ratom() {
|
|
local String token;
|
|
token = readToken(RAS, RAB);
|
|
return tokenToAtom(token);
|
|
}
|
|
|
|
Cell read() {
|
|
local String token;
|
|
token = readToken(RES, REB);
|
|
return read0(token);
|
|
}
|
|
|
|
Cell readch() {
|
|
local Character ch;
|
|
local Integer n;
|
|
local String s;
|
|
local Cell aux;
|
|
ch = readChar();
|
|
if (isDigit(ch)) {
|
|
n = char2int(ch) - char2int('0');
|
|
if (n < numBase) {
|
|
aux = makeNumber(n);
|
|
} else {
|
|
s = toString(ch);
|
|
aux = searchOblist(s);
|
|
}
|
|
} else {
|
|
s = toString(ch);
|
|
aux = searchOblist(s);
|
|
}
|
|
ratomAtom.car = aux;
|
|
return aux;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// N. Printer Functions and Control Variables
|
|
// -------------------------------------------------------------
|
|
|
|
//
|
|
// auxiliary stuff
|
|
//
|
|
|
|
void putConsole(Character ch) {
|
|
// do any terminal-specific character translations here
|
|
writeCharacter(ch);
|
|
}
|
|
|
|
void printChar(Character ch) {
|
|
local Integer ascii;
|
|
// handle case conversion
|
|
if (printAtom.car == nilAtom) {
|
|
ch = toLower(ch);
|
|
}
|
|
// determine output sink
|
|
if (wrsAtom.car == nilAtom) {
|
|
putConsole(ch);
|
|
} else {
|
|
// file output not implemented
|
|
if (echoAtom.car != nilAtom) {
|
|
putConsole(ch);
|
|
}
|
|
}
|
|
// update cursor position
|
|
ascii = char2int(ch);
|
|
if (ascii == 8) {
|
|
// CTRL-H, backspace
|
|
cursPos = cursPos - 1;
|
|
} else
|
|
if (ascii == 9) {
|
|
// CTRL-I, tab
|
|
cursPos = ((cursPos + 8) / 8) * 8;
|
|
} else
|
|
if (ascii == 10) {
|
|
// CTRL-J, begin of next line
|
|
cursPos = 0;
|
|
} else
|
|
if (ascii == 11) {
|
|
// CTRL-K, begin of previous line
|
|
cursPos = 0;
|
|
} else
|
|
if (ascii == 12) {
|
|
// CTRL-L, begin of screen
|
|
cursPos = 0;
|
|
} else
|
|
if (ascii == 13) {
|
|
// CTRL-M, begin of current line
|
|
cursPos = 0;
|
|
} else {
|
|
// all other characters
|
|
cursPos = cursPos + 1;
|
|
}
|
|
}
|
|
|
|
Boolean isSpecial(Character ch) {
|
|
local Integer index;
|
|
index = char2int(ch);
|
|
return OSP[index] || REB[index] || RES[index];
|
|
}
|
|
|
|
void printName(String s) {
|
|
local Integer n;
|
|
local Integer i;
|
|
local Character ch;
|
|
local Boolean quoted;
|
|
n = sizeof(s);
|
|
i = 0;
|
|
quoted = false;
|
|
while (i < n) {
|
|
ch = s[i];
|
|
if (prin1Atom.car == nilAtom && isSpecial(ch) && !quoted) {
|
|
quoted = true;
|
|
printChar('\"');
|
|
}
|
|
printChar(ch);
|
|
if (ch == '\"' && quoted) {
|
|
printChar('\"');
|
|
}
|
|
i = i + 1;
|
|
}
|
|
if (quoted) {
|
|
printChar('\"');
|
|
}
|
|
}
|
|
|
|
void printNumber(Integer n) {
|
|
local Integer a;
|
|
local Integer b;
|
|
if (n < 0) {
|
|
printChar('-');
|
|
n = -n;
|
|
}
|
|
a = n / numBase;
|
|
if (a != 0) {
|
|
printNumber(a);
|
|
}
|
|
b = n % numBase;
|
|
if (b < 10) {
|
|
printChar(int2char(char2int('0') + b));
|
|
} else {
|
|
if (a == 0) {
|
|
// this is the first digit printed, and it is >= 10
|
|
// prepend a single zero to distinguish number from name
|
|
printChar('0');
|
|
}
|
|
printChar(int2char(char2int('A') + (b - 10)));
|
|
}
|
|
}
|
|
|
|
//
|
|
// end of auxiliary stuff
|
|
//
|
|
|
|
Cell wrs(Cell x, Cell y, Cell z) {
|
|
// file handling not implemented
|
|
// error("WRS not implemented", false);
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell print(Cell x) {
|
|
prin1(x);
|
|
printChar('\n');
|
|
return x;
|
|
}
|
|
|
|
Cell prin1(Cell x) {
|
|
if (x.typ == NAME) {
|
|
printName(x.name);
|
|
return x;
|
|
}
|
|
if (x.typ == NUMBER) {
|
|
printNumber(x.val);
|
|
return x;
|
|
}
|
|
printChar('(');
|
|
prin1(x.car);
|
|
x = x.cdr;
|
|
while (x.typ == NODE) {
|
|
printChar(' ');
|
|
prin1(x.car);
|
|
x = x.cdr;
|
|
}
|
|
if (x != nilAtom) {
|
|
printChar(' ');
|
|
printChar('.');
|
|
printChar(' ');
|
|
prin1(x);
|
|
}
|
|
printChar(')');
|
|
return x;
|
|
}
|
|
|
|
Cell terpri(Cell x) {
|
|
local Integer n;
|
|
if (x.typ == NUMBER) {
|
|
n = x.val;
|
|
if (n < 0 || n > 255) {
|
|
printChar('\n');
|
|
return nilAtom;
|
|
}
|
|
while (n > 0) {
|
|
printChar('\n');
|
|
n = n - 1;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
printChar('\n');
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell spaces(Cell x) {
|
|
local Integer n;
|
|
if (x.typ == NUMBER) {
|
|
n = x.val;
|
|
if (n < 0 || n > 255) {
|
|
return makeNumber(cursPos);
|
|
}
|
|
while (n > 0) {
|
|
printChar(' ');
|
|
n = n - 1;
|
|
}
|
|
return makeNumber(cursPos);
|
|
}
|
|
return makeNumber(cursPos);
|
|
}
|
|
|
|
Cell linelength(Cell x) {
|
|
local Integer n;
|
|
local Cell aux;
|
|
if (x.typ == NUMBER) {
|
|
n = x.val;
|
|
if (n > 11 && n < 256) {
|
|
aux = makeNumber(lineLen);
|
|
lineLen = n;
|
|
return aux;
|
|
}
|
|
return makeNumber(lineLen);
|
|
}
|
|
return makeNumber(lineLen);
|
|
}
|
|
|
|
Cell radix(Cell x) {
|
|
local Integer n;
|
|
local Cell aux;
|
|
if (x.typ == NUMBER) {
|
|
n = x.val;
|
|
if (n > 1 && n < 37) {
|
|
aux = makeNumber(numBase);
|
|
numBase = n;
|
|
return aux;
|
|
}
|
|
return makeNumber(numBase);
|
|
}
|
|
return makeNumber(numBase);
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// O. Evaluation Functions
|
|
// -------------------------------------------------------------
|
|
|
|
//
|
|
// auxiliary stuff
|
|
//
|
|
|
|
Cell evlis(Cell x) {
|
|
local Cell anchor;
|
|
local Cell aux;
|
|
anchor = makeNode(nilAtom, nilAtom);
|
|
anchor.car = anchor;
|
|
while (x.typ == NODE) {
|
|
aux = eval(x.car);
|
|
anchor.car.cdr = makeNode(aux, nilAtom);
|
|
anchor.car = anchor.car.cdr;
|
|
x = x.cdr;
|
|
}
|
|
anchor.car.cdr = x;
|
|
return anchor.cdr;
|
|
}
|
|
|
|
Cell evalbody(Cell x, Cell y) {
|
|
local Cell aux;
|
|
aux = x;
|
|
while (y.typ == NODE) {
|
|
if (y.car.typ != NODE || y.car.car.typ != NODE) {
|
|
aux = eval(y.car);
|
|
y = y.cdr;
|
|
} else
|
|
if (y.car.car.car.typ != NODE) {
|
|
aux = eval(y.car.car);
|
|
if (aux == nilAtom) {
|
|
y = y.cdr;
|
|
} else {
|
|
y = y.car.cdr;
|
|
}
|
|
} else {
|
|
aux = evalbody(aux, y.car);
|
|
y = y.cdr;
|
|
}
|
|
}
|
|
return aux;
|
|
}
|
|
|
|
void bind(Cell x, Cell y) {
|
|
if (x.typ != NODE) {
|
|
if (x != nilAtom) {
|
|
argStack = makeNode(x.car, argStack);
|
|
x.car = y;
|
|
}
|
|
return;
|
|
}
|
|
while (x.typ == NODE && y.typ == NODE) {
|
|
argStack = makeNode(x.car.car, argStack);
|
|
x.car.car = y.car;
|
|
x = x.cdr;
|
|
y = y.cdr;
|
|
}
|
|
while (x.typ == NODE) {
|
|
argStack = makeNode(x.car.car, argStack);
|
|
x.car.car = nilAtom;
|
|
x = x.cdr;
|
|
}
|
|
}
|
|
|
|
void unbind(Cell x) {
|
|
local Cell aux;
|
|
if (x.typ != NODE) {
|
|
if (x != nilAtom) {
|
|
x.car = argStack.car;
|
|
argStack = argStack.cdr;
|
|
}
|
|
return;
|
|
}
|
|
aux = nilAtom;
|
|
while (x.typ == NODE) {
|
|
aux = makeNode(x.car, aux);
|
|
x = x.cdr;
|
|
}
|
|
while (aux.typ == NODE) {
|
|
aux.car.car = argStack.car;
|
|
argStack = argStack.cdr;
|
|
aux = aux.cdr;
|
|
}
|
|
}
|
|
|
|
//
|
|
// end of auxiliary stuff
|
|
//
|
|
|
|
Cell quote(Cell x) {
|
|
// ATTENTION: CBN
|
|
return x.car;
|
|
}
|
|
|
|
Cell eval(Cell x) {
|
|
local Cell aux;
|
|
if (x.typ != NODE) {
|
|
return x.car;
|
|
}
|
|
if (x.car.typ == NAME) {
|
|
if (x.car.func == nilAtom) {
|
|
if (x.car == x.car.car) {
|
|
return evlis(x);
|
|
}
|
|
aux = makeNode(x.car.car, x.cdr);
|
|
return eval(aux);
|
|
}
|
|
if (x.car.func.car == subrAtom ||
|
|
x.car.func.car == lambdaAtom) {
|
|
aux = evlis(x.cdr);
|
|
return apply(x.car, aux);
|
|
}
|
|
if (x.car.func.car == nsubrAtom ||
|
|
x.car.func.car == nlambdaAtom) {
|
|
return apply(x.car, x.cdr);
|
|
}
|
|
return evlis(x);
|
|
}
|
|
if (x.car.car == lambdaAtom) {
|
|
aux = evlis(x.cdr);
|
|
return apply(x.car, aux);
|
|
}
|
|
if (x.car.car == nlambdaAtom) {
|
|
return apply(x.car, x.cdr);
|
|
}
|
|
return evlis(x);
|
|
}
|
|
|
|
Cell apply(Cell x, Cell y) {
|
|
local Cell aux;
|
|
if (x.typ == NAME) {
|
|
if (x.func == nilAtom) {
|
|
if (x == x.car) {
|
|
return nilAtom;
|
|
}
|
|
return apply(x.car, y);
|
|
}
|
|
if (x.func.car == subrAtom) {
|
|
if (y.typ != NODE) {
|
|
return exec(x.func.cdr.val, nilAtom, nilAtom, nilAtom);
|
|
}
|
|
if (y.cdr.typ != NODE) {
|
|
return exec(x.func.cdr.val, y.car, nilAtom, nilAtom);
|
|
}
|
|
if (y.cdr.cdr.typ != NODE) {
|
|
return exec(x.func.cdr.val, y.car, y.cdr.car, nilAtom);
|
|
}
|
|
return exec(x.func.cdr.val, y.car, y.cdr.car, y.cdr.cdr.car);
|
|
}
|
|
if (x.func.car == nsubrAtom) {
|
|
return exec(x.func.cdr.val, y, nilAtom, nilAtom);
|
|
}
|
|
if (x.func.car == lambdaAtom || x.func.car == nlambdaAtom) {
|
|
bind(x.func.cdr.car, y);
|
|
aux = evalbody(nilAtom, x.func.cdr.cdr);
|
|
unbind(x.func.cdr.car);
|
|
return aux;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
if (x.car == lambdaAtom || x.car == nlambdaAtom) {
|
|
bind(x.cdr.car, y);
|
|
aux = evalbody(nilAtom, x.cdr.cdr);
|
|
unbind(x.cdr.car);
|
|
return aux;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell cond(Cell x) {
|
|
// ATTENTION: CBN
|
|
local Cell aux;
|
|
while (x.typ == NODE) {
|
|
aux = eval(x.car.car);
|
|
if (aux != nilAtom) {
|
|
return evalbody(aux, x.car.cdr);
|
|
}
|
|
x = x.cdr;
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell loop(Cell x) {
|
|
// ATTENTION: CBN
|
|
local Cell aux1;
|
|
local Cell aux2;
|
|
while (true) {
|
|
aux1 = x;
|
|
while (aux1.typ == NODE) {
|
|
if (aux1.car.typ != NODE || aux1.car.car.typ != NODE) {
|
|
eval(aux1.car);
|
|
aux1 = aux1.cdr;
|
|
} else
|
|
if (aux1.car.car.car.typ != NODE) {
|
|
aux2 = eval(aux1.car.car);
|
|
if (aux2 != nilAtom) {
|
|
return evalbody(aux2, aux1.car.cdr);
|
|
}
|
|
aux1 = aux1.cdr;
|
|
} else {
|
|
evalbody(nilAtom, aux1.car);
|
|
aux1 = aux1.cdr;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
Cell prog1(Cell x) {
|
|
// ATTENTION: CBN
|
|
local Cell aux;
|
|
aux = eval(x.car);
|
|
x = x.cdr;
|
|
while (x.typ == NODE) {
|
|
eval(x.car);
|
|
x = x.cdr;
|
|
}
|
|
return aux;
|
|
}
|
|
|
|
Cell driver() {
|
|
local Cell aux1;
|
|
local Cell aux2;
|
|
rdsAtom.car = nilAtom;
|
|
wrsAtom.car = nilAtom;
|
|
echoAtom.car = nilAtom;
|
|
readchAtom.car = readchAtom;
|
|
while (true) {
|
|
printChar('\n');
|
|
printChar('$');
|
|
printChar('\n');
|
|
//printChar('\n');
|
|
//printChar('$');
|
|
//printChar(' ');
|
|
aux1 = read();
|
|
aux2 = eval(aux1);
|
|
print(aux2);
|
|
}
|
|
// never reached
|
|
return nilAtom;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// P. Memory Management Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell reclaim() {
|
|
// not implemented
|
|
error("RECLAIM not implemented", false);
|
|
return nilAtom;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// Q. Environment Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell save(Cell x, Cell y) {
|
|
error("SAVE not implemented", false);
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell load(Cell x, Cell y) {
|
|
error("LOAD not implemented", false);
|
|
return nilAtom;
|
|
}
|
|
|
|
Cell system() {
|
|
writeString("\nThanks for using Ninja LISP!\n\n");
|
|
exit();
|
|
// never reached
|
|
return nilAtom;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// R. Mutator Functions
|
|
// -------------------------------------------------------------
|
|
|
|
Cell xchgpname(Cell x, Cell y) {
|
|
local String name;
|
|
if (x.typ != NAME || y.typ != NAME) {
|
|
return nilAtom;
|
|
}
|
|
name = x.name;
|
|
x.name = y.name;
|
|
y.name = name;
|
|
return tAtom;
|
|
}
|
|
|
|
Cell purgename(Cell x) {
|
|
local Cell aux;
|
|
if (x.typ != NAME) {
|
|
return nilAtom;
|
|
}
|
|
aux = objectList;
|
|
if (aux.typ == NODE) {
|
|
if (aux.car == x) {
|
|
objectList = aux.cdr;
|
|
return tAtom;
|
|
}
|
|
while (aux.cdr.typ == NODE) {
|
|
if (aux.cdr.car == x) {
|
|
aux.cdr = aux.cdr.cdr;
|
|
return tAtom;
|
|
}
|
|
aux = aux.cdr;
|
|
}
|
|
}
|
|
return nilAtom;
|
|
}
|
|
|
|
// -------------------------------------------------------------
|
|
// Main Program
|
|
// -------------------------------------------------------------
|
|
|
|
void initConstants() {
|
|
NAME = 0;
|
|
NUMBER = 1;
|
|
NODE = 2;
|
|
}
|
|
|
|
void initCharTypes() {
|
|
local Integer i;
|
|
RAS = new(Boolean[128]);
|
|
RAB = new(Boolean[128]);
|
|
RES = new(Boolean[128]);
|
|
REB = new(Boolean[128]);
|
|
OSP = new(Boolean[128]);
|
|
i = 0;
|
|
while (i < 128) {
|
|
RAS[i] = false;
|
|
RAB[i] = false;
|
|
RES[i] = false;
|
|
REB[i] = false;
|
|
OSP[i] = false;
|
|
i = i + 1;
|
|
}
|
|
// ratom separator characters
|
|
RAS[char2int(' ')] = true;
|
|
RAS[char2int('\r')] = true;
|
|
RAS[char2int('\n')] = true;
|
|
RAS[char2int('\t')] = true;
|
|
// ratom break characters
|
|
RAB[char2int('!')] = true;
|
|
RAB[char2int('$')] = true;
|
|
RAB[char2int('&')] = true;
|
|
RAB[char2int('\'')] = true;
|
|
RAB[char2int('(')] = true;
|
|
RAB[char2int(')')] = true;
|
|
RAB[char2int('*')] = true;
|
|
RAB[char2int('+')] = true;
|
|
RAB[char2int(',')] = true;
|
|
RAB[char2int('-')] = true;
|
|
RAB[char2int('.')] = true;
|
|
RAB[char2int('/')] = true;
|
|
RAB[char2int('@')] = true;
|
|
RAB[char2int(':')] = true;
|
|
RAB[char2int(';')] = true;
|
|
RAB[char2int('<')] = true;
|
|
RAB[char2int('=')] = true;
|
|
RAB[char2int('>')] = true;
|
|
RAB[char2int('?')] = true;
|
|
RAB[char2int('[')] = true;
|
|
RAB[char2int('\\')] = true;
|
|
RAB[char2int(']')] = true;
|
|
RAB[char2int('^')] = true;
|
|
RAB[char2int('_')] = true;
|
|
RAB[char2int('`')] = true;
|
|
RAB[char2int('{')] = true;
|
|
RAB[char2int('|')] = true;
|
|
RAB[char2int('}')] = true;
|
|
RAB[char2int('~')] = true;
|
|
// read separator characters
|
|
RES[char2int(' ')] = true;
|
|
RES[char2int(',')] = true;
|
|
RES[char2int('\r')] = true;
|
|
RES[char2int('\n')] = true;
|
|
RES[char2int('\t')] = true;
|
|
// read break characters
|
|
REB[char2int('(')] = true;
|
|
REB[char2int(')')] = true;
|
|
REB[char2int('.')] = true;
|
|
REB[char2int('[')] = true;
|
|
REB[char2int(']')] = true;
|
|
// other special characters
|
|
OSP[char2int('\"')] = true;
|
|
OSP[char2int('%')] = true;
|
|
}
|
|
|
|
void initObjects() {
|
|
// init NIL, objectList, and argStack
|
|
nilAtom = makeNil();
|
|
objectList = nilAtom;
|
|
addOblist(nilAtom);
|
|
argStack = nilAtom;
|
|
// init other objects and functions
|
|
tAtom = makeObject("T");
|
|
subrAtom = makeObject("SUBR");
|
|
nsubrAtom = makeObject("NSUBR");
|
|
lambdaAtom = makeObject("LAMBDA");
|
|
nlambdaAtom = makeObject("NLAMBDA");
|
|
echoAtom = makeObject("ECHO");
|
|
readAtom = makeBuiltin("READ", subrAtom, 64);
|
|
ratomAtom = makeBuiltin("RATOM", subrAtom, 63);
|
|
readchAtom = makeBuiltin("READCH", subrAtom, 65);
|
|
rdsAtom = makeBuiltin("RDS", subrAtom, 62);
|
|
printAtom = makeBuiltin("PRINT", subrAtom, 67);
|
|
prin1Atom = makeBuiltin("PRIN1", subrAtom, 68);
|
|
wrsAtom = makeBuiltin("WRS", subrAtom, 66);
|
|
driverAtom = makeBuiltin("DRIVER", subrAtom, 79);
|
|
carAtom = makeBuiltin("CAR", subrAtom, 0);
|
|
cdrAtom = makeBuiltin("CDR", subrAtom, 1);
|
|
cadrAtom = makeBuiltin("CADR", subrAtom, 3);
|
|
cddrAtom = makeBuiltin("CDDR", subrAtom, 5);
|
|
caddrAtom = makeBuiltin("CADDR", subrAtom, 9);
|
|
cdddrAtom = makeBuiltin("CDDDR", subrAtom, 13);
|
|
caarAtom = makeBuiltin("CAAR", subrAtom, 2);
|
|
cdarAtom = makeBuiltin("CDAR", subrAtom, 4);
|
|
caaarAtom = makeBuiltin("CAAAR", subrAtom, 6);
|
|
cdaarAtom = makeBuiltin("CDAAR", subrAtom, 10);
|
|
cadarAtom = makeBuiltin("CADAR", subrAtom, 8);
|
|
cddarAtom = makeBuiltin("CDDAR", subrAtom, 12);
|
|
caadrAtom = makeBuiltin("CAADR", subrAtom, 7);
|
|
cdadrAtom = makeBuiltin("CDADR", subrAtom, 11);
|
|
consAtom = makeBuiltin("CONS", subrAtom, 14);
|
|
rplacaAtom = makeBuiltin("RPLACA", subrAtom, 18);
|
|
rplacdAtom = makeBuiltin("RPLACD", subrAtom, 19);
|
|
nconcAtom = makeBuiltin("NCONC", subrAtom, 20);
|
|
setAtom = makeBuiltin("SET", subrAtom, 38);
|
|
assocAtom = makeBuiltin("ASSOC", subrAtom, 42);
|
|
putAtom = makeBuiltin("PUT", subrAtom, 44);
|
|
getAtom = makeBuiltin("GET", subrAtom, 43);
|
|
memberAtom = makeBuiltin("MEMBER", subrAtom, 31);
|
|
rempropAtom = makeBuiltin("REMPROP", subrAtom, 45);
|
|
flagpAtom = makeBuiltin("FLAGP", subrAtom, 46);
|
|
flagAtom = makeBuiltin("FLAG", subrAtom, 47);
|
|
remflagAtom = makeBuiltin("REMFLAG", subrAtom, 48);
|
|
movdAtom = makeBuiltin("MOVD", subrAtom, 51);
|
|
putdAtom = makeBuiltin("PUTD", subrAtom, 50);
|
|
getdAtom = makeBuiltin("GETD", subrAtom, 49);
|
|
packAtom = makeBuiltin("PACK", subrAtom, 52);
|
|
unpackAtom = makeBuiltin("UNPACK", subrAtom, 53);
|
|
lengthAtom = makeBuiltin("LENGTH", subrAtom, 54);
|
|
reverseAtom = makeBuiltin("REVERSE", subrAtom, 16);
|
|
oblistAtom = makeBuiltin("OBLIST", subrAtom, 17);
|
|
atomAtom = makeBuiltin("ATOM", subrAtom, 23);
|
|
nameAtom = makeBuiltin("NAME", subrAtom, 21);
|
|
nullAtom = makeBuiltin("NULL", subrAtom, 24);
|
|
notAtom = makeBuiltin("NOT", subrAtom, 35);
|
|
orderpAtom = makeBuiltin("ORDERP", subrAtom, 34);
|
|
orderedAtom = makeObject("ORDERED");
|
|
eqAtom = makeBuiltin("EQ", subrAtom, 29);
|
|
equalAtom = makeBuiltin("EQUAL", subrAtom, 30);
|
|
applyAtom = makeBuiltin("APPLY", subrAtom, 75);
|
|
evalAtom = makeBuiltin("EVAL", subrAtom, 74);
|
|
reclaimAtom = makeBuiltin("RECLAIM", subrAtom, 80);
|
|
terpriAtom = makeBuiltin("TERPRI", subrAtom, 69);
|
|
spacesAtom = makeBuiltin("SPACES", subrAtom, 70);
|
|
linelengthAtom = makeBuiltin("LINELENGTH", subrAtom, 71);
|
|
radixAtom = makeBuiltin("RADIX", subrAtom, 72);
|
|
loadAtom = makeBuiltin("LOAD", subrAtom, 82);
|
|
saveAtom = makeBuiltin("SAVE", subrAtom, 81);
|
|
systemAtom = makeBuiltin("SYSTEM", subrAtom, 83);
|
|
numberpAtom = makeBuiltin("NUMBERP", subrAtom, 22);
|
|
greaterpAtom = makeBuiltin("GREATERP", subrAtom, 32);
|
|
lesspAtom = makeBuiltin("LESSP", subrAtom, 33);
|
|
pluspAtom = makeBuiltin("PLUSP", subrAtom, 25);
|
|
minuspAtom = makeBuiltin("MINUSP", subrAtom, 26);
|
|
zeropAtom = makeBuiltin("ZEROP", subrAtom, 27);
|
|
evenAtom = makeBuiltin("EVEN", subrAtom, 28);
|
|
minusAtom = makeBuiltin("MINUS", subrAtom, 55);
|
|
plusAtom = makeBuiltin("PLUS", subrAtom, 56);
|
|
differenceAtom = makeBuiltin("DIFFERENCE", subrAtom, 57);
|
|
timesAtom = makeBuiltin("TIMES", subrAtom, 58);
|
|
divideAtom = makeBuiltin("DIVIDE", subrAtom, 61);
|
|
quotientAtom = makeBuiltin("QUOTIENT", subrAtom, 59);
|
|
remainderAtom = makeBuiltin("REMAINDER", subrAtom, 60);
|
|
listAtom = makeBuiltin("LIST", nsubrAtom, 15);
|
|
quoteAtom = makeBuiltin("QUOTE", nsubrAtom, 73);
|
|
condAtom = makeBuiltin("COND", nsubrAtom, 76);
|
|
loopAtom = makeBuiltin("LOOP", nsubrAtom, 77);
|
|
prog1Atom = makeBuiltin("PROG1", nsubrAtom, 78);
|
|
andAtom = makeBuiltin("AND", nsubrAtom, 36);
|
|
orAtom = makeBuiltin("OR", nsubrAtom, 37);
|
|
setqAtom = makeBuiltin("SETQ", nsubrAtom, 39);
|
|
popAtom = makeBuiltin("POP", nsubrAtom, 40);
|
|
pushAtom = makeBuiltin("PUSH", nsubrAtom, 41);
|
|
xchgpnameAtom = makeBuiltin("XCHGPNAME", subrAtom, 84);
|
|
purgenameAtom = makeBuiltin("PURGENAME", subrAtom, 85);
|
|
}
|
|
|
|
void initCtlVars() {
|
|
unreadPresent = false;
|
|
rdsAtom.car = nilAtom;
|
|
readAtom.car = readAtom;
|
|
readchAtom.car = readchAtom;
|
|
echoAtom.car = nilAtom;
|
|
wrsAtom.car = nilAtom;
|
|
printAtom.car = printAtom;
|
|
prin1Atom.car = prin1Atom;
|
|
cursPos = 0;
|
|
lineLen = 79;
|
|
numBase = 10;
|
|
}
|
|
|
|
void main() {
|
|
// write greeting
|
|
writeString("\nWelcome to Ninja LISP!\n");
|
|
// initialization
|
|
initConstants();
|
|
initCharTypes();
|
|
initObjects();
|
|
initCtlVars();
|
|
// start interpreter
|
|
while (true) {
|
|
apply(driverAtom, nilAtom);
|
|
}
|
|
}
|