C:/Users/Dennis/src/lang/russell.orig/src/pass4/checksigs.c

Go to the documentation of this file.
00001 # define DEBUG
00002 
00003 # ifdef DEBUG
00004 #   define IFDEBUG(x) x
00005 # else
00006 #   define IFDEBUG(x)
00007 # endif
00008 
00009 # include <stdio.h>
00010 # include "parm.h"
00011 
00012 # include "stree/ststructs.mh"
00013 
00014 # include "sigs.h"
00015 
00016 # include "stree/is_ptr.h"
00017 
00018 NODE * curr_tsig = NIL;  /* signature of anonymous local type ids */
00019 
00020 boolean in_sig;  /* checking inside a signature */
00021 
00022 # define ERR_NODE_DEFINED
00023 NODE * err_node = NIL;  /* node to be used for error message in lieu */
00024                         /* of current node.  Used by errmsg macros   */
00025 char * err_msg;         /* message to be used in lieu of usual one   */
00026 
00027 extern NODE * val_Boolean,
00028             * val_Void,
00029             * var_Void;
00030 
00031 extern NODE * sig_Signature;
00032 
00033 extern int yynerrs;
00034 
00035 extern FILE * unparse_file;
00036 
00037 /*
00038  *  checksigs(p,dont_coerce)
00039  *
00040  *  Do signature checking on the expression subtree headed by p
00041  *  Dont_coerce indicates that that the expression occurs in a context
00042  * in which the result will be discarded anyway.
00043  *  It is also insured that all signature and optimization info
00044  * needed to generate code for p will be attached to the nodes in the
00045  * subtree.
00046  */
00047 
00048 
00049 checksigs(p,dont_coerce)
00050 NODE * p;
00051 {
00052     register int knd;
00053     NODE * op;  /* operator in application */
00054 
00055     if (p == ERR_SIG) return;
00056     knd = p -> kind;
00057 
00058     switch(knd) {
00059         case OPRID:
00060         case LETTERID:
00061             if (p -> sel_type != NIL) {
00062                 /* find type signature first.  This guarantees that */
00063                 /* sel_index will be filled in                      */
00064                 checksigs(p -> sel_type, FALSE);
00065             }
00066             tl_findsig(p,dont_coerce);
00067             if (p -> sel_type != NIL && in_sig
00068                 && p -> sel_type -> signature != ERR_SIG) {
00069               /* check for ambiguous selection */
00070                 if (!is_unique(p -> sel_type -> signature,
00071                                p -> id_str_table_index)) {
00072                     errmsg0(p, "ambiguous selection in signature");
00073                 }
00074             }
00075             break;
00076 
00077         case QSTR:
00078         case UQSTR:
00079             {
00080                 NODE * sig;
00081                 int maxlen;
00082                 tl_findsig(p, dont_coerce);
00083                 if (p -> signature != ERR_SIG) {
00084                   sig = p -> sel_type -> signature;
00085                   if (sig -> ts_string_max == -1) {
00086                       maxlen = MAXSTRLEN;
00087                   } else {
00088                       maxlen = sig -> ts_string_max;
00089                   }
00090                   if (sig -> ts_string_code == NIL
00091                       || sig -> ts_element_code == NIL
00092                       || strlen(p -> str_string) > maxlen
00093                       || p -> sel_type -> kind != LETTERID
00094                       || p -> sel_type -> sel_type != NIL) {
00095                     checksigs(p -> str_expansion, dont_coerce);
00096                   } else {
00097                     checksigs(p -> sel_type, FALSE);
00098                   }
00099                 }
00100             }
00101             break;
00102 
00103         case FUNCCONSTR:
00104           {
00105             boolean is_val_Void =
00106                       (comp_st(val_Void,
00107                                p -> signature -> fsig_result_sig,
00108                                NIL, NIL) == 0);
00109             checksigs(p -> fc_body, is_val_Void);
00110             tl_findsig(p,dont_coerce);
00111             if (!in_sig &&
00112                 p -> signature -> fsig_result_sig != ERR_SIG) {
00113                 /* find signatures of var parameter types     */
00114                 /* and of result type for code generator      */
00115                 /* code generator                             */
00116                   in_sig = TRUE;
00117                   if (p -> signature -> fsig_result_sig -> kind
00118                       == VALSIGNATURE) {
00119                         tl_findsig(p -> signature -> fsig_result_sig
00120                                      -> val_denotation, FALSE);
00121                   }
00122                   maplist(q, p -> signature -> fsig_param_list, {
00123                       NODE * sig = q -> par_signature;
00124 
00125                       if (sig -> kind == VARSIGNATURE) {
00126                         tl_findsig(sig -> var_denotation, FALSE);
00127                       }
00128                   });
00129                   in_sig = FALSE;
00130             }
00131             if (p -> fc_body -> kind == EXTERNDEF) {
00132               /* check that last parameter has var void sig */
00133                 NODE * psig;
00134 
00135                 if (is_empty(p -> signature -> fsig_param_list)) {
00136                     psig = NIL;
00137                 } else {
00138                     psig = last(p -> signature -> fsig_param_list) -> par_signature;
00139                 }
00140                 if (comp_st(psig, var_Void, NIL, NIL) != 0) {
00141                     errmsg0(p, "Warning - last parameter of extern should be var Void");
00142                     yynerrs --; /* Only a warning */
00143                 }
00144             } else {
00145               /* check that result sig matches body */
00146                 if (!is_val_Void &&
00147                     !amatch(p -> fc_body -> signature, 
00148                             p -> signature -> fsig_result_sig)) {
00149                     errmsg0(p, "Function result signature mismatch");
00150                 }
00151             }
00152             break;
00153           }
00154 
00155         case REXTERNDEF:
00156             break;
00157 
00158         case APPLICATION:
00159             /* insert coercions first */
00160                 tl_findsig(p, dont_coerce);
00161             maplist(q, p -> ap_args, {
00162                 checksigs(q,FALSE);
00163             });
00164             op = p -> ap_operator;
00165             if (op -> kind == OPRID || op -> kind == LETTERID) {
00166                 /* use argument list to find right decl. */
00167                     op -> id_appl = p;
00168             }
00169             checksigs(op, FALSE);
00170             tl_findsig(p,dont_coerce);
00171             if (p -> signature != ERR_SIG 
00172                 && op -> signature != ERR_SIG /* not implied by prec cond */) {
00173                 NODE * op_sig = op -> signature;
00174                 NODE * new_args;
00175                 int num_args;
00176                 int num_params;
00177 
00178                 /* This guarantees operator has func signature */
00179       
00180                 /*  printf("Checksigs looking at application(%X):",p);
00181                     unparse_file = stdout;
00182                     unparse(p);
00183                     printf("\n");
00184                 */
00185                 if (!in_sig) {
00186                   /* Try to fill in in-line code, if not already there */
00187                     if (op -> signature -> fsig_inline_code == NIL
00188                         && op -> signature -> fsig_construction != NIL) {
00189                         op -> signature -> fsig_inline_code =
00190                             op -> signature -> fsig_construction
00191                                -> signature -> fsig_inline_code;
00192                     }
00193                   /* compute signature of result type (for code generator) */
00194                     in_sig = TRUE;
00195                     err_node = p;
00196                     err_msg = "signature of result type is bad";
00197                     switch(p -> signature -> kind) {
00198                       case VALSIGNATURE:
00199                         tl_findsig(p -> signature -> val_denotation, TRUE);
00200                       case VARSIGNATURE:
00201                         tl_findsig(p -> signature -> var_denotation, TRUE);
00202                     }
00203                     in_sig = FALSE;
00204                     err_node = NIL;
00205                 }
00206 
00207                 /* check argument parameter matching, and compute signature */
00208                 /* of any var parameter types     (for code generator)      */
00209 
00210 #                   ifdef DEBUG
00211                         if (!is_ptr(op_sig)) {
00212                             dbgmsg("checksigs: bad operator signature\n");
00213                             unparse_file = stdout;
00214                             unparse(p);
00215                             printf("\n");
00216                             prtree(p);
00217                             printf("Signature:\n");
00218                             prtree(p -> signature);
00219                             abort();
00220                         }
00221                         if (!is_ptr(op_sig -> fsig_param_list)
00222                             || !is_list(op_sig -> fsig_param_list)) {
00223                             dbgmsg("checksigs: bad parameter list\n");
00224                             abort();
00225                         }
00226                         if (!is_ptr(p -> ap_args) || !is_list(p -> ap_args)) {
00227                             dbgmsg("checksigs: bad argument list\n");
00228                             abort();
00229                         }
00230 #                   endif
00231                     num_args = length(p -> ap_args);
00232                     num_params = length(op_sig -> fsig_param_list);
00233                     if (num_args != num_params) {
00234                         errmsg0(p, "wrong number of arguments");
00235                     } else {
00236                         NODE * par_sig;
00237 
00238                         begin_map2lists (s, p -> ap_args,
00239                                          r, op_sig -> fsig_param_list) {
00240                             NODE * sig = s -> signature;
00241                             NODE * den;
00242 
00243                             if (has_sig(s) &&
00244                                 (sig -> kind == VARSIGNATURE)
00245                                 && !in_sig) {
00246                                 /* find signature for code generator */
00247                                     in_sig = TRUE;
00248                                     err_node = s;
00249                                     err_msg = "bad argument type signature";
00250                                     if (sig -> kind == VALSIGNATURE) {
00251                                         den = sig -> val_denotation;
00252                                     } else {
00253                                         den = sig -> var_denotation;
00254                                     }
00255                                     tl_findsig(den, TRUE);
00256                                     err_node = NIL;
00257                                     in_sig = FALSE;
00258                             }
00259                             par_sig = subst(r -> par_signature,
00260                                             op_sig -> fsig_param_list,
00261                                             p -> ap_args);
00262                             lock(par_sig);
00263                             if (!amatch(s -> signature, par_sig)) {
00264                                 extern NODE * failed_comp; /* set by amatch */
00265 
00266                                 errmsg0(p, "Argument parameter mismatch");
00267                                 unparse_file = stderr;
00268                                 fprintf(stderr, "\tArgument:\n\t");
00269                                 unparse(s);
00270                                 fprintf(stderr,
00271                                    "\n\tParameter signature after substitution:\n\t");
00272                                 unparse(par_sig);
00273                                 if (failed_comp != NIL) {
00274                                   if (failed_comp -> kind == DEFCHARSIGS) {
00275                                     fprintf(stderr, "\n\tMissing Constant");
00276                                   } else {
00277                                     /* TSCOMPONENT */
00278                                     fprintf(stderr,
00279                                             "\n\tOffending parameter component: ");
00280                                     unparse(failed_comp -> tsc_id);
00281                                     fprintf(stderr, ":");
00282                                     unparse(failed_comp -> tsc_signature);
00283                                   }
00284                                 }
00285                                 fprintf(stderr,
00286                                    "\n\tArgument signature:\n\t");
00287                                 unparse(s -> signature);
00288                                 fprintf(stderr, "\n");
00289                             }
00290                             vfree(unlock(par_sig));
00291                         } end_map2lists;
00292                     }
00293             }
00294             break;
00295 
00296         case GUARDEDLIST:
00297         case LOOPDENOTATION:
00298             maplist(q, p -> gl_list, {
00299                 checksigs(q -> ge_guard, FALSE);
00300                 checksigs(q -> ge_element, knd==LOOPDENOTATION || dont_coerce);
00301             });
00302             tl_findsig(p,dont_coerce);
00303             /* check that all guards have Boolean signature */
00304               maplist(q, p -> gl_list, {
00305                 if (q -> ge_guard -> signature != ERR_SIG &&
00306                     comp_st(q -> ge_guard -> signature, 
00307                             val_Boolean, NIL,NIL) != 0)  { 
00308                     errmsg0(q -> ge_guard, "Guard has inappropriate signature");
00309                     unparse_file = stderr;
00310                     fprintf(stderr, "\tGuard signature:\n\t");
00311                     unparse(q -> ge_guard -> signature);
00312                     fprintf(stderr, "\n");
00313                 }
00314               });
00315             if(!dont_coerce && knd == GUARDEDLIST
00316                && p -> signature != ERR_SIG) {
00317                 /* Signatures should all be the same - make sure they are */
00318                     maplist(q, p -> gl_list, {
00319                         if (q -> ge_element -> signature != ERR_SIG
00320                             && comp_st(q -> ge_element -> signature,
00321                                        p -> signature, NIL, NIL) != 0) {
00322                             errmsg0(q -> ge_element, 
00323                                 "Guarded expression has incorrect signature:");
00324                             unparse_file = stderr;
00325                             fprintf(stderr, "\t");
00326                             unparse(q -> ge_element -> signature);
00327                             fprintf(stderr, "\n\tShould be:\n\t");
00328                             unparse(p -> signature);
00329                             fprintf(stderr, "\n");
00330                         }
00331                     });
00332             }
00333             break;
00334 
00335         case BLOCKDENOTATION:
00336             maplist(q, p -> bld_declaration_list, {
00337                 checksigs(q -> decl_denotation,FALSE);
00338                 if (q -> decl_signature != NIL &&
00339                     q -> decl_denotation -> signature != ERR_SIG &&
00340                     comp_st(q -> decl_signature,
00341                             q -> decl_denotation -> signature, NIL, NIL) != 0) {
00342                     errmsg0(q, "Signature does not match declaration");
00343                     unparse_file = stderr;
00344                     fprintf(stderr, "\texplicit signature:\n\t");
00345                     unparse(q -> decl_signature);
00346                     fprintf(stderr, "\n\texpression signature:\n\t");
00347                     unparse(q -> decl_denotation -> signature);
00348                     fprintf(stderr, "\n");
00349                 }
00350                 if (q -> decl_signature == NIL) {
00351                     q -> decl_signature = q -> decl_denotation -> signature;
00352                     q -> decl_sig_done = SIG_DONE;
00353                 }
00354             });
00355             maplist(q, p -> bld_den_seq, {
00356                 if (q == last(p -> bld_den_seq)) {
00357                     checksigs(q,dont_coerce);
00358                 } else {
00359                     checksigs(q,TRUE);
00360                 }
00361             });
00362             tl_findsig(p,dont_coerce);
00363             break;
00364 
00365         case USELIST:
00366             maplist(q, p -> usl_type_list, {
00367                 checksigs(q,FALSE);
00368                 if (q -> signature != ERR_SIG) {
00369                     if (q -> signature -> kind != TYPESIGNATURE) {
00370                         chgfld(&(q -> signature),
00371                                sig_structure(q -> signature));
00372                         if (q -> signature -> kind != TYPESIGNATURE) {
00373                           errmsg0(q, "Non-type appears in use type list");
00374                         }
00375                     }
00376                 }
00377             });
00378             maplist(q, p -> usl_den_seq, {
00379                 if (q == last(p -> usl_den_seq)) {
00380                     checksigs(q,dont_coerce);
00381                 } else {
00382                     checksigs(q,TRUE);
00383                 }
00384             });
00385             tl_findsig(p,dont_coerce);
00386             break;
00387 
00388         case WORDELSE:
00389             tl_findsig(p,dont_coerce);
00390             break;
00391 
00392         case MODPRIMARY:
00393             checksigs(p -> mp_primary, FALSE);
00394             /* Make sure with list components are traversed in their */
00395             /* final order, so that they don't get reordered in the  */
00396             /* middle of this.                                       */
00397               {
00398                 NODE * q;
00399 
00400                 if((q = findsig(p, dont_coerce)) != SUCCESS) {
00401                    errmsg0(p, "Can't find signature of with list");
00402                    fprintf(stderr,"\tOffending expression:\n\t");
00403                    unparse_file = stderr;
00404                    unparse(q);
00405                    fprintf(stderr, "\n");
00406                    p -> sig_done = SIG_DONE;
00407                    p -> signature = ERR_SIG;
00408                    break;
00409                 };
00410               }
00411             if (!in_sig && has_sig(p -> mp_primary)) {
00412               /* check for ambiguous selections etc. in orig. type */
00413                 err_node = p;
00414                 err_msg = 
00415                    "bad type signature before modification";
00416                 checksigs(p -> mp_primary -> signature, FALSE);
00417                 err_node = NIL;
00418             }
00419             if (p -> mp_type_modifier != NIL
00420                 && p -> mp_type_modifier -> kind == WITHLIST) {
00421                 maplist(q, p -> mp_type_modifier -> wl_component_list, {
00422                     IFDEBUG(
00423                         if (q -> kind != DECLARATION) {
00424                             dbgmsg("checksigs: bad with list\n");
00425                         }
00426                     )
00427                     checksigs(q -> decl_denotation, dont_coerce);
00428                     if (q -> decl_signature != NIL &&
00429                         q -> decl_denotation -> signature != ERR_SIG &&
00430                         comp_st(q -> decl_signature,
00431                                 q -> decl_denotation -> signature,
00432                                 NIL, NIL) != 0) {
00433                         errmsg0(q, "Signature does not match WITH declaration");
00434                     }
00435                 });
00436                 tl_findsig(p, dont_coerce);
00437                 if (!in_sig && has_sig(p)) {
00438                   /* check for export rule violations after hiding */
00439                   /* but before adding new components.             */
00440                     NODE * sig_after_hiding =
00441                       lock(delcomp(p -> mp_primary -> signature,
00442                                    p -> mp_delete_v));
00443     
00444                     err_node = p;
00445                     err_msg = "bad signature after hiding";
00446                     checksigs(sig_after_hiding, FALSE);
00447                     vfree(unlock(sig_after_hiding));
00448 
00449                   /* Check for ambiguous selections after component addition */
00450                     err_msg = "bad signature after adding components";
00451                     checksigs(p -> signature, FALSE);
00452                     err_node = NIL;
00453                 }
00454               } else {
00455                 tl_findsig(p, dont_coerce);
00456                 /* check for export rule violations */
00457                   if (!in_sig && has_sig(p)) {
00458                     err_node = p;
00459                     err_msg = "bad signature after hiding";
00460                     checksigs(p -> signature, FALSE);
00461                     err_node = NIL;
00462                   }
00463               }
00464             break;
00465 
00466         case RECORDCONSTRUCTION:
00467             tl_findsig(p,dont_coerce);
00468             maplist(q, p -> rec_component_list, {
00469                 tl_findsig(q -> re_denotation);
00470                 if (q -> re_denotation -> signature != ERR_SIG
00471                     && q -> re_denotation -> signature -> kind
00472                        != TYPESIGNATURE) {
00473                     errmsg0(q, "Non-type expression in record");
00474                 }
00475             });
00476             break;
00477 
00478         case UNIONCONSTRUCTION:
00479         case PRODCONSTRUCTION:
00480             tl_findsig(p, dont_coerce);
00481             maplist(q, p -> prod_components, {
00482                 if (q -> par_signature -> kind == VARSIGNATURE) {
00483                   switch(p -> kind) {
00484                    case PRODCONSTRUCTION:
00485                     errmsg0(q, "Product shouldn't have var component");
00486                    case UNIONCONSTRUCTION:
00487                     errmsg0(q, "Union shouldn't have var component");
00488                   }
00489                 }
00490             });
00491             break;
00492 
00493         case ENUMERATION:
00494             tl_findsig(p, dont_coerce);
00495             break;
00496 
00497         case EXTENSION:
00498             checksigs(p -> ext_denotation);
00499             tl_findsig(p, dont_coerce);
00500             break;
00501 
00502         case TYPESIGNATURE:
00503             {
00504                 boolean old_in_sig = in_sig;
00505                 NODE * old_curr_tsig = curr_tsig;
00506 
00507                 if (p -> signature == NIL) {
00508                     initfld(&(p -> signature), sig_Signature);
00509                 }
00510                 p -> sig_done = SIG_DONE;
00511                 in_sig = TRUE;
00512                 curr_tsig = p;
00513                 /* check nested signatures */
00514                   maplist(s, p -> ts_clist, {
00515                     if (s -> kind == TSCOMPONENT) {
00516                       checksigs(s -> tsc_signature, FALSE);
00517                     }
00518                   });
00519                 in_sig = old_in_sig;
00520                 curr_tsig = old_curr_tsig;
00521                 break;
00522             }
00523 
00524         case FUNCSIGNATURE:
00525             /* should occur only when checking signatures of type     */
00526             /* modifications and when signatures occur as expressions */
00527             if (p -> signature == NIL) {
00528                 initfld(&(p -> signature), sig_Signature);
00529             }
00530             p -> sig_done = SIG_DONE;
00531             maplist(s, p -> fsig_param_list, {
00532                 IFDEBUG(
00533                   if (s -> kind != PARAMETER || !is_ptr(s -> par_signature)) {
00534                     dbgmsg("checksigs: bad parameter\n");
00535                     prtree(s);
00536                     abort();
00537                   }
00538                 )
00539                 checksigs(s -> par_signature, FALSE);
00540             });
00541             checksigs(p -> fsig_result_sig);
00542             break;
00543 
00544         case VALSIGNATURE:
00545             if (p -> signature == NIL) {
00546                 initfld(&(p -> signature), sig_Signature);
00547             }
00548             p -> sig_done = SIG_DONE;
00549             checksigs(p -> val_denotation, FALSE);
00550             break;
00551 
00552         case VARSIGNATURE:
00553             if (p -> signature == NIL) {
00554                 initfld(&(p -> signature), sig_Signature);
00555             }
00556             p -> sig_done = SIG_DONE;
00557             checksigs(p -> var_denotation, FALSE);
00558             break;
00559 
00560         case SIGNATURESIG:
00561             if (p -> signature == NIL) {
00562                 initfld(&(p -> signature), sig_Signature);
00563             }
00564             p -> sig_done = SIG_DONE;
00565             break;
00566 
00567         case EXTERNDEF:
00568             break;
00569 
00570         default:
00571             dbgmsg("checksigs: bad kind: %s\n",kindname(p -> kind));
00572             abort();
00573     }
00574 #   ifdef DEBUG
00575         if (p -> kind != TYPESIGNATURE && p -> kind != FUNCSIGNATURE
00576             && p -> kind != VALSIGNATURE && p -> kind != VARSIGNATURE
00577             && p -> kind != EXTERNDEF && p -> sig_done == SIG_IN_PROGRESS) {
00578             dbgmsg("Checksigs: findsig blew it on %s\n", kindname(p -> kind));
00579         }
00580 #   endif
00581 }
00582 
00583 
00584 /*
00585  * Top level driver routine for the above.  Also calls import to check 
00586  * for import and export rule violations.
00587  */
00588 
00589 tl_checksigs(p)
00590 NODE * p;
00591 {
00592     checksigs(p, FALSE);
00593     import(p, NIL);
00594 }
00595
Generated on Fri Jan 25 10:39:46 2008 for russell by  doxygen 1.5.4