From bd4a699266fec55732b228ed4fa3c206571a4ccd Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 5 Aug 2008 04:44:46 +0000
Subject: 	Fix SF/2037811 	* interp/vmlisp.lisp (EMBED): Evaluate lambda
 forms to FUNCTIOn type. 	* interp/trace.boot (transTraceItem): Fix
 thinko. 	(spadTrace): Use assoc, not ASSOC. 	(addTraceItem): Test
 for domain objects before constructors.

---
 src/ChangeLog          | 8 ++++++++
 src/interp/trace.boot  | 9 ++++-----
 src/interp/vmlisp.lisp | 5 +++--
 3 files changed, 15 insertions(+), 7 deletions(-)

(limited to 'src')

diff --git a/src/ChangeLog b/src/ChangeLog
index 63568972..de0dddcc 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2008-08-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	Fix SF/2037811
+	* interp/vmlisp.lisp (EMBED): Evaluate lambda forms to FUNCTIOn type.
+	* interp/trace.boot (transTraceItem): Fix thinko.
+	(spadTrace): Use assoc, not ASSOC.
+	(addTraceItem): Test for domain objects before constructors.
+
 2008-08-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	Fix SF/2037804
diff --git a/src/interp/trace.boot b/src/interp/trace.boot
index f52892bb..fe6d00ae 100644
--- a/src/interp/trace.boot
+++ b/src/interp/trace.boot
@@ -304,9 +304,8 @@ transTraceItem x ==
         (y:= domainToGenvar x) => y
         x
     UPPER_-CASE_-P (STRINGIMAGE x).(0) =>
-      y := unabbrev x
-      constructor?(y) => y
-      PAIRP(y) and constructor?(CAR y) => CAR y
+      y := opOf unabbrev x
+      constructor? y => y
       (y:= domainToGenvar x) => y
       x
     x
@@ -438,7 +437,7 @@ spadTrace(domain,options) ==
     options := removeOption("VARBREAK",options)
   anyifTrue:= null listOfOperations
   domainId:= opOf domain.(0)
-  currentEntry:= ASSOC(domain,_/TRACENAMES)
+  currentEntry:= assoc(domain,_/TRACENAMES)
   currentAlist:= KDR currentEntry
   opStructureList:= flattenOperationAlist getOperationAlistFromLisplib domainId
   sigSlotNumberAlist:=
@@ -760,9 +759,9 @@ traceReply() ==
     sayBrightly flowSegmentedMsg(displayList,$LINELENGTH,6)
 
 addTraceItem d ==
-  constructor? d => $constructors:=[d,:$constructors]
   isDomain d => $domains:= [devaluate d,:$domains]
   isDomainOrPackage d => $packages:= [devaluate d,:$packages]
+  constructor? d => $constructors:=[d,:$constructors]
 
 _?t() ==
   null _/TRACENAMES => sayMSG bright '"nothing is traced"
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 25e848f2..76b52318 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -1601,10 +1601,11 @@
                 (OR (EQ OP 'LAMBDA) (EQ OP 'MLAMBDA)))
               (COND
                 ( (NOT (MEMQ CURRENT-BINDING (FLAT-BV-LIST BV)))
-                 `(,OP ,BV ((LAMBDA (,CURRENT-BINDING) . ,BODY) ',OLD-DEF))
+                 (eval `(,OP ,BV ((LAMBDA (,CURRENT-BINDING) . ,BODY)
+				  ',OLD-DEF)))
                    )
                 ( 'T
-                  NEW-DEFINITION ) ) )
+                  (eval NEW-DEFINITION) ) ) )
             ( 'T
               `((LAMBDA (,CURRENT-BINDING) ,NEW-DEFINITION) ',OLD-DEF)))
             ) )
-- 
cgit v1.2.3