* compiler.boot (comp3): Use isQuasiquote.

	(compSymbol): Use condition type view for non Union objects.
	(getUniqueCaseView): New. Subroutine of compSymbol.
	(compForm2): Don't infer type for flag parameter through
	unique compilcation. 
	(checkCallingConvention): New.
	(compileQuasiquote): coerce, don't convert.
	(compCase1): Handle non Union type object through modemap
	selection.
	(maybeSpliceMode): New.  Subroutine of compCase1.
	Register special form compiler with their names, not pointers.
	* define.boot (candidateSignatures): New.
	(hasSigInTargetCategory): Use it.  Tidy.
	(checkAndDeclare): Use isQuasiquote.
	(spadCompileorSetq): Rename non atomic parameters before calling
	LISP compiler.
	* g-util.boot (quasiquote): New.
	(isQuasiquote): Likewise.
	* i-intern.boot (flagArguments): New.
	(signatureFromModemap): Likewise.
	(mkAtree3): Use them.  Handle functions taking flag arguments.
	* i-object.boot (getFlagArgsPos): New.
	* i-spec1.boot (userDefinedCase): Now prepare form and hands back
	to bottomUp.
	(upcase): Adjust call to userDefinedCase.
	* modemap.boot (addDomain): Don't add flag domains to the
	environment. 
	* nruncomp.boot (NRTencode): Handle flag values.
	(NRTgetLocalIndex1): Likewise.
	* nrunfast.boot (lazyMatch): Likewise.
	(newExpandLocalTypeForm): Likewise.
	* sys-constants.boot ($DummyFunctorNames): Include quasiquote
	constructor. 
	* template.boot (NRTaddInner): Handle flag values.

13 files changed, 268 insertions, 86 deletions

diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
index 34dafa84..e2e1d25e 100644
--- a/src/interp/ChangeLog
+++ b/src/interp/ChangeLog
@@ -1,3 +1,40 @@
+2007-12-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* compiler.boot (comp3): Use isQuasiquote.
+	(compSymbol): Use condition type view for non Union objects.
+	(getUniqueCaseView): New. Subroutine of compSymbol.
+	(compForm2): Don't infer type for flag parameter through
+	unique compilcation. 
+	(checkCallingConvention): New.
+	(compileQuasiquote): coerce, don't convert.
+	(compCase1): Handle non Union type object through modemap
+	selection.
+	(maybeSpliceMode): New.  Subroutine of compCase1.
+	Register special form compiler with their names, not pointers.
+	* define.boot (candidateSignatures): New.
+	(hasSigInTargetCategory): Use it.  Tidy.
+	(checkAndDeclare): Use isQuasiquote.
+	(spadCompileorSetq): Rename non atomic parameters before calling
+	LISP compiler.
+	* g-util.boot (quasiquote): New.
+	(isQuasiquote): Likewise.
+	* i-intern.boot (flagArguments): New.
+	(signatureFromModemap): Likewise.
+	(mkAtree3): Use them.  Handle functions taking flag arguments.
+	* i-object.boot (getFlagArgsPos): New.
+	* i-spec1.boot (userDefinedCase): Now prepare form and hands back
+	to bottomUp.
+	(upcase): Adjust call to userDefinedCase.
+	* modemap.boot (addDomain): Don't add flag domains to the
+	environment. 
+	* nruncomp.boot (NRTencode): Handle flag values.
+	(NRTgetLocalIndex1): Likewise.
+	* nrunfast.boot (lazyMatch): Likewise.
+	(newExpandLocalTypeForm): Likewise.
+	* sys-constants.boot ($DummyFunctorNames): Include quasiquote
+	constructor. 
+	* template.boot (NRTaddInner): Handle flag values.
+	
 2007-12-09  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* br-saturn.boot (compDefineCapsuleFunction): Remove.
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index b39ad841..5a8ecd27 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -134,6 +134,10 @@ comp3(x,m,$e) ==
   m is ["Mapping",:.] => compWithMappingMode(x,m,e)
   m is ["QUOTE",a] => (x=a => [x,m,$e]; nil)
   STRINGP m => (atom x => (m=x or m=STRINGIMAGE x => [m,m,e]; nil); nil)
