aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2013-05-29 15:34:35 +0000
committerdos-reis <gdr@axiomatics.org>2013-05-29 15:34:35 +0000
commit9302bb2272f4e90b057548afe7c406f52b773e62 (patch)
tree03cc11710bd9cb265cf566d24e64b9aa80b1dcbe /src/interp
parent2b324bcfd116749f4966dd1948f0d9bf7b4a0033 (diff)
downloadopen-axiom-9302bb2272f4e90b057548afe7c406f52b773e62.tar.gz
Simplify backend functions
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/c-util.boot6
-rw-r--r--src/interp/compiler.boot2
-rw-r--r--src/interp/debug.lisp2
-rw-r--r--src/interp/define.boot2
-rw-r--r--src/interp/lisp-backend.boot13
-rw-r--r--src/interp/lisplib.boot4
-rw-r--r--src/interp/slam.boot6
-rw-r--r--src/interp/sys-macros.lisp2
-rw-r--r--src/interp/sys-utility.boot13
-rw-r--r--src/interp/vmlisp.lisp47
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))