* Makefile.pamphlet (functor.$(FASLEXT)): New rule.

	(<<functor.clisp>>): Remove.
	* functor.boot.pamphlet: Push into package "BOOT".

1 files changed, 0 insertions, 1543 deletions

diff --git a/src/interp/define.boot.pamphlet b/src/interp/define.boot.pamphlet
deleted file mode 100644
index 6bebbf01..00000000
--- a/src/interp/define.boot.pamphlet
+++ /dev/null
@@ -1,1543 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/interp/define.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-
-\section{compCapsuleItems}
-
-The variable [[data]] appears to be unbound at runtime. Optimized
-code won't check for this but interpreted code fails. We should
-PROVE that data is unbound at runtime but have not done so yet.
-Rather than remove the code entirely (since there MIGHT be a 
-path where it is used) we check for the runtime bound case and
-assign [[$myFunctorBody]] if data has a value.
-
-The [[compCapsuleInner]] function in this file LOOKS like it sets
-data and expects code to manipulate the assigned data structure.
-Since we can't be sure we take the least disruptive course of action.
-<<compCapsuleItems>>=
-compCapsuleItems(itemlist,$predl,$e) ==
-  $TOP__LEVEL: local
-  $myFunctorBody :local         -- := data    ---needed for translator
-  if (BOUNDP 'data) then 
-    $myFunctorBody:= SYMBOL_-VALUE 'data -- unbound at runtime?
-  $signatureOfForm: local
-  $suffix: local:= 0
-  for item in itemlist repeat $e:= compSingleCapsuleItem(item,$predl,$e)
-  $e
- 
-@ 
-\section{License}
-<<license>>=
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
---
--- Redistribution and use in source and binary forms, with or without
--- modification, are permitted provided that the following conditions are
--- met:
---
---     - Redistributions of source code must retain the above copyright
---       notice, this list of conditions and the following disclaimer.
---
---     - Redistributions in binary form must reproduce the above copyright
---       notice, this list of conditions and the following disclaimer in
---       the documentation and/or other materials provided with the
---       distribution.
---
---     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
---       names of its contributors may be used to endorse or promote products
---       derived from this software without specific prior written permission.
---
--- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-@
-<<*>>=
-<<license>>
-
-import '"c-util"
-import '"cattable"
-import '"category"
-)package "BOOT"
-
-NRTPARSE := false
-
---% FUNCTIONS WHICH MUNCH ON == STATEMENTS
- 
-compDefine(form,m,e) ==
-  $tripleHits: local:= 0
-  $macroIfTrue: local
-  $packagesUsed: local
-  result:= compDefine1(form,m,e)
-  result
- 
-compDefine1(form,m,e) ==
-  $insideExpressionIfTrue: local:= false
-  --1. decompose after macro-expanding form
-  ['DEF,lhs,signature,specialCases,rhs]:= form:= macroExpand(form,e)
-  $insideWhereIfTrue and isMacro(form,e) and (m=$EmptyMode or m=$NoValueMode)
-     => [lhs,m,put(first lhs,'macro,rhs,e)]
-  null signature.target and not MEMQ(KAR rhs,$ConstructorNames) and
-    (sig:= getSignatureFromMode(lhs,e)) =>
-  -- here signature of lhs is determined by a previous declaration
-      compDefine1(['DEF,lhs,[first sig,:rest signature],specialCases,rhs],m,e)
-  if signature.target=$Category then $insideCategoryIfTrue:= true
---?? following 3 lines seem bogus, BMT 6/23/93
---?  if signature.target is ['Mapping,:map] then
---?    signature:= map
---?    form:= ['DEF,lhs,signature,specialCases,rhs]
- 
--- RDJ (11/83): when argument and return types are all declared,
---  or arguments have types declared in the environment,
---  and there is no existing modemap for this signature, add
---  the modemap by a declaration, then strip off declarations and recurse
-  e := compDefineAddSignature(lhs,signature,e)
--- 2. if signature list for arguments is not empty, replace ('DEF,..) by
---       ('where,('DEF,..),..) with an empty signature list;
---     otherwise, fill in all NILs in the signature
-  not (and/[null x for x in rest signature]) => compDefWhereClause(form,m,e)
-  signature.target=$Category =>
-    compDefineCategory(form,m,e,nil,$formalArgList)
-  isDomainForm(rhs,e) and not $insideFunctorIfTrue =>
-    if null signature.target then signature:=
-      [getTargetFromRhs(lhs,rhs,giveFormalParametersValues(rest lhs,e)),:
-          rest signature]
-    rhs:= addEmptyCapsuleIfNecessary(signature.target,rhs)
-    compDefineFunctor(['DEF,lhs,signature,specialCases,rhs],m,e,nil,
-      $formalArgList)
-  null $form => stackAndThrow ['"bad == form ",form]
-  newPrefix:=
-    $prefix => INTERN STRCONC(encodeItem $prefix,'",",encodeItem $op)
-    getAbbreviation($op,#rest $form)
-  compDefineCapsuleFunction(form,m,e,newPrefix,$formalArgList)
- 
-compDefineAddSignature([op,:argl],signature,e) ==
-  (sig:= hasFullSignature(argl,signature,e)) and
-   not assoc(['$,:sig],LASSOC('modemap,getProplist(op,e))) =>
-     declForm:=
-       [":",[op,:[[":",x,m] for x in argl for m in rest sig]],first signature]
-     [.,.,e]:= comp(declForm,$EmptyMode,e)
-     e
-  e
- 
-hasFullSignature(argl,[target,:ml],e) ==
-  target =>
-    u:= [m or get(x,"mode",e) or return 'failed for x in argl for m in ml]
-    u^='failed => [target,:u]
- 
-addEmptyCapsuleIfNecessary(target,rhs) ==
-  MEMQ(KAR rhs,$SpecialDomainNames) => rhs
-  ['add,rhs,['CAPSULE]]
- 
-getTargetFromRhs(lhs,rhs,e) ==
-  --undeclared target mode obtained from rhs expression
-  rhs is ['CAPSULE,:.] =>
-    stackSemanticError(['"target category of ",lhs,
-      '" cannot be determined from definition"],nil)
-  rhs is ['SubDomain,D,:.] => getTargetFromRhs(lhs,D,e)
-  rhs is ['add,D,['CAPSULE,:.]] => getTargetFromRhs(lhs,D,e)
-  rhs is ['Record,:l] => ['RecordCategory,:l]
-  rhs is ['Union,:l] => ['UnionCategory,:l]
-  rhs is ['List,:l] => ['ListCategory,:l]
-  rhs is ['Vector,:l] => ['VectorCategory,:l]
-  [.,target,.]:= compOrCroak(rhs,$EmptyMode,e)
-  target
- 
-giveFormalParametersValues(argl,e) ==
-  for x in argl repeat
-    e:= put(x,'value,[genSomeVariable(),get(x,'mode,e),nil],e)
-  e
- 
-macroExpandInPlace(x,e) ==
-  y:= macroExpand(x,e)
-  atom x or atom y => y
-  RPLACA(x,first y)
-  RPLACD(x,rest y)
-  x
- 
-macroExpand(x,e) ==   --not worked out yet
-  atom x => (u:= get(x,'macro,e) => macroExpand(u,e); x)
-  x is ['DEF,lhs,sig,spCases,rhs] =>
-    ['DEF,macroExpand(lhs,e),macroExpandList(sig,e),macroExpandList(spCases,e),
-      macroExpand(rhs,e)]
-  macroExpandList(x,e)
- 
-macroExpandList(l,e) ==
-  -- macros should override niladic props
-  (l is [name]) and IDENTP name and GETDATABASE(name, 'NILADIC) and
-	(u := get(name, 'macro, e)) => macroExpand(u,e)
-  [macroExpand(x,e) for x in l]
- 
-compDefineCategory1(df is ['DEF,form,sig,sc,body],m,e,prefix,fal) ==
-  categoryCapsule :=
---+
-    body is ['add,cat,capsule] =>
-      body := cat
-      capsule
-    nil
-  [d,m,e]:= compDefineCategory2(form,sig,sc,body,m,e,prefix,fal)
---+ next two lines
-  if categoryCapsule and not $bootStrapMode then [.,.,e] :=
-    $insideCategoryPackageIfTrue: local := true  --see NRTmakeSlot1
--->
-    $categoryPredicateList: local :=
-        makeCategoryPredicates(form,$lisplibCategory)
-    compDefine1(mkCategoryPackage(form,cat,categoryCapsule),$EmptyMode,e)
-  [d,m,e]
- 
-makeCategoryPredicates(form,u) ==
-      $tvl := TAKE(#rest form,$TriangleVariableList)
-      $mvl := TAKE(#rest form,rest $FormalMapVariableList)
-      fn(u,nil) where
-        fn(u,pl) ==
-          u is ['Join,:.,a] => fn(a,pl)
-          u is ['has,:.] => insert(EQSUBSTLIST($mvl,$tvl,u),pl)
-          u is [op,:.] and MEMQ(op,'(SIGNATURE ATTRIBUTE)) => pl
-          atom u => pl
-          fnl(u,pl)
-        fnl(u,pl) ==
-          for x in u repeat pl := fn(x,pl)
-          pl
- 
---+ the following function
-mkCategoryPackage(form is [op,:argl],cat,def) ==
-  packageName:= INTERN(STRCONC(PNAME op,'"&"))
-  packageAbb := INTERN(STRCONC(GETDATABASE(op,'ABBREVIATION),'"-"))
-  $options:local := []
-  -- This stops the next line from becoming confused
-  abbreviationsSpad2Cmd ['domain,packageAbb,packageName]
-  -- This is a little odd, but the parser insists on calling
-  -- domains, rather than packages
-  nameForDollar := first SETDIFFERENCE('(S A B C D E F G H I),argl)
-  packageArgl := [nameForDollar,:argl]
-  capsuleDefAlist := fn(def,nil) where fn(x,oplist) ==
-    atom x => oplist
-    x is ['DEF,y,:.] => [y,:oplist]
-    fn(rest x,fn(first x,oplist))
-  explicitCatPart := gn cat where gn cat ==
-    cat is ['CATEGORY,:.] => rest rest cat
-    cat is ['Join,:u] => gn last u
-    nil
-  catvec := eval mkEvalableCategoryForm form
-  fullCatOpList:=(JoinInner([catvec],$e)).1
-  catOpList :=
-    --note: this gets too many modemaps in general
-    --   this is cut down in NRTmakeSlot1
-    [['SIGNATURE,op1,sig] for [[op1,sig],:.] in fullCatOpList
-         --above line calls the category constructor just compiled
-        | assoc(op1,capsuleDefAlist)]
-  null catOpList => nil
-  packageCategory := ['CATEGORY,'domain,
-                     :SUBLISLIS(argl,$FormalMapVariableList,catOpList)]
-  nils:= [nil for x in argl]
-  packageSig := [packageCategory,form,:nils]
-  $categoryPredicateList := SUBST(nameForDollar,'$,$categoryPredicateList)
-  SUBST(nameForDollar,'$,
-      ['DEF,[packageName,:packageArgl],packageSig,[nil,:nils],def])
- 
-compDefineCategory2(form,signature,specialCases,body,m,e,
-  $prefix,$formalArgList) ==
-    --1. bind global variables
-    $insideCategoryIfTrue: local:= true
-    $TOP__LEVEL: local
-    $definition: local
-                 --used by DomainSubstitutionFunction
-    $form: local
-    $op: local
-    $extraParms: local
-             --Set in DomainSubstitutionFunction, used further down
---  1.1  augment e to add declaration $: <form>
-    [$op,:argl]:= $definition:= form
-    e:= addBinding("$",[['mode,:$definition]],e)
- 
---  2. obtain signature
-    signature':=
-      [first signature,:[getArgumentModeOrMoan(a,$definition,e) for a in argl]]
-    e:= giveFormalParametersValues(argl,e)
- 
---   3. replace arguments by $1,..., substitute into body,
---     and introduce declarations into environment
-    sargl:= TAKE(# argl, $TriangleVariableList)
-    $functorForm:= $form:= [$op,:sargl]
-    $formalArgList:= [:sargl,:$formalArgList]
-    aList:= [[a,:sa] for a in argl for sa in sargl]
-    formalBody:= SUBLIS(aList,body)
-    signature' := SUBLIS(aList,signature')
---Begin lines for category default definitions
-    $functionStats: local:= [0,0]
-    $functorStats: local:= [0,0]
-    $frontier: local := 0
-    $getDomainCode: local := nil
-    $addForm: local:= nil
-    for x in sargl for t in rest signature' repeat
-      [.,.,e]:= compMakeDeclaration([":",x,t],m,e)
- 
---   4. compile body in environment of %type declarations for arguments
-    op':= $op
-    -- following line causes cats with no with or Join to be fresh copies
-    if opOf(formalBody)^='Join and opOf(formalBody)^='mkCategory then
-           formalBody := ['Join, formalBody]
-    body:= optFunctorBody (compOrCroak(formalBody,signature'.target,e)).expr
-    if $extraParms then
-      formals:=actuals:=nil
-      for u in $extraParms repeat
-        formals:=[CAR u,:formals]
-        actuals:=[MKQ CDR u,:actuals]
-      body := ['sublisV,['PAIR,['QUOTE,formals],['LIST,:actuals]],body]
-    if argl then body:=  -- always subst for args after extraparms
-        ['sublisV,['PAIR,['QUOTE,sargl],['LIST,:
-          [['devaluate,u] for u in sargl]]],body]
-    body:=
-      ['PROG1,['LET,g:= GENSYM(),body],['SETELT,g,0,mkConstructor $form]]
-    fun:= compile [op',['LAM,sargl,body]]
- 
---  5. give operator a 'modemap property
-    pairlis:= [[a,:v] for a in argl for v in $FormalMapVariableList]
-    parSignature:= SUBLIS(pairlis,signature')
-    parForm:= SUBLIS(pairlis,form)
-    lisplibWrite('"compilerInfo",
-      removeZeroOne ['SETQ,'$CategoryFrame,
-       ['put,['QUOTE,op'],'
-        (QUOTE isCategory),true,['addModemap,MKQ op',MKQ parForm,
-          MKQ parSignature,true,MKQ fun,'$CategoryFrame]]],$libFile)
-    --Equivalent to the following two lines, we hope
-    if null sargl then
-      evalAndRwriteLispForm('NILADIC,
-            ['MAKEPROP,['QUOTE,op'],'(QUOTE NILADIC),true])
- 
---   6. put modemaps into InteractiveModemapFrame
-    $domainShell := eval [op',:MAPCAR('MKQ,sargl)]
-    $lisplibCategory:= formalBody
-    if $LISPLIB then
-      $lisplibForm:= form
-      $lisplibKind:= 'category
-      modemap:= [[parForm,:parSignature],[true,op']]
-      $lisplibModemap:= modemap
-      $lisplibParents  :=         
-        getParentsFor($op,$FormalMapVariableList,$lisplibCategory)
-      $lisplibAncestors := computeAncestorsOf($form,nil)
-      $lisplibAbbreviation := constructor? $op
-      form':=[op',:sargl]
-      augLisplibModemapsFromCategory(form',formalBody,signature')
-    [fun,'(Category),e]
- 
-mkConstructor form ==
-  atom form => ['devaluate,form]
-  null rest form => ['QUOTE,[first form]]
-  ['LIST,MKQ first form,:[mkConstructor x for x in rest form]]
- 
-compDefineCategory(df,m,e,prefix,fal) ==
-  $domainShell: local -- holds the category of the object being compiled
-  $lisplibCategory: local
-  not $insideFunctorIfTrue and $LISPLIB =>
-    compDefineLisplib(df,m,e,prefix,fal,'compDefineCategory1)
-  compDefineCategory1(df,m,e,prefix,fal)
- 
-compDefineFunctor(df,m,e,prefix,fal) ==
-  $domainShell: local -- holds the category of the object being compiled
-  $profileCompiler: local := true
-  $profileAlist:    local := nil
-  $LISPLIB => compDefineLisplib(df,m,e,prefix,fal,'compDefineFunctor1)
-  compDefineFunctor1(df,m,e,prefix,fal)
- 
-compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body],
-  m,$e,$prefix,$formalArgList) ==
-    if NRTPARSE = true then
-      [lineNumber,:$functorSpecialCases] := $functorSpecialCases
---  1. bind global variables
-    $addForm: local
-    $viewNames: local:= nil
- 
-            --This list is only used in genDomainViewName, for generating names
-            --for alternate views, if they do not already exist.
-            --format: Alist: (domain name . sublist)
-            --sublist is alist: category . name of view
-    $functionStats: local:= [0,0]
-    $functorStats: local:= [0,0]
-    $form: local
-    $op: local
-    $signature: local
-    $functorTarget: local
-    $Representation: local
-         --Set in doIt, accessed in the compiler - compNoStacking
-    $LocalDomainAlist: local  --set in doIt, accessed in genDeltaEntry
-    $LocalDomainAlist:= nil
-    $functorForm: local
-    $functorLocalParameters: local
-    SETQ($myFunctorBody, body)
-    $CheckVectorList: local
-                  --prevents CheckVector from printing out same message twice
-    $getDomainCode: local -- code for getting views
-    $insideFunctorIfTrue: local:= true
-    $functorsUsed: local --not currently used, finds dependent functors
-    $setelt: local :=
-      $QuickCode = true => 'QSETREFV
-      'SETELT
-    $TOP__LEVEL: local
-    $genSDVar: local:= 0
-    originale:= $e
-    [$op,:argl]:= form
-    $formalArgList:= [:argl,:$formalArgList]
-    $pairlis := [[a,:v] for a in argl for v in $FormalMapVariableList]
-    $mutableDomain: local :=
-      -- all defaulting packages should have caching turned off
-       isCategoryPackageName $op or   
-         (if BOUNDP '$mutableDomains then MEMQ($op,$mutableDomains)
-            else false )   --true if domain has mutable state
-    signature':=
-      [first signature,:[getArgumentModeOrMoan(a,form,$e) for a in argl]]
-    $functorForm:= $form:= [$op,:argl]
-    if null first signature' then signature':=
-      modemap2Signature getModemap($form,$e)
-    target:= first signature'
-    $functorTarget:= target
-    $e:= giveFormalParametersValues(argl,$e)
-    [ds,.,$e]:= compMakeCategoryObject(target,$e) or
---+ copy needed since slot1 is reset; compMake.. can return a cached vector
-      sayBrightly '"   cannot produce category object:"
-      pp target
-      return nil
-    $domainShell:= COPY_-SEQ ds
-    $attributesName:local := INTERN STRCONC(PNAME $op,'";attributes")
-    attributeList := disallowNilAttribute ds.2 --see below under "loadTimeAlist"
---+ 7 lines for $NRT follow
-    $goGetList: local := nil
--->--these globals used by NRTmakeCategoryAlist, set by NRTsetVector4Part1
-    $condAlist: local := nil
-    $uncondAlist: local := nil
--->>-- next global initialized here, reset by NRTbuildFunctor
-    $NRTslot1PredicateList: local :=
-      REMDUP [CADR x for x in attributeList]
--->>-- next global initialized here, used by NRTgenAttributeAlist (NRUNOPT)
-    $NRTattributeAlist: local := NRTgenInitialAttributeAlist attributeList
-    $NRTslot1Info: local  --set in NRTmakeSlot1 called by NRTbuildFunctor
-       --this is used below to set $lisplibSlot1 global
-    $NRTbase: local := 6 -- equals length of $domainShell
-    $NRTaddForm: local := nil   -- see compAdd; NRTmakeSlot1
-    $NRTdeltaList: local := nil --list of misc. elts used in compiled fncts
-    $NRTdeltaListComp: local := nil --list of COMP-ed forms for $NRTdeltaList
-    $NRTaddList: local := nil --list of fncts not defined in capsule (added)
-    $NRTdeltaLength: local := 0 -- =length of block of extra entries in vector
-    $NRTloadTimeAlist: local := nil --used for things in slot4 (NRTsetVector4)
-    $NRTdomainFormList: local := nil -- of form ((gensym . (Repe...)) ...
-    -- the above optimizes the calls to local domains
-    $template: local:= nil --stored in the lisplib (if $NRTvec = true)
-    $functionLocations: local := nil --locations of defined functions in source
-    -- generate slots for arguments first, then for $NRTaddForm in compAdd
-    for x in argl repeat NRTgetLocalIndex x
-    [.,.,$e]:= compMakeDeclaration([":",'_$,target],m,$e)
-    --The following loop sees if we can economise on ADDed operations
-    --by using those of Rep, if that is the same. Example: DIRPROD
-    if $insideCategoryPackageIfTrue^= true  then
-      if body is ['add,ab:=[fn,:.],['CAPSULE,:cb]] and MEMQ(fn,'(List Vector))
-         and FindRep(cb) = ab
-               where FindRep cb ==
-                 u:=
-                   while cb repeat
-                     ATOM cb => return nil
-                     cb is [['LET,'Rep,v,:.],:.] => return (u:=v)
-                     cb:=CDR cb
-                 u
-      then $e:= augModemapsFromCategoryRep('_$,ab,cb,target,$e)
-      else $e:= augModemapsFromCategory('_$,'_$,'_$,target,$e)
-    $signature:= signature'
-    operationAlist:= SUBLIS($pairlis,$domainShell.(1))
-    parSignature:= SUBLIS($pairlis,signature')
-    parForm:= SUBLIS($pairlis,form)
- 
---  (3.1) now make a list of the functor's local parameters; for
---  domain D in argl,check its signature: if domain, its type is Join(A1,..,An);
---  in this case, D is replaced by D1,..,Dn (gensyms) which are set
---  to the A1,..,An view of D
-    if isPackageFunction() then $functorLocalParameters:=
-      [nil,:
-        [nil
-          for i in 6..MAXINDEX $domainShell |
-            $domainShell.i is [.,.,['ELT,'_$,.]]]]
-    --leave space for vector ops and package name to be stored
---+
-    $functorLocalParameters:=
-      argPars :=
-        makeFunctorArgumentParameters(argl,rest signature',first signature')
- -- must do above to bring categories into scope --see line 5 of genDomainView
-      argl
---  4. compile body in environment of %type declarations for arguments
-    op':= $op
-    rettype:= signature'.target
-    T:= compFunctorBody(body,rettype,$e,parForm)
-    -- If only compiling certain items, then ignore the body shell.
-    $compileOnlyCertainItems =>
-       reportOnFunctorCompilation()
-       [nil, ['Mapping, :signature'], originale]
- 
-    body':= T.expr
-    lamOrSlam:= if $mutableDomain then 'LAM else 'SPADSLAM
-    fun:= compile SUBLIS($pairlis, [op',[lamOrSlam,argl,body']])
-    --The above statement stops substitutions gettting in one another's way
---+
-    operationAlist := SUBLIS($pairlis,$lisplibOperationAlist)
-    if $LISPLIB then
-      augmentLisplibModemapsFromFunctor(parForm,operationAlist,parSignature)
-    reportOnFunctorCompilation()
- 
---  5. give operator a 'modemap property
---   if $functorsUsed then MAKEPROP(op',"NEEDS",$functorsUsed)
-    if $LISPLIB then
-      modemap:= [[parForm,:parSignature],[true,op']]
-      $lisplibModemap:= modemap
-      $lisplibCategory := modemap.mmTarget
-      $lisplibParents  :=         
-        getParentsFor($op,$FormalMapVariableList,$lisplibCategory)
-      $lisplibAncestors := computeAncestorsOf($form,nil)
-      $lisplibAbbreviation := constructor? $op
-    $insideFunctorIfTrue:= false
-    if $LISPLIB then
-      $lisplibKind:=
-------->This next line prohibits changing the KIND once given
---------kk:=GETDATABASE($op,'CONSTRUCTORKIND) => kk
-        $functorTarget is ["CATEGORY",key,:.] and key^="domain" => 'package
-        'domain
-      $lisplibForm:= form
-      if null $bootStrapMode then
-        $NRTslot1Info := NRTmakeSlot1Info()
-        $isOpPackageName: local := isCategoryPackageName $op
-        if $isOpPackageName then lisplibWrite('"slot1DataBase",
-          ['updateSlot1DataBase,MKQ $NRTslot1Info],$libFile)
-        $lisplibFunctionLocations := SUBLIS($pairlis,$functionLocations)
-        $lisplibCategoriesExtended := SUBLIS($pairlis,$lisplibCategoriesExtended)
-        -- see NRTsetVector4 for initial setting of $lisplibCategoriesExtended
-        libFn := GETDATABASE(op','ABBREVIATION)
-        $lookupFunction: local :=
-            NRTgetLookupFunction($functorForm,CADAR $lisplibModemap,$NRTaddForm)
-            --either lookupComplete (for forgetful guys) or lookupIncomplete
-        $byteAddress :local := 0
-        $byteVec :local := nil
-        $NRTslot1PredicateList :=
-          [simpBool x for x in $NRTslot1PredicateList]
-        rwriteLispForm('loadTimeStuff,
-          ['MAKEPROP,MKQ $op,''infovec,getInfovecCode()])
-      $lisplibSlot1 := $NRTslot1Info --NIL or set by $NRTmakeSlot1
-      $lisplibOperationAlist:= operationAlist
-      $lisplibMissingFunctions:= $CheckVectorList
-    lisplibWrite('"compilerInfo",
-       removeZeroOne ['SETQ,'$CategoryFrame,
-        ['put,['QUOTE,op'],'
-         (QUOTE isFunctor),
-          ['QUOTE,operationAlist],['addModemap,['QUOTE,op'],['
-           QUOTE,parForm],['QUOTE,parSignature],true,['QUOTE,op'],
-            ['put,['QUOTE,op' ],'(QUOTE mode),
-             ['QUOTE,['Mapping,:parSignature]],'$CategoryFrame]]]], $libFile)
-    if null argl then
-      evalAndRwriteLispForm('NILADIC,
-            ['MAKEPROP, ['QUOTE,op'], ['QUOTE,'NILADIC], true])
-    [fun,['Mapping,:signature'],originale]
- 
-disallowNilAttribute x == 
-  res := [y for y in x | car y and car y ^= "nil"]
---HACK to get rid of nil attibutes ---NOTE: nil is RENAMED to NIL
-
-compFunctorBody(body,m,e,parForm) ==
-  $bootStrapMode = true =>
-    [bootStrapError($functorForm, _/EDITFILE),m,e]
-  T:= compOrCroak(body,m,e)
-  body is [op,:.] and MEMQ(op,'(add CAPSULE)) => T
-  $NRTaddForm :=
-    body is ["SubDomain",domainForm,predicate] => domainForm
-    body
-  T
- 
-reportOnFunctorCompilation() ==
-  displayMissingFunctions()
-  if $semanticErrorStack then sayBrightly '" "
-  displaySemanticErrors()
-  if $warningStack then sayBrightly '" "
-  displayWarnings()
-  $functorStats:= addStats($functorStats,$functionStats)
-  [byteCount,elapsedSeconds] := $functorStats
-  sayBrightly ['%l,:bright '"  Cumulative Statistics for Constructor",
-    $op]
-  timeString := normalizeStatAndStringify elapsedSeconds
-  sayBrightly ['"      Time:",:bright timeString,'"seconds"]
-  sayBrightly '" "
-  'done
- 
-displayMissingFunctions() ==
-  null $CheckVectorList => nil
-  loc := nil
-  exp := nil
-  for [[op,sig,:.],:pred] in $CheckVectorList  | null pred repeat
-    null member(op,$formalArgList) and
-      getmode(op,$env) is ['Mapping,:.] =>
-        loc := [[op,sig],:loc]
-    exp := [[op,sig],:exp]
-  if loc then
-    sayBrightly ['%l,:bright '"  Missing Local Functions:"]
-    for [op,sig] in loc for i in 1.. repeat
-      sayBrightly ['"      [",i,'"]",:bright op,
-        ": ",:formatUnabbreviatedSig sig]
-  if exp then
-    sayBrightly ['%l,:bright '"  Missing Exported Functions:"]
-    for [op,sig] in exp for i in 1.. repeat
-      sayBrightly ['"      [",i,'"]",:bright op,
-        ": ",:formatUnabbreviatedSig sig]
- 
---% domain view code
- 
-makeFunctorArgumentParameters(argl,sigl,target) ==
-  $alternateViewList: local:= nil
-  $forceAdd: local:= true
-  $ConditionalOperators: local
-  ("append"/[fn(a,augmentSig(s,findExtras(a,target)))
-              for a in argl for s in sigl]) where
-    findExtras(a,target) ==
-      --  see if conditional information implies anything else
-      --  in the signature of a
-      target is ['Join,:l] => "union"/[findExtras(a,x) for x in l]
-      target is ['CATEGORY,.,:l] => "union"/[findExtras1(a,x) for x in l] where
-        findExtras1(a,x) ==
-          x is ['AND,:l] => "union"/[findExtras1(a,y) for y in l]
-          x is ['OR,:l] => "union"/[findExtras1(a,y) for y in l]
-          x is ['IF,c,p,q] =>
-            union(findExtrasP(a,c),
-                  union(findExtras1(a,p),findExtras1(a,q))) where
-              findExtrasP(a,x) ==
-                x is ['AND,:l] => "union"/[findExtrasP(a,y) for y in l]
-                x is ['OR,:l] => "union"/[findExtrasP(a,y) for y in l]
-                x is ['has,=a,y] and y is ['SIGNATURE,:.] => [y]
-                nil
-        nil
-    augmentSig(s,ss) ==
-       -- if we find something extra, add it to the signature
-      null ss => s
-      for u in ss repeat
-        $ConditionalOperators:=[CDR u,:$ConditionalOperators]
-      s is ['Join,:sl] =>
-        u:=ASSQ('CATEGORY,ss) =>
-          SUBST([:u,:ss],u,s)
-        ['Join,:sl,['CATEGORY,'package,:ss]]
-      ['Join,s,['CATEGORY,'package,:ss]]
-    fn(a,s) ==
-      isCategoryForm(s,$CategoryFrame) =>
-        s is ["Join",:catlist] => genDomainViewList0(a,rest s)
-        [genDomainView(a,a,s,"getDomainView")]
-      [a]
- 
-genDomainViewList0(id,catlist) ==
-  l:= genDomainViewList(id,catlist,true)
-  l
- 
-genDomainViewList(id,catlist,firsttime) ==
-  null catlist => nil
-  catlist is [y] and not isCategoryForm(y,$EmptyEnvironment) => nil
-  [genDomainView(if firsttime then id else genDomainViewName(id,first catlist),
-    id,first catlist,"getDomainView"),:genDomainViewList(id,rest catlist,nil)]
- 
-genDomainView(viewName,originalName,c,viewSelector) ==
-  c is ['CATEGORY,.,:l] => genDomainOps(viewName,originalName,c)
-  code:=
-    c is ['SubsetCategory,c',.] => c'
-    c
-  $e:= augModemapsFromCategory(originalName,viewName,nil,c,$e)
-  --$alternateViewList:= ((viewName,:code),:$alternateViewList)
-  cd:= ['LET,viewName,[viewSelector,originalName,mkDomainConstructor code]]
-  if null member(cd,$getDomainCode) then
-          $getDomainCode:= [cd,:$getDomainCode]
-  viewName
- 
-genDomainOps(viewName,dom,cat) ==
-  oplist:= getOperationAlist(dom,dom,cat)
-  siglist:= [sig for [sig,:.] in oplist]
-  oplist:= substNames(dom,viewName,dom,oplist)
-  cd:=
-    ['LET,viewName,['mkOpVec,dom,['LIST,:
-      [['LIST,MKQ op,['LIST,:[mkDomainConstructor mode for mode in sig]]]
-        for [op,sig] in siglist]]]]
-  $getDomainCode:= [cd,:$getDomainCode]
-  for [opsig,cond,:.] in oplist for i in 0.. repeat
-    if opsig in $ConditionalOperators then cond:=nil
-    [op,sig]:=opsig
-    $e:= addModemap(op,dom,sig,cond,['ELT,viewName,i],$e)
-  viewName
- 
-mkOpVec(dom,siglist) ==
-  dom:= getPrincipalView dom
-  substargs:= [['$,:dom.0],:
-    [[a,:x] for a in $FormalMapVariableList for x in rest dom.0]]
-  oplist:= getOperationAlistFromLisplib opOf dom.0
-  --new form is (<op> <signature> <slotNumber> <condition> <kind>)
-  ops:= MAKE_-VEC (#siglist)
-  for (opSig:= [op,sig]) in siglist for i in 0.. repeat
-    u:= ASSQ(op,oplist)
-    assoc(sig,u) is [.,n,.,'ELT] => ops.i := dom.n
-    noplist:= SUBLIS(substargs,u)
- -- following variation on assoc needed for GENSYMS in Mutable domains
-    AssocBarGensym(SUBST(dom.0,'$,sig),noplist) is [.,n,.,'ELT] =>
-                   ops.i := dom.n
-    ops.i := [function Undef,[dom.0,i],:opSig]
-  ops
- 
-genDomainViewName(a,category) ==
---+
-  a
- 
-compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) ==
--- form is lhs (f a1 ... an) of definition; body is rhs;
--- signature is (t0 t1 ... tn) where t0= target type, ti=type of ai, i > 0;
--- specialCases is (NIL l1 ... ln) where li is list of special cases
--- which can be given for each ti
- 
--- removes declarative and assignment information from form and
--- signature, placing it in list L, replacing form by ("where",form',:L),
--- signature by a list of NILs (signifying declarations are in e)
-  $sigAlist: local
-  $predAlist: local
- 
--- 1. create sigList= list of all signatures which have embedded
---    declarations moved into global variable $sigAlist
-  sigList:=
-    [transformType fetchType(a,x,e,form) for a in rest form for x in rest signature]
-       where
-        fetchType(a,x,e,form) ==
-          x => x
-          getmode(a,e) or userError concat(
-            '"There is no mode for argument",a,'"of function",first form)
-        transformType x ==
-          atom x => x
-          x is [":",R,Rtype] =>
-            ($sigAlist:= [[R,:transformType Rtype],:$sigAlist]; x)
-          x is ['Record,:.] => x --RDJ 8/83
-          [first x,:[transformType y for y in rest x]]
- 
--- 2. replace each argument of the form (|| x p) by x, recording
---    the given predicate in global variable $predAlist
-  argList:=
-    [removeSuchthat a for a in rest form] where
-      removeSuchthat x ==
-        x is ["|",y,p] => ($predAlist:= [[y,:p],:$predAlist]; y)
-        x
- 
--- 3. obtain a list of parameter identifiers (x1 .. xn) ordered so that
---       the type of xi is independent of xj if i < j
-  varList:=
-    orderByDependency(ASSOCLEFT argDepAlist,ASSOCRIGHT argDepAlist) where
-      argDepAlist:=
-        [[x,:dependencies] for [x,:y] in argSigAlist] where
-          dependencies() ==
-            union(listOfIdentifiersIn y,
-              delete(x,listOfIdentifiersIn LASSOC(x,$predAlist)))
-          argSigAlist:= [:$sigAlist,:pairList(argList,sigList)]
- 
--- 4. construct a WhereList which declares and/or defines the xi's in
---    the order constructed in step 3
-  (whereList:= [addSuchthat(x,[":",x,LASSOC(x,argSigAlist)]) for x in varList])
-     where addSuchthat(x,y) == (p:= LASSOC(x,$predAlist) => ["|",y,p]; y)
- 
--- 5. compile new ('DEF,("where",form',:WhereList),:.) where
---    all argument parameters of form' are bound/declared in WhereList
-  comp(form',m,e) where
-    form':=
-      ["where",defform,:whereList] where
-        defform:=
-          ['DEF,form'',signature',specialCases,body] where
-            form'':= [first form,:argList]
-            signature':= [first signature,:[nil for x in rest signature]]
- 
-orderByDependency(vl,dl) ==
-  -- vl is list of variables, dl is list of dependency-lists
-  selfDependents:= [v for v in vl for d in dl | MEMQ(v,d)]
-  for v in vl for d in dl | MEMQ(v,d) repeat
-    (SAY(v," depends on itself"); fatalError:= true)
-  fatalError => userError '"Parameter specification error"
-  until (null vl) repeat
-    newl:=
-      [v for v in vl for d in dl | null intersection(d,vl)] or return nil
-    orderedVarList:= [:newl,:orderedVarList]
-    vl':= setDifference(vl,newl)
-    dl':= [setDifference(d,newl) for x in vl for d in dl | member(x,vl')]
-    vl:= vl'
-    dl:= dl'
-  REMDUP NREVERSE orderedVarList --ordered so ith is indep. of jth if i < j
- 
-compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
-  m,oldE,$prefix,$formalArgList) ==
-    [lineNumber,:specialCases] := specialCases
-    e := oldE
-    --1. bind global variables
-    $form: local
-    $op: local
-    $functionStats: local:= [0,0]
-    $argumentConditionList: local
-    $finalEnv: local
-             --used by ReplaceExitEtc to get a common environment
-    $initCapsuleErrorCount: local:= #$semanticErrorStack
-    $insideCapsuleFunctionIfTrue: local:= true
-    $CapsuleModemapFrame: local:= e
-    $CapsuleDomainsInScope: local:= get("$DomainsInScope","special",e)
-    $insideExpressionIfTrue: local:= true
-    $returnMode:= m
-    [$op,:argl]:= form
-    $form:= [$op,:argl]
-    argl:= stripOffArgumentConditions argl
-    $formalArgList:= [:argl,:$formalArgList]
- 
-    --let target and local signatures help determine modes of arguments
-    argModeList:=
-      identSig:= hasSigInTargetCategory(argl,form,first signature,e) =>
-        (e:= checkAndDeclare(argl,form,identSig,e); rest identSig)
-      [getArgumentModeOrMoan(a,form,e) for a in argl]
-    argModeList:= stripOffSubdomainConditions(argModeList,argl)
-    signature':= [first signature,:argModeList]
-    if null identSig then  --make $op a local function
-      oldE := put($op,'mode,['Mapping,:signature'],oldE)
- 
-    --obtain target type if not given
-    if null first signature' then signature':=
-      identSig => identSig
-      getSignature($op,rest signature',e) or return nil
-    e:= giveFormalParametersValues(argl,e)
- 
-    $signatureOfForm:= signature' --this global is bound in compCapsuleItems
-    $functionLocations := [[[$op,$signatureOfForm],:lineNumber],
-      :$functionLocations]
-    e:= addDomain(first signature',e)
-    e:= compArgumentConditions e
- 
-    if $profileCompiler then
-      for x in argl for t in rest signature' repeat profileRecord('arguments,x,t)
-
-
-    --4. introduce needed domains into extendedEnv
-    for domain in signature' repeat e:= addDomain(domain,e)
- 
-    --6. compile body in environment with extended environment
-    rettype:= resolve(signature'.target,$returnMode)
- 
-    localOrExported :=
-      null member($op,$formalArgList) and
-        getmode($op,e) is ['Mapping,:.] => 'local
-      'exported
- 
-    --6a skip if compiling only certain items but not this one
-    -- could be moved closer to the top
-    formattedSig := formatUnabbreviated ['Mapping,:signature']
-    $compileOnlyCertainItems and _
-      not member($op, $compileOnlyCertainItems) =>
-        sayBrightly ['"   skipping ", localOrExported,:bright $op]
-        [nil,['Mapping,:signature'],oldE]
-    sayBrightly ['"   compiling ",localOrExported,
-      :bright $op,'": ",:formattedSig]
- 
-    if $newComp = true then
-      wholeBody := ['DEF, form, signature', specialCases, body]
-      T := CATCH('compCapsuleBody, newComp(wholeBody,$NoValueMode,e))
-           or ["",rettype,e]
-      T := [T.expr.2.2, rettype, T.env]
-      if $newCompCompare=true then
-         oldT := CATCH('compCapsuleBody, compOrCroak(body,rettype,e))
-              or ["",rettype,e]
-         SAY '"The old compiler generates:"
-         prTriple oldT
-         SAY '"The new compiler generates:"
-         prTriple T
-    else
-      T := CATCH('compCapsuleBody, compOrCroak(body,rettype,e))
-           or ["",rettype,e]
---+
-      NRTassignCapsuleFunctionSlot($op,signature')
-      if $newCompCompare=true then
-         SAY '"The old compiler generates:"
-         prTriple T
---  A THROW to the above CATCH occurs if too many semantic errors occur
---  see stackSemanticError
-    catchTag:= MKQ GENSYM()
-    fun:=
-      body':= replaceExitEtc(T.expr,catchTag,"TAGGEDreturn",$returnMode)
-      body':= addArgumentConditions(body',$op)
-      finalBody:= ["CATCH",catchTag,body']
-      compileCases([$op,["LAM",[:argl,'_$],finalBody]],oldE)
-    $functorStats:= addStats($functorStats,$functionStats)
- 
- 
---  7. give operator a 'value property
-    val:= [fun,signature',e]
-    [fun,['Mapping,:signature'],oldE] -- oldE:= put($op,'value,removeEnv val,e)
- 
-getSignatureFromMode(form,e) ==
-  getmode(opOf form,e) is ['Mapping,:signature] =>
-    #form^=#signature => stackAndThrow ["Wrong number of arguments: ",form]
-    EQSUBSTLIST(rest form,take(#rest form,$FormalMapVariableList),signature)
- 
-hasSigInTargetCategory(argl,form,opsig,e) ==
-  mList:= [getArgumentMode(x,e) for x in argl]
-    --each element is a declared mode for the variable or nil if none exists
-  potentialSigList:=
-    REMDUP
-      [sig
-        for [[opName,sig,:.],:.] in $domainShell.(1) |
-          fn(opName,sig,opsig,mList,form)] where
-            fn(opName,sig,opsig,mList,form) ==
-              opName=$op and #sig=#form and (null opsig or opsig=first sig) and
-                (and/[compareMode2Arg(x,m) for x in mList for m in rest sig])
-  c:= #potentialSigList
-  1=c => first potentialSigList
-    --accept only those signatures op right length which match declared modes
-  0=c => (#(sig:= getSignatureFromMode(form,e))=#form => sig; nil)
-  1<c =>
-    sig:= first potentialSigList
-    stackWarning ["signature of lhs not unique:",
-                  :bright formatSignature sig, "chosen"]
-    sig
-  nil --this branch will force all arguments to be declared
- 
-compareMode2Arg(x,m) == null x or modeEqual(x,m)
- 
-getArgumentModeOrMoan(x,form,e) ==
-  getArgumentMode(x,e) or
-    stackSemanticError(["argument ",x," of ",form," is not declared"],nil)
- 
-getArgumentMode(x,e) ==
-  STRINGP x => x
-  m:= get(x,'mode,e) => m
- 
-checkAndDeclare(argl,form,sig,e) ==
- 
--- arguments with declared types must agree with those in sig;
--- those that don't get declarations put into e
-  for a in argl for m in rest sig repeat
-    m1:= getArgumentMode(a,e) =>
-      ^modeEqual(m1,m) =>
-        stack:= ["   ",:bright a,'"must have type ",m,
-          '" not ",m1,'%l,:stack]
-    e:= put(a,'mode,m,e)
-  if stack then
-    sayBrightly ['"   Parameters of ",:bright first form,
-      '" are of wrong type:",'%l,:stack]
-  e
- 
-getSignature(op,argModeList,$e) ==
-  1=#
-    (sigl:=
-      REMDUP
-        [sig
-          for [[dc,:sig],[pred,:.]] in (mmList:= get(op,'modemap,$e)) | dc='_$
-            and rest sig=argModeList and knownInfo pred]) => first sigl
-  null sigl =>
-    (u:= getmode(op,$e)) is ['Mapping,:sig] => sig
-    SAY '"************* USER ERROR **********"
-    SAY("available signatures for ",op,": ")
-    if null mmList
-       then SAY "    NONE"
-       else for [[dc,:sig],:.] in mmList repeat printSignature("     ",op,sig)
-    printSignature("NEED ",op,["?",:argModeList])
-    nil
-  for u in sigl repeat
-    for v in sigl | not (u=v) repeat
-      if SourceLevelSubsume(u,v) then sigl:= delete(v,sigl)
-              --before we complain about duplicate signatures, we should
-              --check that we do not have for example, a partial - as
-              --well as a total one.  SourceLevelSubsume (from CATEGORY BOOT)
-              --should do this
-  1=#sigl => first sigl
-  stackSemanticError(["duplicate signatures for ",op,": ",argModeList],nil)
- 
---% ARGUMENT CONDITION CODE
- 
-stripOffArgumentConditions argl ==
-  [f for x in argl for i in 1..] where
-    f() ==
-      x is ["|",arg,condition] =>
-        condition:= SUBST('_#1,arg,condition)
-        -- in case conditions are given in terms of argument names, replace
-        $argumentConditionList:= [[i,arg,condition],:$argumentConditionList]
-        arg
-      x
- 
-stripOffSubdomainConditions(margl,argl) ==
-  [f for x in margl for arg in argl for i in 1..] where
-    f() ==
-      x is ['SubDomain,marg,condition] =>
-        pair:= assoc(i,$argumentConditionList) =>
-          (RPLAC(CADR pair,MKPF([condition,CADR pair],'AND)); marg)
-        $argumentConditionList:= [[i,arg,condition],:$argumentConditionList]
-        marg
-      x
- 
-compArgumentConditions e ==
-  $argumentConditionList:=
-    [f for [n,a,x] in $argumentConditionList] where
-      f() ==
-        y:= SUBST(a,'_#1,x)
-        T := [.,.,e]:= compOrCroak(y,$Boolean,e)
-        [n,x,T.expr]
-  e
- 
-addArgumentConditions($body,$functionName) ==
-  $argumentConditionList =>
-               --$body is only used in this function
-    fn $argumentConditionList where
-      fn clist ==
-        clist is [[n,untypedCondition,typedCondition],:.] =>
-          ['COND,[typedCondition,fn rest clist],
-            [$true,["argumentDataError",n,
-              MKQ untypedCondition,MKQ $functionName]]]
-        null clist => $body
-        systemErrorHere '"addArgumentConditions"
-  $body
- 
-putInLocalDomainReferences (def := [opName,[lam,varl,body]]) ==
-  $elt: local := ($QuickCode => 'QREFELT; 'ELT)
---+
-  NRTputInTail CDDADR def
-  def
- 
- 
-canCacheLocalDomain(dom,elt)==
-   dom is [op,'_$,n] and MEMQ(op,'(ELT QREFELT)) => nil
-   domargsglobal(dom) =>
-        $functorLocalParameters:= [:$functorLocalParameters,dom]
-        PUSH([dom,GENVAR(),[elt,$selector,$funcLocLen]],$usedDomList)
-        $selcount:= $selcount+1
-        $funcLocLen:= $funcLocLen+1
-   nil
-  where
-     domargsglobal(dom) ==
-       dom='_$ => true
-       IDENTP dom => MEMQ(dom,$functorLocalParameters)
-       ATOM dom => true
-       and/[domargsglobal(arg) for arg in rest dom]
- 
- 
-compileCases(x,$e) == -- $e is referenced in compile
-  $specialCaseKeyList: local
-  not ($insideFunctorIfTrue=true) => compile x
-  specialCaseAssoc:=
-    [y for y in getSpecialCaseAssoc() | not get(first y,"specialCase",$e) and
-          ([R,R']:= y) and isEltArgumentIn(FindNamesFor(R,R'),x)] where
-        FindNamesFor(R,R') ==
-          [R,:
-            [v
-              for ['LET,v,u,:.] in $getDomainCode | CADR u=R and
-                eval substitute(R',R,u)]]
-        isEltArgumentIn(Rlist,x) ==
-          atom x => nil
-          x is ['ELT,R,.] => MEMQ(R,Rlist) or isEltArgumentIn(Rlist,rest x)
-          x is ["QREFELT",R,.] => MEMQ(R,Rlist) or isEltArgumentIn(Rlist,rest x)
-          isEltArgumentIn(Rlist,first x) or isEltArgumentIn(Rlist,rest x)
-  null specialCaseAssoc => compile x
-  listOfDomains:= ASSOCLEFT specialCaseAssoc
-  listOfAllCases:= outerProduct ASSOCRIGHT specialCaseAssoc
-  cl:=
-    [u for l in listOfAllCases] where
-      u() ==
-        $specialCaseKeyList:= [[D,:C] for D in listOfDomains for C in l]
-        [MKPF([["EQUAL",D,C] for D in listOfDomains for C in l],"AND"),
-          compile COPY x]
-  $specialCaseKeyList:= nil
-  ["COND",:cl,[$true,compile x]]
- 
-getSpecialCaseAssoc() ==
-  [[R,:l] for R in rest $functorForm
-    for l in rest $functorSpecialCases | l]
- 
-compile u ==
-  [op,lamExpr] := u
-  if $suffix then
-    $suffix:= $suffix+1
-    op':=
-      opexport:=nil
-      opmodes:=
-        [sel
-          for [[DC,:sig],[.,sel]] in get(op,'modemap,$e) |
-            DC='_$ and (opexport:=true) and
-             (and/[modeEqual(x,y) for x in sig for y in $signatureOfForm])]
-      isLocalFunction op =>
-        if opexport then userError ['%b,op,'%d,'" is local and exported"]
-        INTERN STRCONC(encodeItem $prefix,'";",encodeItem op) 
-      isPackageFunction() and KAR $functorForm^="CategoryDefaults" =>
-        if null opmodes then userError ['"no modemap for ",op]
-        opmodes is [['PAC,.,name]] => name
-        encodeFunctionName(op,$functorForm,$signatureOfForm,";",$suffix)
-      encodeFunctionName(op,$functorForm,$signatureOfForm,";",$suffix)
-     where
-       isLocalFunction op ==
-	 null member(op,$formalArgList) and
-	   getmode(op,$e) is ['Mapping,:.]
-    u:= [op',lamExpr]
-  -- If just updating certain functions, check for previous existence.
-  -- Deduce old sequence number and use it (items have been skipped).
-  if $LISPLIB and $compileOnlyCertainItems then
-    parts := splitEncodedFunctionName(u.0, ";")
---  Next line JHD/SMWATT 7/17/86 to deal with inner functions
-    parts='inner => $savableItems:=[u.0,:$savableItems]
-    unew  := nil
-    for [s,t] in $splitUpItemsAlreadyThere repeat
-       if parts.0=s.0 and parts.1=s.1 and parts.2=s.2 then unew := t
-    null unew =>
-      sayBrightly ['"   Error: Item did not previously exist"]
-      sayBrightly ['"   Item not saved: ", :bright u.0]
-      sayBrightly ['"   What's there is: ", $lisplibItemsAlreadyThere]
-      nil
-    sayBrightly ['"   Renaming ", u.0, '" as ", unew]
-    u := [unew, :rest u]
-    $savableItems := [unew, :$saveableItems] -- tested by embedded RWRITE
-  optimizedBody:= optimizeFunctionDef u
-  stuffToCompile:=
-    if null $insideCapsuleFunctionIfTrue
-       then optimizedBody
-       else putInLocalDomainReferences optimizedBody
-  $doNotCompileJustPrint=true => (PRETTYPRINT stuffToCompile; op')
-  $macroIfTrue => constructMacro stuffToCompile
-  result:= spadCompileOrSetq stuffToCompile
-  functionStats:=[0,elapsedTime()]
-  $functionStats:= addStats($functionStats,functionStats)
-  printStats functionStats
-  result
- 
-spadCompileOrSetq (form is [nam,[lam,vl,body]]) ==
-        --bizarre hack to take account of the existence of "known" functions
-        --good for performance (LISPLLIB size, BPI size, NILSEC)
-  CONTAINED("",body) => sayBrightly ['"  ",:bright nam,'" not compiled"]
-  if vl is [:vl',E] and body is [nam',: =vl'] then
-      LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ nam']
-      sayBrightly ['"     ",:bright nam,'"is replaced by",:bright nam']
-  else if (ATOM body or and/[ATOM x for x in body])
-         and vl is [:vl',E] and not CONTAINED(E,body) then
-           macform := ['XLAM,vl',body]
-           LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ macform]
-           sayBrightly ['"     ",:bright nam,'"is replaced by",:bright body]
-  $insideCapsuleFunctionIfTrue => first COMP LIST form
-  compileConstructor form
- 
-compileConstructor form ==
-  u:= compileConstructor1 form
-  clearClams()                  --clear all CLAMmed functions
-  u
- 
-compileConstructor1 (form:=[fn,[key,vl,:bodyl]]) ==
--- fn is the name of some category/domain/package constructor;
--- we will cache all of its values on $ConstructorCache with reference
--- counts
-  $clamList: local
-  lambdaOrSlam :=
-    GETDATABASE(fn,'CONSTRUCTORKIND) = 'category => 'SPADSLAM
-    $mutableDomain => 'LAMBDA
-    $clamList:=
-      [[fn,"$ConstructorCache",'domainEqualList,'count],:$clamList]
-    'LAMBDA
-  compForm:= LIST [fn,[lambdaOrSlam,vl,:bodyl]]
-  if GETDATABASE(fn,'CONSTRUCTORKIND) = 'category
-      then u:= compAndDefine compForm
-      else u:=COMP compForm
-  clearConstructorCache fn      --clear cache for constructor
-  first u
- 
-constructMacro (form is [nam,[lam,vl,body]]) ==
-  ^(and/[atom x for x in vl]) =>
-    stackSemanticError(["illegal parameters for macro: ",vl],nil)
-  ["XLAM",vl':= [x for x in vl | IDENTP x],body]
- 
-listInitialSegment(u,v) ==
-  null u => true
-  null v => nil
-  first u=first v and listInitialSegment(rest u,rest v)
-  --returns true iff u.i=v.i for i in 1..(#u)-1
- 
-modemap2Signature [[.,:sig],:.] == sig
- 
-uncons x ==
-  atom x => x
-  x is ["CONS",a,b] => [a,:uncons b]
- 
---% CAPSULE
- 
-bootStrapError(functorForm,sourceFile) ==
-  ['COND, _
-    ['$bootStrapMode, _
-        ['VECTOR,mkDomainConstructor functorForm,nil,nil,nil,nil,nil]],
-    [''T, ['systemError,['LIST,''%b,MKQ CAR functorForm,''%d,'"from", _
-      ''%b,MKQ namestring sourceFile,''%d,'"needs to be compiled"]]]]
- 
-compAdd(['add,$addForm,capsule],m,e) ==
-  $bootStrapMode = true =>
-    if $addForm is ['Tuple,:.] then code := nil
-       else [code,m,e]:= comp($addForm,m,e)
-    [['COND, _
-       ['$bootStrapMode, _
-           code],_
-       [''T, ['systemError,['LIST,''%b,MKQ CAR $functorForm,''%d,'"from", _
-         ''%b,MKQ namestring _/EDITFILE,''%d,'"needs to be compiled"]]]],m,e]
-  $addFormLhs: local:= $addForm
-  if $addForm is ["SubDomain",domainForm,predicate] then
-    $packagesUsed := [domainForm,:$packagesUsed]
---+
-    $NRTaddForm := domainForm
-    NRTgetLocalIndex domainForm
-    --need to generate slot for add form since all $ go-get
-    --  slots will need to access it
-    [$addForm,.,e]:= compSubDomain1(domainForm,predicate,m,e)
-  else
-    $packagesUsed :=
-      $addForm is ['Tuple,:u] => [:u,:$packagesUsed]
-      [$addForm,:$packagesUsed]
---+
-    $NRTaddForm := $addForm
-    [$addForm,.,e]:=
-      $addForm is ['Tuple,:.] =>
-        $NRTaddForm := ['Tuple,:[NRTgetLocalIndex x for x in rest $addForm]]
-        compOrCroak(compTuple2Record $addForm,$EmptyMode,e)
-      compOrCroak($addForm,$EmptyMode,e)
-  compCapsule(capsule,m,e)
- 
-compTuple2Record u == ['Record,:[[":",i,x] for i in 1.. for x in rest u]]
- 
-compCapsule(['CAPSULE,:itemList],m,e) ==
-  $bootStrapMode = true =>
-    [bootStrapError($functorForm, _/EDITFILE),m,e]
-  $insideExpressionIfTrue: local:= false
-  compCapsuleInner(itemList,m,addDomain('_$,e))
- 
-compSubDomain(["SubDomain",domainForm,predicate],m,e) ==
-  $addFormLhs: local:= domainForm
-  $addForm: local
-  $NRTaddForm := domainForm
-  [$addForm,.,e]:= compSubDomain1(domainForm,predicate,m,e)
---+
-  compCapsule(['CAPSULE],m,e)
- 
-compSubDomain1(domainForm,predicate,m,e) ==
-  [.,.,e]:=
-    compMakeDeclaration([":","#1",domainForm],$EmptyMode,addDomain(domainForm,e))
-  u:=
-    compOrCroak(predicate,$Boolean,e) or
-      stackSemanticError(["predicate: ",predicate,
-        " cannot be interpreted with #1: ",domainForm],nil)
-  prefixPredicate:= lispize u.expr
-  $lisplibSuperDomain:=
-    [domainForm,predicate]
-  evalAndRwriteLispForm('evalOnLoad2,
-    ['SETQ,'$CategoryFrame,['put,op':= ['QUOTE,$op],'
-     (QUOTE SuperDomain),dF':= ['QUOTE,domainForm],['put,dF','(QUOTE SubDomain),[
-       'CONS,['QUOTE,[$op,:prefixPredicate]],['DELASC,op',['get,dF','
-         (QUOTE SubDomain),'$CategoryFrame]]],'$CategoryFrame]]])
-  [domainForm,m,e]
- 
-compCapsuleInner(itemList,m,e) ==
-  e:= addInformation(m,e)
-           --puts a new 'special' property of $Information
-  data:= ["PROGN",:itemList]
-      --RPLACd by compCapsuleItems and Friends
-  e:= compCapsuleItems(itemList,nil,e)
-  localParList:= $functorLocalParameters
-  if $addForm then data:= ['add,$addForm,data]
-  code:=
-    $insideCategoryIfTrue and not $insideCategoryPackageIfTrue => data
-    processFunctorOrPackage($form,$signature,data,localParList,m,e)
-  [MKPF([:$getDomainCode,code],"PROGN"),m,e]
- 
---% PROCESS FUNCTOR CODE
- 
-processFunctor(form,signature,data,localParList,e) ==
-  form is ["CategoryDefaults"] =>
-    error "CategoryDefaults is a reserved name"
-  buildFunctor(form,signature,data,localParList,e)
- 
-<<compCapsuleItems>>
-compSingleCapsuleItem(item,$predl,$e) ==
-  doIt(macroExpandInPlace(item,$e),$predl)
-  $e
- 
-doIt(item,$predl) ==
-  $GENNO: local:= 0
-  item is ['SEQ,:l,['exit,1,x]] =>
-    RPLACA(item,"PROGN")
-    RPLACA(LASTNODE item,x)
-    for it1 in rest item repeat $e:= compSingleCapsuleItem(it1,$predl,$e)
-        --This will RPLAC as appropriate
-  isDomainForm(item,$e) =>
-     -- convert naked top level domains to import
-    u:= ["import", [first item,:rest item]]
-    stackWarning ["Use: import ", [first item,:rest item]]
-    RPLACA(item,first u)
-    RPLACD(item,rest u)
-    doIt(item,$predl)
-  item is ['LET,lhs,rhs,:.] =>
-    not (compOrCroak(item,$EmptyMode,$e) is [code,.,$e]) =>
-      stackSemanticError(["cannot compile assigned value to",:bright lhs],nil)
-    not (code is ['LET,lhs',rhs',:.] and atom lhs') =>
-      code is ["PROGN",:.] =>
-         stackSemanticError(["multiple assignment ",item," not allowed"],nil)
-      RPLACA(item,first code)
-      RPLACD(item,rest code)
-    lhs:= lhs'
-    if not member(KAR rhs,$NonMentionableDomainNames) and
-      not MEMQ(lhs, $functorLocalParameters) then
-         $functorLocalParameters:= [:$functorLocalParameters,lhs]
-    if code is ['LET,.,rhs',:.] and isDomainForm(rhs',$e) then
-      if isFunctor rhs' then
-        $functorsUsed:= insert(opOf rhs',$functorsUsed)
-        $packagesUsed:= insert([opOf rhs'],$packagesUsed)
-      if lhs="Rep" then
-        $Representation:= (get("Rep",'value,$e)).(0)
-           --$Representation bound by compDefineFunctor, used in compNoStacking
---+
-        if $NRTopt = true
-          then NRTgetLocalIndex $Representation
---+
-      $LocalDomainAlist:= --see genDeltaEntry
-        [[lhs,:SUBLIS($LocalDomainAlist,(get(lhs,'value,$e)).0)],:$LocalDomainAlist]
---+
-    code is ['LET,:.] =>
-      RPLACA(item,($QuickCode => 'QSETREFV;'SETELT))
-      rhsCode:=
-       rhs'
-      RPLACD(item,['$,NRTgetLocalIndexClear lhs,rhsCode])
-    RPLACA(item,first code)
-    RPLACD(item,rest code)
-  item is [":",a,t] => [.,.,$e]:= compOrCroak(item,$EmptyMode,$e)
-  item is ["import",:doms] =>
-     for dom in doms repeat
-       sayBrightly ['"   importing ",:formatUnabbreviated dom]
-     [.,.,$e] := compOrCroak(item,$EmptyMode,$e)
-     RPLACA(item,'PROGN)
-     RPLACD(item,NIL) -- creates a no-op
-  item is ["IF",:.] => doItIf(item,$predl,$e)
-  item is ["where",b,:l] => compOrCroak(item,$EmptyMode,$e)
-  item is ["MDEF",:.] => [.,.,$e]:= compOrCroak(item,$EmptyMode,$e)
-  item is ['DEF,[op,:.],:.] =>
-    body:= isMacro(item,$e) => $e:= put(op,'macro,body,$e)
-    [.,.,$e]:= t:= compOrCroak(item,$EmptyMode,$e)
-    RPLACA(item,"CodeDefine")
-        --Note that DescendCode, in CodeDefine, is looking for this
-    RPLACD(CADR item,[$signatureOfForm])
-      --This is how the signature is updated for buildFunctor to recognise
---+
-    functionPart:= ['dispatchFunction,t.expr]
-    RPLACA(CDDR item,functionPart)
-    RPLACD(CDDR item,nil)
-  u:= compOrCroak(item,$EmptyMode,$e) =>
-    ([code,.,$e]:= u; RPLACA(item,first code); RPLACD(item,rest code))
-  true => cannotDo()
- 
-isMacro(x,e) ==
-  x is ['DEF,[op,:args],signature,specialCases,body] and
-    null get(op,'modemap,e) and null args and null get(op,'mode,e)
-      and signature is [nil] => body
- 
-doItIf(item is [.,p,x,y],$predl,$e) ==
-  olde:= $e
-  [p',.,$e]:= comp(p,$Boolean,$e) or userError ['"not a Boolean:",p]
-  oldFLP:=$functorLocalParameters
-  if x^="noBranch" then
-    compSingleCapsuleItem(x,$predl,getSuccessEnvironment(p,$e))
-    x':=localExtras(oldFLP)
-  oldFLP:=$functorLocalParameters
-  if y^="noBranch" then
-    compSingleCapsuleItem(y,$predl,getInverseEnvironment(p,olde))
-    y':=localExtras(oldFLP)
-  RPLACA(item,"COND")
-  RPLACD(item,[[p',x,:x'],['(QUOTE T),y,:y']])
- where localExtras(oldFLP) ==
-   EQ(oldFLP,$functorLocalParameters) => NIL
-   flp1:=$functorLocalParameters
-   oldFLP':=oldFLP
-   n:=0
-   while oldFLP' repeat
-     oldFLP':=CDR oldFLP'
-     flp1:=CDR flp1
-     n:=n+1
-   -- Now we have to add code to compile all the elements
-   -- of functorLocalParameters that were added during the
-   -- conditional compilation
-   nils:=ans:=[]
-   for u in flp1 repeat -- is =u form always an ATOM?
-     if ATOM u or (or/[v is [.,=u,:.] for v in $getDomainCode])
-       then
-	 nils:=[u,:nils]
-       else
-	 gv := GENSYM()
-	 ans:=[['LET,gv,u],:ans]
-	 nils:=[gv,:nils]
-     n:=n+1
-   $functorLocalParameters:=[:oldFLP,:NREVERSE nils]
-   NREVERSE ans
- 
---compSingleCapsuleIf(x,predl,e,$functorLocalParameters) ==
---  compSingleCapsuleItem(x,predl,e)
- 
---% CATEGORY AND DOMAIN FUNCTIONS
-compContained(["CONTAINED",a,b],m,e) ==
-  [a,ma,e]:= comp(a,$EmptyMode,e) or return nil
-  [b,mb,e]:= comp(b,$EmptyMode,e) or return nil
-  isCategoryForm(ma,e) and isCategoryForm(mb,e) =>
-    (T:= [["CONTAINED",a,b],$Boolean,e]; convert(T,m))
-  nil
- 
-compJoin(["Join",:argl],m,e) ==
-  catList:= [(compForMode(x,$Category,e) or return 'failed).expr for x in argl]
-  catList='failed => stackSemanticError(["cannot form Join of: ",argl],nil)
-  catList':=
-    [extract for x in catList] where
-      extract() ==
-        isCategoryForm(x,e) =>
-          parameters:=
-            union("append"/[getParms(y,e) for y in rest x],parameters)
-              where getParms(y,e) ==
-                atom y =>
-                  isDomainForm(y,e) => LIST y
-                  nil
-                y is ['LENGTH,y'] => [y,y']
-                LIST y
-          x
-        x is ["DomainSubstitutionMacro",pl,body] =>
-          (parameters:= union(pl,parameters); body)
-        x is ["mkCategory",:.] => x
-        atom x and getmode(x,e)=$Category => x
-        stackSemanticError(["invalid argument to Join: ",x],nil)
-        x
-  T:= [wrapDomainSub(parameters,["Join",:catList']),$Category,e]
-  convert(T,m)
- 
-compForMode(x,m,e) ==
-  $compForModeIfTrue: local:= true
-  comp(x,m,e)
- 
-compMakeCategoryObject(c,$e) ==
-  not isCategoryForm(c,$e) => nil
-  u:= mkEvalableCategoryForm c => [eval u,$Category,$e]
-  nil
- 
-quotifyCategoryArgument x == MKQ x
- 
-makeCategoryForm(c,e) ==
-  not isCategoryForm(c,e) => nil
-  [x,m,e]:= compOrCroak(c,$EmptyMode,e)
-  [x,e]
- 
-compCategory(x,m,e) ==
-  $TOP__LEVEL: local:= true
-  (m:= resolve(m,["Category"]))=["Category"] and x is ['CATEGORY,
-    domainOrPackage,:l] =>
-      $sigList: local
-      $atList: local
-      $sigList:= $atList:= nil
-      for x in l repeat compCategoryItem(x,nil)
-      rep:= mkExplicitCategoryFunction(domainOrPackage,$sigList,$atList)
-    --if inside compDefineCategory, provide for category argument substitution
-      [rep,m,e]
-  systemErrorHere '"compCategory"
- 
-mkExplicitCategoryFunction(domainOrPackage,sigList,atList) ==
-  body:=
-    ["mkCategory",MKQ domainOrPackage,['LIST,:REVERSE sigList],['LIST,:
-      REVERSE atList],MKQ domList,nil] where
-        domList() ==
-          ("union"/[fn sig for ["QUOTE",[[.,sig,:.],:.]] in sigList]) where
-            fn sig == [D for D in sig | mustInstantiate D]
-  parameters:=
-    REMDUP
-      ("append"/
-        [[x for x in sig | IDENTP x and x^='_$]
-          for ["QUOTE",[[.,sig,:.],:.]] in sigList])
-  wrapDomainSub(parameters,body)
- 
-wrapDomainSub(parameters,x) ==
-   ["DomainSubstitutionMacro",parameters,x]
- 
-mustInstantiate D ==
-  D is [fn,:.] and ^(MEMQ(fn,$DummyFunctorNames) or GETL(fn,"makeFunctionList"))
- 
-DomainSubstitutionFunction(parameters,body) ==
-  --see definition of DomainSubstitutionMacro in SPAD LISP
-  if parameters then
-    (body:= Subst(parameters,body)) where
-      Subst(parameters,body) ==
-        ATOM body =>
-          MEMQ(body,parameters) => MKQ body
-          body
-        member(body,parameters) =>
-          g:=GENSYM()
-          $extraParms:=PUSH([g,:body],$extraParms)
-           --Used in SetVector12 to generate a substitution list
-           --bound in buildFunctor
-           --For categories, bound and used in compDefineCategory
-          MKQ g
-        first body="QUOTE" => body
-        PAIRP $definition and
-            isFunctor first body and
-              first body ^= first $definition
-          =>  ['QUOTE,optimize body]
-        [Subst(parameters,u) for u in body]
-  not (body is ["Join",:.]) => body
-  atom $definition => body
-  null rest $definition => body
-           --should not bother if it will only be called once
-  name:= INTERN STRCONC(KAR $definition,";CAT")
-  SETANDFILE(name,nil)
-  body:= ["COND",[name],['(QUOTE T),['SETQ,name,body]]]
-  body
- 
-compCategoryItem(x,predl) ==
-  x is nil => nil
-  --1. if x is a conditional expression, recurse; otherwise, form the predicate
-  x is ["COND",[p,e]] =>
-    predl':= [p,:predl]
-    e is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl')
-    compCategoryItem(e,predl')
-  x is ["IF",a,b,c] =>
-    predl':= [a,:predl]
-    if b^="noBranch" then
-      b is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl')
-      compCategoryItem(b,predl')
-    c="noBranch" => nil
-    predl':= [["not",a],:predl]
-    c is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl')
-    compCategoryItem(c,predl')
-  pred:= (predl => MKPF(predl,"AND"); true)
- 
-  --2. if attribute, push it and return
-  x is ["ATTRIBUTE",y] => PUSH(MKQ [y,pred],$atList)
- 
-  --3. it may be a list, with PROGN as the CAR, and some information as the CDR
-  x is ["PROGN",:l] => for u in l repeat compCategoryItem(u,predl)
- 
--- 4. otherwise, x gives a signature for a
---    single operator name or a list of names; if a list of names,
---    recurse
-  ["SIGNATURE",op,:sig]:= x
-  null atom op =>
-    for y in op repeat compCategoryItem(["SIGNATURE",y,:sig],predl)
- 
-  --4. branch on a single type or a signature %with source and target
-  PUSH(MKQ [rest x,pred],$sigList)
- 
-
-
-
-
-
-
-
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}