_b_e_g_i_n _c_o_m_m_e_n_t ALGOL 60 version of program lisp(input,output).
*** version 1, March 28, l988 ***
*** author: F.E.J. Kruseman Aretz ***
*** Philips Research Laboratory Eindhoven ***;
_i_n_t_e_g_e_r maxidf,maxnbr,maxstruct; maxidf:= 200; maxnbr:= 200; maxstruct:= 2000;
_b_e_g_i_n
_i_n_t_e_g_e_r sym,shift,lastidf,lastnbr,d24,d25,free,indentation,linewidth,dummy,
f,
args,
p,
id,
olp,
t,
nilv,
quote,
cond,
lambda,
define,
car,
cdr,
cons,
equal,
atom,
numberp,
lessp,
greaterp,
add1,
sub1,
add,
minus,
timesv,
divf;
_i_n_t_e_g_e_r _a_r_r_a_y idf[0:maxidf,0:9],alist[0:maxidf];
_r_e_a_l _a_r_r_a_y nbr[0:maxnbr];
_i_n_t_e_g_e_r _a_r_r_a_y a,d[1:maxstruct];
_b_o_o_l_e_a_n _a_r_r_a_y m[1:maxstruct];
_c_o_m_m_e_n_t *** error handling ***;
_p_r_o_c_e_d_u_r_e errorhandler(errorstring); _s_t_r_i_n_g errorstring;
_b_e_g_i_n NLCR; NLCR; PRINTTEXT(|<+++ error: |>); PRINTTEXT(errorstring);
_g_o_t_o ex;
_e_n_d errorhandler;
_c_o_m_m_e_n_t *** representation dependent functions ***;
_p_r_o_c_e_d_u_r_e collect garbage;
_b_e_g_i_n _i_n_t_e_g_e_r i,j;
free:= 0;
_f_o_r i:= 1 _s_t_e_p 1 _u_n_t_i_l maxstruct _d_o m[i]:= _t_r_u_e;
NLCR; PRINTTEXT(|<garbage collector: |>);
mark(olp);
_f_o_r i:= 0 _s_t_e_p 1 _u_n_t_i_l lastidf - 1 _d_o mark(alist[i]);
_f_o_r i:= 1 _s_t_e_p 1 _u_n_t_i_l maxstruct _d_o
_i_f m[i] _t_h_e_n _b_e_g_i_n a[i]:= free; free:= i _e_n_d;
_i_f free = 0 _t_h_e_n errorhandler(|<free list exhausted|>);
i:= 1; j:= free;
_f_o_r j:= carf(j) _w_h_i_l_e j |= 0 _d_o i:= i + 1;
ABSFIXT(4,0,i); NLCR
_e_n_d collect garbage;
_p_r_o_c_e_d_u_r_e mark(ref); _v_a_l_u_e ref; _i_n_t_e_g_e_r ref;
_b_e_g_i_n
work: _i_f ref < d24
_t_h_e_n _b_e_g_i_n _i_f m[ref]
_t_h_e_n _b_e_g_i_n m[ref]:= _f_a_l_s_e;
mark(a[ref]); ref:= d[ref]; _g_o_t_o work
_e_n_d
_e_n_d
_e_n_d mark;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e createidf;
_b_e_g_i_n _i_n_t_e_g_e_r i,j;
i:= 0;
_f_o_r dummy:= 0 _w_h_i_l_e i < lastidf _d_o
_b_e_g_i_n _f_o_r j:= 0 _s_t_e_p 1 _u_n_t_i_l 9 _d_o
_i_f idf[lastidf,j] |= idf[i,j] _t_h_e_n _g_o_t_o diff;
_g_o_t_o old;
diff: i:= i + 1
_e_n_d;
new: i:= lastidf; alist[i]:= nilv; lastidf:= lastidf + 1;
_i_f lastidf = maxidf _t_h_e_n
_b_e_g_i_n _f_o_r i:= 0 _s_t_e_p 1 _u_n_t_i_l 99 _d_o
_b_e_g_i_n NLCR; write(d25+i) _e_n_d;
errorhandler(|<too much identifiers|>)
_e_n_d;
old: createidf:= d25 + i
_e_n_d createidf;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e createnum(x); _r_e_a_l x;
_b_e_g_i_n _i_n_t_e_g_e_r i;
nbr[last nbr]:= x; i:= 0;
_f_o_r dummy:= 0 _w_h_i_l_e i < last nbr _d_o
_b_e_g_i_n _i_f nbr[last nbr] = nbr[i] _t_h_e_n _g_o_t_o old;
i:= i + 1
_e_n_d;
new: i:= last nbr; last nbr:= last nbr + 1;
_i_f last nbr = maxnbr _t_h_e_n errorhandler(|<too much numbers|>);
old: createnum:= d24 + i
_e_n_d createnum;
_b_o_o_l_e_a_n _p_r_o_c_e_d_u_r_e atomf(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n atomf:= x _> d24 _e_n_d atomf;
_b_o_o_l_e_a_n _p_r_o_c_e_d_u_r_e numberpf(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n numberpf:= x _> d24 ^ x < d25 _e_n_d numberpf;
_p_r_o_c_e_d_u_r_e getidfval(x,idf); _v_a_l_u_e x; _i_n_t_e_g_e_r x,idf;
_b_e_g_i_n idf:= x - d25 _e_n_d getidfval;
APPENDIX A. SAMPLE PROGRAMS
- 1
_r_e_a_l _p_r_o_c_e_d_u_r_e numval(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n numval:=nbr[ x - d24] _e_n_d numval;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e carf(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n _i_f x _> d24
_t_h_e_n errorhandler(|<car undefined for atomic lisp value|>);
carf:= a[x]
_e_n_d carf;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e cdrf(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n _i_f x _> d24
_t_h_e_n errorhandler(|<cdr undefined for atomic lisp value|>);
cdrf:= d[x]
_e_n_d cdrf;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e consf(x,y);
_v_a_l_u_e x,y; _i_n_t_e_g_e_r x,y;
_b_e_g_i_n _i_n_t_e_g_e_r n;
_i_f free = 0 _t_h_e_n collect garbage;
n:= free; free:= a[free];
a[n]:= x; d[n]:= y; consf:= n
_e_n_d consf;
_p_r_o_c_e_d_u_r_e returncell(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n a[x]:= free; free:= x _e_n_d;
_p_r_o_c_e_d_u_r_e returnlist(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n _f_o_r dummy:= 0 _w_h_i_l_e x |= nilv _d_o
_b_e_g_i_n returncell(x); x:= d[x] _e_n_d
_e_n_d returnlist;
_p_r_o_c_e_d_u_r_e recycle(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n _f_o_r dummy:= 0 _w_h_i_l_e ~ atomf(x) _d_o
_b_e_g_i_n recycle(a[x]); returncell(x); x:= d[x] _e_n_d
_e_n_d recycle;
_b_o_o_l_e_a_n _p_r_o_c_e_d_u_r_e equalf(x,y);
_v_a_l_u_e x,y; _i_n_t_e_g_e_r x,y;
_b_e_g_i_n _s_w_i_t_c_h s:= str,num,id;
work:
_i_f x _: d24 = y _: d24
_t_h_e_n _b_e_g_i_n _g_o_t_o s[x _: d24 + 1];
id: num: equalf:= x = y; _g_o_t_o ex;
str: _i_f equalf(a[x],a[y])
_t_h_e_n _b_e_g_i_n x:= d[x]; y:= d[y];
_g_o_t_o work
_e_n_d
_e_l_s_e equalf:= _f_a_l_s_e
_e_n_d
_e_l_s_e equalf := _f_a_l_s_e;
ex:
_e_n_d equalf;
_c_o_m_m_e_n_t *** input procedures ***;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e RESYM;
_b_e_g_i_n _i_n_t_e_g_e_r s;
s:= read;
_i_f s = 122 # s = 124 _t_h_e_n _b_e_g_i_n shift:= s;
RESYM:= RESYM
_e_n_d _e_l_s_e
_i_f s = 16 _t_h_e_n RESYM:= 93 _e_l_s_e
_i_f s = 26 _t_h_e_n RESYM:= 119 _e_l_s_e
_i_f s = 8 ^ shift = 124 _t_h_e_n RESYM:= 98 _e_l_s_e
_i_f s = 25 ^ shift = 124 _t_h_e_n RESYM:= 99 _e_l_s_e
_i_f s = 107 _t_h_e_n RESYM:= 88 _e_l_s_e
_i_f s = 32 _t_h_e_n RESYM:= 0 _e_l_s_e
_b_e_g_i_n s:= s_:32*32 + s - s_:16*16;
_i_f s = 0 _t_h_e_n errorhandler(|<eof|>);
RESYM:= _i_f s < 10 _t_h_e_n s _e_l_s_e
_i_f s < 64 _t_h_e_n s - 6 _e_l_s_e
_i_f s < 96 _t_h_e_n s - 46 _e_l_s_e s - 87
_e_n_d
_e_n_d RESYM;
_p_r_o_c_e_d_u_r_e nextsym;
_b_e_g_i_n sym:= RESYM; PRSYM(sym) _e_n_d nextsym;
_p_r_o_c_e_d_u_r_e skipspaces;
_b_e_g_i_n _f_o_r dummy:= 0
_w_h_i_l_e sym = 93 # sym = 118 # sym = 119 _d_o nextsym
_e_n_d skipspaces;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e number;
_b_e_g_i_n _r_e_a_l x; _b_o_o_l_e_a_n signed;
x:= 0; signed:= (sym = 65);
_i_f signed
_t_h_e_n _b_e_g_i_n nextsym;
_i_f sym > 9 _t_h_e_n errorhandler(|<digit expected in input|>)
_e_n_d;
_f_o_r dummy:= 0 _w_h_i_l_e sym < 10 _d_o
_b_e_g_i_n x:= 10 * x + sym; nextsym _e_n_d;
number:= createnum(_i_f signed _t_h_e_n -x _e_l_s_e x)
_e_n_d number;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e identifier;
_b_e_g_i_n _i_n_t_e_g_e_r i;
idf[lastidf,0]:= sym; nextsym;
_f_o_r i:= 1 _s_t_e_p 1 _u_n_t_i_l 9 _d_o idf[lastidf,i]:= 93;
i:= 0;
_f_o_r dummy:= 0 _w_h_i_l_e sym < 64 ^ i < 9 _d_o
_b_e_g_i_n i:= i + 1; idf[lastidf,i]:= sym; nextsym _e_n_d;
_f_o_r dummy:= 0 _w_h_i_l_e sym < 64 _d_o nextsym;
identifier:= createidf
_e_n_d identifier;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e nextitem;
_b_e_g_i_n _i_n_t_e_g_e_r lv,op;
skipspaces;
_i_f sym < 10 # sym = 65 _t_h_e_n nextitem:= number
_e_l_s_e
_i_f sym < 64 _t_h_e_n nextitem := identifier
_e_l_s_e
_i_f sym = 98
APPENDIX A. SAMPLE PROGRAMS
- 1
_t_h_e_n _b_e_g_i_n nextsym; skipspaces;
_i_f sym = 99
_t_h_e_n _b_e_g_i_n nextitem:= nilv; nextsym _e_n_d
_e_l_s_e _b_e_g_i_n op:= olp; olp:= consf(nilv,op);
lv:= a[olp]:= consf(nilv,nilv); nextitem:= lv;
a[lv]:= nextitem; skipspaces;
_i_f sym = 88
_t_h_e_n _b_e_g_i_n nextsym; d[lv]:= nextitem;
skipspaces;
_i_f sym |= 99
_t_h_e_n errorhandler
(|<close missing for dotted pair in input|>)
_e_n_d
_e_l_s_e _f_o_r dummy:= 0 _w_h_i_l_e sym |= 99 _d_o
_b_e_g_i_n lv:= d[lv]:= consf(nilv,nilv);
a[lv]:= nextitem; skipspaces
_e_n_d;
nextsym;
olp:= op
_e_n_d;
_e_n_d
_e_l_s_e
_i_f sym = 120
_t_h_e_n _b_e_g_i_n nextsym;
op:= olp; olp:= consf(nilv,olp);
lv:= a[olp]:= consf(nilv,nilv); nextitem:= lv;
a[lv]:= quote; lv:= d[lv]:= consf(nilv,nilv); a[lv]:= nextitem;
olp:= op
_e_n_d
_e_l_s_e errorhandler(|<illegal symbol in input|>)
_e_n_d nextitem;
_c_o_m_m_e_n_t *** output procedures ***;
_p_r_o_c_e_d_u_r_e PRSYM(sym); _v_a_l_u_e sym; _i_n_t_e_g_e_r sym;
_b_e_g_i_n _s_w_i_t_c_h sw:= a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,
a,b,c,d,e,f,g,h,i,j,k,l,m,
n,o,p,q,r,s,t,u,v,w,x,y,z;
_i_f sym = 93 _t_h_e_n SPACE(1) _e_l_s_e
_i_f sym = 88 _t_h_e_n PRINTTEXT(|<.|>) _e_l_s_e
_i_f sym = 98 _t_h_e_n PRINTTEXT(|<(|>) _e_l_s_e
_i_f sym = 99 _t_h_e_n PRINTTEXT(|<)|>) _e_l_s_e
_i_f sym = 119 _t_h_e_n NLCR _e_l_s_e
_b_e_g_i_n _i_f sym > 35
_t_h_e_n errorhandler(|<illegal output symbol|>);
_g_o_t_o sw[sym+1];
a0: PRINTTEXT(|<0|>); _g_o_t_o ex;
a1: PRINTTEXT(|<1|>); _g_o_t_o ex;
a2: PRINTTEXT(|<2|>); _g_o_t_o ex;
a3: PRINTTEXT(|<3|>); _g_o_t_o ex;
a4: PRINTTEXT(|<4|>); _g_o_t_o ex;
a5: PRINTTEXT(|<5|>); _g_o_t_o ex;
a6: PRINTTEXT(|<6|>); _g_o_t_o ex;
a7: PRINTTEXT(|<7|>); _g_o_t_o ex;
a8: PRINTTEXT(|<8|>); _g_o_t_o ex;
a9: PRINTTEXT(|<9|>); _g_o_t_o ex;
a: PRINTTEXT(|<a|>); _g_o_t_o ex;
b: PRINTTEXT(|<b|>); _g_o_t_o ex;
c: PRINTTEXT(|<c|>); _g_o_t_o ex;
d: PRINTTEXT(|<d|>); _g_o_t_o ex;
e: PRINTTEXT(|<e|>); _g_o_t_o ex;
f: PRINTTEXT(|<f|>); _g_o_t_o ex;
g: PRINTTEXT(|<g|>); _g_o_t_o ex;
h: PRINTTEXT(|<h|>); _g_o_t_o ex;
i: PRINTTEXT(|<i|>); _g_o_t_o ex;
j: PRINTTEXT(|<j|>); _g_o_t_o ex;
k: PRINTTEXT(|<k|>); _g_o_t_o ex;
l: PRINTTEXT(|<l|>); _g_o_t_o ex;
m: PRINTTEXT(|<m|>); _g_o_t_o ex;
n: PRINTTEXT(|<n|>); _g_o_t_o ex;
o: PRINTTEXT(|<o|>); _g_o_t_o ex;
p: PRINTTEXT(|<p|>); _g_o_t_o ex;
q: PRINTTEXT(|<q|>); _g_o_t_o ex;
r: PRINTTEXT(|<r|>); _g_o_t_o ex;
s: PRINTTEXT(|<s|>); _g_o_t_o ex;
t: PRINTTEXT(|<t|>); _g_o_t_o ex;
u: PRINTTEXT(|<u|>); _g_o_t_o ex;
v: PRINTTEXT(|<v|>); _g_o_t_o ex;
w: PRINTTEXT(|<w|>); _g_o_t_o ex;
x: PRINTTEXT(|<x|>); _g_o_t_o ex;
y: PRINTTEXT(|<y|>); _g_o_t_o ex;
z: PRINTTEXT(|<z|>)
_e_n_d;
ex:
_e_n_d PRSYM;
_p_r_o_c_e_d_u_r_e analyse(x,r); _v_a_l_u_e x; _i_n_t_e_g_e_r x,r;
_b_e_g_i_n _i_n_t_e_g_e_r n,l; _b_o_o_l_e_a_n simple;
_i_f numberpf(x)
_t_h_e_n _b_e_g_i_n _r_e_a_l dg,v,absv;
v:= numval(x);
_i_f v _> 0
_t_h_e_n _b_e_g_i_n absv:= v; l:= 1 _e_n_d
_e_l_s_e _b_e_g_i_n absv:= - v;l:= 2 _e_n_d;
dg:= 10;
_f_o_r dummy:= 0 _w_h_i_l_e dg _< absv _d_o
_b_e_g_i_n l:= l + 1; dg:= 10 * dg _e_n_d;
r:= createnum(l)
_e_n_d
_e_l_s_e
_i_f atomf(x)
_t_h_e_n _b_e_g_i_n getidfval(x,id); n:= 10;
_f_o_r dummy:= 0 _w_h_i_l_e idf[id,n-1] = 93 _d_o n:= n - 1;
r:= createnum(n)
_e_n_d
_e_l_s_e
_i_f islist(x)
_t_h_e_n _b_e_g_i_n indentation:= indentation + 1;
analyselist(x,r,l,simple);
indentation:= indentation - 1;
_i_f simple ^ indentation + l _< linewidth
_t_h_e_n _b_e_g_i_n recycle(r); r:= createnum(l) _e_n_d
_e_n_d
_e_l_s_e _b_e_g_i_n indentation:= indentation + 1;
olp:= consf(nilv,olp);
r:= a[olp]:= consf(nilv,nilv);
analyse(carf(x),a[r]); analyse(cdrf(x),d[r]);
indentation:= indentation - 1;
APPENDIX A. SAMPLE PROGRAMS
- 1
_i_f atomf(a[r]) ^ atomf(d[r])
_t_h_e_n _b_e_g_i_n l:= numval(carf(r)) + numval(cdrf(r)) + 5;
_i_f indentation + l _< linewidth
_t_h_e_n _b_e_g_i_n recycle(r); r:= createnum(l) _e_n_d
_e_n_d;
returncell(olp); olp:= d[olp]
_e_n_d
_e_n_d analyse;
_p_r_o_c_e_d_u_r_e analyselist(x,r,l,simple);
_v_a_l_u_e x; _i_n_t_e_g_e_r x,r,l; _b_o_o_l_e_a_n simple;
_b_e_g_i_n _i_f x = nilv
_t_h_e_n _b_e_g_i_n r:= nilv; l:= 1; simple:= _t_r_u_e _e_n_d
_e_l_s_e _b_e_g_i_n olp:= consf(nilv, olp);
r:= a[olp]:= consf(nilv,nilv);
analyse(carf(x),a[r]); analyselist(cdrf(x),d[r],l,simple);
_i_f simple ^ atomf(a[r])
_t_h_e_n l:= numval(a[r]) + l + 1
_e_l_s_e simple:= _f_a_l_s_e;
returncell(olp); olp:= d[olp]
_e_n_d
_e_n_d analyselist;
_b_o_o_l_e_a_n _p_r_o_c_d_u_r_e islist(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n
work: _i_f atomf(x)
_t_h_e_n islist:= equalf(x,nilv)
_e_l_s_e _b_e_g_i_n x:= cdrf(x); _g_o_t_o work _e_n_d
_e_n_d islist;
_p_r_o_c_e_d_u_r_e writenumber(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n _i_n_t_e_g_e_r n,d,v;
v:= numval(x);
_i_f v < 0 _t_h_e_n v:= - v;
d:= 10;
_f_o_r dummy:= 0 _w_h_i_l_e d _< v _d_o d:= d * 10;
_f_o_r d:= d _: 10 _w_h_i_l_e d > 0.5 _d_o
_b_e_g_i_n n:= v_: d; PRSYM(n); v:= v - d * n _e_n_d
_e_n_d writenumber;
_p_r_o_c_e_d_u_r_e writeidentifier(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n _i_n_t_e_g_e_r i;
getidfval(x,id);
_f_o_r i:= 0 _s_t_e_p 1 _u_n_t_i_l 9 _d_o
_i_f idf[id,i] |= 93 _t_h_e_n PRSYM(idf[id,i])
_e_n_d writeidentifier;
_p_r_o_c_e_d_u_r_e writelist(x,r); _v_a_l_u_e x,r; _i_n_t_e_g_e_r x,r;
_b_e_g_i_n _i_n_t_e_g_e_r a,ind; _b_o_o_l_e_a_n simple,nl;
PRSYM(98);
_i_f atomf(r)
_t_h_e_n _b_e_g_i_n _f_o_r dummy:= 0 _w_h_i_l_e x |= nilv _d_o
_b_e_g_i_n writevalue(carf(x),r); x:= cdrf(x);
_i_f x |= nilv _t_h_e_n PRSYM(93)
_e_n_d
_e_n_d
_e_l_s_e _b_e_g_i_n indentation:= indentation + 1; ind:= indentation;
_f_o_r dummy:= 0 _w_h_i_l_e x |= nilv _d_o
_b_e_g_i_n a:= carf(r);
simple:= atomf(a);
_i_f simple
_t_h_e_n nl:= numval(a) + indentation > linewidth
_e_l_s_e nl:= indentation > ind;
_i_f nl
_t_h_e_n _b_e_g_i_n indentation:= ind;
NLCR; SPACE(ind)
_e_n_d
_e_l_s_e _i_f indentation > ind _t_h_e_n PRSYM(93);
writevalue(carf(x),a);
_i_f simple
_t_h_e_n indentation:= indentation + numval(a) + 1
_e_l_s_e indentation:= linewidth + 1;
x:= cdrf(x); r:= cdrf(r)
_e_n_d;
indentation:= ind - 1; NLCR; SPACE(indentation)
_e_n_d;
PRSYM(99)
_e_n_d writelist;
_p_r_o_c_e_d_u_r_e writepair(x,r); _v_a_l_u_e x,r; _i_n_t_e_g_e_r x,r;
_b_e_g_i_n PRSYM(98);
_i_f atomf(r)
_t_h_e_n _b_e_g_i_n writevalue(carf(x),r); PRINTTEXT(|< . |>);
writevalue(cdrf(x),r)
_e_n_d
_e_l_s_e _b_e_g_i_n indentation:= indentation + 1;
writevalue(carf(x),carf(r));
NLCR; SPACE(indentation-1); PRINTTEXT(|< . |>);
NLCR; SPACE(indentation); writevalue(cdrf(x),cdrf(r));
NLCR; SPACE(indentation)
_e_n_d;
PRSYM(99)
_e_n_d writepair;
_p_r_o_c_e_d_u_r_e writevalue(x,r); _v_a_l_u_e x,r; _i_n_t_e_g_e_r x,r;
_b_e_g_i_n _i_f numberpf(x) _t_h_e_n writenumber(x)
_e_l_s_e
_i_f atomf(x) _t_h_e_n writeidentifier(x)
_e_l_s_e
_i_f islist(x) _t_h_e_n writelist(x,r)
_e_l_s_e writepair(x,r)
_e_n_d writevalue;
_p_r_o_c_e_d_u_r_e write(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n _i_n_t_e_g_e_r r;
indentation:= 0;
analyse(x,r); writevalue(x,r); recycle(r)
_e_n_d write;
_c_o_m_m_e_n_t *** interpreter proper ***;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e assoc(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n _i_n_t_e_g_e_r ax;
getidfval(x,id); ax:= alist[id];
_i_f ax = nilv _t_h_e_n errorhandler(|<identifier has no value|>);
assoc:= carf(ax)
_e_n_d assoc;
APPENDIX A. SAMPLE PROGRAMS
- 1
_p_r_o_c_e_d_u_r_e pairlis(x,y); _v_a_l_u_e x,y; _i_n_t_e_g_e_r x,y;
_b_e_g_i_n _f_o_r dummy:= 0 _w_h_i_l_e ~ equalf(x,nilv) _d_o
_b_e_g_i_n getidfval(carf(x),id); alist[id]:= consf(carf(y),alist[id]);
x:= cdrf(x); y:= cdrf(y)
_e_n_d
_e_n_d pairlis;
_p_r_o_c_e_d_u_r_e depairlis(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n _f_o_r dummy:= 0 _w_h_i_l_e ~ equalf(x,nilv) _d_o
_b_e_g_i_n getidfval(carf(x),id); alist[id]:= cdrf(alist[id]);
x:= cdrf(x)
_e_n_d
_e_n_d depairlis;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e eval(e); _v_a_l_u_e e; _i_n_t_e_g_e_r e;
_b_e_g_i_n _i_n_t_e_g_e_r care;
work: _i_f atomf(e)
_t_h_e_n _b_e_g_i_n _i_f equalf(e,nilv) # equalf(e,t) # numberpf(e)
_t_h_e_n eval:= e _e_l_s_e eval:= assoc(e)
_e_n_d
_e_l_s_e _b_e_g_i_n care:= carf(e);
_i_f equalf(care,cond)
_t_h_e_n _b_e_g_i_n e:= evcon(cdrf(e)); _g_o_t_o work _e_n_d
_e_l_s_e _i_f equalf(care,quote)
_t_h_e_n eval:= carf(cdrf(e))
_e_l_s_e _b_e_g_i_n olp:= consf(nilv,olp);
a[olp]:= evlist(cdrf(e)); eval:= apply(care,a[olp]);
returnlist(a[olp]); returncell(olp); olp:= cdrf(olp)
_e_n_d
_e_n_d
_e_n_d eval;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e apply(f,x);
_v_a_l_u_e f,x; _i_n_t_e_g_e_r f,x;
_b_e_g_i_n
work: _i_f atomf(f)
_t_h_e_n _b_e_g_i_n
_i_f equalf(f,car) _t_h_e_n apply:= carf(carf(x))
_e_l_s_e
_i_f equalf(f,cdr) _t_h_e_n apply:= cdrf(carf(x))
_e_l_s_e
_i_f equalf(f,cons) _t_h_e_n apply:= consf(carf(x),carf(cdrf(x)))
_e_l_s_e
_i_f equalf(f,equal)
_t_h_e_n _b_e_g_i_n _i_f equalf(carf(x),carf(cdrf(x)))
_t_h_e_n apply:= t
_e_l_s_e apply:= nilv
_e_n_d
_e_l_s_e
_i_f equalf(f,atom) _t_h_e_n _b_e_g_i_n _i_f atomf(carf(x))
_t_h_e_n apply:= t
_e_l_s_e apply:= nilv
_e_n_d
_e_l_s_e
_i_f equalf(f,numberp) _t_h_e_n _b_e_g_i_n _i_f numberpf(carf(x))
_t_h_e_n apply:= t
_e_l_s_e apply:= nilv
_e_n_d
_e_l_s_e
_i_f equalf(f,lessp)
_t_h_e_n _b_e_g_i_n _i_f numval(carf(x)) < numval(carf(cdrf(x)))
_t_h_e_n apply:= t
_e_l_s_e apply:= nilv
_e_n_d
_e_l_s_e
_i_f equalf(f,greaterp)
_t_h_e_n _b_e_g_i_n _i_f numval(carf(x)) > numval(carf(cdrf(x)))
_t_h_e_n apply:= t
_e_l_s_e apply:= nilv
_e_n_d
_e_l_s_e
_i_f equalf(f,add)
_t_h_e_n apply:= createnum(numval(carf(x)) + 1)
_e_l_s_e
_i_f equalf(f,sub1)
_t_h_e_n apply:= createnum(numval(carf(x)) - 1)
_e_l_s_e
_i_f equalf(f,add)
_t_h_e_n apply:= createnum(numval(carf(x)) + numval(carf(cdrf(x))))
_e_l_s_e
_i_f equalf(f,minus)
_t_h_e_n apply:= createnum(numval(carf(x)) - numval(carf(cdrf(x))))
_e_l_s_e
_i_f equalf(f,timesv)
_t_h_e_n apply:= createnum(numval(carf(x)) * numval(carf(cdrf(x))))
_e_l_s_e
_i_f equalf(f,divf)
_t_h_e_n apply:= createnum(numval(carf(x)) _: numval(carf(cdrf(x))))
_e_l_s_e _b_e_g_i_n f:= assoc(f); _g_o_t_o work _e_n_d
_e_n_d
_e_l_s_e _b_e_g_i_n pairlis(carf(cdrf(f)),x);
apply:= eval(carf(cdrf(cdrf(f))));
depairlis(carf(cdrf(f)))
_e_n_d
_e_n_d apply;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e evcon(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n _i_n_t_e_g_e_r r;
work: r:= carf(x);
_i_f equalf(eval(carf(r)),nilv)
_t_h_e_n _b_e_g_i_n x:= cdrf(x); _g_o_t_o work _e_n_d
_e_l_s_e evcon:= carf(cdrf(r))
_e_n_d evcon;
_i_n_t_e_g_e_r _p_r_o_c_e_d_u_r_e evlist(x); _v_a_l_u_e x; _i_n_t_e_g_e_r x;
_b_e_g_i_n _i_n_t_e_g_e_r res;
_i_f equalf(x,nilv)
_t_h_e_n evlist:= nilv
_e_l_s_e _b_e_g_i_n olp:= consf(nilv,olp); a[olp]:= res:= consf(nilv,nilv);
a[res]:= eval(carf(x)); d[res]:= evlist(cdrf(x));
evlist:= res;
returncell(olp); olp:= cdrf(olp)
_e_n_d
_e_n_d evlist;
_c_o_m_m_e_n_t *** initialization ***;
APPENDIX A. SAMPLE PROGRAMS
- 1
_p_r_o_c_e_d_u_r_e create(lv); _i_n_t_e_g_e_r lv;
_b_e_g_i_n skipspaces;
lv:= identifier;
_e_n_d create;
_p_r_o_c_e_d_u_r_e init;
_b_e_g_i_n _i_n_t_e_g_e_r i,j;
d24:= 16777216; d25:= 33554432;
last idf:= 0; sym:= 93; nilv:= d25 + 1;
create(t); create(nilv);
create(quote); create(cond);
create(lambda); create(define);
create(car); create(cdr);
create(cons); create(equal);
create(atom); create(numberp);
create(lessp); create(greaterp);
create(add1); create(sub1);
create(add); create(minus);
create(timesv); create(divf);
olp:= nilv;
free:= 1; last nbr:= 0; linewidth:= 40;
_f_o_r i:= 1 _s_t_e_p 1 _u_n_t_i_l maxstruct - 1 _d_o a[i]:= i + 1;
a[maxstruct]:= 0
_e_n_d init;
_c_o_m_m_e_n_t *** main program ***;
_p_r_o_c_e_d_u_r_e function definitions(x,a,r); _v_a_l_u_e x; _i_n_t_e_g_e_r x,a,r;
_b_e_g_i_n _i_n_t_e_g_e_r carx,lr;
_i_f equalf(x,nilv)
_t_h_e_n r:= nilv
_e_l_s_e _b_e_g_i_n carx:= carf(x);
a:= consf(consf(carf(carx),carf(cdrf(carx))),a);
function definitions(cdrf(x),a,lr);
r:= consf(carf(carx),lr)
_e_n_d
_e_n_d function definitions;
PRINTTEXT(|<Lisp interpreter version 1, Oktober 2004|>);
NLCR; NLCR;
init;
_f_o_r dummy:= 0 _w_h_i_l_e _t_r_u_e _d_o
_b_e_g_i_n olp:= consf(nilv,olp); a[olp]:= p:= consf(nilv,nilv);
a[p]:= f:= nextitem; d[p]:= args:= nextitem;
NLCR;
_i_f equalf(f,define)
_t_h_e_n _b_e_g_i_n args:= carf(args); PRSYM(98);
_f_o_r dummy:= 0 _w_h_i_l_e ~ equalf(args,nilv) _d_o
_b_e_g_i_n p:= carf(args); write(carf(p));
getidfval(carf(p),id);
alist[id]:= consf(carf(cdrf(p)),nilv);
args:= cdrf(args);
_i_f ~ equalf(args,nilv) _t_h_e_n SPACE(1)
_e_n_d;
PRSYM(99)
_e_n_d
_e_l_s_e _b_e_g_i_n p:= apply(f,args);
NLCR; write(p)
_e_n_d;
olp:= cdrf(olp)
_e_n_d;
ex:
_e_n_d
_e_n_d