Next: 5.3 クロージャデータ
Up: 5 ユーザ定義関数を作る
Previous: 5.1 defun の定義
関数本体のクロージャを作る定義はxlclose(xlcont.c)です．
これは, xldmem.cにあるnewclosureを使ってクロージャデータを
作り，仮引数データの通常引数，
オプショナル引数，レスト引数，キーワード引数，局所変数用宣言(aux宣言）
の登録を行います．
/* xlclose - create a function closure */
LVAL xlclose(name,type,fargs,body,env,fenv)
LVAL name,type,fargs,body,env,fenv;
{
LVAL closure,key,arg,def,svar,new,last;
char keyname[STRMAX+2];
/* protect some pointers */
xlsave1(closure);
/* create the closure object */
closure = newclosure(name,type,env,fenv);
setlambda(closure,fargs);
setbody(closure,body);
/* handle each required argument */
last = NIL;
while (consp(fargs) &&
(arg = car(fargs)) &&
!iskey(arg)) {
/* make sure the argument is a symbol */
if (!symbolp(arg))
badarglist();
/* create a new argument list entry */
new = cons(arg,NIL);
/* link it into the required
argument list */
if (last)
rplacd(last,new);
else
setargs(closure,new);
last = new;
/* move the formal argument list
pointer ahead */
fargs = cdr(fargs);
}
/* check for the '&optional' keyword */
if (consp(fargs) && car(fargs) ==
lk_optional) {
fargs = cdr(fargs);
/* handle each optional argument */
last = NIL;
while (consp(fargs) &&
(arg = car(fargs)) &&
!iskey(arg)) {
/* get the default expression and
specified-p variable */
def = svar = NIL;
if (consp(arg)) {
if (def = cdr(arg))
if (consp(def)) {
if (svar = cdr(def))
if (consp(svar)) {
svar = car(svar);
if (!symbolp(svar))
badarglist();
}
else
badarglist();
def = car(def);
}
else
badarglist();
arg = car(arg);
}
/* make sure the argument is
a symbol */
if (!symbolp(arg))
badarglist();
/* create a fully expanded
optional expression */
new = cons(cons(arg,
cons(def,
cons(svar,NIL))),
NIL);
/* link it into the optional
argument list */
if (last)
rplacd(last,new);
else
setoargs(closure,new);
last = new;
/* move the formal argument
list pointer ahead */
fargs = cdr(fargs);
}
}
/* check for the '&rest' keyword */
if (consp(fargs) && car(fargs) ==
lk_rest) {
fargs = cdr(fargs);
/* get the &rest argument */
if (consp(fargs) &&
(arg = car(fargs)) &&
!iskey(arg) && symbolp(arg))
setrest(closure,arg);
else
badarglist();
/* move the formal argument list
pointer ahead */
fargs = cdr(fargs);
}
/* check for the '&key' keyword */
if (consp(fargs) && car(fargs) ==
lk_key) {
fargs = cdr(fargs);
/* handle each key argument */
last = NIL;
while (consp(fargs) &&
(arg = car(fargs)) &&
!iskey(arg)) {
/* get the default expression and
specified-p variable */
def = svar = NIL;
if (consp(arg)) {
if (def = cdr(arg))
if (consp(def)) {
if (svar = cdr(def))
if (consp(svar)) {
svar = car(svar);
if (!symbolp(svar))
badarglist();
}
else
badarglist();
def = car(def);
}
else
badarglist();
arg = car(arg);
}
/* get the keyword and the variable */
if (consp(arg)) {
key = car(arg);
if (!symbolp(key))
badarglist();
if (arg = cdr(arg))
if (consp(arg))
arg = car(arg);
else
badarglist();
}
else if (symbolp(arg)) {
strcpy(keyname,":");
strcat(keyname,getstring(getpname(arg)));
key = xlenter(keyname);
}
/* make sure the argument is a symbol */
if (!symbolp(arg))
badarglist();
/* create a fully expanded key expression */
new = cons(cons(key,
cons(arg,
cons(def,
cons(svar,
NIL)))),
NIL);
/* link it into the optional
argument list */
if (last)
rplacd(last,new);
else
setkargs(closure,new);
last = new;
/* move the formal argument
list pointer ahead */
fargs = cdr(fargs);
}
}
/* check for the '&allow-other-keys' keyword */
if (consp(fargs) && car(fargs) ==
lk_allow_other_keys)
fargs = cdr(fargs);
/* this is the default anyway */
/* check for the '&aux' keyword */
if (consp(fargs) && car(fargs) ==
lk_aux) {
fargs = cdr(fargs);
/* handle each aux argument */
last = NIL;
while (consp(fargs) &&
(arg = car(fargs)) &&
!iskey(arg)) {
/* get the initial value */
def = NIL;
if (consp(arg)) {
if (def = cdr(arg))
if (consp(def))
def = car(def);
else
badarglist();
arg = car(arg);
}
/* make sure the argument is
a symbol */
if (!symbolp(arg))
badarglist();
/* create a fully expanded
aux expression */
new = cons(cons(arg,
cons(def,
NIL)),
NIL);
/* link it into the aux
argument list */
if (last)
rplacd(last,new);
else
setaargs(closure,new);
last = new;
/* move the formal
argument list pointer ahead */
fargs = cdr(fargs);
}
}
/* make sure this is the end of
the formal argument list */
if (fargs)
badarglist();
/* restore the stack */
xlpop();
/* return the new closure */
return (closure);
}
generated through LaTeX2HTML. M.Inaba 平成18年5月6日