diff options
| -rw-r--r-- | src/ChangeLog | 10 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 6 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 2 | ||||
| -rw-r--r-- | src/interp/debug.lisp | 2 | ||||
| -rw-r--r-- | src/interp/define.boot | 2 | ||||
| -rw-r--r-- | src/interp/lisp-backend.boot | 13 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 4 | ||||
| -rw-r--r-- | src/interp/slam.boot | 6 | ||||
| -rw-r--r-- | src/interp/sys-macros.lisp | 2 | ||||
| -rw-r--r-- | src/interp/sys-utility.boot | 13 | ||||
| -rw-r--r-- | src/interp/vmlisp.lisp | 47 |
11 files changed, 25 insertions, 82 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 8adfcbcc..c0525c47 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2013-05-29 Gabriel Dos Reis <gdr@integrable-solutions.net> + + * interp/lisp-backend.boot (compileLispDefinition): Remove. + Adjust callers. + (printBackendDecl): Lose first parameter. Adjust callers. + * interp/slam.boot (compQuietly): Simplify. + * interp/sys-utility.boot (COMPILE-DEFUN): Remove. Adjust callers. + (EVAL-DEFUN): Likewise. + * interp/sys-macros.lisp (MACROEXPANDALL): Remove as no longer used.. + 2013-05-28 Gabriel Dos Reis <gdr@integrable-solutions.net> * interp/define.boot (compDefineCategory1): Take DB parameter. 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)) |