* 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.

1 files changed, 35 insertions, 2 deletions

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: