15static LISP llength(LISP
obj)
20 return(flocons(
obj->storage_as.string.dim));
22 return(flocons(
obj->storage_as.double_array.dim));
24 return(flocons(
obj->storage_as.long_array.dim));
26 return(flocons(
obj->storage_as.lisp_array.dim));
30 for(l=
obj,n=0;CONSP(l);l=CDR(l),++n) INTERRUPT_CHECK();
31 if NNULLP(l) err(
"improper list to length",
obj);
34 return(err(
"wrong type of argument to length",
obj));}}
36LISP assoc(LISP x,LISP alist)
38 for(l=alist;CONSP(l);l=CDR(l))
40 if (CONSP(tmp) && equal(CAR(tmp),x))
return(tmp);
42 if EQ(l,NIL)
return(NIL);
43 return(err(
"improper list to assoc",alist));}
45LISP assq(LISP x,LISP alist)
47 for(l=alist;CONSP(l);l=CDR(l))
49 if (CONSP(tmp) && EQ(CAR(tmp),x))
return(tmp);
51 if EQ(l,NIL)
return(NIL);
52 return(err(
"improper list to assq",alist));}
54LISP setcar(LISP cell, LISP value)
55{
if NCONSP(cell) err(
"wrong type of argument to setcar",cell);
56 return(CAR(cell) = value);}
58LISP setcdr(LISP cell, LISP value)
59{
if NCONSP(cell) err(
"wrong type of argument to setcdr",cell);
60 return(CDR(cell) = value);}
62LISP delq(LISP elem,LISP l)
63{
if NULLP(l)
return(l);
65 if EQ(elem,car(l))
return(cdr(l));
66 setcdr(l,delq(elem,cdr(l)));
70{
if NULLP(x)
return(NIL);
72 return(cons(car(x),copy_list(cdr(x))));}
74static LISP eq(LISP x,LISP y)
75{
if EQ(x,y)
return(truth);
else return(NIL);}
77LISP eql(LISP x,LISP y)
78{
if EQ(x,y)
return(truth);
79 if NFLONUMP(x)
return(NIL);
80 if NFLONUMP(y)
return(NIL);
81 if (FLONM(x) == FLONM(y))
return(truth);
84static LISP nullp(LISP x)
89LISP siod_flatten(LISP tree)
94 return append(siod_flatten(car(tree)),siod_flatten(cdr(tree)));
96 return cons(tree,NIL);
99LISP cons(LISP x,LISP y)
108 if ((x==NIL) || CONSP(x))
115{
if CONSP(x)
return(truth);
else return(NIL);}
124 return(err(
"wrong type of argument to car",x));}}
133 return(err(
"wrong type of argument to cdr",x));}}
135LISP equal(LISP a,LISP b)
141 if EQ(a,b)
return(truth);
143 if (atype != TYPE(b))
return(NIL);
146 if NULLP(equal(car(a),car(b)))
return(NIL);
151 return((FLONM(a) == FLONM(b)) ? truth : NIL);
164 p = get_user_type_hooks(atype);
166 return((*p->equal)(a,b));
168 return ((USERVAL(a) == USERVAL(b)) ? truth : NIL);
175 for(p=l;NNULLP(p);p=cdr(p)) n = cons(car(p),n);
178LISP append(LISP l1, LISP l2)
179{LISP n=l2,p,rl1 = reverse(l1);
180 for(p=rl1;NNULLP(p);p=cdr(p))
184void init_subrs_list(
void)
186 init_subr_2(
"assoc",assoc,
187 "(assoc KEY A-LIST)\n\
188 Return pair with KEY in A-LIST or nil.");
189 init_subr_1(
"length",llength,
191 Return length of LIST, or 0 if LIST is not a list.");
192 init_subr_1(
"flatten",siod_flatten,
194 Return flatend list (list of all atoms in LIST).");
195 init_subr_2(
"assq",assq,
196 "(assq ITEM ALIST)\n\
197 Returns pairs from ALIST whose car is ITEM or nil if ITEM is not in ALIST.");
198 init_subr_2(
"delq",delq,
200 Destructively delete ITEM from LIST, returns LIST, if ITEM is not first\n\
201 in LIST, cdr of LIST otherwise. If ITEM is not in LIST, LIST is\n\
202 returned unchanged." );
203 init_subr_1(
"copy-list",copy_list,
205 Return new list with same members as LIST.");
206 init_subr_2(
"cons",cons,
207 "(cons DATA1 DATA2)\n\
208 Construct cons pair whose car is DATA1 and cdr is DATA2.");
209 init_subr_1(
"pair?",consp,
211 Returns t if DATA is a cons cell, nil otherwise.");
212 init_subr_1(
"car",car,
214 Returns car of DATA1. If DATA1 is nil or a symbol, return nil.");
215 init_subr_1(
"cdr",cdr,
217 Returns cdr of DATA1. If DATA1 is nil or a symbol, return nil.");
218 init_subr_2(
"set-car!",setcar,
219 "(set-car! CONS1 DATA1)\n\
220 Set car of CONS1 to be DATA1. Returns CONS1. If CONS1 not of type\n\
221 consp an error is is given. This is a destructive operation.");
222 init_subr_2(
"set-cdr!",setcdr,
223 "(set-cdr! CONS1 DATA1)\n\
224 Set cdr of CONS1 to be DATA1. Returns CONS1. If CONS1 not of type\n\
225 consp an error is is given. This is a destructive operation.");
226 init_subr_2(
"eq?",eq,
227 "(eq? DATA1 DATA2)\n\
228 Returns t if DATA1 and DATA2 are the same object.");
229 init_subr_2(
"eqv?",eql,
230 "(eqv? DATA1 DATA2)\n\
231 Returns t if DATA1 and DATA2 are the same object or equal numbers.");
232 init_subr_2(
"equal?",equal,
234 t if s-expressions A and B are recursively equal, nil otherwise.");
235 init_subr_1(
"not",nullp,
237 Returns t if DATA is nil, nil otherwise.");
238 init_subr_1(
"null?",nullp,
240 Returns t if DATA is nil, nil otherwise.");
241 init_subr_1(
"reverse",reverse,
243 Returns destructively reversed LIST.");
244 init_subr_2(
"append",append,
245 "(append LIST1 LIST2)\n\
246 Returns LIST2 appended to LIST1, LIST1 is distroyed.");