50 |
if (MMcadr(args) != Cnil && type_of(MMcadr(args)) != t_cons) |
if (MMcadr(args) != Cnil && type_of(MMcadr(args)) != t_cons) |
51 |
FEerror("~S is an illegal lambda-list.", 1, MMcadr(args)); |
FEerror("~S is an illegal lambda-list.", 1, MMcadr(args)); |
52 |
name = MMcar(args); |
name = MMcar(args); |
53 |
if (type_of(name) != t_symbol) |
if (type_of(name) != t_symbol) { |
54 |
not_a_symbol(name); |
if (setf_fn_form(name)) { |
55 |
|
vs_base = vs_top; |
56 |
|
vs_push(MMcons(sLlambda, MMcdr(args))); |
57 |
|
putprop(MMcadr(name),vs_base[0],sSsetf_function); |
58 |
|
vs_base[0]=name; |
59 |
|
return; |
60 |
|
} else |
61 |
|
not_a_symbol(name); |
62 |
|
} |
63 |
if (name->s.s_sfdef != NOT_SPECIAL) { |
if (name->s.s_sfdef != NOT_SPECIAL) { |
64 |
if (name->s.s_mflag) { |
if (name->s.s_mflag) { |
65 |
if (symbol_value(sSAinhibit_macro_specialA) != Cnil) |
if (symbol_value(sSAinhibit_macro_specialA) != Cnil) |
66 |
name->s.s_sfdef = NOT_SPECIAL; |
name->s.s_sfdef = NOT_SPECIAL; |
67 |
} else if (symbol_value(sSAinhibit_macro_specialA) != Cnil) |
} else if (symbol_value(sSAinhibit_macro_specialA) != Cnil) |
68 |
FEerror("~S, a special form, cannot be redefined.", 1, name); |
FEerror("~S, a special form, cannot be redefined.", 1, name); |
69 |
} |
} |
70 |
if (name->s.s_hpack == lisp_package && |
if (name->s.s_hpack == lisp_package && |
71 |
name->s.s_gfdef != OBJNULL && initflag) { |
name->s.s_gfdef != OBJNULL && initflag) { |
72 |
vs_push(make_simple_string( |
vs_push(make_simple_string( |
73 |
"~S is being redefined.")); |
"~S is being redefined.")); |
74 |
ifuncall2(sLwarn, vs_head, name); |
ifuncall2(sLwarn, vs_head, name); |
75 |
vs_popp; |
vs_popp; |
76 |
} |
} |
77 |
vs_base = vs_top; |
vs_base = vs_top; |
78 |
if (lex_env[0] == Cnil && lex_env[1] == Cnil && lex_env[2] == Cnil) { |
if (lex_env[0] == Cnil && lex_env[1] == Cnil && lex_env[2] == Cnil) { |
79 |
vs_push(MMcons(sLlambda_block, args)); |
vs_push(MMcons(sLlambda_block, args)); |
80 |
} else { |
} else { |
81 |
vs_push(MMcons(lex_env[2], args)); |
vs_push(MMcons(lex_env[2], args)); |
82 |
vs_base[0] = MMcons(lex_env[1], vs_base[0]); |
vs_base[0] = MMcons(lex_env[1], vs_base[0]); |
83 |
vs_base[0] = MMcons(lex_env[0], vs_base[0]); |
vs_base[0] = MMcons(lex_env[0], vs_base[0]); |
84 |
vs_base[0] = MMcons(sLlambda_block_closure, vs_base[0]); |
vs_base[0] = MMcons(sLlambda_block_closure, vs_base[0]); |
85 |
} |
} |
86 |
{object fname = clear_compiler_properties(name,vs_base[0]); |
{object fname = clear_compiler_properties(name,vs_base[0]); |
87 |
fname->s.s_gfdef = vs_base[0]; |
fname->s.s_gfdef = vs_base[0]; |
88 |
fname->s.s_mflag = FALSE;} |
fname->s.s_mflag = FALSE;} |
89 |
vs_base[0] = name; |
vs_base[0] = name; |
90 |
for (body = MMcddr(args); !endp(body); body = body->c.c_cdr) { |
for (body = MMcddr(args); !endp(body); body = body->c.c_cdr) { |
91 |
form = macro_expand(body->c.c_car); |
form = macro_expand(body->c.c_car); |
92 |
if (type_of(form) == t_string) { |
if (type_of(form) == t_string) { |
93 |
if (endp(body->c.c_cdr)) |
if (endp(body->c.c_cdr)) |
94 |
break; |
break; |
95 |
vs_push(form); |
vs_push(form); |
96 |
name->s.s_plist = |
name->s.s_plist = |
97 |
putf(name->s.s_plist, |
putf(name->s.s_plist, |
98 |
form, |
form, |
99 |
sSfunction_documentation); |
sSfunction_documentation); |
100 |
vs_popp; |
vs_popp; |
101 |
break; |
break; |
102 |
} |
} |
103 |
if (type_of(form) != t_cons || form->c.c_car != sLdeclare) |
if (type_of(form) != t_cons || form->c.c_car != sLdeclare) |
104 |
break; |
break; |
105 |
} |
} |
106 |
} |
} |
107 |
|
|
214 |
DEF_ORDINARY("TYPEP",sLtypep,LISP,""); |
DEF_ORDINARY("TYPEP",sLtypep,LISP,""); |
215 |
DEF_ORDINARY("VALUES",sLvalues,LISP,""); |
DEF_ORDINARY("VALUES",sLvalues,LISP,""); |
216 |
DEF_ORDINARY("VARIABLE-DOCUMENTATION",sSvariable_documentation,SI,""); |
DEF_ORDINARY("VARIABLE-DOCUMENTATION",sSvariable_documentation,SI,""); |
217 |
|
DEF_ORDINARY("SETF-FUNCTION",sSsetf_function,SI,""); |
218 |
DEF_ORDINARY("WARN",sLwarn,LISP,""); |
DEF_ORDINARY("WARN",sLwarn,LISP,""); |
219 |
|
|
220 |
void |
void |