Simplify backend functions

10 files changed, 15 insertions, 82 deletions

diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 20768ba8..4a28c92d 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1309,7 +1309,7 @@ clearReplacement name ==
   property(name,'%redex) := nil
 
 printBackendStmt(db,stmt) ==
-  printBackendDecl(nil,stmt)
+  printBackendDecl stmt
 
 evalAndPrintBackendStmt(db,stmt) ==
   eval stmt
@@ -1601,10 +1601,6 @@ noteSpecialVariable x ==
   $SpecialVars := insert(x,$SpecialVars)
 
 --%
-
-$compileDontDefineFunctions := true
-
---%
 --% Compile Time operation lookup for the benefit of domain inlining.
 --%
 
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index d3fa6fde..fa193e00 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1545,7 +1545,7 @@ checkExternalEntity(id,type,lang,e) ==
     stackAndThrow('"Signature for external entity must be a Mapping type",nil)
   id' := encodeLocalFunctionName id
   [def] := genImportDeclaration(id',[bootDenotation "%Signature",id,type'])
-  compileLispDefinition(id,def)
+  apply($backend,[def])
   id'
 
 
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index cae598bf..ba5fee2c 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -157,7 +157,7 @@
          METAKEYLST DEFINITION_NAME (|$sourceFileTypes| '(|spad| |boot| |lisp| |lsp| |meta|))
          ($FUNCTION FN) $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK
          TRAPFLAG |$InteractiveMode| COLUMN *QUERY LINE
-         (|$backend| (if (eq op 'define) #'eval-defun #'compile-defun)))
+         (|$backend| #'|evaluateLispDefinition|))
         (declare (special |$Echo| SINGLINEMODE INPUTSTREAM |$backend|
                      SPADERRORSTREAM ISID NBLNK COMMENTCHR /SOURCEFILES
                      METAKEYLST DEFINITION_NAME |$sourceFileTypes|
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 65bf6de4..80e24bd7 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -2159,7 +2159,7 @@ compileConstructor1(db,form:=[fn,[key,vl,:bodyl]]) ==
 ++ Subroutine of compileConstructor1.  Called to compile the body
 ++ of a category constructor definition.
 compAndDefine(db,l) ==
-  $backend: local := function((v,x) +-> evalAndPrintBackendStmt(db,x))
+  $backend: local := function(x +-> evalAndPrintBackendStmt(db,x))
   backendCompile(db,l)
 
 compHash(db,op,argl,body) ==
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index db970d90..941aca5b 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -43,7 +43,7 @@ namespace BOOT
 module lisp_-backend where
   expandToVMForm: %Thing -> %Thing
   eval: %Thing -> %Thing
-  printBackendDecl: (%Symbol,%Code) -> %Void
+  printBackendDecl: %Code -> %Void
   transformToBackendCode: %Form -> %Code
 
 
@@ -767,10 +767,9 @@ expandToVMForm x ==
 eval x ==
   EVAL expandToVMForm x
 
-
-compileLispDefinition(name,def) ==
-  $backend ~= nil => apply($backend,name,def,nil)
-  nil
+++ Augment the current evaluation environment with a function definition.
+evaluateLispDefinition body ==
+  eval body
 
 ++ Return true if `parms' is the empty list
 ++ or is a proper list of identifiers.
@@ -814,7 +813,7 @@ COMPILE1 fun ==
   body :=
     type in '(%lambda LAMBDA) => ['DEFUN,name,newArgs,:body]
     ['DEFMACRO,name,newArgs,:body]
-  compileLispDefinition(name,body)
+  apply($backend,[body])
   body
 
 COMP370 x ==
@@ -827,7 +826,7 @@ assembleCode x ==
   else COMP370 x
   first x
 
-printBackendDecl(label,decl) ==
+printBackendDecl decl ==
   st :=
     sp := symbolAssoc('COMPILER_-OUTPUT_-STREAM,$compilerOptions) => rest sp
     $OutputStream
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 1dd83d18..bc47c2bf 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -456,14 +456,14 @@ mkCtorDBForm db ==
 writeInfo(db,info,key,prop) ==
   if info ~= nil then
     insn := ['%store,[prop,mkCtorDBForm db],quote info]
-    printBackendDecl(key,expandToVMForm insn)
+    printBackendDecl expandToVMForm insn
   lisplibWrite(symbolName key,info,dbLibstream db)
 
 ++ Like writeInfo, but only write to the load unit.
 writeLoadInfo(db,info,key,prop) ==
   info = nil => nil
   insn := ['%store,[prop,mkCtorDBForm db],info]
-  printBackendDecl(key,expandToVMForm insn)
+  printBackendDecl expandToVMForm insn
 
 writeTemplate db ==
   dbConstructorKind db = 'category => nil
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index 7ee0d05d..d1ef7b3c 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2012, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -404,9 +404,7 @@ compileInteractive fn ==
 
 ++ Subroutine of compileInteractive.
 compQuietly fn ==
-  $backend: local :=
-    $compileDontDefineFunctions => "COMPILE-DEFUN"
-    "EVAL-DEFUN"
+  $backend: local := function evaluateLispDefinition
   quietlyIfInteractive backendCompile(nil,fn)
 
 clearAllSlams x ==
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index f73cc080..d03cec85 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2012, Gabriel Dos Reis.
+;; Copyright (C) 2007-2013, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index 5f7102f6..e4757eca 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -235,19 +235,6 @@ bitior: (%Short,%Short) -> %Short
 bitior(x,y) ==
   BOOLE(BOOLE_-IOR,x,y)
 
-
---% Back ends 
-
-++ compile a function definition, augmenting the current
-++ evaluation environement with the result of the compilation.
-COMPILE_-DEFUN(name,body) ==
-  eval body
-  COMPILE name
-
-++ Augment the current evaluation environment with a function definition.
-EVAL_-DEFUN(name,body) ==
-  eval MACROEXPANDALL body
-
 --% Hash table
 
 hashTable cmp ==
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 49c58494..8528cb17 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -1500,53 +1500,6 @@ terminals and empty or at-end files.  In Common Lisp, we must assume record size
 
 #-(OR IBCL AKCL)
 (defmacro |elapsedGcTime| () '0)
- 
-; This function was modified by Greg Vanuxem on March 31, 2005
-; to handle the special case of #'(lambda ..... which expands
-; into (function (lambda .....
-; 
-; The extra if clause fixes bugs #196 and #114
-;
-; an example that used to cause the failure was:
-; )set func comp off
-; f(xl:LIST FRAC INT): LIST FRAC INT == map(x +-> x, xl)
-; f [1,2,3]
-;
-; which expanded into
-;
-; (defun |xl;f;1;initial| (|#1| |envArg|)
-;  (prog (#:G1420)
-;   (return 
-;    (progn
-;     (lett #:G1420 'uninitialized_variable |f| |#1;f;1:initial|)
-;      (spadcall 
-;       (cons (|function| (lambda (#:G1420 |envArg|) #:G1420)) (vector))
-;       |#1|
-;       (svref |*1;f;1;initial;MV| 0))))))
-;
-; the (|function| (lambda form used to cause an infinite expansion loop
-;      
-(defun macroexpandall (sexpr)
- (cond
-  ((atom sexpr) sexpr)
-  ((eq (car sexpr) 'quote) sexpr)
-  ((eq (car sexpr) 'defun)
-   (cons (car sexpr) (cons (cadr sexpr)
-       (mapcar #'macroexpandall (cddr sexpr)))))
-  ((and (symbolp (car sexpr)) (macro-function (car sexpr)))
-   (do ()
-       ((not (and (consp sexpr) (symbolp (car sexpr))
-                  (macro-function (car sexpr)))))
-     (setq sexpr (macroexpand sexpr)))
-   (if (consp sexpr) 
-     (let ((a (car sexpr)) (b (caadr sexpr)))
-       (if (and (eq a 'function) (eq b 'lambda))
-         (cons a (list (cons b (mapcar #'macroexpandall (cdadr sexpr)))))
-         (mapcar #'macroexpandall sexpr)))
-       sexpr))
-  ('else        
-    (mapcar #'macroexpandall sexpr))))
-
 
 (defun |deleteWOC| (item list) (delete item list :test #'equal))