+  -- In quasiquote mode, x should match exactly
+  (y := isQuasiquote m) =>
+     y = x => [["QUOTE",x], m, $e]
+     nil
   ^x or atom x => compAtom(x,m,e)
   op:= first x
   getmode(op,e) is ["Mapping",:ml] and (u:= applyMapping(x,m,e,ml)) => u
@@ -298,11 +302,20 @@ compSymbol(s,m,e) ==
   s="true" => ['(QUOTE T),$Boolean,e]
   s="false" => [false,$Boolean,e]
   s=m or get(s,"isLiteral",e) => [["QUOTE",s],s,e]
-  v:= get(s,"value",e) =>
+  v := get(s,"value",e) =>
 --+
     MEMQ(s,$functorLocalParameters) =>
         NRTgetLocalIndex s
         [s,v.mode,e] --s will be replaced by an ELT form in beforeCompile
+
+    -- If the symbol s has a type given by a condition as the result of
+    -- a `case' form or a `suchthat' form, then we want to take 
+    -- advantage of that mode knowledge.  However, we must ensure that
+    -- we are not messing with members of Union objects which need
+    -- extra indirections to get to the actual object representation.
+    not isUnionMode(v.mode,e) and (t := getUniqueCaseView(s,e)) => 
+      coerce([s,t,e],m)
+
     [s,v.mode,e] --s has been SETQd
   m':= getmode(s,e) =>
     if not member(s,$formalArgList) and not MEMQ(s,$FormalMapVariableList) and
@@ -312,6 +325,16 @@ compSymbol(s,m,e) ==
   m = $Expression or m = $Symbol => [['QUOTE,s],m,e]
   not isFunction(s,e) => errorRef s
 
+++ Return the more recent unique type case assumption on `x' (if any) 
+++ that predates its declaration in environment `e'.  Note, this cannot 
+++ be the same thing as just asking for the 'condition' property of `x'.
+getUniqueCaseView(s,e) ==
+  props := getProplist(s,e)
+  for [p,:v] in props repeat
+    p = "condition" and v is [["case",.,t],:.] => return t
+    p = "value" => return nil
+
+
 convertOrCroak(T,m) ==
   u:= convert(T,m) => u
   userError ["CANNOT CONVERT: ",T.expr,"%l"," OF MODE: ",T.mode,"%l",
@@ -415,8 +438,12 @@ compForm2(form is [op,:argl],m,e,modemapList) ==
   -- its important that subsumed ops (newList) be considered last
   if newList then modemapList := append(modemapList,newList)
   Tl:=
-    [[.,.,e]:= T
-      for x in argl while (isSimple x and (T:= compUniquely(x,$EmptyMode,e)))]
+    [[.,.,e]:= T for x in argl for z in first modemapList
+       while (T := inferMode(x,z,e))] where
+      inferMode(x,z,e) ==
+        isQuasiquote z => [x,quasiquote x,e]
+        isSimple x and compUniquely(x,$EmptyMode,e)
+
   or/[x for x in Tl] =>
     partialModeList:= [(x => x.mode; nil) for x in Tl]
     compFormPartiallyBottomUp(form,m,e,modemapList,partialModeList) or
@@ -463,6 +490,28 @@ getFormModemaps(form is [op,:argl],e) ==
     stackMessage ["no modemap for","%b",op,"%d","with ",nargs," arguments"]
   finalModemapList
 
+++ We are either compiling a function call, or trying to determine
+++ whether we know something about a function being defined with
+++ parameters are not declared in the definition.  `sigs' is the list of
+++ candidate signatures for `nargs' arguments or parameters.  We need
+++ to detemine whether any of the arguments are flags.  If any
+++ operation takes a flag argument, then all other overloads must have
+++ the same arity and must take flag argument in the same position.
+++ Returns a vector of length `nargs' with positive entries indicating
+++ flag arguments, and negative entries for normal argument passing.
+checkCallingConvention(sigs,nargs) ==
+  v := GETZEROVEC nargs
+  for sig in sigs repeat
+    for t in rest sig 
+      for i in 0.. repeat
+         isQuasiquote t => 
+           v.i < 0 => userError '"flag argument restriction violation"
+           v.i := v.i + 1
+         v.i > 0 => userError '"flag argument restriction violation"
+         v.i := v.i - 1
+  v
+
+
 getConstructorFormOfMode(m,e) ==
   isConstructorForm m => m
   if m="$" then m:= "Rep"
@@ -679,7 +728,7 @@ setqMultipleExplicit(nameList,valList,m,e) ==
 ++ fledged AST algebra -- which we don't have yet in mainstream.
 compileQuasiquote(["[||]",:form],m,e) ==
   null form => nil
-  [["QUOTE", :form],$Syntax,e]
+  coerce([["QUOTE", :form],$Syntax,e], m)
 
 
 --% WHERE
@@ -1041,13 +1090,25 @@ compCase(["case",x,m'],m,e) ==
 
 compCase1(x,m,e) ==
   [x',m',e']:= comp(x,$EmptyMode,e) or return nil
+  -- `case' operations for non-Union types are function calls
+  not isUnionMode(m',e') => compForm(["case",x',m],$Boolean,e')
   u:=
     [cexpr
-      for (modemap:= [map,cexpr]) in getModemapList("case",2,e') | map is [.,.,s,
-        t] and modeEqual(t,m) and modeEqual(s,m')] or return nil
+      for (modemap:= [map,cexpr]) in getModemapList("case",2,e') 
+        | map is [.,.,s,t] and modeEqual(maybeSpliceMode t,m) 
+            and modeEqual(s,m')] or return nil
   fn:= (or/[selfn for [cond,selfn] in u | cond=true]) or return nil
   [["call",fn,x'],$Boolean,e']
 
+
+++ For `case' operation implemented in library, the second operand
+++ (target type) is taken unevaluated. The corresponding parameter 
+++ type in the modemap was specified as quasiquotation.  We
+++ want to look at the actual type when comparing with modeEqual.
+maybeSpliceMode m ==
+  (m' := isQuasiquote m) => m'
+  m
+
 compColon([":",f,t],m,e) ==
   $insideExpressionIfTrue=true => compColonInside(f,m,e,t)
     --if inside an expression, ":" means to convert to m "on faith"
@@ -1442,48 +1503,48 @@ compilerDoitWithScreenedLisplib(constructor, fun) ==
 --% Register compilers for special forms.
 -- Those compilers are on the `SPECIAL' property of the corresponding
 -- special form operator symbol.
-for x in [["_|", :function compSuchthat],_
-	  ["_@", :function compAtSign],_
-	  ["_:", :function compColon],_
-	  ["_:_:", :function compCoerce],_
-	  ["QUOTE", :function compQuote],_
-	  ["add", :function compAdd],_
-	  ["CAPSULE", :function compCapsule],_
-	  ["case", :function compCase],_
-	  ["CATEGORY", :function compCategory],_
-	  ["COLLECT", :function compRepeatOrCollect],_
-	  ["COLLECTV", :function compCollectV],_
-	  ["CONS", :function compCons],_
-	  ["construct", :function compConstruct],_
-	  ["DEF", :function compDefine],_
-	  ["elt", :function compElt],_
-	  ["exit", :function compExit],_
-	  ["has", :function compHas],_
-	  ["IF", :function compIf],_
-	  ["import", :function compImport],_
-	  ["is", :function compIs],_
-	  ["Join", :function compJoin],_
-	  ["leave", :function compLeave],_
-	  ["LET", :function compSetq],_
-	  ["ListCategory", :function compConstructorCategory],_
-	  ["MDEF", :function compMacro],_
-          ["not", :function compileNot],_
-	  ["pretend", :function compPretend],_
-	  ["Record", :function compCat],_
-	  ["RecordCategory", :function compConstructorCategory],_
-	  ["REDUCE", :function compReduce],_
-	  ["REPEAT", :function compRepeatOrCollect],_
-	  ["return", :function compReturn],_
-	  ["SEQ", :function compSeq],_
-	  ["SETQ", :function compSetq],_
-	  ["String", :function compString],_
-	  ["SubDomain", :function compSubDomain],_
-	  ["SubsetCategory", :function compSubsetCategory],_
-	  ["Union", :function compCat],_
-	  ["Mapping", :function compCat],_
-	  ["UnionCategory", :function compConstructorCategory],_
-	  ["VECTOR", :function compVector],_
-	  ["VectorCategory", :function compConstructorCategory],_
-	  ["where", :function compWhere],_
-          ["[||]", :function compileQuasiquote]] repeat
+for x in [["_|", :"compSuchthat"],_
+	  ["_@", :"compAtSign"],_
+	  ["_:", :"compColon"],_
+	  ["_:_:", :"compCoerce"],_
+	  ["QUOTE", :"compQuote"],_
+	  ["add", :"compAdd"],_
+	  ["CAPSULE", :"compCapsule"],_
+	  ["case", :"compCase"],_
+	  ["CATEGORY", :"compCategory"],_
+	  ["COLLECT", :"compRepeatOrCollect"],_
+	  ["COLLECTV", :"compCollectV"],_
+	  ["CONS", :"compCons"],_
+	  ["construct", :"compConstruct"],_
+	  ["DEF", :"compDefine"],_
+	  ["elt", :"compElt"],_
+	  ["exit", :"compExit"],_
+	  ["has", :"compHas"],_
+	  ["IF", : "compIf"],_
+	  ["import", :"compImport"],_
+	  ["is", :"compIs"],_
+	  ["Join", :"compJoin"],_
+	  ["leave", :"compLeave"],_
+	  ["LET", :"compSetq"],_
+	  ["ListCategory", :"compConstructorCategory"],_
+	  ["MDEF", :"compMacro"],_
+          ["not", :"compileNot"],_
+	  ["pretend", :"compPretend"],_
+	  ["Record", :"compCat"],_
+	  ["RecordCategory", :"compConstructorCategory"],_
+	  ["REDUCE", :"compReduce"],_
+	  ["REPEAT", :"compRepeatOrCollect"],_
+	  ["return", :"compReturn"],_
+	  ["SEQ", :"compSeq"],_
+	  ["SETQ", :"compSetq"],_
+	  ["String", :"compString"],_
+	  ["SubDomain", :"compSubDomain"],_
+	  ["SubsetCategory", :"compSubsetCategory"],_
+	  ["Union", :"compCat"],_
+	  ["Mapping", :"compCat"],_
+	  ["UnionCategory", :"compConstructorCategory"],_
+	  ["VECTOR", :"compVector"],_
+	  ["VectorCategory", :"compConstructorCategory"],_
+	  ["where", :"compWhere"],_
+          ["[||]", :"compileQuasiquote"]] repeat
   MAKEPROP(car x, 'SPECIAL, cdr x)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 43405cc3..8430610e 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -231,7 +231,8 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
  
 --  2. obtain signature
     signature':=
-      [first signature,:[getArgumentModeOrMoan(a,$definition,e) for a in argl]]
+      [first signature,
+        :[getArgumentModeOrMoan(a,$definition,e) for a in argl]]
     e:= giveFormalParametersValues(argl,e)
  
 --   3. replace arguments by $1,..., substitute into body,
@@ -832,17 +833,26 @@ 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)
- 
+
+candidateSignatures(op,nmodes,slot1) ==
+  [sig for [[=op,sig,:.],:.] in slot1 | #sig = nmodes]
+
+++ We are compiling a capsule function definition with head given by `form'.
+++ Determine whether the function with possibly partial signature `opsig'
+++ is exported.  Return the complete signature if yes; otherwise
+++ return nil, with diagnostic in ambiguity case.
 hasSigInTargetCategory(argl,form,opsig,e) ==
-  mList:= [getArgumentMode(x,e) for x in argl]
+  sigs := candidateSignatures($op,#form,$domainShell.1)
+  cc := checkCallingConvention(sigs,#argl)
+  mList:= [(cc.i > 0 => quasiquote x; getArgumentMode(x,e))
+            for x in argl for i in 0..]
     --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
+      [sig for sig in sigs |
+          fn(sig,opsig,mList)] where
+            fn(sig,opsig,mList) ==
+              (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
@@ -866,10 +876,10 @@ getArgumentMode(x,e) ==
   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
+    isQuasiquote m => nil	  -- we just built m from a.
     m1:= getArgumentMode(a,e) =>
       ^modeEqual(m1,m) =>
         stack:= ["   ",:bright a,'"must have type ",m,
@@ -1063,6 +1073,17 @@ 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"]
+
+  -- flag parameters needs to be made atomic, otherwise Lisp is confused.
+  -- We try our best to preserve
+  -- Note that we don't need substitution in the body because flag
+  -- parameters are never used in the body.
+  vl := [ renameParameter for v in vl] where
+    renameParameter() ==
+      NUMBERP v or IDENTP v or STRINGP v => v
+      GENSYM '"flag"
+  form := [nam,[lam,vl,body]]
+
   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']
diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
index 43d7d3c5..feab45b8 100644
--- a/src/interp/fnewmeta.lisp
+++ b/src/interp/fnewmeta.lisp
@@ -819,9 +819,8 @@
 		      (MUST (MATCH-ADVANCE-STRING "|]"))
 		      (PUSH-REDUCTION '|PARSE-Enclosure|
 				      (CONS '|[\|\|]|
-					    (CONS (POP-STACK-1) NIL))))))
-
-
+					    (CONS (POP-STACK-1) NIL)))
+		      )))
       )) 
 
 
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 20feccf0..2f900f6a 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -93,6 +93,14 @@ put(x,prop,val,e) ==
   addBinding(x,newProplist,e)
 
 
+++ Build a quasiquotation form for `x'.
+quasiquote x ==
+  ["[||]",x]
+
+++ Extract the quoted form, otherwise return nil
+isQuasiquote m ==
+  m is ["[||]",y] => y
+
 
 -- Convert an arbitrary lisp object to canonical boolean.
 bool x ==
diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot
index e58821c1..8eefe0d7 100644
--- a/src/interp/i-intern.boot
+++ b/src/interp/i-intern.boot
@@ -264,9 +264,26 @@ mkAtree3(x,op,argl) ==
       v := mkAtreeNode $immediateDataSymbol
       putValue(v,getBasicObject op)
       v
-    atom op => mkAtreeNode op
+    atom op => 
+      t := mkAtreeNode op
+      putAtree(t, 'flagArgsPos, flagArguments(op,#argl))
+      t
     mkAtree1 op
-  [z,:[mkAtree1 y for y in argl]]
+  -- this is a general form handled by modemap selection.  Be
+  -- careful not to evaluate arguments that are not meant to.
+  flagArgPos := getFlagArgsPos z
+  [z,:[buildTreeForOperand for y in argl for i in 0..]] where
+           buildTreeForOperand() ==
+             flagArgPos and flagArgPos.i > 0 =>
+               y' := parseTransform postTransform y
+               a := mkAtreeNode $immediateDataSymbol
+               m := quasiquote y'
+               putMode(a, m)
+               putValue(a, objNewWrap(MKQ y',m))
+               putModeSet(a, [m])
+               a
+             mkAtree1 y
+
  where
   fn(a,b) ==
     a and b =>
@@ -274,6 +291,22 @@ mkAtree3(x,op,argl) ==
       else throwMessage '"   double declaration of parameter"
     a or b
 
+++ Check if op accepts flag arguments.  If so, returns a vector whose
+++ positive entry indicates that modemaps for `op' takes flag arguments
+++ in that position.
+flagArguments(op, nargs) ==
+  v := GETZEROVEC nargs
+  sigs := [signatureFromModemap m for m in getModemapsFromDatabase(op, nargs)]
+  checkCallingConvention(sigs, nargs)
+
+++ Extract the signature of modemap `m'.
+signatureFromModemap m ==
+  [sig,pred,:.]  := m
+  pred = true => rest sig
+  car pred = "AND" =>
+    sl := [[a,:b] for [.,a,b] in cdr pred]
+    rest SUBLIS(sl,sig)
+  
 collectDefTypesAndPreds args ==
   -- given an arglist to a DEF-like form, this function returns
   -- a vector of three things:
diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot
index 2ac8ae61..d9dbd969 100644
--- a/src/interp/i-object.boot
+++ b/src/interp/i-object.boot
@@ -393,6 +393,13 @@ srcPosDisplay(sp) ==
   true
 
 
+++ Returns the calling convention vector for an operation
+++ represented by the VAT `t'.
+getFlagArgsPos t ==
+  VECP t => getAtree(t, 'flagArgsPos)
+  atom t => keyedSystemError("S2II0001",[t])
+  getFlagArgsPos car t
+
 --% Transfer of VAT properties.
 
 
diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot
index 0047f7f0..574d5b75 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-spec1.boot
@@ -303,27 +303,27 @@ upor x ==
 
 ++ subroutine of upcase. Handles the situation where `case' may
 ++ have been defined as a library function.  
-++ `op', `lhs' are VATs; `rhs' is a parse form.
-++ Note: Some of the code here needs to be refactored with code
-++ in bottomUp and elsewhere to avoid logic duplication.
-userDefinedCase(op, lhs, rhs) ==
-  -- At this point, op and lhs have already been bottomUp'd.
-  rhs := mkAtree rhs
-  bottomUp rhs
-  -- Prepare for evaluating call to a library function.
-  for x in [lhs, rhs] for i in 1.. repeat
-    putAtree(x, "callingFunction", "case")
-    putAtree(x, "argumentNumber", i)
-    putAtree(x, "totalArgs", 2)
-  bottomUpForm([op, lhs, rhs], op, "case", [lhs, rhs], 
-    [bottomUp lhs, bottomUp rhs])
-
+++ `op', `lhs' are VATs; `rhs' is unevaluated.
+userDefinedCase(t is [op, lhs, rhs]) ==
+  -- We want to resolve the situation by general modemap selection.
+  -- So, we want to let bottomUp (which called us through upcase)
+  -- to continue the work.  The way we do that is to return `nil'.
+  -- Therefore we need a VAT for `rhs' with sufficient information
+  -- to prevent bottomUp from trying to evaluate `rhs'.
+  putAtree(op, 'flagArgsPos, flagArguments("case",2))
+  r := mkAtreeNode $immediateDataSymbol
+  m := quasiquote rhs
+  putMode(r, m)
+  putValue(r, objNewWrap(MKQ rhs,m))
+  putModeSet(r, [m])
+  RPLACD(cdr t, [r])                   -- fix up contained for rhs.
+  nil                                  -- tell bottomUp to continue.
 
 upcase t ==
   t isnt [op,lhs,rhs] => nil
   bottomUp lhs
   triple := getValue lhs
-  objMode(triple) isnt ['Union,:unionDoms] => userDefinedCase(op,lhs,rhs)
+  objMode(triple) isnt ['Union,:unionDoms] => userDefinedCase t
   if (rhs' := isDomainValuedVariable(rhs)) then rhs := rhs'
   if first unionDoms is [":",.,.] then
      for i in 0.. for d in unionDoms repeat
diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot
index 7dc30283..1cdfdd2c 100644
--- a/src/interp/modemap.boot
+++ b/src/interp/modemap.boot
@@ -56,6 +56,9 @@ addDomain(domain,e) ==
       addNewDomain(domain,e)
     -- constructor? test needed for domains compiled with $bootStrapMode=true
   isFunctor name or constructor? name => addNewDomain(domain,e)
+  -- ??? we should probably augment $DummyFunctorNames with CATEGORY
+  -- ??? so that we don't have to do this special check here.  Investigate.
+  isQuasiquote domain => e 
   if not isCategoryForm(domain,e) and
     not member(name,'(Mapping CATEGORY)) then
       unknownTypeError name
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 15468369..b732ece8 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -106,6 +106,7 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) ==
     QCAR x='Record or x is ['Union,['_:,a,b],:.] =>
       [QCAR x,:[['_:,a,encode(b,c,false)]
         for [.,a,b] in QCDR x for [.,=a,c] in CDR compForm]]
+    isQuasiquote x => x
     constructor? QCAR x or MEMQ(QCAR x,'(Union Mapping)) =>
       [QCAR x,:[encode(y,z,false) for y in QCDR x for z in CDR compForm]]
     ['NRTEVAL,NRTreplaceAllLocalReferences COPY_-TREE lispize compForm]
@@ -244,11 +245,20 @@ NRTgetLocalIndex1(item,killBindingIfTrue) ==
     $NRTdeltaListComp:=[item,:$NRTdeltaListComp]
     $NRTdeltaLength := $NRTdeltaLength+1
     $NRTbase + $NRTdeltaLength - 1
-  $NRTdeltaList:= [['domain,NRTaddInner item,:value],:$NRTdeltaList]
+  -- when assigning slot to flag values, we don't really want to
+  -- compile them.  Rather, we want to record them as if they were atoms.
+  flag := isQuasiquote item
+  $NRTdeltaList:= [['domain,(flag => item; NRTaddInner item),:value],
+                    :$NRTdeltaList]
   saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
   saveIndex := $NRTbase + $NRTdeltaLength
   $NRTdeltaLength := $NRTdeltaLength+1
-  compEntry:= (compOrCroak(item,$EmptyMode,$e)).expr
+  compEntry:= 
+    -- we don't need to compile the flag again.
+    -- ??? In fact we should not be compiling again at this phase.
+    -- ??? That we do is likely a bug.
+    flag => item  
+    (compOrCroak(item,$EmptyMode,$e)).expr
 --    item
   RPLACA(saveNRTdeltaListComp,compEntry)
   saveIndex
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 770c956c..d791335a 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -430,6 +430,7 @@ lazyMatch(source,lazyt,dollar,domain) ==
               for [.,stag,s] in sargl for [.,atag,a] in argl]
       MEMQ(op,'(Union Mapping QUOTE)) =>
          and/[lazyMatchArg(s,a,dollar,domain) for s in sargl for a in argl]
+      op="[||]" => source = lazyt
       coSig := GETDATABASE(op,'COSIG)
       NULL coSig => error ["bad Constructor op", op]
       and/[lazyMatchArg2(s,a,dollar,domain,flag)
@@ -439,8 +440,9 @@ lazyMatch(source,lazyt,dollar,domain) ==
       lazyt is ['_#, slotNum] => source = #(domain.slotNum)
       lazyt is ['call,'LENGTH, slotNum] => source = #(domain.slotNum)
       nil
-  source is ['construct,:l] => l = lazyt
+
   -- A hideous hack on the same lines as the previous four lines JHD/MCD
+  source is ['construct,:l] => l = lazyt
   nil
 
  
@@ -511,7 +513,7 @@ newExpandLocalTypeForm([functorName,:argl],dollar,domain) ==
                                  for [.,tag,dom] in argl]]
   MEMQ(functorName, '(Union Mapping)) =>
           [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]]
-  functorName = 'QUOTE => [functorName,:argl]
+  functorName in '(QUOTE _[_|_|_]) => [functorName,:argl]
   coSig := GETDATABASE(functorName,'COSIG)
   NULL coSig => error ["bad functorName", functorName]
   [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,flag)
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index 0ce969c6..0f008f5a 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -529,7 +529,7 @@ $ConstructorNames ==
 
 ++ A list of functors that do not really have modemaps
 $DummyFunctorNames ==
-  '(Mapping)
+  '(Mapping _[_|_|_])
 
 --% 
 
diff --git a/src/interp/template.boot b/src/interp/template.boot
index 75e61ac8..a8abe566 100644
--- a/src/interp/template.boot
+++ b/src/interp/template.boot
@@ -286,6 +286,7 @@ NRTaddInner x ==
     getConstructorSignature x is [.,:ml] =>
       for y in rest x for m in ml | not (y = '$) repeat
         isCategoryForm(m,$CategoryFrame) => NRTinnerGetLocalIndex y
+    isQuasiquote x => NRTinnerGetLocalIndex x
     keyedSystemError("S2NR0003",[x])
   x
 
@@ -294,7 +295,7 @@ NRTaddInner x ==
 NRTinnerGetLocalIndex x ==
   atom x => x
   -- following test should skip Unions, Records, Mapping
-  MEMQ(opOf x,'(Union Record Mapping)) => NRTgetLocalIndex x
+  MEMQ(opOf x,'(Union Record Mapping _[_|_|_])) => NRTgetLocalIndex x
   constructor?(x) => NRTgetLocalIndex x
   NRTaddInner x