From b65e17e4ccd9f302b5dff63e65008b349c2b3f71 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sat, 11 Oct 2008 00:08:39 +0000
Subject: 	* interp/c-util.boot (backendCompile2): Bootified from COMP-2.
 	* interp/compiler.boot (COMP): Use it. 	* interp/comp.lisp (COMP-2):
 Remove.

---
 src/interp/c-util.boot   | 15 +++++++++++++++
 src/interp/comp.lisp     | 13 -------------
 src/interp/compiler.boot |  2 +-
 3 files changed, 16 insertions(+), 14 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 66f13aae..c26887c2 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1121,3 +1121,18 @@ backendCompileSPADSLAM(name,args,body) ==
   if $PrettyPrint then PRETTYPRINT u
   COMP370 [u]
   name
+
+
+backendCompile2 form ==
+  form isnt [name,[type,args,:body],:junk] or junk ^= nil =>
+    MOAN FORMAT(nil,'"******* parenthesis error in (~S (~S ...) ...)",name,type)
+  type = "SLAM" => backendCompileSLAM(name,args,body)
+  LASSQ(name,$clamList) => compClam(name,args,body,$clamList)
+  type = "SPADSLAM" => backendCompileSPADSLAM(name,args,body)
+  type = "ILAM" => backendCompileILAM(name,args,body)
+  body := [name,[type,args,:body]]
+  if $PrettyPrint then PRETTYPRINT body
+  if not $COMPILE then SAY '"No Compilation"
+  else COMP370 [body]
+  name
+
diff --git a/src/interp/comp.lisp b/src/interp/comp.lisp
index c8bdb9fb..871cbe4c 100644
--- a/src/interp/comp.lisp
+++ b/src/interp/comp.lisp
@@ -83,19 +83,6 @@
   (|dropInputLibrary| lib)
    (setq input-libraries (cons (open-library lib) input-libraries)) )
 
-(defun Comp-2 (args &aux name type argl bodyl junk)
-    (dsetq (NAME (TYPE ARGL . BODYL) . JUNK) args)
-    (cond (JUNK (MOAN (format nil "******pren error in (~S (~S ...) ...)" NAME TYPE)))
-          ((eq TYPE 'SLAM) (|backendCompileSLAM| NAME ARGL BODYL))
-          ((LASSQ NAME |$clamList|) (|compClam| NAME ARGL BODYL |$clamList|))
-          ((eq TYPE 'SPADSLAM) (|backendCompileSPADSLAM| NAME ARGL BODYL))
-          ((eq TYPE 'ILAM) (|backendCompileILAM| NAME ARGL BODYL))
-          ((setq BODYL (LIST NAME (CONS TYPE (CONS ARGL BODYL))))
-           (if |$PrettyPrint| (pprint bodyl))
-           (if (null $COMPILE) (SAY "No Compilation")
-               (COMP370 (LIST BODYL)))
-           NAME)))
-
 ;; used to be called POSN - but that interfered with a CCL function
 (DEFUN POSN1 (X L) (position x l :test #'equal))
 
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index f0d1d245..dc5f1211 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1920,7 +1920,7 @@ compileQuietly fn ==
 
 
 COMP l ==
-  MAPCAR(function COMP_-2, MAPCAN(function COMP_-1,l))
+  MAPCAR(function backendCompile2, MAPCAN(function COMP_-1,l))
 
 COMP_-1 x ==
   fname := first x
-- 
cgit v1.2.3