1-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
2-- All rights reserved.
3--
4-- Redistribution and use in source and binary forms, with or without
5-- modification, are permitted provided that the following conditions are
6-- met:
7--
8--     - Redistributions of source code must retain the above copyright
9--       notice, this list of conditions and the following disclaimer.
10--
11--     - Redistributions in binary form must reproduce the above copyright
12--       notice, this list of conditions and the following disclaimer in
13--       the documentation and/or other materials provided with the
14--       distribution.
15--
16--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
17--       names of its contributors may be used to endorse or promote products
18--       derived from this software without specific prior written permission.
19--
20-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
21-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
22-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
23-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
24-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
25-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
26-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
27-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
28-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
29-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
30-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31
32)package "BOOT"
33
34--%  Utilities
35
36mkDevaluate a ==
37  null a => nil
38  a is ['QUOTE,a'] => (a' => a; nil)
39  a='$ => MKQ '$
40  a is ['LIST] => nil
41  a is ['LIST,:.] => a
42  ['devaluate,a]
43
44compCategories(u, e) ==
45  ATOM u => u
46  not ATOM first u =>
47    error ['"compCategories: need an atom in operator position", first u]
48  first u = "Record" =>
49    -- There is no modemap property for these guys so do it by hand.
50      [first u, :[[":", a.1, compCategories1(a.2, '(SetCategory), e)]
51                   for a in rest u]]
52  first u = "Union" or first u = "Mapping" =>
53    -- There is no modemap property for these guys so do it by hand.
54      [first u, :[compCategories1(a, '(SetCategory), e) for a in rest u]]
55  u is ['SubDomain, D, .] => compCategories(D, e)
56  v := get(first u, 'modemap, e)
57  ATOM v =>
58    error ['"compCategories: could not get proper modemap for operator",first u]
59  rest v =>
60    error ['"compCategories: unexpected stuff at end of modemap",
61           rest v]
62  v:= CDDAAR v
63  v:=resolvePatternVars(v, rest u) -- replaces #n forms
64  -- select the modemap part of the first entry, and skip result etc.
65  u:=[first u, :[compCategories1(a, b, e) for a in rest u for b in v]]
66  u
67
68compCategories1(u, v, e) ==
69-- v is the mode of u
70  ATOM u => u
71  isCategoryForm(v) => compCategories(u, e)
72  [c, :.] := comp(macroExpand(u, e), v, e) => c
73  error 'compCategories1
74
75optFunctorBody x ==
76  atom x => x
77  x is ['QUOTE,:l] => x
78  x is ['DomainSubstitutionMacro,parms,body] =>
79      optFunctorBody(DomainSubstitutionFunction($definition, parms, body))
80  x is ['LIST,:l] =>
81    null l => nil
82    l:= [optFunctorBody u for u in l]
83    and/[optFunctorBodyQuotable u for u in l] =>
84      ['QUOTE,[optFunctorBodyRequote u for u in l]]
85    l=rest x => x --CONS-saving hack
86    ['LIST,:l]
87  x is ['PROGN,:l] => ['PROGN,:optFunctorPROGN l]
88  x is ['COND,:l] =>
89--+
90    l:=
91      [CondClause u for u in l | u and first u] where
92        CondClause [pred,:conseq] ==
93          [optFunctorBody pred,:optFunctorPROGN conseq]
94    l:= EFFACE('((QUOTE T)),l)
95                   --delete any trailing ("T)
96    null l => nil
97    CAAR l='(QUOTE T) =>
98      (null CDAR l => nil; null CDDAR l => CADAR l; ["PROGN",:CDAR l])
99    null rest l and null CDAR l =>
100            --there is no meat to this COND
101      pred:= CAAR l
102      atom pred => nil
103      first pred="HasCategory" => nil
104      ['COND,:l]
105    ['COND,:l]
106  [optFunctorBody u for u in x]
107
108optFunctorBodyQuotable u ==
109  null u => true
110  NUMBERP u => true
111  atom u => nil
112  u is ['QUOTE,:.] => true
113  nil
114
115optFunctorBodyRequote u ==
116  atom u => u
117  u is ['QUOTE,v] => v
118  systemErrorHere '"optFunctorBodyRequote"
119
120optFunctorPROGN l ==
121  l is [x,:l'] =>
122    worthlessCode x => optFunctorPROGN l'
123    l':= optFunctorBody l'
124    l'=[nil] => [optFunctorBody x]
125    [optFunctorBody x,:l']
126  l
127
128worthlessCode x ==
129  x is ['COND,:l] and (and/[x is [.,y] and worthlessCode y for x in l]) => true
130  x is ['PROGN,:l] => (null (l':= optFunctorPROGN l) => true; false)
131  x is ['LIST] => true
132  null x => true
133  false
134
135cons5(p,l) ==
136  l and (CAAR l = first p) => [p,: rest l]
137  LENGTH l < 5 => [p,:l]
138  RPLACD(QCDDR(QCDDR l), nil)
139  [p,:l]
140
141mkDomainConstructor x ==
142  atom x => mkDevaluate x
143  x is ['Join] => nil
144  x is ['LIST] => nil
145  x is ['CATEGORY,:.] => MKQ x
146  x is ['mkCategory,:.] => MKQ x
147  x is ['_:,selector,dom] =>
148    ['LIST,MKQ '_:,MKQ selector,mkDomainConstructor dom]
149  x is ['Record,:argl] =>
150    ['LIST,MKQ 'Record,:[mkDomainConstructor y for y in argl]]
151  x is ['Join,:argl] =>
152    ['LIST,MKQ 'Join,:[mkDomainConstructor y for y in argl]]
153  x is [op] => MKQ x
154  x is [op,:argl] => ['LIST,MKQ op,:[mkDomainConstructor a for a in argl]]
155
156
157DescendCodeAdd(base, flag, kvec, e) ==
158  atom base => DescendCodeVarAdd(base, flag, kvec, e)
159  not (modemap:=get(opOf base,'modemap,$CategoryFrame)) =>
160      if getmode(opOf base, e) is ["Mapping", target, :formalArgModes]
161         then formalArgs:= take(#formalArgModes,$FormalMapVariableList)
162                --argument substitution if parameterized?
163
164         else keyedSystemError("S2OR0001",[opOf base])
165      DescendCodeAdd1(base, flag, target, formalArgs, formalArgModes, kvec, e)
166  for [[[.,:formalArgs],target,:formalArgModes],.] in modemap repeat
167      (ans := DescendCodeAdd1(base, flag, target, formalArgs,
168                              formalArgModes, kvec, e)) => return ans
169  ans
170
171DescendCodeAdd1(base, flag, target, formalArgs, formalArgModes, kvec, e) ==
172  slist:= pairList(formalArgs,rest $addFormLhs)
173         --base = comp $addFormLhs-- bound in compAdd
174  newModes:= SUBLIS(slist,formalArgModes)
175  or/[not comp(u,m,e) for u in rest $addFormLhs for m in newModes] =>
176    return nil
177      --I should check that the actual arguments are of the right type
178  for u in formalArgs for m in newModes repeat
179    [.,.,e]:= compMakeDeclaration(['_:,u,m],m,e)
180      --we can not substitute in the formal arguments before we comp
181      --for that may change the shape of the object, but we must before
182      --we match signatures
183  cat:= (compMakeCategoryObject(target,e)).expr
184  instantiatedBase:= GENVAR()
185  n:=MAXINDEX cat
186  code:=
187    [u
188      for i in 6..n | not atom cat.i and not atom (sig:= first cat.i)
189         and
190          (u:=
191            SetFunctionSlots(SUBLIS(slist, sig), ['ELT, instantiatedBase, i],
192                             flag, kvec)) ~= nil]
193     --The code from here to the end is designed to replace repeated LOAD/STORE
194     --combinations (SETELT ...(ELT ..)) by MVCs where this is practicable
195  copyvec:=GETREFV (1+n)
196  for u in code repeat
197      if update(u,copyvec,[]) then code:=delete(u,code)
198    where update(code,copyvec,sofar) ==
199      ATOM code =>nil
200      MEMQ(QCAR code,'(ELT QREFELT)) =>
201          copyvec.(CADDR code):=union(copyvec.(CADDR code), sofar)
202          true
203      code is [x,name,number,u'] and MEMQ(x,'(SETELT QSETREFV)) =>
204        update(u',copyvec,[[name,:number],:sofar])
205  for i in 6..n repeat
206    if copyvec.i then
207      v:=[($QuickCode => 'QREFELT;'ELT),instantiatedBase,i]
208      for u in copyvec.i repeat
209        [name,:count]:=u
210        v:=[($QuickCode => 'QSETREFV;'SETELT),name,count,v]
211      code:=[v,:code]
212  [['LET,instantiatedBase,base],:code]
213
214DescendCode(code, flag, viewAssoc, EnvToPass, kvec, e) ==
215  -- flag = true if we are walking down code always executed;
216  -- otherwise set to conditions in which
217  code=nil => nil
218  code='noBranch => nil
219  code is ['add,base,:codelist] =>
220    codelist:=
221        [v for u in codelist | (v := DescendCode(u, flag, viewAssoc,
222           EnvToPass, kvec, e)) ~= nil]
223                  -- must do this first, to get this overriding Add code
224    ['PROGN, :DescendCodeAdd(base, flag, kvec, e), :codelist]
225  code is ['PROGN,:codelist] =>
226    ['PROGN,:
227            --Two REVERSEs leave original order, but ensure last guy wins
228      NREVERSE [v for u in REVERSE codelist | (v := DescendCode(
229                         u, flag, viewAssoc, EnvToPass, kvec, e)) ~= nil]]
230  code is ['COND,:condlist] =>
231    c := [[u2 := ProcessCond(first(u), e), :q] for u in condlist] where q ==
232          null u2 => nil
233          f:=
234            TruthP u2 => flag;
235            TruthP flag =>
236               flag := ['NOT,u2]
237               u2
238            f1 := ['AND, flag, u2]
239            flag := ['AND,flag,['NOT,u2]];
240            f1
241          [DescendCode(v, f,
242            if first u is ['HasCategory,dom,cat]
243              then [[dom,:cat],:viewAssoc]
244              else viewAssoc, EnvToPass, kvec, e) for v in rest u]
245    TruthP CAAR c => ['PROGN,:CDAR c]
246    while (c and (last c is [c1] or last c is [c1,[]]) and
247            (c1 = '(QUOTE T))) repeat
248                   --strip out some worthless junk at the end
249        c := NREVERSE rest NREVERSE c
250    null c => '(LIST)
251    ['COND,:c]
252  code is ['LET,name,body,:.] =>
253                    --only keep the names that are useful
254    u:=member(name,$locals) =>
255        CONTAINED('$, body) and isDomainForm(body, e) =>
256          --instantiate domains which depend on $ after constants are set
257          code:=[($QuickCode => 'QSETREFV; 'SETELT),[($QuickCode => 'QREFELT; 'ELT),'$,5],#$locals-#u,code]
258          $epilogue:=
259            TruthP flag => [code,:$epilogue]
260            [['COND, [ProcessCond(flag, e), code]], :$epilogue]
261          nil
262        code
263    code -- doItIf deletes entries from $locals so can't optimize this
264  code is ['CodeDefine,sig,implem] =>
265             --Generated by doIt in COMPILER BOOT
266    dom:= EnvToPass
267    dom:=
268      u := LASSOC(dom, viewAssoc) => ["getDomainView", dom, u]
269      dom
270    body:= ['CONS,implem,dom]
271    u := SetFunctionSlots(sig, body, flag, kvec)
272    ConstantCreator u =>
273      if not (flag = true) then u := ['COND, [ProcessCond(flag, e), u]]
274      $ConstantAssignments:= [u,:$ConstantAssignments]
275      nil
276    u
277  code is ['_:,:.] => (RPLACA(code,'LIST); RPLACD(code,NIL))
278      --Yes, I know that's a hack, but how else do you kill a line?
279  code is ['LIST,:.] => nil
280  code is ['devaluate,:.] => nil
281  code is ['MDEF,:.] => nil
282  code is ['call,:.] => code
283  code is ['SETELT,:.] => code -- can be generated by doItIf
284  code is ['QSETREFV,:.] => code -- can be generated by doItIf
285  stackWarning ['"unknown Functor code ",code]
286  code
287
288ConstantCreator u ==
289  null u => nil
290  u is [q,.,.,u'] and (q='SETELT or q='QSETREFV) => ConstantCreator u'
291  u is ['CONS,:.] => nil
292  true
293
294ProcessCond(cond, et) ==
295  ncond := SUBLIS($pairlis,cond)
296  INTEGERP POSN1(ncond, $NRTslot1PredicateList) => predicateBitRef(ncond, et)
297  cond
298
299SetFunctionSlots(sig, body, flag, kvec) ==
300--+
301  v := '$
302  u := kvec
303  if true then
304    null body => return NIL
305    for catImplem in LookUpSigSlots(sig,u.1) repeat
306      if catImplem is [q,.,index] and (q='ELT or q='CONST) then
307          if q is 'CONST and body is ['CONS,a,b] then
308             body := ['CONS,'IDENTITY,['FUNCALL,a,b]]
309          body:= [($QuickCode => 'QSETREFV; 'SETELT),v,index,body]
310          if REFVECP $SetFunctions and TruthP flag then u.index:= true
311                 --used by CheckVector to determine which ops are missing
312          if v='$ then  -- i.e. we are looking at the principal view
313            not REFVECP $SetFunctions => nil
314                    --packages don't set it
315            $MissingFunctionInfo.index:= flag
316            TruthP $SetFunctions.index => (body:= nil; return nil)
317                     -- the function was already assigned
318            $SetFunctions.index:=
319              TruthP flag => true
320              not $SetFunctions.index=>flag --JHD didn't set $SF on this branch
321              ["or",$SetFunctions.index,flag]
322      else
323          keyedSystemError("S2OR0002",[catImplem])
324  body is ['SETELT,:.] => body
325  body is ['QSETREFV,:.] => body
326  nil
327
328LookUpSigSlots(sig,siglist) ==
329--+ must kill any implementations below of the form (ELT $ NIL)
330  if $insideCategoryPackageIfTrue then
331           sig := substitute('$,CADR($functorForm),sig)
332  siglist := $lisplibOperationAlist
333  REMDUP [implem for u in siglist | SigSlotsMatch(sig,first u,implem:=CADDR u)
334              and IFCAR(IFCDR(IFCDR(implem)))]
335
336SigSlotsMatch(sig,pattern,implem) ==
337  sig=pattern => true
338  not (LENGTH CADR sig=LENGTH CADR pattern) => nil
339                       --CADR sig is the actual signature part
340  not (first sig=first pattern) => nil
341  pat' :=SUBSTQ($definition,'$,CADR pattern)
342  sig' :=SUBSTQ($definition,'$,CADR sig)
343  sig'=pat' => true
344  --If we don't have this next test, then we'll recurse in SetFunctionSlots
345  SourceLevelSubsume(sig',pat') => true
346  nil
347
348makeMissingFunctionEntry(alist,i) ==
349  tran SUBLIS(alist,$MissingFunctionInfo.i) where
350    tran x ==
351      x is ["HasCategory",a,["QUOTE",b]] => ['has,a,b]
352      x is [op,:l] and op in '(AND OR NOT) => [op,:[tran y for y in l]]
353      x
354
355--%  Under what conditions may views exist?
356
357InvestigateConditions(catvecListMaker, base_shell, e) ==
358  -- given a principal view and a list of secondary views,
359  -- discover under what conditions the secondary view are
360  -- always present.
361  [principal, :secondaries] := catvecListMaker
362      --We are not interested in the principal view
363      --The next block allows for the possibility that $principal may
364      --have conditional secondary views
365--+
366  null secondaries => '(T)
367      --return for packages which generally have no secondary views
368  if principal is [op, :.] then
369    [principal', :.] := compMakeCategoryObject(principal, e)
370              --Rather like eval, but quotes parameters first
371    for u in CADR principal'.4 repeat
372      if not TruthP(cond:=CADR u) then
373        new := ['CATEGORY, 'domain,
374                ['IF, cond, ['ATTRIBUTE, first u], 'noBranch]]
375        principal is ['Join, :l] =>
376          not member(new,l) =>
377             principal := ['Join, :l, new]
378        principal := ['Join, principal, new]
379  [principal', Conditions] :=
380    pessimise(principal, nil) where
381      pessimise(a, Conditions) ==
382        atom a => [a, Conditions]
383        a is ['SIGNATURE, :.] => [a, Conditions]
384        a is ['IF,cond,:.] =>
385          if not member(cond, Conditions) then
386              Conditions := [cond, Conditions]
387          [nil, Conditions]
388        [r1, Conditions] := pessimise(first(a), Conditions)
389        [r2, Conditions] := pessimise(rest(a), Conditions)
390        [[r1, :r2], Conditions]
391  null Conditions => [true, :[true for u in secondaries]]
392  PrincipalSecondaries:= getViewsConditions(principal', e)
393  MinimalPrimary := first first PrincipalSecondaries
394  MaximalPrimary:= CAAR base_shell.4
395  necessarySecondaries:= [first u for u in PrincipalSecondaries | rest u=true]
396  and/[member(u,necessarySecondaries) for u in secondaries] =>
397    [true,:[true for u in secondaries]]
398  HackSlot4:=
399    MaximalPrimary = nil => nil
400    MinimalPrimary=MaximalPrimary => nil
401    MaximalPrimaries := [MaximalPrimary, :first (CatEval MaximalPrimary).4]
402    MinimalPrimaries := [MinimalPrimary, :first (CatEval MinimalPrimary).4]
403    MaximalPrimaries := set_difference(MaximalPrimaries, MinimalPrimaries)
404    [[x] for x in MaximalPrimaries]
405  (Conditions := Conds(principal, nil)) where
406    Conds(code,previous) ==
407           --each call takes a list of conditions, and returns a list
408           --of refinements of that list
409      atom code => [previous]
410      code is ['DomainSubstitutionMacro,.,b] => Conds(b,previous)
411      code is ['IF,a,b,c] => union(Conds(b,[a,:previous]),Conds(c,previous))
412      code is ['PROGN,:l] => "union"/[Conds(u,previous) for u in l]
413      code is ['CATEGORY,:l] => "union"/[Conds(u,previous) for u in l]
414      code is ['Join,:l] => "union"/[Conds(u,previous) for u in l]
415      [previous]
416  Conditions := EFFACE(nil, [EFFACE(nil, u) for u in Conditions])
417  partList:=
418    [getViewsConditions(partPessimise(principal, cond), e)
419         for cond in Conditions]
420  masterSecondaries:= secondaries
421  for u in partList repeat
422    for [v,:.] in u repeat
423      if not member(v,secondaries) then secondaries:= [v,:secondaries]
424  --PRETTYPRINT $Conditions
425  --PRETTYPRINT masterSecondaries
426  --PRETTYPRINT secondaries
427  (list:= [mkNilT member(u,necessarySecondaries) for u in secondaries]) where
428    mkNilT u ==
429      u => true
430      nil
431  for u in Conditions for newS in partList repeat
432    --newS is a list of secondaries and conditions (over and above
433    --u) for which they apply
434    u:=
435      LENGTH u=1 => first u
436      ['AND,:u]
437    for [v,:.] in newS repeat
438      for v' in [v, :first (CatEval v).4] repeat
439        if (w:= assoc(v', HackSlot4)) then
440          rplac(rest w, if rest w then mkOr(u, rest w) else u)
441    (list:= update(list,u,secondaries,newS)) where
442      update(list,cond,secondaries,newS) ==
443        (list2:=
444          [flist(sec,newS,old,cond) for sec in secondaries for old in list]) where
445            flist(sec,newS,old,cond) ==
446              old=true => old
447              for [newS2,:morecond] in newS repeat
448                old:=
449                  not AncestorP(sec,[newS2]) => old
450                  cond2:= mkAnd(cond,morecond)
451                  null old => cond2
452                  mkOr(cond2,old)
453              old
454        list2
455  list:= ICformat_loop(list, secondaries, e)
456  [true,:[LASSOC(ms,list) for ms in masterSecondaries]]
457
458ICformat_loop(list, secondaries, e) ==
459  $ICformat_hash : local := MAKE_HASHTABLE('EQUAL)
460  [[sec, :ICformat(u, e)] for u in list for sec in secondaries]
461
462ORreduce l ==
463    for u in l | u is ['AND, :.] or u is ['and, :.] repeat
464                                  --check that B causes (and A B) to go
465        for v in l | not (v = u) repeat
466            if member(v, u) or (and/[member(w, u) for w in v]) then
467                l := delete(u, l)
468                       --v subsumes u
469                           --Note that we are ignoring AND as a component.
470                           --Convince yourself that this code still works
471    l
472
473ICformat(u, e) ==
474      atom u => u
475      u is ['has,:.] =>
476          (res := HGET($ICformat_hash, u)) => res
477          res := compHasFormat(u, e)
478          HPUT($ICformat_hash, u, res)
479          res
480      u is ['AND,:l] or u is ['and,:l] =>
481        l:= REMDUP [ICformat(v, e) for [v,:l'] in tails l | not member(v,l')]
482             -- we could have duplicates after, even if not before
483        LENGTH l=1 => first l
484        l1:= first l
485        for u in rest l repeat
486          l1:=mkAnd(u,l1)
487        l1
488      u is ['OR,:l] =>
489        (l := ORreduce l)
490        LENGTH l=1 => ICformat(first l, e)
491        l:= ORreduce REMDUP [ICformat(u, e) for u in l]
492                 --causes multiple ANDs to be squashed, etc.
493                 -- and duplicates that have been built up by tidying
494        (l:= Hasreduce l) where
495          Hasreduce l ==
496            for u in l | u is ['HasCategory,name,cond] and cond is ['QUOTE,
497              cond] repeat
498                                  --check that v causes descendants to go
499                for v in l | not (v=u) and v is ['HasCategory, =name,['QUOTE,
500                  cond2]] repeat if DescendantP(cond,cond2) then l:= delete(u,l)
501                       --v subsumes u
502            for u in l | u is ['AND,:l'] or u is ['and,:l'] repeat
503              for u' in l' | u' is ['HasCategory,name,cond] and cond is ['QUOTE,
504                cond] repeat
505                                    --check that v causes descendants to go
506                  for v in l | v is ['HasCategory, =name,['QUOTE,
507                    cond2]] repeat if DescendantP(cond,cond2) then l:= delete(u,l)
508                         --v subsumes u
509            l
510        LENGTH l=1 => first l
511        ['OR,:l]
512      systemErrorHere '"ICformat"
513
514partPessimise(a,trueconds) ==
515  atom a => a
516  a is ['SIGNATURE,:.] => a
517  a is ['IF,cond,:.] => (member(cond,trueconds) => a; nil)
518  [partPessimise(first a,trueconds),:partPessimise(rest a,trueconds)]
519
520getViewsConditions(u, e) ==
521
522  --returns a list of all the categories that can be views of this one
523  --paired with the condition under which they are such views
524  [vec, :.] := compMakeCategoryObject(u, e) or
525    systemErrorHere '"getViewsConditions"
526  views:= [[first u,:CADR u] for u in CADR vec.4]
527  null vec.0 =>
528--+
529    null first(vec.4) => views
530    [[CAAR vec.4,:true],:views] --*
531  [[vec.0,:true],:views] --*
532      --the two lines marked  ensure that the principal view comes first
533      --if you don't want it, CDR it off
534
535DescendCodeVarAdd(base, flag, kvec, e) ==
536   princview := kvec
537   [SetFunctionSlots(sig, SUBST('ELT,'CONST,implem), flag, kvec) repeat
538       for i in 6..MAXINDEX princview |
539         princview.i is [sig:=[op,types],:.] and
540           LASSOC([base, :SUBST(base, '$, types)], get(op, 'modemap, e)) is
541                  [[pred,implem]]]
542
543resolvePatternVars(p,args) ==
544  p := SUBLISLIS(args, $TriangleVariableList, p)
545  SUBLISLIS(args, $FormalMapVariableList, p)
546