home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / gofer / Sources / c / static < prev    next >
Encoding:
Text File  |  1993-02-12  |  57.1 KB  |  1,840 lines
  1. /* --------------------------------------------------------------------------
  2.  * static.c:    Copyright (c) Mark P Jones 1991-1993.   All rights reserved.
  3.  *              See goferite.h for details and conditions of use etc...
  4.  *              Gofer version 2.28 January 1993
  5.  *
  6.  * Static Analysis for Gofer
  7.  * ------------------------------------------------------------------------*/
  8.  
  9. #include "prelude.h"
  10. #include "storage.h"
  11. #include "connect.h"
  12. #include "errors.h"
  13.  
  14. /* --------------------------------------------------------------------------
  15.  * local function prototypes:
  16.  * ------------------------------------------------------------------------*/
  17.  
  18. static Void  local checkTyconDefn    Args((Tycon));
  19. static Type  local depTypeExp        Args((Int,List,Type));
  20. static Void  local depConstr        Args((Int,List,Cell));
  21. static Void  local checkTyconGroup    Args((List));
  22. static Void  local addConstrs        Args((Tycon));
  23. static Name  local newConstr        Args((Tycon,Int,Type,Cell));
  24. static Void  local checkSynonyms    Args((List));
  25. static List  local visitSyn        Args((List,Tycon,List));
  26.  
  27. static Type  local fullExpand        Args((Type));
  28. static Type  local instantiateSyn    Args((Type,Type));
  29. static Cell  local fullExpPred        Args((Cell));
  30.  
  31. static List  local typeVarsIn        Args((Cell,List));
  32. static List  local maybeAppendVar    Args((Cell,List));
  33.  
  34. static List  local offsetTyvarsIn    Args((Type,List));
  35.  
  36. static Type  local checkSigType        Args((Int,String,Cell,Type));
  37.  
  38. static Void  local checkClassDefn    Args((Class));
  39. static Void  local depPredExp        Args((Int,List,Cell));
  40. static Void  local checkMems        Args((Class,List,Cell));
  41. static Void  local checkClassGroup    Args((List));
  42. static Void  local addMembers        Args((Class));
  43. static Name  local newMember        Args((Int,Int,Cell,Type));
  44.  
  45. static Void  local checkInstDefn        Args((Inst));
  46.  
  47. static List  local classBindings        Args((String,Class,List));
  48. static Int   local memberNumber         Args((Class,Text));
  49. static List  local numInsert            Args((Int,Cell,List));
  50.  
  51. static Void  local addNewPrim        Args((Int,Text,String,Cell));
  52.  
  53. static Cell  local checkPat        Args((Int,Cell));
  54. static Cell  local checkMaybeCnkPat    Args((Int,Cell));
  55. static Cell  local checkApPat        Args((Int,Int,Cell));
  56. static Void  local addPatVar        Args((Int,Cell));
  57. static Name  local conDefined        Args((Int,Text));
  58. static Void  local checkIsCfun        Args((Int,Cell));
  59. static Void  local checkCfunArgs    Args((Int,Cell,Int));
  60.  
  61. static Cell  local bindPat        Args((Int,Cell));
  62. static Void  local bindPats        Args((Int,List));
  63.  
  64. static List  local extractSigdecls    Args((List));
  65. static List  local extractBindings    Args((List));
  66. static List  local eqnsToBindings    Args((List));
  67. static Void  local notDefined        Args((Int,List,Cell));
  68. static Cell  local findBinding        Args((Text,List));
  69. static Void  local addSigDecl        Args((List,Cell));
  70. static Void  local setType        Args((Int,Cell,Cell,List));
  71.  
  72. static List  local dependencyAnal    Args((List));
  73. static List  local topDependAnal    Args((List));
  74. static Void  local addDepField        Args((Cell));
  75. static Void  local remDepField        Args((List));
  76. static Void  local remDepField1        Args((Cell));
  77. static Void  local clearScope        Args((Void));
  78. static Void  local withinScope        Args((List));
  79. static Void  local leaveScope        Args((Void));
  80.  
  81. static Void  local depBinding        Args((Cell));
  82. static Void  local depDefaults          Args((Class));
  83. static Void  local depInsts             Args((Inst));
  84. static Void  local depClassBindings     Args((List));
  85. static Void  local depAlt        Args((Cell));
  86. static Void  local depRhs        Args((Cell));
  87. static Void  local depGuard        Args((Cell));
  88. static Cell  local depExpr        Args((Int,Cell));
  89. static Void  local depPair        Args((Int,Cell));
  90. static Void  local depTriple        Args((Int,Cell));
  91. static Void  local depComp        Args((Int,Cell,List));
  92. static Void  local depCaseAlt        Args((Int,Cell));
  93. static Cell  local depVar        Args((Int,Cell));
  94.  
  95. static Int   local sccMin        Args((Int,Int));
  96. static List  local tscc            Args((List));
  97. static List  local cscc            Args((List));
  98. static List  local bscc            Args((List));
  99.  
  100. static Void  local addRSsigdecls    Args((Pair));
  101. static Void  local opDefined        Args((List,Cell));
  102. static Void  local allNoPrevDef        Args((Cell));
  103. static Void  local noPrevDef        Args((Int,Cell));
  104. static Void  local checkTypeIn        Args((Pair));
  105.  
  106. /* --------------------------------------------------------------------------
  107.  * Static analysis of type declarations:
  108.  *
  109.  * Type declarations come in two forms:
  110.  * - data declarations - define new constructed data types
  111.  * - type declarations - define new type synonyms
  112.  *
  113.  * A certain amount of work is carried out as the declarations are
  114.  * read during parsing.  In particular, for each type constructor
  115.  * definition encountered:
  116.  * - check that there is no previous definition of constructor
  117.  * - ensure type constructor not previously used as a class name
  118.  * - make a new entry in the type constructor table
  119.  * - record line number of declaration
  120.  * - Build separate lists of newly defined constructors for later use.
  121.  * ------------------------------------------------------------------------*/
  122.  
  123. Void tyconDefn(line,lhs,rhs,what)    /* process new type definition       */
  124. Int  line;                /* definition line number       */
  125. Cell lhs;                /* left hand side of definition       */
  126. Cell rhs;                /* right hand side of definition   */
  127. Cell what; {                /* SYNONYM/DATATYPE/etc...       */
  128.     Cell  t   = getHead(lhs);
  129.     Tycon new = findTycon(textOf(t));
  130.  
  131.     if (isNull(new)) {
  132.     if (nonNull(findClass(textOf(t)))) {
  133.         ERROR(line) "\"%s\" used as both class and type constructor",
  134.             textToStr(textOf(t))
  135.         EEND;
  136.     }
  137.     new = newTycon(textOf(t));
  138.     }
  139.     else if (tycon(new).defn!=PREDEFINED) {
  140.     ERROR(line) "Repeated definition of type constructor \"%s\"",
  141.             textToStr(textOf(t))
  142.     EEND;
  143.     }
  144.  
  145.     tycon(new).line  = line;
  146.     tycon(new).arity = argCount;
  147.     tycon(new).defn  = pair(lhs,rhs);
  148.     tycon(new).what  = what;
  149.     tyconDefns       = cons(new,tyconDefns);
  150.     if (what!=DATATYPE && what!=SYNONYM) {
  151.     typeInDefns     = cons(pair(new,what),typeInDefns);
  152.     tycon(new).what = RESTRICTSYN;
  153.     }
  154. }
  155.  
  156. Void setTypeIns(bs)            /* set local synonyms for given       */
  157. List bs; {                /* binding group           */
  158.     List cvs = typeInDefns;
  159.     for (; nonNull(cvs); cvs=tl(cvs)) {
  160.     Tycon c  = fst(hd(cvs));
  161.     List  vs = snd(hd(cvs));
  162.     for (tycon(c).what = RESTRICTSYN; nonNull(vs); vs=tl(vs)) {
  163.         if (nonNull(findBinding(textOf(hd(vs)),bs))) {
  164.         tycon(c).what = SYNONYM;
  165.         break;
  166.         }
  167.     }
  168.     }
  169. }
  170.  
  171. Void clearTypeIns() {            /* clear list of local synonyms       */
  172.     for (; nonNull(typeInDefns); typeInDefns=tl(typeInDefns))
  173.     tycon(fst(hd(typeInDefns))).what = RESTRICTSYN;
  174. }
  175.  
  176. /* --------------------------------------------------------------------------
  177.  * Further analysis of Type declarations:
  178.  *
  179.  * In order to allow the definition of mutually recursive families of
  180.  * data types, the static analysis of the right hand sides of type
  181.  * declarations cannot be performed until all of the type declarations
  182.  * have been read.
  183.  *
  184.  * Once parsing is complete, we carry out the following:
  185.  *
  186.  * - check format of lhs, extracting list of bound vars and ensuring that
  187.  *   there are no repeated variables.
  188.  * - run dependency analysis on rhs to check that only bound type vars
  189.  *   appear in type and that all constructors are defined.
  190.  *   Replace type variables by offsets, constructors by Tycons.
  191.  * - use list of dependents to sort into strongly connected components.
  192.  * - ensure that there is not more than one synonym in each group.
  193.  * - kind-check each group of type definitions.
  194.  *
  195.  * - check that there are no previous definitions for constructor
  196.  *   functions in data type definitions.
  197.  * - install synonym expansions and constructor definitions.
  198.  * ------------------------------------------------------------------------*/
  199.  
  200. static List tyconDeps = NIL;        /* list of dependent type constrs  */
  201.  
  202. static Void local checkTyconDefn(d)    /* validate type constructor defn  */
  203. Tycon d; {
  204.     Cell lhs    = fst(tycon(d).defn);
  205.     Cell rhs    = snd(tycon(d).defn);
  206.     Int  line   = tycon(d).line;
  207.     List tyvars = getArgs(lhs);
  208.     List temp;
  209.                     /* check for repeated tyvars on lhs*/
  210.     for (temp=tyvars; nonNull(temp); temp=tl(temp))
  211.     if (nonNull(varIsMember(textOf(hd(temp)),tl(temp)))) {
  212.         ERROR(line) "Repeated type variable \"%s\" on left hand side",
  213.             textToStr(textOf(hd(temp)))
  214.         EEND;
  215.     }
  216.  
  217.     tyconDeps = NIL;            /* find dependents           */
  218.     switch (tycon(d).what) {
  219.     case RESTRICTSYN :
  220.     case SYNONYM     : rhs = depTypeExp(line,tyvars,rhs);
  221.                if (cellIsMember(d,tyconDeps)) {
  222.                    ERROR(line) "Recursive type synonym \"%s\"",
  223.                        textToStr(tycon(d).text)
  224.                    EEND;
  225.                }
  226.                break;
  227.  
  228.     case DATATYPE     : map2Proc(depConstr,line,tyvars,rhs);
  229.                break;
  230.  
  231.     default         : internal("checkTyconDefn");
  232.     }
  233.  
  234.     tycon(d).defn = rhs;
  235.     tycon(d).kind = tyconDeps;
  236.     tyconDeps      = NIL;
  237. }
  238.  
  239. static Type local depTypeExp(line,tyvars,type)
  240. Int  line;
  241. List tyvars;
  242. Type type; {
  243.     switch (whatIs(type)) {
  244.     case AP        : fst(type) = depTypeExp(line,tyvars,fst(type));
  245.               snd(type) = depTypeExp(line,tyvars,snd(type));
  246.               break;
  247.  
  248.     case VARIDCELL    : {   Int offset = 0;
  249.                   while (nonNull(tyvars) &&
  250.                     textOf(type)!=textOf(hd(tyvars))) {
  251.                   tyvars = tl(tyvars);
  252.                   offset++;
  253.                   }
  254.                   if (isNull(tyvars)) {
  255.                   ERROR(line) "Undefined type variable \"%s\"",
  256.                           textToStr(textOf(type))
  257.                   EEND;
  258.                   }
  259.                   return mkOffset(offset);
  260.               }
  261.  
  262.     case CONIDCELL    : {   Tycon tc = findTycon(textOf(type));
  263.                   if (isNull(tc)) {
  264.                   ERROR(line)
  265.                       "Undefined type constructor \"%s\"",
  266.                       textToStr(textOf(type))
  267.                   EEND;
  268.                   }
  269.                   if (cellIsMember(tc,tyconDefns) &&
  270.                   !cellIsMember(tc,tyconDeps))
  271.                   tyconDeps = cons(tc,tyconDeps);
  272.                   return tc;
  273.               }
  274.  
  275.     case TUPLE    :
  276.     case UNIT    :
  277.     case LIST    :
  278.     case ARROW    : break;
  279.  
  280.     default        : internal("depTypeExp");
  281.     }
  282.     return type;
  283. }
  284.  
  285. static Void local depConstr(line,tyvars,constr)
  286. Int  line;
  287. List tyvars;
  288. Cell constr; {
  289.     for (; isAp(constr); constr=fun(constr))
  290.     arg(constr) = depTypeExp(line,tyvars,arg(constr));
  291. }
  292.  
  293. static Void local checkTyconGroup(ts)    /* validate mutually recursive gp  */
  294. List ts; {                /* of type constructors           */
  295.  
  296.     kindTyconGroup(ts);            /* assign kinds to each tycon       */
  297.     mapProc(addConstrs,ts);        /* add definitions for constructor */
  298.                     /* functions of data types       */
  299. }
  300.  
  301. static Void local addConstrs(t)        /* Add definitions of constructor  */
  302. Tycon t; {
  303.     if (tycon(t).what==DATATYPE) {
  304.     Type lhs      = t;
  305.     List cs          = tycon(t).defn;
  306.     Int  constrNo = 0;
  307.     Int  i;
  308.  
  309.     for (i=0; i<tycon(t).arity; ++i)
  310.         lhs = ap(lhs,mkOffset(i));
  311.  
  312.     for (; nonNull(cs); cs=tl(cs))
  313.         hd(cs) = newConstr(t,constrNo++,lhs,hd(cs));
  314.     }
  315. }
  316.  
  317. static Name local newConstr(t,num,lhs,c)/* Make definition for constructor */
  318. Tycon t;
  319. Int   num;
  320. Type  lhs;
  321. Cell  c; {
  322.     Type type = lhs;
  323.     Int  arity;
  324.     Name n;
  325.  
  326.     for (arity=0; isAp(c); arity++) {    /* calculate type of constructor   */
  327.     Type t = fun(c);
  328.     fun(c) = ARROW;
  329.     type   = ap(c,type);
  330.         c      = t;
  331.     }
  332.     if (tycon(t).arity>0)        /* add `universal quantifiers'       */
  333.     type = mkPolyType(tycon(t).kind,type);
  334.  
  335.     n = findName(textOf(c));        /* add definition to name table       */
  336.  
  337.     if (isNull(n))
  338.     n = newName(textOf(c));
  339.     else if (name(n).defn!=PREDEFINED) {
  340.     ERROR(tycon(t).line)
  341.         "Repeated definition for constructor function \"%s\"",
  342.         textToStr(name(n).text)
  343.     EEND;
  344.     }
  345.  
  346.     name(n).line   = tycon(t).line;
  347.     name(n).arity  = arity;
  348.     name(n).number = num;
  349.     name(n).type   = type;
  350.     name(n).defn   = CFUN;
  351.  
  352.     return n;
  353. }
  354.  
  355. static Void local checkSynonyms(ts)    /* check for mutually recursive       */
  356. List ts; {                /* synonyms in list of tycons ts   */
  357.     List syns = NIL;
  358.     for (; nonNull(ts); ts=tl(ts))    /* build list of all synonyms       */
  359.     if (tycon(hd(ts)).what!=DATATYPE)
  360.         syns = cons(hd(ts),syns);
  361.     while (nonNull(syns))        /* then visit each synonym       */
  362.     syns = visitSyn(NIL,hd(syns),syns);
  363. }
  364.  
  365. static List local visitSyn(path,t,syns)    /* visit synonym definition to look*/
  366. List  path;                /* for cycles               */
  367. Tycon t;
  368. List  syns; {
  369.     if (cellIsMember(t,path)) {        /* every elt in path depends on t  */
  370.     ERROR(tycon(t).line)
  371.         "Type synonyms \"%s\" and \"%s\" are mutually recursive",
  372.         textToStr(tycon(t).text), textToStr(tycon(hd(path)).text)
  373.     EEND;
  374.     }
  375.     else {
  376.     List ds    = tycon(t).kind;
  377.         List path1 = NIL;
  378.     for (; nonNull(ds); ds=tl(ds))
  379.         if (cellIsMember(hd(ds),syns)) {
  380.         if (isNull(path1))
  381.             path1 = cons(t,path);
  382.         syns = visitSyn(path1,hd(ds),syns);
  383.         }
  384.     }
  385.     tycon(t).defn = fullExpand(tycon(t).defn);
  386.     return removeCell(t,syns);
  387. }
  388.  
  389. /* --------------------------------------------------------------------------
  390.  * Expanding out all type synonyms in a type expression:
  391.  * ------------------------------------------------------------------------*/
  392.  
  393. static Type local fullExpand(t)        /* find full expansion of type exp */
  394. Type t; {                /* assuming that all relevant      */
  395.     Cell h = t;                /* synonym defns of lower rank have*/
  396.     for (; isAp(h); h=fun(h))        /* already been fully expanded       */
  397.     arg(h) = fullExpand(arg(h));
  398.     if (isSynonym(h))
  399.         t = instantiateSyn(tycon(h).defn,t);
  400.     return t;
  401. }
  402.  
  403. static Type local instantiateSyn(t,env)    /* instantiate type according using*/
  404. Type t;                    /* env to determine appropriate    */
  405. Type env; {                /* values for OFFSET type vars       */
  406.     switch (whatIs(t)) {
  407.         case AP      : return ap(instantiateSyn(fun(t),env),
  408.                                  instantiateSyn(arg(t),env));
  409.  
  410.         case OFFSET  : return nthArg(offsetOf(t),env);
  411.  
  412.     default         : return t;
  413.     }
  414. }
  415.  
  416. static Cell local fullExpPred(p)    /* find full expansion of predicate*/
  417. Cell p; {
  418.     Cell h = p;
  419.     while (isAp(h)) {
  420.     arg(h) = fullExpand(arg(h));
  421.     h      = fun(h);
  422.     }
  423.     return p;
  424. }
  425.  
  426. /* --------------------------------------------------------------------------
  427.  * Calculate set of variables appearing in a given type expression (possibly
  428.  * qualified) as a list of distinct values.  The order in which variables
  429.  * appear in the list is the same as the order in which those variables
  430.  * occur in the type expression when read from left to right.
  431.  * ------------------------------------------------------------------------*/
  432.  
  433. static List local typeVarsIn(type,vs)  /* calculate list of type variables */
  434. Cell type;                   /* used in type expression, reading */
  435. List vs; {                   /* from left to right           */
  436.     switch (whatIs(type)) {
  437.     case AP        : return typeVarsIn(snd(type),
  438.                        typeVarsIn(fst(type),
  439.                               vs));
  440.     case VARIDCELL :
  441.     case VAROPCELL : return maybeAppendVar(type,vs);
  442.  
  443.     case QUAL      : {   List qs = fst(snd(type));
  444.                  for (; nonNull(qs); qs=tl(qs))
  445.                  vs = typeVarsIn(hd(qs),vs);
  446.                  return typeVarsIn(snd(snd(type)),vs);
  447.              }
  448.     }
  449.     return vs;
  450. }
  451.  
  452. static List local maybeAppendVar(v,vs) /* append variable to list if not   */
  453. Cell v;                    /* already included           */
  454. List vs; {
  455.     Text t = textOf(v);
  456.     List p = NIL;
  457.     List c = vs;
  458.  
  459.     while (nonNull(c)) {
  460.     if (textOf(hd(c))==t)
  461.         return vs;
  462.     p = c;
  463.     c = tl(c);
  464.     }
  465.  
  466.     if (nonNull(p))
  467.     tl(p) = cons(v,NIL);
  468.     else
  469.     vs    = cons(v,NIL);
  470.  
  471.     return vs;
  472. }
  473.  
  474. /* --------------------------------------------------------------------------
  475.  * Check for ambiguous types:
  476.  * A type  Preds => type  is ambiguous if not (TV(P) `subset` TV(type))
  477.  * ------------------------------------------------------------------------*/
  478.  
  479. static List local offsetTyvarsIn(t,vs)    /* add list of offset tyvars in t  */
  480. Type t;                    /* to list vs               */
  481. List vs; {
  482.     switch (whatIs(t)) {
  483.     case AP        : return offsetTyvarsIn(fun(t),offsetTyvarsIn(snd(t),vs));
  484.  
  485.     case OFFSET : if (cellIsMember(t,vs))
  486.               return vs;
  487.               else
  488.               return cons(t,vs);
  489.  
  490.     case QUAL   : return offsetTyvarsIn(snd(t),vs);
  491.  
  492.     default        : return vs;
  493.     }
  494. }
  495.  
  496. Bool isAmbiguous(type)            /* Determine whether type is       */
  497. Type type; {                /* ambiguous                */
  498.     if (isPolyType(type))
  499.     type = monoTypeOf(type);
  500.     if (whatIs(type)==QUAL) {        /* only qualified types can be       */
  501.     List tvps = offsetTyvarsIn(fst(snd(type)),NIL);    /* ambiguous       */
  502.     List tvts = offsetTyvarsIn(snd(snd(type)),NIL);
  503.     while (nonNull(tvps) && cellIsMember(hd(tvps),tvts))
  504.         tvps = tl(tvps);
  505.     return nonNull(tvps);
  506.     }
  507.     return FALSE;
  508. }
  509.  
  510. Void ambigError(line,where,e,type)    /* produce error message for       */
  511. Int    line;                /* ambiguity               */
  512. String where;
  513. Cell   e;
  514. Type   type; {
  515.     ERROR(line) "Ambiguous type signature in %s", where ETHEN
  516.     ERRTEXT "\n*** ambiguous type : " ETHEN ERRTYPE(type);
  517.     ERRTEXT "\n*** assigned to    : " ETHEN ERREXPR(e);
  518.     ERRTEXT "\n"
  519.     EEND;
  520. }
  521.  
  522. /* --------------------------------------------------------------------------
  523.  * Type expressions appearing in type signature declarations and expressions
  524.  * also require static checking, but unlike type expressions in type decls,
  525.  * they may introduce arbitrary new type variables.  The static analysis
  526.  * required here is:
  527.  *   - ensure that each type constructor is defined and used with the
  528.  *     correct number of arguments.
  529.  *   - replace type variables by offsets, constructor names by Tycons.
  530.  *   - ensure that type is well-kinded.
  531.  * ------------------------------------------------------------------------*/
  532.  
  533. static Type local checkSigType(line,where,e,type)
  534. Int    line;                   /* check validity of type expression*/
  535. String where;                   /* in explicit type signature       */
  536. Cell   e;
  537. Type   type; {
  538.     List tyvars = typeVarsIn(type,NIL);
  539.     Int  n      = length(tyvars);
  540.  
  541.     if (whatIs(type)==QUAL) {
  542.     map2Proc(depPredExp,line,tyvars,fst(snd(type)));
  543.     snd(snd(type)) = depTypeExp(line,tyvars,snd(snd(type)));
  544.  
  545.     if (isAmbiguous(type))
  546.         ambigError(line,where,e,type);
  547.     }
  548.     else
  549.     type = depTypeExp(line,tyvars,type);
  550.  
  551.     if (n>0) {
  552.     if (n>=NUM_OFFSETS) {
  553.         ERROR(line) "Too many type variables in %s\n", where
  554.         EEND;
  555.     }
  556.     type = mkPolyType(mkSelect(n),type);
  557.     }
  558.  
  559.     kindSigType(line,type);        /* check that type is well-kinded  */
  560.     return type;
  561. }
  562.  
  563. /* --------------------------------------------------------------------------
  564.  * Static analysis of class declarations:
  565.  *
  566.  * Performed in a similar manner to that used for type declarations.
  567.  *
  568.  * The first part of the static analysis is performed as the declarations
  569.  * are read during parsing:
  570.  * - no previous definition for class
  571.  * - class name not previously used as a type constructor
  572.  * - make new entry in class table
  573.  * - determine arity of class
  574.  * - record line number of declaration
  575.  * - build list of classes defined in current script for use in later
  576.  *   stages of static analysis.
  577.  * ------------------------------------------------------------------------*/
  578.  
  579. Void classDefn(line,head,ms)           /* process new class definition       */
  580. Int  line;                   /* definition line number       */
  581. Cell head;                   /* class header :: ([Supers],Class) */
  582. List ms; {                   /* class definition body           */
  583.     Text  ct    = textOf(getHead(snd(head)));
  584.     Int   arity = argCount;
  585.     Class new   = findClass(ct);
  586.  
  587.     if (isNull(new)) {
  588.     if (nonNull(findTycon(ct))) {
  589.         ERROR(line) "\"%s\" used as both class and type constructor",
  590.             textToStr(ct)
  591.         EEND;
  592.     }
  593.     new = newClass(ct);
  594.     }
  595.     else if (class(new).head!=PREDEFINED) {
  596.     ERROR(line) "Repeated definition of type class \"%s\"",
  597.             textToStr(ct)
  598.     EEND;
  599.     }
  600.  
  601.     class(new).arity    = arity;
  602.     class(new).line    = line;
  603.     class(new).head     = snd(head);
  604.     class(new).supers    = fst(head);
  605.     class(new).members    = ms;
  606.     classDefns        = cons(new,classDefns);
  607. }
  608.  
  609. /* --------------------------------------------------------------------------
  610.  * Further analysis of class declarations:
  611.  *
  612.  * Full static analysis of class definitions must be postponed until the
  613.  * complete script has been read and all static analysis on type definitions
  614.  * has been completed.
  615.  *
  616.  * Once this has been achieved, we carry out the following checks on each
  617.  * class definition:
  618.  *
  619.  * - check that class header has distinct type variable arguments.
  620.  * - convert class header to predicate skeleton.
  621.  * - check that superclasses are well-formed, replace by skeletons.
  622.  * - calculate list of dependent superclasses.
  623.  *
  624.  * - split body of class into members and declarations
  625.  * - make new name entry for each member function
  626.  * - record member function number (eventually an offset into dictionary!)
  627.  * - no member function has a previous definition ...
  628.  * - no member function is mentioned more than once in the list of members
  629.  * - each member function type is valid, replace vars by offsets
  630.  * - qualify each member function type by class header
  631.  * - only bindings for members appear in defaults
  632.  * - only function bindings appear in defaults
  633.  * ------------------------------------------------------------------------*/
  634.  
  635. static Void local checkClassDefn(c)    /* validate class definition       */
  636. Class c; {
  637.     List tyvars = NIL;
  638.     Int  args   = 0;
  639.     Int  i;
  640.     Cell temp;
  641.  
  642.     /* build list of type variables in class header */
  643.  
  644.     for (temp=class(c).head; isAp(temp); temp=fun(temp)) {
  645.     if (!isVar(arg(temp))) {
  646.         ERROR(class(c).line) "Type variable required in class header"
  647.         EEND;
  648.     }
  649.     if (nonNull(varIsMember(textOf(arg(temp)),tyvars))) {
  650.         ERROR(class(c).line)
  651.         "Repeated type variable \"%s\" in class header",
  652.         textToStr(textOf(arg(temp)))
  653.         EEND;
  654.     }
  655.     tyvars = cons(arg(temp),tyvars);
  656.     args++;
  657.     }
  658.  
  659.     for (temp=class(c).head, i=args-1; i>0; temp=fun(temp), i--)
  660.     arg(temp) = mkOffset(i);
  661.     arg(temp) = mkOffset(0);
  662.     fun(temp) = c;
  663.  
  664.     class(c).sig = NIL;            /* validate superclass predicates  */
  665.     for (temp=class(c).supers; nonNull(temp); temp=tl(temp)) {
  666.     Class c0 = NIL;
  667.     depPredExp(class(c).line,tyvars,hd(temp));
  668.     c0 = getHead(hd(temp));
  669.     if (c0!=c && cellIsMember(c0,classDefns)
  670.           && !cellIsMember(c0,class(c).sig))
  671.         class(c).sig = cons(c0,class(c).sig);
  672.     }
  673.  
  674.     class(c).numSupers = length(class(c).supers);
  675.     temp               = class(c).members;
  676.     class(c).members   = extractSigdecls(temp);
  677.     class(c).defaults  = extractBindings(temp);
  678.     map2Proc(checkMems,c,tyvars,class(c).members);
  679. }
  680.  
  681. static Void local depPredExp(line,tyvars,pred)
  682. Int  line;
  683. List tyvars;
  684. Cell pred; {
  685.     Int   args = 0;
  686.     Class c;
  687.  
  688.     for (;;) {                /* parser ensures # args >= 1       */
  689.     arg(pred) = depTypeExp(line,tyvars,arg(pred));
  690.     args++;
  691.     if (isAp(fun(pred)))
  692.         pred = fun(pred);
  693.     else
  694.         break;
  695.     }
  696.  
  697.     if (isNull(c = findClass(textOf(fun(pred))))) {
  698.     ERROR(line) "Undefined class \"%s\"", textToStr(textOf(fun(pred)))
  699.     EEND;
  700.     }
  701.     fun(pred) = c;
  702.  
  703.     if (args!=class(c).arity) {
  704.     ERROR(line) "Wrong number of arguments for class \"%s\"",
  705.             textToStr(class(c).text)
  706.     EEND;
  707.     }
  708. }
  709.  
  710. static Void local checkMems(c,tyvars,m)    /* check member function details   */
  711. Class c;
  712. List  tyvars;
  713. Cell  m; {
  714.     Int  line = intOf(fst3(m));
  715.     List vs   = snd3(m);
  716.     Type t    = thd3(m);
  717.  
  718.     tyvars    = typeVarsIn(t,tyvars);
  719.     t          = mkPolyType(mkSelect(length(tyvars)),
  720.                ap(QUAL,pair(singleton(class(c).head),
  721.                     depTypeExp(line,tyvars,t))));
  722.  
  723.     if (isAmbiguous(t))
  724.     ambigError(line,"class declaration",hd(vs),t);
  725.  
  726.     thd3(m)  = t;                /* save type           */
  727.     tyvars   = take(class(c).arity,tyvars);    /* delete extra type vars  */
  728. }
  729.  
  730. static Void local checkClassGroup(cs)    /* validate mutually recursive gp  */
  731. List cs; {                /* of type classes           */
  732.     kindClassGroup(cs);
  733.     mapProc(addMembers,cs);
  734. }
  735.  
  736. static Void local addMembers(c)        /* Add definitions of member funs  */
  737. Class c; {
  738.     Int  mno   = 1;            /* member function number       */
  739.     List mfuns = NIL;            /* list of member functions       */
  740.     List ms    = class(c).members;
  741.  
  742.     for (; nonNull(ms); ms=tl(ms)) {    /* cycle through each sigdecl       */
  743.     Int  line = intOf(fst3(hd(ms)));
  744.     List vs   = rev(snd3(hd(ms)));
  745.     Type t    = thd3(hd(ms));
  746.     for (; nonNull(vs); vs=tl(vs))
  747.         mfuns = cons(newMember(line,mno++,hd(vs),t),mfuns);
  748.     }
  749.     class(c).members    = rev(mfuns);    /* save list of members           */
  750.     class(c).numMembers = length(class(c).members);
  751.     class(c).defaults   = classBindings("class",c,class(c).defaults);
  752. }
  753.  
  754. static Name local newMember(l,no,v,t)    /* Make definition for member fn   */
  755. Int  l;
  756. Int  no;
  757. Cell v;
  758. Type t; {
  759.     Name m = findName(textOf(v));
  760.  
  761.     if (isNull(m))
  762.     m = newName(textOf(v));
  763.     else if (name(m).defn!=PREDEFINED) {
  764.     ERROR(l) "Repeated definition for member function \"%s\"",
  765.          textToStr(name(m).text)
  766.     EEND;
  767.     }
  768.  
  769.     name(m).line   = l;
  770.     name(m).arity  = 1;
  771.     name(m).number = no;
  772.     name(m).type   = t;
  773.     name(m).defn   = MFUN;
  774.  
  775.     return m;
  776. }
  777.  
  778. /* --------------------------------------------------------------------------
  779.  * Static analysis of instance declarations:
  780.  *
  781.  * The first part of the static analysis is performed as the declarations
  782.  * are read during parsing:
  783.  * - make new entry in instance table
  784.  * - record line number of declaration
  785.  * - build list of instances defined in current script for use in later
  786.  *   stages of static analysis.
  787.  * ------------------------------------------------------------------------*/
  788.  
  789. Void instDefn(line,head,ms)           /* process new instance definition  */
  790. Int  line;                   /* definition line number       */
  791. Cell head;                   /* inst header :: (context,Class)   */
  792. List ms; {                   /* instance members           */
  793.     Inst new             = newInst();
  794.     inst(new).line       = line;
  795.     inst(new).specifics  = fst(head);
  796.     inst(new).head     = snd(head);
  797.     inst(new).implements = ms;
  798.     instDefns            = cons(new,instDefns);
  799. }
  800.  
  801. /* --------------------------------------------------------------------------
  802.  * Further static analysis of instance declarations:
  803.  *
  804.  * Makes the following checks:
  805.  * - Class part of header is a valid class expression C t1 ... tn not
  806.  *   overlapping with any other instance in class C.
  807.  * - Each element of context is a valid class expression, with type vars
  808.  *   drawn from the types t1,...,tn.
  809.  * - replace type vars in class header by offsets, validate all types etc.
  810.  * - All bindings are function bindings
  811.  * - All bindings define member functions for class C
  812.  * - Arrange bindings into appropriate order for member list
  813.  * - No top level type signature declarations
  814.  * ------------------------------------------------------------------------*/
  815.  
  816. static Void local checkInstDefn(in)    /* validate instance declaration    */
  817. Inst in; {
  818.     Int  line   = inst(in).line;
  819.     List tyvars = typeVarsIn(inst(in).head,NIL);
  820.  
  821.     depPredExp(line,tyvars,inst(in).head);
  822.     map2Proc(depPredExp,line,tyvars,inst(in).specifics);
  823.     inst(in).cl = getHead(inst(in).head);
  824.     kindInst(in,length(tyvars));
  825.     inst(in).head = fullExpPred(inst(in).head);
  826.     insertInst(line,inst(in).cl,in);
  827.     inst(in).numSpecifics = length(inst(in).specifics);
  828.  
  829.     if (nonNull(extractSigdecls(inst(in).implements))) {
  830.         ERROR(line) "Type signature decls not permitted in instance decl"
  831.         EEND;
  832.     }
  833.  
  834.     inst(in).implements = classBindings("instance",
  835.                                         inst(in).cl,
  836.                                         extractBindings(inst(in).implements));
  837. }
  838.  
  839. /* --------------------------------------------------------------------------
  840.  * Process class and instance declaration binding groups:
  841.  * ------------------------------------------------------------------------*/
  842.  
  843. static List local classBindings(where,c,bs)
  844. String where;                          /* check validity of bindings bs for*/
  845. Class  c;                              /* class c (or an instance of c)    */
  846. List   bs; {                           /* sort into approp. member order   */
  847.     List nbs = NIL;
  848.  
  849.     for (; nonNull(bs); bs=tl(bs)) {
  850.         Cell b  = hd(bs);
  851.         Name nm = newName(inventText());   /* pick name for implementation */
  852.         Int  mno;
  853.  
  854.         if (!isVar(fst(b))) {          /* only allows function bindings    */
  855.             ERROR(rhsLine(snd(snd(snd(b)))))
  856.                "Pattern binding illegal in %s declaration", where
  857.             EEND;
  858.         }
  859.  
  860.         mno = memberNumber(c,textOf(fst(b)));
  861.  
  862.         if (mno==0) {
  863.             ERROR(rhsLine(snd(hd(snd(snd(b))))))
  864.                 "No member \"%s\" in class \"%s\"",
  865.                 textToStr(textOf(fst(b))),
  866.                 textToStr(class(c).text)
  867.             EEND;
  868.         }
  869.  
  870.         name(nm).defn = snd(snd(b));   /* save definition of implementation*/
  871.         nbs = numInsert(mno-1,nm,nbs);
  872.     }
  873.     return nbs;
  874. }
  875.  
  876. static Int local memberNumber(c,t)     /* return number of member function */
  877. Class c;                               /* with name t in class c           */
  878. Text  t; {                             /* return 0 if not a member         */
  879.     List ms = class(c).members;
  880.     for (; nonNull(ms); ms=tl(ms))
  881.         if (t==name(hd(ms)).text)
  882.             return name(hd(ms)).number;
  883.     return 0;
  884. }
  885.  
  886. static List local numInsert(n,x,xs)    /* insert x at nth position in xs,  */
  887. Int  n;                                /* filling gaps with NIL            */
  888. Cell x;
  889. List xs; {
  890.     List start = isNull(xs) ? cons(NIL,NIL) : xs;
  891.  
  892.     for (xs=start; 0<n--; xs=tl(xs))
  893.         if (isNull(tl(xs)))
  894.             tl(xs) = cons(NIL,NIL);
  895.     hd(xs) = x;
  896.     return start;
  897. }
  898.  
  899. /* --------------------------------------------------------------------------
  900.  * Primitive definitions are usually only included in the first script
  901.  * file read - the prelude.  A primitive definition associates a variable
  902.  * name with a string (which identifies a built-in primitive) and a type.
  903.  * ------------------------------------------------------------------------*/
  904.  
  905. Void primDefn(line,prims,type)           /* Handle primitive definitions       */
  906. Int  line;
  907. List prims;
  908. Cell type; {
  909.     type = checkSigType(line,"primitive definition",fst(hd(prims)),type);
  910.     for (; nonNull(prims); prims=tl(prims))
  911.     addNewPrim(line,
  912.            textOf(fst(hd(prims))),
  913.            textToStr(textOf(snd(hd(prims)))),
  914.            type);
  915. }
  916.  
  917. static Void local addNewPrim(l,vn,s,t)    /* make binding of variable vn to  */
  918. Int    l;                /* primitive function referred       */
  919. Text   vn;                /* to by s, with given type t       */
  920. String s;                /* return TRUE if vn already bound */
  921. Cell   t;{
  922.     Name n = findName(vn);
  923.  
  924.     if (isNull(n))
  925.         n = newName(vn);
  926.     else if (name(n).defn!=PREDEFINED) {
  927.         ERROR(l) "Redeclaration of primitive \"%s\"", textToStr(vn)
  928.         EEND;
  929.     }
  930.  
  931.     addPrim(l,n,s,t);
  932. }
  933.  
  934. /* --------------------------------------------------------------------------
  935.  * Static analysis of patterns:
  936.  *
  937.  * Patterns are parsed as ordinary (atomic) expressions.  Static analysis
  938.  * makes the following checks:
  939.  *  - Patterns are well formed (according to pattern syntax), including the
  940.  *    special case of (n+k) patterns.
  941.  *  - All constructor functions have been defined and are used with the
  942.  *    correct number of arguments.
  943.  *  - No variable name is used more than once in a pattern.
  944.  *
  945.  * The list of pattern variables occuring in each pattern is accumulated in
  946.  * a global list `patVars', which must be initialised to NIL at appropriate
  947.  * points before using these routines to check for valid patterns.  This
  948.  * mechanism enables the pattern checking routine to be mapped over a list
  949.  * of patterns, ensuring that no variable occurs more than once in the
  950.  * complete pattern list (as is required on the lhs of a function defn).
  951.  * ------------------------------------------------------------------------*/
  952.  
  953. static List patVars;               /* list of vars bound in pattern    */
  954.  
  955. static Cell local checkPat(line,p)     /* Check valid pattern syntax       */
  956. Int  line;
  957. Cell p; {
  958.     switch (whatIs(p)) {
  959.     case VARIDCELL :
  960.     case VAROPCELL : addPatVar(line,p);
  961.              break;
  962.  
  963.     case AP        : return checkMaybeCnkPat(line,p);
  964.  
  965.     case NAME      :
  966.     case CONIDCELL :
  967.     case CONOPCELL : return checkApPat(line,0,p);
  968.  
  969.     case UNIT      :
  970.     case WILDCARD  :
  971.     case STRCELL   :
  972.     case CHARCELL  :
  973.     case INTCELL   : break;
  974.  
  975.     case ASPAT     : addPatVar(line,fst(snd(p)));
  976.              snd(snd(p)) = checkPat(line,snd(snd(p)));
  977.              break;
  978.  
  979.     case LAZYPAT   : snd(p) = checkPat(line,snd(p));
  980.              break;
  981.  
  982.     case FINLIST   : map1Over(checkPat,line,snd(p));
  983.              break;
  984.  
  985.     default        : ERROR(line) "Illegal pattern syntax"
  986.              EEND;
  987.     }
  988.     return p;
  989. }
  990.  
  991. static Cell local checkMaybeCnkPat(l,p)/* Check applicative pattern with   */
  992. Int  l;                       /* the possibility of c*n or n+k    */
  993. Cell p; {                   /* pattern               */
  994.     Cell h = getHead(p);
  995.  
  996.     if (argCount==2 && isVar(h)) {
  997.     if (textOf(h)==textPlus) {  /* n+k pattern               */
  998.         Cell v = arg(fun(p));
  999.         if (!isInt(arg(p))) {
  1000.         ERROR(l) "Second argument in (n+k) pattern must be an integer"
  1001.         EEND;
  1002.         }
  1003.         if (intOf(arg(p))<=0) {
  1004.         ERROR(l) "Integer k in (n+k) pattern must be > 0"
  1005.         EEND;
  1006.         }
  1007.         fst(fun(p))     = ADDPAT;
  1008.         intValOf(fun(p)) = intOf(arg(p));
  1009.         arg(p)         = checkPat(l,v);
  1010.         return p;
  1011.     }
  1012.  
  1013.     if (textOf(h)==textMult) {  /* c*n pattern               */
  1014.         if (!isInt(arg(fun(p)))) {
  1015.         ERROR(l) "First argument in (c*n) pattern must be an integer"
  1016.         EEND;
  1017.         }
  1018.         if (intOf(arg(fun(p)))<=1) {
  1019.         ERROR(l) "Integer c in (c*n) pattern must be > 1"
  1020.         EEND;
  1021.         }
  1022.         fst(fun(p))      = MULPAT;
  1023.         intValOf(fun(p)) = intOf(arg(fun(p)));
  1024.         arg(p)           = checkPat(l,arg(p));
  1025.         return p;
  1026.     }
  1027.     }
  1028.  
  1029.     return checkApPat(l,0,p);
  1030. }
  1031.  
  1032. static Cell local checkApPat(line,args,p)
  1033. Int  line;                   /* check validity of application    */
  1034. Int  args;                   /* of constructor to arguments       */
  1035. Cell p; {
  1036.     switch (whatIs(p)) {
  1037.     case AP        : fun(p) = checkApPat(line,args+1,fun(p));
  1038.              arg(p) = checkPat(line,arg(p));
  1039.              break;
  1040.  
  1041.     case TUPLE     : if (tupleOf(p)!=args)
  1042.                  internal("bad pattern tuple");
  1043.              break;
  1044.  
  1045.     case CONIDCELL :
  1046.     case CONOPCELL : p = conDefined(line,textOf(p));
  1047.              checkCfunArgs(line,p,args);
  1048.              break;
  1049.  
  1050.     case NAME      : checkIsCfun(line,p);
  1051.              checkCfunArgs(line,p,args);
  1052.              break;
  1053.  
  1054.     default        : ERROR(line) "Illegal pattern syntax"
  1055.              EEND;
  1056.     }
  1057.     return p;
  1058. }
  1059.  
  1060. static Void local addPatVar(line,v)    /* add variable v to list of vars   */
  1061. Int  line;                   /* in current pattern, checking for */
  1062. Cell v; {                   /* repeated variables.           */
  1063.      Text t = textOf(v);
  1064.      List p = NIL;
  1065.      List n = patVars;
  1066.  
  1067.      for (; nonNull(n); p=n, n=tl(n))
  1068.      if (textOf(hd(n))==t) {
  1069.          ERROR(line) "Repeated variable \"%s\" in pattern",
  1070.              textToStr(t)
  1071.          EEND;
  1072.      }
  1073.  
  1074.      if (isNull(p))
  1075.      patVars = cons(v,NIL);
  1076.      else
  1077.      tl(p)     = cons(v,NIL);
  1078. }
  1079.  
  1080. static Name local conDefined(line,t)   /* check that t is the name of a    */
  1081. Int line;                   /* previously defined constructor   */
  1082. Text t; {                   /* function.               */
  1083.     Cell c=findName(t);
  1084.     if (isNull(c)) {
  1085.     ERROR(line) "Undefined constructor function \"%s\"", textToStr(t)
  1086.     EEND;
  1087.     }
  1088.     checkIsCfun(line,c);
  1089.     return c;
  1090. }
  1091.  
  1092. static Void local checkIsCfun(line,c)  /* Check that c is a constructor fn */
  1093. Int  line;
  1094. Cell c; {
  1095.     if (name(c).defn!=CFUN) {
  1096.     ERROR(line) "\"%s\" is not a constructor function",
  1097.             textToStr(name(c).text)
  1098.     EEND;
  1099.     }
  1100. }
  1101.  
  1102. static Void local checkCfunArgs(line,c,args)
  1103. Int  line;                   /* Check constructor applied with   */
  1104. Cell c;                    /* correct number of arguments       */
  1105. Int  args; {
  1106.     if (name(c).arity!=args) {
  1107.     ERROR(line) "Constructor function \"%s\" needs %d args in pattern",
  1108.             textToStr(name(c).text), name(c).arity
  1109.     EEND;
  1110.     }
  1111. }
  1112.  
  1113. /* --------------------------------------------------------------------------
  1114.  * Maintaining lists of bound variables and local definitions, for
  1115.  * dependency and scope analysis.
  1116.  * ------------------------------------------------------------------------*/
  1117.  
  1118. static List bounds;               /* list of lists of bound vars       */
  1119. static List bindings;               /* list of lists of binds in scope  */
  1120. static List depends;               /* list of lists of dependents       */
  1121.  
  1122. #define saveBvars()     hd(bounds)    /* list of bvars in current scope   */
  1123. #define restoreBvars(bs) hd(bounds)=bs /* restore list of bound variables  */
  1124.  
  1125. static Cell local bindPat(line,p)      /* add new bound vars for pattern   */
  1126. Int  line;
  1127. Cell p; {
  1128.     patVars    = NIL;
  1129.     p           = checkPat(line,p);
  1130.     hd(bounds) = revOnto(patVars,hd(bounds));
  1131.     return p;
  1132. }
  1133.  
  1134. static Void local bindPats(line,ps)    /* add new bound vars for patterns  */
  1135. Int  line;
  1136. List ps; {
  1137.     patVars    = NIL;
  1138.     map1Over(checkPat,line,ps);
  1139.     hd(bounds) = revOnto(patVars,hd(bounds));
  1140. }
  1141.  
  1142. /* --------------------------------------------------------------------------
  1143.  * Before processing value and type signature declarations, all data and
  1144.  * type definitions have been processed so that:
  1145.  * - all valid type constructors (with their arities) are known.
  1146.  * - all valid constructor functions (with their arities and types) are
  1147.  *   known.
  1148.  *
  1149.  * The result of parsing a list of value declarations is a list of Eqns:
  1150.  *     Eqn ::= (SIGDECL,(Line,[Var],type))  |  (Expr,Rhs)
  1151.  * The ordering of the equations in this list is the reverse of the original
  1152.  * ordering in the script parsed.  This is a consequence of the structure of
  1153.  * the parser ... but also turns out to be most convenient for the static
  1154.  * analysis.
  1155.  *
  1156.  * As the first stage of the static analysis of value declarations, each
  1157.  * list of Eqns is converted to a list of Bindings.  As part of this
  1158.  * process:
  1159.  * - The ordering of the list of Bindings produced is the same as in the
  1160.  *   original script.
  1161.  * - When a variable (function) is defined over a number of lines, all
  1162.  *   of the definitions should appear together and each should give the
  1163.  *   same arity to the variable being defined.
  1164.  * - No variable can have more than one definition.
  1165.  * - For pattern bindings:
  1166.  *   - Each lhs is a valid pattern/function lhs, all constructor functions
  1167.  *     have been defined and are used with the correct number of arguments.
  1168.  *   - Each lhs contains no repeated pattern variables.
  1169.  *   - Each equation defines at least one variable (e.g. True = False is
  1170.  *     not allowed).
  1171.  * - Types appearing in type signatures are well formed:
  1172.  *    - Type constructors used are defined and used with correct number
  1173.  *    of arguments.
  1174.  *    - type variables are replaced by offsets, type constructor names
  1175.  *    by Tycons.
  1176.  * - Every variable named in a type signature declaration is defined by
  1177.  *   one or more equations elsewhere in the script.
  1178.  * - No variable has more than one type declaration.
  1179.  *
  1180.  * ------------------------------------------------------------------------*/
  1181.  
  1182. #define bindingType(b) fst(snd(b))     /* type (or types) for binding       */
  1183. #define fbindAlts(b)   snd(snd(b))     /* alternatives for function binding*/
  1184.  
  1185. static List local extractSigdecls(es)  /* extract the SIGDECLS from list   */
  1186. List es; {                   /* of equations               */
  1187.     List sigDecls  = NIL;           /* :: [(Line,[Var],Type)]       */
  1188.  
  1189.     for(; nonNull(es); es=tl(es))
  1190.     if (fst(hd(es))==SIGDECL)             /* type-declaration?  */
  1191.         sigDecls = cons(snd(hd(es)),sigDecls);   /* discard SIGDECL tag*/
  1192.  
  1193.     return sigDecls;
  1194. }
  1195.  
  1196. static List local extractBindings(es)  /* extract untyped bindings from    */
  1197. List es; {                   /* given list of equations       */
  1198.     Cell lastVar   = NIL;           /* = var def'd in last eqn (if any) */
  1199.     Int  lastArity = 0;            /* = number of args in last defn    */
  1200.     List bs       = NIL;           /* :: [Binding]               */
  1201.  
  1202.     for(; nonNull(es); es=tl(es)) {
  1203.     Cell e = hd(es);
  1204.  
  1205.     if (fst(e)!=SIGDECL) {
  1206.         Int  line     = rhsLine(snd(e));
  1207.         Cell lhsHead = getHead(fst(e));
  1208.  
  1209.         switch (whatIs(lhsHead)) {
  1210.         case VARIDCELL :
  1211.         case VAROPCELL : {              /* function-binding? */
  1212.             Cell newAlt = pair(getArgs(fst(e)), snd(e));
  1213.             if (nonNull(lastVar) && textOf(lhsHead)==textOf(lastVar)) {
  1214.             if (argCount!=lastArity) {
  1215.                 ERROR(line)
  1216.                 "Equations give different arities for \"%s\"",
  1217.                 textToStr(textOf(lhsHead))
  1218.                 EEND;
  1219.             }
  1220.             fbindAlts(hd(bs)) = cons(newAlt,fbindAlts(hd(bs)));
  1221.             }
  1222.             else {
  1223.             lastVar   = lhsHead;
  1224.             lastArity = argCount;
  1225.             notDefined(line,bs,lhsHead);
  1226.             bs      = cons(pair(lhsHead,
  1227.                           pair(NIL,
  1228.                            singleton(newAlt))),
  1229.                      bs);
  1230.             }
  1231.         }
  1232.         break;
  1233.  
  1234.         case CONOPCELL :
  1235.         case CONIDCELL :
  1236.         case FINLIST   :
  1237.         case TUPLE     :
  1238.         case UNIT      :
  1239.         case ASPAT     : lastVar = NIL;       /* pattern-binding?  */
  1240.                  patVars = NIL;
  1241.                  fst(e)  = checkPat(line,fst(e));
  1242.                  if (isNull(patVars)) {
  1243.                      ERROR(line)
  1244.                       "No variables defined in lhs pattern"
  1245.                      EEND;
  1246.                  }
  1247.                  map2Proc(notDefined,line,bs,patVars);
  1248.                  bs = cons(pair(patVars,pair(NIL,e)),bs);
  1249.                  break;
  1250.  
  1251.         default        : ERROR(line) "Improper left hand side"
  1252.                  EEND;
  1253.         }
  1254.     }
  1255.     }
  1256.     return bs;
  1257. }
  1258.  
  1259. static List local eqnsToBindings(es)   /* Convert list of equations to list*/
  1260. List es; {                   /* of typed bindings           */
  1261.     List bs = extractBindings(es);
  1262.     map1Proc(addSigDecl,bs,extractSigdecls(es));
  1263.     return bs;
  1264. }
  1265.  
  1266. static Void local notDefined(line,bs,v)/* check if name already defined in */
  1267. Int  line;                   /* list of bindings           */
  1268. List bs;
  1269. Cell v; {
  1270.     if (nonNull(findBinding(textOf(v),bs))) {
  1271.     ERROR(line) "\"%s\" multiply defined", textToStr(textOf(v))
  1272.     EEND;
  1273.     }
  1274. }
  1275.  
  1276. static Cell local findBinding(t,bs)    /* look for binding for variable t  */
  1277. Text t;                    /* in list of bindings bs       */
  1278. List bs; {
  1279.     for (; nonNull(bs); bs=tl(bs))
  1280.     if (isVar(fst(hd(bs)))) {              /* function-binding? */
  1281.         if (textOf(fst(hd(bs)))==t)
  1282.         return hd(bs);
  1283.     }
  1284.     else if (nonNull(varIsMember(t,fst(hd(bs))))) /* pattern-binding?  */
  1285.         return hd(bs);
  1286.     return NIL;
  1287. }
  1288.  
  1289. static Void local addSigDecl(bs,sigDecl)/* add type information to bindings*/
  1290. List bs;                   /* :: [Binding]               */
  1291. Cell sigDecl; {                /* :: (Line,[Var],Type)           */
  1292.     Int  line = intOf(fst3(sigDecl));
  1293.     Cell vs   = snd3(sigDecl);
  1294.     Cell type = checkSigType(line,"type declaration",hd(vs),thd3(sigDecl));
  1295.  
  1296.     map3Proc(setType,line,type,bs,vs);
  1297. }
  1298.  
  1299. static Void local setType(line,type,bs,v)
  1300. Int  line;                   /* Set type of variable           */
  1301. Cell type;
  1302. Cell v;
  1303. List bs; {
  1304.     Text t = textOf(v);
  1305.     Cell b = findBinding(t,bs);
  1306.  
  1307.     if (isNull(b)) {
  1308.     ERROR(line) "Type declaration for variable \"%s\" with no body",
  1309.             textToStr(t)
  1310.     EEND;
  1311.     }
  1312.  
  1313.     if (isVar(fst(b))) {                  /* function-binding? */
  1314.     if (isNull(bindingType(b))) {
  1315.         bindingType(b) = type;
  1316.         return;
  1317.     }
  1318.     }
  1319.     else {                          /* pattern-binding?  */
  1320.     List vs = fst(b);
  1321.     List ts = bindingType(b);
  1322.  
  1323.     if (isNull(ts))
  1324.         bindingType(b) = ts = copy(length(vs),NIL);
  1325.  
  1326.     while (nonNull(vs) && t!=textOf(hd(vs))) {
  1327.         vs = tl(vs);
  1328.         ts = tl(ts);
  1329.     }
  1330.  
  1331.     if (nonNull(vs) && isNull(hd(ts))) {
  1332.         hd(ts) = type;
  1333.         return;
  1334.     }
  1335.     }
  1336.  
  1337.     ERROR(line) "Repeated type declaration for \"%s\"", textToStr(t)
  1338.     EEND;
  1339. }
  1340.  
  1341. /* --------------------------------------------------------------------------
  1342.  * To facilitate dependency analysis, lists of bindings are temporarily
  1343.  * augmented with an additional field, which is used in two ways:
  1344.  * - to build the `adjacency lists' for the dependency graph. Represented by
  1345.  *   a list of pointers to other bindings in the same list of bindings.
  1346.  * - to hold strictly positive integer values (depth first search numbers) of
  1347.  *   elements `on the stack' during the strongly connected components search
  1348.  *   algorithm, or a special value mkInt(0), once the binding has been added
  1349.  *   to a particular strongly connected component.
  1350.  *
  1351.  * Using this extra field, the type of each list of declarations during
  1352.  * dependency analysis is [Binding'] where:
  1353.  *
  1354.  *    Binding' ::= (Var, (Dep, (Type, [Alt])))          -- function binding
  1355.  *        |  ([Var], (Dep, (Type, (Pat,Rhs))))  -- pattern binding
  1356.  *
  1357.  * ------------------------------------------------------------------------*/
  1358.  
  1359. #define depVal(d) (fst(snd(d)))        /* Access to dependency information */
  1360.  
  1361. static List local dependencyAnal(bs)   /* Separate lists of bindings into  */
  1362. List bs; {                   /* mutually recursive groups in       */
  1363.                        /* order of dependency           */
  1364.  
  1365.     mapProc(addDepField,bs);           /* add extra field for dependents   */
  1366.     mapProc(depBinding,bs);           /* find dependents of each binding  */
  1367.     bs = bscc(bs);               /* sort to strongly connected comps */
  1368.     mapProc(remDepField,bs);           /* remove dependency info field       */
  1369.     return bs;
  1370. }
  1371.  
  1372. static List local topDependAnal(bs)    /* Like dependencyAnal(), but at    */
  1373. List bs; {                   /* top level, reporting on progress */
  1374.     List xs;
  1375.     Int  i = 0;
  1376.  
  1377.     setGoal("Dependency analysis",(Target)(length(bs)));
  1378.     mapProc(addDepField,bs);           /* add extra field for dependents   */
  1379.     for (xs=bs; nonNull(xs); xs=tl(xs)) {
  1380.     depBinding(hd(xs));
  1381.     soFar((Target)(i++));
  1382.     }
  1383.     bs = bscc(bs);               /* sort to strongly connected comps */
  1384.     mapProc(remDepField,bs);           /* remove dependency info field       */
  1385.     done();
  1386.     return bs;
  1387. }
  1388.  
  1389. static Void local addDepField(b)       /* add extra field to binding to    */
  1390. Cell b; {                   /* hold list of dependents       */
  1391.     snd(b) = pair(NIL,snd(b));
  1392. }
  1393.  
  1394. static Void local remDepField(bs)      /* remove dependency field from       */
  1395. List bs; {                   /* list of bindings           */
  1396.     mapProc(remDepField1,bs);
  1397. }
  1398.  
  1399. static Void local remDepField1(b)      /* remove dependency field from       */
  1400. Cell b; {                   /* single binding           */
  1401.     snd(b) = snd(snd(b));
  1402. }
  1403.  
  1404. static Void local clearScope() {       /* initialise dependency scoping    */
  1405.     bounds   = NIL;
  1406.     bindings = NIL;
  1407.     depends  = NIL;
  1408. }
  1409.  
  1410. static Void local withinScope(bs)      /* enter scope of bindings bs       */
  1411. List bs; {
  1412.     bounds   = cons(NIL,bounds);
  1413.     bindings = cons(bs,bindings);
  1414.     depends  = cons(NIL,depends);
  1415. }
  1416.  
  1417. static Void local leaveScope() {       /* leave scope of last withinScope  */
  1418.     bounds   = tl(bounds);
  1419.     bindings = tl(bindings);
  1420.     depends  = tl(depends);
  1421. }
  1422.  
  1423. /* --------------------------------------------------------------------------
  1424.  * As a side effect of the dependency analysis we also make the following
  1425.  * checks:
  1426.  * - Each lhs is a valid pattern/function lhs, all constructor functions
  1427.  *   have been defined and are used with the correct number of arguments.
  1428.  * - No lhs contains repeated pattern variables.
  1429.  * - Expressions used on the rhs of an eqn should be well formed.  This
  1430.  *   includes:
  1431.  *   - Checking for valid patterns (including repeated vars) in lambda,
  1432.  *     case, and list comprehension expressions.
  1433.  *   - Recursively checking local lists of equations.
  1434.  * - No free (i.e. unbound) variables are used in the declaration list.
  1435.  * ------------------------------------------------------------------------*/
  1436.  
  1437. static Void local depBinding(b)        /* find dependents of binding       */
  1438. Cell b; {
  1439.     Cell defpart = snd(snd(snd(b)));   /* definition part of binding       */
  1440.  
  1441.     hd(depends) = NIL;
  1442.  
  1443.     if (isVar(fst(b))) {           /* function-binding?           */
  1444.     mapProc(depAlt,defpart);
  1445.     }
  1446.     else {                   /* pattern-binding?           */
  1447.     depRhs(snd(defpart));
  1448.     }
  1449.  
  1450.     depVal(b) = hd(depends);
  1451. }
  1452.  
  1453. static Void local depDefaults(c)       /* dependency analysis on defaults  */
  1454. Class c; {                             /* from class definition            */
  1455.     depClassBindings(class(c).defaults);
  1456. }
  1457.  
  1458. static Void local depInsts(in)         /* dependency analysis on instance  */
  1459. Inst in; {                             /* bindings                         */
  1460.     depClassBindings(inst(in).implements);
  1461. }
  1462.  
  1463. static Void local depClassBindings(bs) /* dependency analysis on list of   */
  1464. List bs; {                             /* bindings, possibly containing    */
  1465.     for (; nonNull(bs); bs=tl(bs))     /* NIL bindings ...                 */
  1466.         if (nonNull(hd(bs)))           /* No need to add extra field for   */
  1467.             mapProc(depAlt,name(hd(bs)).defn); /* dependency information.. */
  1468. }
  1469.  
  1470. static Void local depAlt(a)           /* find dependents of alternative   */
  1471. Cell a; {
  1472.     List origBvars = saveBvars();      /* save list of bound variables       */
  1473.     bindPats(rhsLine(snd(a)),fst(a));  /* add new bound vars for patterns  */
  1474.     depRhs(snd(a));               /* find dependents of rhs       */
  1475.     restoreBvars(origBvars);           /* restore original list of bvars   */
  1476. }
  1477.  
  1478. static Void local depRhs(r)           /* find dependents of rhs       */
  1479. Cell r; {
  1480.     switch (whatIs(r)) {
  1481.     case GUARDED : mapProc(depGuard,snd(r));
  1482.                break;
  1483.  
  1484.     case LETREC  : fst(snd(r)) = eqnsToBindings(fst(snd(r)));
  1485.                withinScope(fst(snd(r)));
  1486.                fst(snd(r)) = dependencyAnal(fst(snd(r)));
  1487.                hd(depends) = fst(snd(r));
  1488.                depRhs(snd(snd(r)));
  1489.                leaveScope();
  1490.                break;
  1491.  
  1492.     default      : snd(r) = depExpr(intOf(fst(r)),snd(r));
  1493.                break;
  1494.     }
  1495. }
  1496.  
  1497. static Void local depGuard(g)           /* find dependents of single guarded*/
  1498. Cell g; {                   /* expression               */
  1499.     depPair(intOf(fst(g)),snd(g));
  1500. }
  1501.  
  1502. static Cell local depExpr(line,e)      /* find dependents of expression    */
  1503. Int  line;
  1504. Cell e; {
  1505.     switch (whatIs(e)) {
  1506.  
  1507.     case VARIDCELL    :
  1508.     case VAROPCELL    : return depVar(line,e);
  1509.  
  1510.     case CONIDCELL    :
  1511.     case CONOPCELL    : return conDefined(line,textOf(e));
  1512.  
  1513.     case AP     : depPair(line,e);
  1514.               break;
  1515.  
  1516.     case NAME    :
  1517.     case UNIT    :
  1518.     case TUPLE    :
  1519.     case STRCELL    :
  1520.     case CHARCELL    :
  1521.     case FLOATCELL  :
  1522.     case INTCELL    : break;
  1523.  
  1524.     case COND    : depTriple(line,snd(e));
  1525.               break;
  1526.  
  1527.     case FINLIST    : map1Over(depExpr,line,snd(e));
  1528.               break;
  1529.  
  1530.     case LETREC    : fst(snd(e)) = eqnsToBindings(fst(snd(e)));
  1531.               withinScope(fst(snd(e)));
  1532.               fst(snd(e)) = dependencyAnal(fst(snd(e)));
  1533.               hd(depends) = fst(snd(e));
  1534.               snd(snd(e)) = depExpr(line,snd(snd(e)));
  1535.               leaveScope();
  1536.               break;
  1537.  
  1538.     case LAMBDA    : depAlt(snd(e));
  1539.               break;
  1540.  
  1541.     case COMP    : depComp(line,snd(e),snd(snd(e)));
  1542.               break;
  1543.  
  1544.     case ESIGN    : fst(snd(e)) = depExpr(line,fst(snd(e)));
  1545.               snd(snd(e)) = checkSigType(line,
  1546.                              "expression",
  1547.                              fst(snd(e)),
  1548.                              snd(snd(e)));
  1549.               break;
  1550.  
  1551.     case CASE    : fst(snd(e)) = depExpr(line,fst(snd(e)));
  1552.               map1Proc(depCaseAlt,line,snd(snd(e)));
  1553.               break;
  1554.  
  1555.     case ASPAT    : ERROR(line) "Illegal `@' in expression"
  1556.               EEND;
  1557.  
  1558.     case LAZYPAT    : ERROR(line) "Illegal `~' in expression"
  1559.               EEND;
  1560.  
  1561.     case WILDCARD    : ERROR(line) "Illegal `_' in expression"
  1562.               EEND;
  1563.  
  1564.     default     : internal("in depExpr");
  1565.    }
  1566.    return e;
  1567. }
  1568.  
  1569. static Void local depPair(line,e)    /* find dependents of pair of exprs*/
  1570. Int  line;
  1571. Cell e; {
  1572.     fst(e) = depExpr(line,fst(e));
  1573.     snd(e) = depExpr(line,snd(e));
  1574. }
  1575.  
  1576. static Void local depTriple(line,e)    /* find dependents of triple exprs */
  1577. Int  line;
  1578. Cell e; {
  1579.     fst3(e) = depExpr(line,fst3(e));
  1580.     snd3(e) = depExpr(line,snd3(e));
  1581.     thd3(e) = depExpr(line,thd3(e));
  1582. }
  1583.  
  1584. static Void local depComp(l,e,qs)    /* find dependents of comprehension*/
  1585. Int  l;
  1586. Cell e;
  1587. List qs; {
  1588.     if (isNull(qs))
  1589.     fst(e) = depExpr(l,fst(e));
  1590.     else {
  1591.     Cell q   = hd(qs);
  1592.     List qs1 = tl(qs);
  1593.     switch (whatIs(q)) {
  1594.         case FROMQUAL : {   List origBvars = saveBvars();
  1595.                                 snd(snd(q))    = depExpr(l,snd(snd(q)));
  1596.                 fst(snd(q))    = bindPat(l,fst(snd(q)));
  1597.                 depComp(l,e,qs1);
  1598.                 restoreBvars(origBvars);
  1599.                 }
  1600.                 break;
  1601.  
  1602.         case QWHERE   : snd(q)      = eqnsToBindings(snd(q));
  1603.                 withinScope(snd(q));
  1604.                             snd(q)      = dependencyAnal(snd(q));
  1605.                 hd(depends) = snd(q);
  1606.                 depComp(l,e,qs1);
  1607.                 leaveScope();
  1608.                 break;
  1609.  
  1610.         case BOOLQUAL : snd(q) = depExpr(l,snd(q));
  1611.                 depComp(l,e,qs1);
  1612.                 break;
  1613.     }
  1614.     }
  1615. }
  1616.  
  1617. static Void local depCaseAlt(line,a)    /* find dependents of case altern. */
  1618. Int  line;
  1619. Cell a; {
  1620.     List origBvars = saveBvars();    /* save list of bound variables       */
  1621.     fst(a) = bindPat(line,fst(a));    /* add new bound vars for patterns */
  1622.     depRhs(snd(a));            /* find dependents of rhs       */
  1623.     restoreBvars(origBvars);        /* restore original list of bvars  */
  1624. }
  1625.  
  1626. static Cell local depVar(line,e)    /* register occurrence of variable */
  1627. Int line;
  1628. Cell e; {
  1629.     List bounds1   = bounds;
  1630.     List bindings1 = bindings;
  1631.     List depends1  = depends;
  1632.     Text t       = textOf(e);
  1633.     Cell n;
  1634.  
  1635.     while (nonNull(bindings1)) {
  1636.     n = varIsMember(t,hd(bounds1));   /* look for t in bound variables */
  1637.     if (nonNull(n))
  1638.         return n;
  1639.  
  1640.     n = findBinding(t,hd(bindings1)); /* look for t in var bindings    */
  1641.     if (nonNull(n)) {
  1642.        if (!cellIsMember(n,hd(depends1)))
  1643.            hd(depends1) = cons(n,hd(depends1));
  1644.        return (isVar(fst(n)) ? fst(n) : e);
  1645.     }
  1646.  
  1647.     bounds1   = tl(bounds1);
  1648.     bindings1 = tl(bindings1);
  1649.     depends1  = tl(depends1);
  1650.     }
  1651.  
  1652.     if (isNull(n=findName(t))) {           /* check global definitions */
  1653.     ERROR(line) "Undefined variable \"%s\"", textToStr(t)
  1654.     EEND;
  1655.     }
  1656.  
  1657.     return n;
  1658. }
  1659.  
  1660. /* --------------------------------------------------------------------------
  1661.  * Several parts of this program require an algorithm for sorting a list
  1662.  * of values (with some added dependency information) into a list of strongly
  1663.  * connected components in which each value appears before its dependents.
  1664.  *
  1665.  * Each of these algorithms is obtained by parameterising a standard
  1666.  * algorithm in "scc.c" as shown below.
  1667.  * ------------------------------------------------------------------------*/
  1668.  
  1669. #define visited(d) (isInt(DEPENDS(d)))    /* binding already visited ?       */
  1670.  
  1671. static Cell daSccs = NIL;
  1672. static Int  daCount;
  1673.  
  1674. static Int local sccMin(x,y)           /* calculate minimum of x,y (unless */
  1675. Int x,y; {                   /* y is zero)               */
  1676.     return (x<=y || y==0) ? x : y;
  1677. }
  1678.  
  1679. #define  SCC        tscc        /* make scc algorithm for Tycons   */
  1680. #define  LOWLINK    tlowlink
  1681. #define  DEPENDS(t) tycon(t).kind
  1682. #include "scc.c"
  1683. #undef     DEPENDS
  1684. #undef      LOWLINK
  1685. #undef     SCC
  1686.  
  1687. #define  SCC        cscc        /* make scc algorithm for Classes  */
  1688. #define  LOWLINK    clowlink
  1689. #define  DEPENDS(c) class(c).sig
  1690. #include "scc.c"
  1691. #undef     DEPENDS
  1692. #undef      LOWLINK
  1693. #undef     SCC
  1694.  
  1695. #define  SCC        bscc        /* make scc algorithm for Bindings */
  1696. #define  LOWLINK    blowlink
  1697. #define  DEPENDS(t) depVal(t)
  1698. #include "scc.c"
  1699. #undef     DEPENDS
  1700. #undef      LOWLINK
  1701. #undef     SCC
  1702.  
  1703. /* --------------------------------------------------------------------------
  1704.  * Main static analysis:
  1705.  * ------------------------------------------------------------------------*/
  1706.  
  1707. Void checkExp() {            /* Top level static check on Expr  */
  1708.     staticAnalysis(RESET);
  1709.     clearScope();            /* Analyse expression in the scope */
  1710.     withinScope(NIL);            /* of no local bindings           */
  1711.     inputExpr = depExpr(0,inputExpr);
  1712.     leaveScope();
  1713.     staticAnalysis(RESET);
  1714. }
  1715.  
  1716. Void checkDefns() {            /* Top level static analysis       */
  1717.     staticAnalysis(RESET);
  1718.  
  1719.     mapProc(checkTyconDefn,tyconDefns);    /* validate tycon definitions       */
  1720.     checkSynonyms(tyconDefns);        /* check synonym definitions       */
  1721.     tyconDefns = tscc(tyconDefns);    /* sort into sc components       */
  1722.     mapProc(checkTyconGroup,tyconDefns);/* validate each group           */
  1723.     tyconDefns = NIL;
  1724.  
  1725.     mapProc(checkClassDefn,classDefns);    /* process class definitions       */
  1726.     mapProc(checkClassGroup,cscc(classDefns));
  1727.  
  1728.     instDefns = rev(instDefns);        /* process instance definitions       */
  1729.     mapProc(checkInstDefn,instDefns);
  1730.  
  1731.     mapProc(addRSsigdecls,typeInDefns);    /* add sigdecls for RESTRICTSYN       */
  1732.     valDefns = eqnsToBindings(valDefns);/* translate value equations       */
  1733.     map1Proc(opDefined,valDefns,opDefns);/*check all declared ops bound       */
  1734.     mapProc(allNoPrevDef,valDefns);    /* check against previous defns       */
  1735.  
  1736.     mapProc(checkTypeIn,typeInDefns);    /* check restricted synonym defns  */
  1737.  
  1738.     clearScope();
  1739.     withinScope(valDefns);
  1740.     valDefns = topDependAnal(valDefns); /* top level dependency ordering   */
  1741.     mapProc(depDefaults,classDefns);    /* dep. analysis on class defaults */
  1742.     mapProc(depInsts,instDefns);        /* dep. analysis on inst defns       */
  1743.     leaveScope();
  1744.  
  1745.     staticAnalysis(RESET);
  1746. }
  1747.  
  1748. static Void local addRSsigdecls(pr)    /* add sigdecls from TYPE ... IN ..*/
  1749. Pair pr; {
  1750.     List vs = snd(pr);            /* get list of variables       */
  1751.     for (; nonNull(vs); vs=tl(vs)) {
  1752.     if (fst(hd(vs))==SIGDECL) {    /* find a sigdecl           */
  1753.         valDefns = cons(hd(vs),valDefns);    /* add to valDefns       */
  1754.         hd(vs)   = hd(snd3(snd(hd(vs))));    /* and replace with var       */
  1755.     }
  1756.     }
  1757. }
  1758.  
  1759. static Void local opDefined(bs,op)     /* check that op bound in bs       */
  1760. List bs;                 /* (or in current module for       */
  1761. Cell op; {                 /* constructor functions etc...)  */
  1762.     Name n;
  1763.  
  1764.     if (isNull(findBinding(textOf(op),bs))
  1765.            && (isNull(n=findName(textOf(op))) || !nameThisModule(n))) {
  1766.     ERROR(0) "No top level definition for operator symbol \"%s\"",
  1767.          textToStr(textOf(op))
  1768.     EEND;
  1769.     }
  1770. }
  1771.  
  1772. static Void local allNoPrevDef(b)     /* ensure no previous bindings for*/
  1773. Cell b; {                 /* variables in new binding       */
  1774.     if (isVar(fst(b)))
  1775.     noPrevDef(rhsLine(snd(hd(snd(snd(b))))),fst(b));
  1776.     else {
  1777.     Int line = rhsLine(snd(snd(snd(b))));
  1778.     map1Proc(noPrevDef,line,fst(b));
  1779.     }
  1780. }
  1781.  
  1782. static Void local noPrevDef(line,v)     /* ensure no previous binding for */
  1783. Int  line;                 /* new variable           */
  1784. Cell v; {
  1785.     Name n = findName(textOf(v));
  1786.  
  1787.     if (isNull(n)) {
  1788.     n            = newName(textOf(v));
  1789.     name(n).defn = PREDEFINED;
  1790.     }
  1791.     else if (name(n).defn!=PREDEFINED) {
  1792.     ERROR(line) "Attempt to redefine variable \"%s\"",
  1793.             textToStr(name(n).text)
  1794.     EEND;
  1795.     }
  1796.     name(n).line = line;
  1797. }
  1798.  
  1799. static Void local checkTypeIn(cvs)    /* Check that vars in restricted   */
  1800. Pair cvs; {                /* synonym are defined, and replace*/
  1801.     Tycon c  = fst(cvs);        /* vars with names           */
  1802.     List  vs = snd(cvs);
  1803.  
  1804.     for (; nonNull(vs); vs=tl(vs))
  1805.     if (isNull(findName(textOf(hd(vs))))) {
  1806.         ERROR(tycon(c).line)
  1807.         "No top level binding of \"%s\" for restricted synonym \"%s\"",
  1808.         textToStr(textOf(hd(vs))), textToStr(tycon(c).text)
  1809.         EEND;
  1810.     }
  1811. }
  1812.  
  1813. /* --------------------------------------------------------------------------
  1814.  * Static Analysis control:
  1815.  * ------------------------------------------------------------------------*/
  1816.  
  1817. Void staticAnalysis(what)
  1818. Int what; {
  1819.     switch (what) {
  1820.     case INSTALL :
  1821.     case RESET   : daSccs     = NIL;
  1822.                patVars     = NIL;
  1823.                bounds     = NIL;
  1824.                bindings     = NIL;
  1825.                depends   = NIL;
  1826.                tyconDeps = NIL;
  1827.                break;
  1828.  
  1829.     case MARK    : mark(daSccs);
  1830.                mark(patVars);
  1831.                mark(bounds);
  1832.                mark(bindings);
  1833.                mark(depends);
  1834.                mark(tyconDeps);
  1835.                break;
  1836.     }
  1837. }
  1838.  
  1839. /*-------------------------------------------------------------------------*/
  1840.