OpenXM_contrib2/asir2000/builtin/strobj.c - diff

Return to strobj.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/strobj.c between version 1.45 and 1.63

-version 1.45, 2004/03/25 01:31:03
+version 1.63, 2005/09/28 08:08:34
 Line 45
 Line 45
 Line 45
   * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
   * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
   *
-  * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.44 2004/03/19 01:18:54 noro Exp $
+  * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.62 2005/09/27 09:32:22 noro Exp $
  */
  #include "ca.h"
  #include "parse.h"
 Line 65  struct TeXSymbol {
 Line 65  struct TeXSymbol {
 Line 65  struct TeXSymbol {
  extern char *parse_strp;
+ void Psprintf();
  void Prtostr(), Pstrtov(), Peval_str();
  void Pstrtoascii(), Pasciitostr();
  void Pstr_len(), Pstr_chr(), Psub_str();
-Line 75  void Pstring_to_tb();
+Line 76  void Pstring_to_tb();
 Line 75  void Pstring_to_tb();
 Line 76  void Pstring_to_tb();
  void Pquotetotex_tb();
  void Pquotetotex();
  void Pquotetotex_env();
+ void Pflatten_quote();
+ void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name();
+ void Pquote_unify(),Pget_quote_id();
+ void Pquote_bin_to_nary(),Pquote_nary_to_bin();
+ void do_assign(NODE arg);
  void fnodetotex_tb(FNODE f,TB tb);
  char *symbol_name(char *name);
  char *conv_rule(char *name);
-Line 84  void tb_to_string(TB tb,STRING *rp);
+Line 90  void tb_to_string(TB tb,STRING *rp);
 Line 84  void tb_to_string(TB tb,STRING *rp);
 Line 90  void tb_to_string(TB tb,STRING *rp);
  void fnodenodetotex_tb(NODE n,TB tb);
  void fargstotex_tb(char *opname,FNODE f,TB tb);
  int top_is_minus(FNODE f);
+ int quote_unify(Obj f,Obj pat,NODE *rp);
  struct ftab str_tab[] = {
+         {"sprintf",Psprintf,-99999999},
          {"rtostr",Prtostr,1},
          {"strtov",Pstrtov,1},
          {"eval_str",Peval_str,1},
-Line 98  struct ftab str_tab[] = {
+Line 106  struct ftab str_tab[] = {
 Line 98  struct ftab str_tab[] = {
 Line 106  struct ftab str_tab[] = {
          {"clear_tb",Pclear_tb,1},
          {"tb_to_string",Ptb_to_string,1},
          {"string_to_tb",Pstring_to_tb,1},
+         {"get_quote_id",Pget_quote_id,1},
+         {"quote_bin_to_nary",Pquote_bin_to_nary,1},
+         {"quote_nary_to_bin",Pquote_nary_to_bin,2},
          {"quotetotex_tb",Pquotetotex_tb,2},
          {"quotetotex",Pquotetotex,1},
          {"quotetotex_env",Pquotetotex_env,-99999999},
+         {"flatten_quote",Pflatten_quote,2},
+         {"quote_to_funargs",Pquote_to_funargs,1},
+         {"quote_unify",Pquote_unify,2},
+         {"funargs_to_quote",Pfunargs_to_quote,1},
+         {"get_function_name",Pget_function_name,1},
          {0,0,0},
  };
-Line 118  int register_symbol_table(Obj arg);
+Line 134  int register_symbol_table(Obj arg);
 Line 118  int register_symbol_table(Obj arg);
 Line 134  int register_symbol_table(Obj arg);
  int register_conv_rule(Obj arg);
  int register_conv_func(Obj arg);
  int register_dp_vars(Obj arg);
+ int register_dp_vars_origin(Obj arg);
+ int register_dp_dvars_origin(Obj arg);
+ int register_dp_dvars_prefix(Obj arg);
  int register_dp_vars_prefix(Obj arg);
  int register_dp_vars_hweyl(Obj arg);
  int register_show_lt(Obj arg);
-Line 126  static struct TeXSymbol *user_texsymbol;
+Line 145  static struct TeXSymbol *user_texsymbol;
 Line 126  static struct TeXSymbol *user_texsymbol;
 Line 145  static struct TeXSymbol *user_texsymbol;
  static char **dp_vars;
  static int dp_vars_len;
  static char *dp_vars_prefix;
+ static char *dp_dvars_prefix;
+ static int dp_vars_origin;
+ static int dp_dvars_origin;
  static int show_lt;
  static FUNC convfunc;
  static int is_lt;
-Line 146  static struct {
+Line 168  static struct {
 Line 146  static struct {
 Line 168  static struct {
          {"conv_func",0,register_conv_func},
          {"dp_vars",0,register_dp_vars},
          {"dp_vars_prefix",0,register_dp_vars_prefix},
+         {"dp_dvars_prefix",0,register_dp_dvars_prefix},
+         {"dp_vars_origin",0,register_dp_vars_origin},
+         {"dp_dvars_origin",0,register_dp_dvars_origin},
          {"dp_vars_hweyl",0,register_dp_vars_hweyl},
          {"show_lt",0,register_show_lt},
          {0,0,0},
-Line 309  int register_symbol_table(Obj arg)
+Line 334  int register_symbol_table(Obj arg)
 Line 309  int register_symbol_table(Obj arg)
 Line 334  int register_symbol_table(Obj arg)
          return 1;
  }
+ int register_dp_vars_origin(Obj arg)
+ {
+         if ( INT(arg) ) {
+                 dp_vars_origin = QTOS((Q)arg);
+                 return 1;
+         } else return 0;
+ }
+ int register_dp_dvars_origin(Obj arg)
+ {
+         if ( INT(arg) ) {
+                 dp_dvars_origin = QTOS((Q)arg);
+                 return 1;
+         } else return 0;
+ }
  int register_dp_vars_hweyl(Obj arg)
  {
          if ( INT(arg) ) {
-Line 393  int register_dp_vars_prefix(Obj arg)
+Line 434  int register_dp_vars_prefix(Obj arg)
 Line 393  int register_dp_vars_prefix(Obj arg)
 Line 434  int register_dp_vars_prefix(Obj arg)
          } else return 0;
  }
+ int register_dp_dvars_prefix(Obj arg)
+ {
+         if ( !arg ) {
+                 dp_dvars_prefix = 0;
+                 return 1;
+         } else if ( OID(arg) == O_STR ) {
+                 dp_dvars_prefix = BDY((STRING)arg);
+                 return 1;
+         } else if ( OID(arg) == O_P ) {
+                 dp_dvars_prefix = NAME(VR((P)arg));
+                 return 1;
+         } else return 0;
+ }
  void Pquotetotex_env(NODE arg,Obj *rp)
  {
          int ac,i;
-Line 457  void Pwrite_to_tb(NODE arg,Q *rp)
+Line 512  void Pwrite_to_tb(NODE arg,Q *rp)
 Line 457  void Pwrite_to_tb(NODE arg,Q *rp)
 Line 512  void Pwrite_to_tb(NODE arg,Q *rp)
          *rp = 0;
  }
+ FNODE partial_eval(FNODE), quote_bin_to_nary(FNODE), quote_nary_to_bin(FNODE,int);
+ void Pquote_bin_to_nary(NODE arg,QUOTE *rp)
+ {
+         FNODE f;
+         f = quote_bin_to_nary(BDY((QUOTE)ARG0(arg)));
+         MKQUOTE(*rp,f);
+ }
+ void Pquote_nary_to_bin(NODE arg,QUOTE *rp)
+ {
+         FNODE f;
+         int direction;
+         direction = QTOS((Q)ARG1(arg));
+         f = quote_nary_to_bin(BDY((QUOTE)ARG0(arg)),direction);
+         MKQUOTE(*rp,f);
+ }
+ void Pquote_unify(NODE arg,Q *rp)
+ {
+         FNODE f,g;
+         QUOTE q;
+         NODE r;
+         int ret;
+ #if 0
+         g = partial_eval(BDY(((QUOTE)ARG0(arg))));
+         MKQUOTE(q,g);
+         ret = quote_unify((Obj)q,(Obj)ARG1(arg),&r);
+ #else
+         ret = quote_unify((Obj)ARG0(arg),(Obj)ARG1(arg),&r);
+ #endif
+         if ( ret ) {
+                 do_assign(r);
+                 *rp = ONE;
+         } else
+                 *rp = 0;
+ }
+ void do_assign(NODE arg)
+ {
+         NODE t,pair;
+         int pv;
+         QUOTE value;
+         for ( t = arg; t; t = NEXT(t) ) {
+                 pair = BDY((LIST)BDY(t));
+                 pv = (int)FA0((FNODE)BDY((QUOTE)BDY(pair)));
+                 value = (QUOTE)(BDY(NEXT(pair)));
+                 ASSPV(pv,value);
+         }
+ }
+ /*
+ /* consistency check and merge
+  */
+ int merge_matching_node(NODE n,NODE a,NODE *rp)
+ {
+         NODE ta,ba,tn,bn;
+         QUOTE pa,va,pn,vn;
+         if ( !n ) {
+                 *rp = a;
+                 return 1;
+         }
+         for ( ta = a; ta; ta = NEXT(ta) ) {
+                 ba = BDY((LIST)BDY(ta));
+                 if ( !ba ) continue;
+                 pa = (QUOTE)BDY(ba); va = (QUOTE)BDY(NEXT(ba));
+                 for ( tn = n; tn; tn = NEXT(tn) ) {
+                         bn = BDY((LIST)BDY(tn));
+                         if ( !bn ) continue;
+                         pn = (QUOTE)BDY(bn); vn = (QUOTE)BDY(NEXT(bn));
+                         if ( !compquote(CO,pa,pn) ) {
+                                 if ( !compquote(CO,va,vn) ) break;
+                                 else return 0;
+                         }
+                 }
+                 if ( !tn ) {
+                         MKNODE(tn,(pointer)BDY(ta),n);
+                         n = tn;
+                 }
+         }
+         *rp = n;
+         return 1;
+ }
+ int quote_unify_node(NODE f,NODE pat,NODE *rp) {
+         NODE r,a,tf,tp,r1;
+         int ret;
+         if ( length(f) != length(pat) ) return 0;
+         r = 0;
+         for ( tf = f, tp = pat; tf; tf = NEXT(tf), tp = NEXT(tp) ) {
+                 ret = quote_unify((Obj)BDY(tf),(Obj)BDY(tp),&a);
+                 if ( !ret ) return 0;
+                 ret = merge_matching_node(r,a,&r1);
+                 if ( !ret ) return 0;
+                 else r = r1;
+         }
+         *rp = r;
+         return 1;
+ }
+ void get_quote_id_arg(QUOTE f,int *id,NODE *r)
+ {
+         LIST fa;
+         NODE arg,fab;
+         arg = mknode(1,f); Pquote_to_funargs(arg,&fa); fab = BDY((LIST)fa);
+         *id = QTOS((Q)BDY(fab)); *r = NEXT(fab);
+ }
+ /* *rp : [[quote(A),quote(1)],...] */
+ int quote_unify(Obj f, Obj pat, NODE *rp)
+ {
+         NODE tf,tp,head,body;
+         NODE parg,farg,r;
+         LIST fa,l;
+         int pid,id;
+         FUNC ff,pf;
+         int ret;
+         if ( OID(pat) == O_LIST ) {
+                 if ( OID(f) == O_LIST )
+                         return quote_unify_node(BDY((LIST)f),BDY((LIST)pat),rp);
+                 else
+                         return 0;
+         } else if ( OID(pat) == O_QUOTE ) {
+                 if ( OID(f) != O_QUOTE ) return 0;
+                 get_quote_id_arg((QUOTE)pat,&pid,&parg);
+                 get_quote_id_arg((QUOTE)f,&id,&farg);
+                 switch ( pid ) {
+                         case I_FORMULA:
+                                 if ( compquote(CO,f,pat) )
+                                         return 0;
+                                 else {
+                                         *rp = 0;
+                                         return 1;
+                                 }
+                                 break;
+                         case I_LIST:
+                                 return quote_unify_node(BDY((LIST)BDY(farg)),
+                                                         BDY((LIST)BDY(parg)),rp);
+                         case I_PVAR:
+                                 /* [[pat,f]] */
+                                 r = mknode(2,pat,f); MKLIST(l,r);
+                                 *rp =  mknode(1,l);
+                                 return 1;
+                         case I_IFUNC:
+                                 /* F(X,Y,...) = ... */
+                                 if ( id == I_FUNC ) {
+                                         r = mknode(2,BDY(parg),BDY(farg)); MKLIST(l,r);
+                                         head = mknode(1,l);
+                                         ret = quote_unify(BDY(NEXT(farg)),
+                                                                 BDY(NEXT(parg)),&body);
+                                         if ( !ret ) return 0;
+                                         else return merge_matching_node(head,body,rp);
+                                 } else
+                                         return 0;
+                         case I_BOP:
+                         case I_FUNC:
+                                 /* X+Y = ... */
+                                 /* f(...) = ... */
+                                 if ( compqa(CO,BDY(farg),BDY(parg)) ) return 0;
+                                 return quote_unify_node(NEXT(farg),NEXT(parg),rp);
+                                 break;
+                         default:
+                                 if ( pid == id )
+                                         return quote_unify_node(farg,parg,rp);
+                                 else
+                                         return 0;
+                 }
+         }
+ }
  void Pquotetotex(NODE arg,STRING *rp)
  {
          TB tb;
-Line 798  char *symbol_name(char *name)
+Line 1035  char *symbol_name(char *name)
 Line 798  char *symbol_name(char *name)
 Line 1035  char *symbol_name(char *name)
          return 0;
  }
+ void Pget_function_name(NODE arg,STRING *rp)
+ {
+                 QUOTEARG qa;
+                 ARF f;
+                 char *opname;
+                 qa = (QUOTEARG)BDY(arg);
+                 if ( !qa || OID(qa) != O_QUOTEARG || qa->type != A_arf )
+                         *rp = 0;
+                 else {
+                         f = (ARF)BDY(qa);
+                         opname = f->name;
+                         MKSTR(*rp,opname);
+                 }
+ }
+ FNODE strip_paren(FNODE);
  void fnodetotex_tb(FNODE f,TB tb)
  {
          NODE n,t,t0;
          char vname[BUFSIZ],prefix[BUFSIZ];
          char *opname,*vname_conv,*prefix_conv;
          Obj obj;
-         int i,len,allzero,elen,elen2;
+         int i,len,allzero,elen,elen2,si;
          C cplx;
          char *r;
          FNODE fi,f2;
-Line 870  void fnodetotex_tb(FNODE f,TB tb)
+Line 1125  void fnodetotex_tb(FNODE f,TB tb)
 Line 870  void fnodetotex_tb(FNODE f,TB tb)
 Line 1125  void fnodetotex_tb(FNODE f,TB tb)
                          } else if ( !strcmp(opname,"^") ) {
                                  fnodetotex_tb((FNODE)FA1(f),tb);
                                  write_tb("^{",tb);
-                                 fnodetotex_tb((FNODE)FA2(f),tb);
+                                 fnodetotex_tb(strip_paren((FNODE)FA2(f)),tb);
                                  write_tb("} ",tb);
                          } else if ( !strcmp(opname,"%") ) {
                                  fnodetotex_tb((FNODE)FA1(f),tb);
-Line 1047  void fnodetotex_tb(FNODE f,TB tb)
+Line 1302  void fnodetotex_tb(FNODE f,TB tb)
 Line 1047  void fnodetotex_tb(FNODE f,TB tb)
 Line 1302  void fnodetotex_tb(FNODE f,TB tb)
                                                          strcpy(prefix,dp_vars_prefix?dp_vars_prefix:"x");
                                                          prefix_conv = conv_rule(prefix);
                                                          vname_conv = (char *)ALLOCA(strlen(prefix_conv)+50);
-                                                         sprintf(vname_conv,i<10?"%s_%d":"%s_{%d}",
+                                                         si = i+dp_vars_origin;
-                                                                 prefix_conv,i);
+                                                         sprintf(vname_conv,(si>=0&&si<10)?"%s_%d":"%s_{%d}",
+                                                                 prefix_conv,si);
                                                  } else if ( i < elen ) {
-                                                         strcpy(prefix,"\\partial");
+                                                         strcpy(prefix,
+                                                                 dp_dvars_prefix?dp_dvars_prefix:"\\partial");
                                                          prefix_conv = conv_rule(prefix);
                                                          vname_conv = (char *)ALLOCA(strlen(prefix_conv)+50);
-                                                         sprintf(vname_conv,i<10?"%s_%d":"%s_{%d}",
+                                                         si = i+dp_dvars_origin-elen2;
-                                                                 prefix_conv,i-elen2);
+                                                         sprintf(vname_conv,(si>=0&&si<10)?"%s_%d":"%s_{%d}",
+                                                                 prefix_conv,si);
                                                  } else {
                                                          strcpy(prefix,"h");
                                                          vname_conv = conv_rule(prefix);
-Line 1063  void fnodetotex_tb(FNODE f,TB tb)
+Line 1321  void fnodetotex_tb(FNODE f,TB tb)
 Line 1063  void fnodetotex_tb(FNODE f,TB tb)
 Line 1321  void fnodetotex_tb(FNODE f,TB tb)
                                                  strcpy(prefix,dp_vars_prefix?dp_vars_prefix:"x");
                                                  prefix_conv = conv_rule(prefix);
                                                  vname_conv = (char *)ALLOCA(strlen(prefix_conv)+50);
-                                                 sprintf(vname_conv,i<10?"%s_%d":"%s_{%d}",
+                                                 si = i+dp_vars_origin;
-                                                         prefix_conv,i);
+                                                 sprintf(vname_conv,(si>=0&&si<10)?"%s_%d":"%s_{%d}",
+                                                         prefix_conv,si);
                                          }
                                  }
                                  if ( fi->id == I_FORMULA && UNIQ(FA0(fi)) ) {
-Line 1152  char *objtostr(Obj obj)
+Line 1411  char *objtostr(Obj obj)
 Line 1152  char *objtostr(Obj obj)
 Line 1411  char *objtostr(Obj obj)
          return r;
  }
+ void Psprintf(NODE arg,STRING *rp)
+ {
+     STRING string;
+     char *s,*t,*r;
+     int argc,n,len;
+     NODE node;
+     string = (STRING)ARG0(arg);
+     asir_assert(string,O_STR,"sprintf");
+     s = BDY(string);
+     for(n = 0, t = s; *t; t++) {
+         if (*t=='%' && *(t+1)=='a') {
+             n++;
+         }
+     }
+     for(node = NEXT(arg), argc = 0, len = strlen(s); node; node = NEXT(node), argc++) {
+         len += estimate_length(CO,BDY(node));
+     }
+     if (argc < n) {
+         error("sprintf: invalid argument");
+     }
+     r = (char *)MALLOC_ATOMIC(len);
+     for(node = NEXT(arg), t = r; *s; s++) {
+         if (*s=='%' && *(s+1)=='a') {
+             strcpy(t,objtostr(BDY(node)));
+             node = NEXT(node);
+             t = strchr(t,0);
+             s++;
+         }else {
+             *t++ = *s;
+         }
+     }
+     *t = 0;
+     MKSTR(*rp,r);
+ }
  void fnodenodetotex_tb(NODE n,TB tb)
  {
          for ( ; n; n = NEXT(n) ) {
-Line 1234  int top_is_minus(FNODE f)
+Line 1529  int top_is_minus(FNODE f)
 Line 1234  int top_is_minus(FNODE f)
 Line 1529  int top_is_minus(FNODE f)
                  default:
                          return 0;
          }
+ }
+ FNODE flatten_fnode(FNODE,char *);
+ void Pflatten_quote(NODE arg,Obj *rp)
+ {
+         FNODE f;
+         QUOTE q;
+         if ( !ARG0(arg) || OID((Obj)ARG0(arg)) != O_QUOTE )
+                 *rp = (Obj)ARG0(arg);
+         else {
+                 f = flatten_fnode(BDY((QUOTE)ARG0(arg)),BDY((STRING)ARG1(arg)));
+                 MKQUOTE(q,f);
+                 *rp = (Obj)q;
+         }
+ }
+ void Pget_quote_id(NODE arg,Q *rp)
+ {
+         FNODE f;
+         QUOTE q;
+         q = (QUOTE)ARG0(arg);
+         if ( !q || OID(q) != O_QUOTE )
+                 error("get_quote_id : invalid argument");
+         f = BDY(q);
+         STOQ((int)f->id,*rp);
+ }
+ void Pquote_to_funargs(NODE arg,LIST *rp)
+ {
+         fid_spec_p spec;
+         QUOTE q;
+         QUOTEARG qa;
+         FNODE f;
+         STRING s;
+         QUOTE r;
+         int i;
+         Q id,a;
+         LIST l;
+         NODE t0,t,w,u,u0;
+         q = (QUOTE)ARG0(arg);
+         if ( !q || OID(q) != O_QUOTE )
+                 error("quote_to_funargs : invalid argument");
+         f = BDY(q);
+         if ( !f ) {
+                 MKLIST(*rp,0);
+                 return;
+         }
+         get_fid_spec(f->id,&spec);
+         if ( !spec )
+                 error("quote_to_funargs : not supported yet");
+         t0 = 0;
+         STOQ((int)f->id,id);
+         NEXTNODE(t0,t);
+         BDY(t) = (pointer)id;
+         for ( i = 0; spec->type[i] != A_end; i++ ) {
+                 NEXTNODE(t0,t);
+                 switch ( spec->type[i] ) {
+                         case A_fnode:
+                                 MKQUOTE(r,(FNODE)f->arg[i]);
+                                 BDY(t) = (pointer)r;
+                                 break;
+                         case A_int:
+                                 STOQ((int)f->arg[i],a);
+                                 BDY(t) = (pointer)a;
+                                 break;
+                         case A_str:
+                                 MKSTR(s,(char *)f->arg[i]);
+                                 BDY(t) = (pointer)s;
+                                 break;
+                         case A_internal:
+                                 BDY(t) = (pointer)f->arg[i];
+                                 break;
+                         case A_node:
+                                 w = (NODE)f->arg[i];
+                                 for ( u0 = 0; w; w = NEXT(w) ){
+                                         NEXTNODE(u0,u);
+                                         MKQUOTE(r,(FNODE)BDY(w));
+                                         BDY(u) = (pointer)r;
+                                 }
+                                 if ( u0 ) NEXT(u) = 0;
+                                 MKLIST(l,u0);
+                                 BDY(t) = (pointer)l;
+                                 break;
+                         default:
+                                 MKQUOTEARG(qa,spec->type[i],f->arg[i]);
+                                 BDY(t) = (pointer)qa;
+                                 break;
+                 }
+         }
+         if ( t0 ) NEXT(t) = 0;
+         MKLIST(*rp,t0);
+ }
+ void Pfunargs_to_quote(NODE arg,QUOTE *rp)
+ {
+         fid_spec_p spec;
+         QUOTE q;
+         QUOTEARG qa;
+         FNODE f;
+         STRING s;
+         QUOTE r,b;
+         int i;
+         LIST l;
+         fid id;
+         Obj a;
+         NODE t0,t,u0,u,w;
+         l = (LIST)ARG0(arg);
+         if ( !l || OID(l) != O_LIST || !(t=BDY(l)) )
+                 error("funargs_to_quote : invalid argument");
+         t = BDY(l);
+         id = (fid)QTOS((Q)BDY(t)); t = NEXT(t);
+         get_fid_spec(id,&spec);
+         if ( !spec )
+                 error("funargs_to_quote : not supported yet");
+         for ( i = 0; spec->type[i] != A_end; i++ );
+         NEWFNODE(f,i);
+         f->id = id;
+         for ( i = 0; spec->type[i] != A_end; i++, t = NEXT(t) ) {
+                 if ( !t )
+                         error("funargs_to_quote : argument mismatch");
+                 a = (Obj)BDY(t);
+                 switch ( spec->type[i] ) {
+                         case A_fnode:
+                                 if ( !a || OID(a) != O_QUOTE )
+                                         error("funargs_to_quote : invalid argument");
+                                 f->arg[i] = BDY((QUOTE)a);
+                                 break;
+                         case A_int:
+                                 if ( !INT(a) )
+                                         error("funargs_to_quote : invalid argument");
+                                 f->arg[i] = (pointer)QTOS((Q)a);
+                                 break;
+                         case A_str:
+                                 if ( !a || OID(a) != O_STR )
+                                         error("funargs_to_quote : invalid argument");
+                                 f->arg[i] = (pointer)BDY((STRING)a);
+                                 break;
+                         case A_internal:
+                                 f->arg[i] = (pointer)a;
+                                 break;
+                         case A_node:
+                                 if ( !a || OID(a) != O_LIST )
+                                         error("funargs_to_quote : invalid argument");
+                                 u0 = 0;
+                                 for ( w = BDY((LIST)a); w; w = NEXT(w) ) {
+                                         NEXTNODE(u0,u);
+                                         b = (QUOTE)BDY(w);
+                                         if ( !b || OID(b) != O_QUOTE )
+                                                 error("funargs_to_quote : invalid argument");
+                                         BDY(u) = BDY(b);
+                                 }
+                                 if ( u0 ) NEXT(u) = 0;
+                                 f->arg[i] = (pointer)u0;
+                                 break;
+                         default:
+                                 if ( !a || OID(a) != O_QUOTEARG ||
+                                         ((QUOTEARG)a)->type != spec->type[i] )
+                                         error("funargs_to_quote : invalid argument");
+                                 f->arg[i] = BDY((QUOTEARG)a);
+                                 break;
+                 }
+         }
+         MKQUOTE(*rp,f);
  }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>