From 6d7d09414b6a40d3005b591ed05f2f466a4494f0 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 12 Dec 2007 07:44:36 +0000
Subject: 	* 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.

---
 src/interp/nruncomp.boot | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

(limited to 'src/interp/nruncomp.boot')

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
-- 
cgit v1.2.3