diff options
| -rw-r--r-- | src/ChangeLog | 6 | ||||
| -rw-r--r-- | src/algebra/catdef.spad.pamphlet | 1 | ||||
| -rw-r--r-- | src/interp/comp.lisp | 70 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 43 |
4 files changed, 49 insertions, 71 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 28f6797a..ab58b8be 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,11 @@ 2008-06-02 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/comp.lisp (|compAndDefine|): Move to interp/compiler.boot + (COMP): Likewise. + (|compQuietly|): Likewise. + (|compileQuietly|): Likewise. + (COMP-1): Likewise. + * interp/define.boot (compDefineCategory): Check that a category was indeed abbreviated a category. diff --git a/src/algebra/catdef.spad.pamphlet b/src/algebra/catdef.spad.pamphlet index 1bb9eabc..75c43cae 100644 --- a/src/algebra/catdef.spad.pamphlet +++ b/src/algebra/catdef.spad.pamphlet @@ -2931,7 +2931,6 @@ OrderedAbelianSemiGroup(): Category == Join(OrderedSet, AbelianSemiGroup) OrderedSemiGroup(): Category == Join(OrderedSet, SemiGroup) @ -@ \section{category OCAMON OrderedCancellationAbelianMonoid} <<category OCAMON OrderedCancellationAbelianMonoid>>= )abbrev category OCAMON OrderedCancellationAbelianMonoid diff --git a/src/interp/comp.lisp b/src/interp/comp.lisp index 8945cc49..b60cd837 100644 --- a/src/interp/comp.lisp +++ b/src/interp/comp.lisp @@ -65,36 +65,6 @@ (defvar $closedfns nil) -(defun |compAndDefine| (L) - (let ((*comp370-apply* (function print-and-eval-defun))) - (declare (special *comp370-apply*)) - (COMP L))) - -(defun COMP (L) (MAPCAR #'COMP-2 (MAPCAN #'COMP-1 L))) - -;;(defun |compQuietly| (L) -;; (let (U CUROUTSTREAM) -;; (declare (special CUROUTSTREAM)) -;; (ADDOPTIONS 'LISTING NULLOUTSTREAM) -;; (SETQ CUROUTSTREAM NULLOUTSTREAM) -;; (setq U (COMP L)) -;; (setq OPTIONLIST (CDDR OPTIONLIST)) -;; U)) - -(defun |compQuietly| (fn) - (let ((*comp370-apply* - (if |$InteractiveMode| - (if |$compileDontDefineFunctions| - #'compile-defun - #'eval-defun) - #'print-defun)) - ;; following creates a null outputstream if $InteractiveMode - (|$OutputStream| - (if |$InteractiveMode| - (make-broadcast-stream) - (make-synonym-stream '*standard-output*)))) - (COMP fn))) - ;; The following are used mainly in setvars.boot (defun notEqualLibs (u v) (if (string= u (library-name v)) (seq (close-library v) t) nil)) @@ -113,46 +83,6 @@ (|dropInputLibrary| lib) (setq input-libraries (cons (open-library lib) input-libraries)) ) - - -;;(defun |compileQuietly| (L) (PROG (U CUROUTSTREAM) -;; ;; calls lisp system COMPILE or DEFINE -;; (ADDOPTIONS 'QUIET 'T) -;; (ADDOPTIONS 'LISTING NULLOUTSTREAM) -;; (SETQ CUROUTSTREAM NULLOUTSTREAM) -;; (SETQ U (COND -;; (|$compileDontDefineFunctions| (COMPILE L)) -;; ('T (DEFINE L)))) -;; (SETQ OPTIONLIST (CDDR OPTIONLIST)) -;; (RETURN U) )) - -(defun |compileQuietly| (fn) - (let ((*comp370-apply* - (if |$InteractiveMode| - (if |$compileDontDefineFunctions| - #'compile-defun - #'eval-defun) - #'print-defun)) - ;; following creates a null outputstream if $InteractiveMode - (|$OutputStream| - (if |$InteractiveMode| - (make-broadcast-stream) - (make-synonym-stream '*standard-output*)))) - (COMP370 fn))) - -(defun COMP-1 (X) - (let* ((FNAME (car X)) - ($FUNNAME FNAME) - ($FUNNAME_TAIL (LIST FNAME)) - (LAMEX (second X)) - ($closedfns nil)) - (declare (special $FUNNAME $FUNNAME_TAIL $CLOSEDFNS)) - (setq LAMEX (COMP-TRAN LAMEX)) - (COMP-NEWNAM LAMEX) - (if (fboundp FNAME) - (format t "~&~%;;; *** ~S REDEFINED~%" FNAME)) - (CONS (LIST FNAME LAMEX) $CLOSEDFNS))) - (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))) diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 3fc3b462..550776b2 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -1614,6 +1614,49 @@ compileFileQuietly path == MAKE_-SYNONYM_-STREAM "*STANDARD-OUTPUT*" COMPILE_-FILE path +compAndDefine l == + _*COMP370_-APPLY_* := function PRINT_-AND_-EVAL_-DEFUN + COMP l + +compQuietly fn == + _*COMP370_-APPLY_* := + $InteractiveMode => + $compileDontDefineFunctions => function COMPILE_-DEFUN + function EVAL_-DEFUN + function PRINT_-DEFUN + -- create a null outputstream if $InteractiveMode + $OutputStream := + $InteractiveMode => MAKE_-BROADCAST_-STREAM() + MAKE_-SYNONYM_-STREAM "*STANDARD-OUTPUT*" + COMP fn + +compileQuietly fn == + _*COMP370_-APPLY_* := + $InteractiveMode => + $compileDontDefineFunctions => function COMPILE_-DEFUN + function EVAL_-DEFUN + function PRINT_-DEFUN + $OutputStream := + $InteractiveMode => MAKE_-BROADCAST_-STREAM() + MAKE_-SYNONYM_-STREAM "*STANDARD-OUTPUT*" + COMP370 fn + + +COMP l == + MAPCAR(function COMP_-2, MAPCAN(function COMP_-1,l)) + +COMP_-1 x == + fname := first x + $FUNNAME := fname + $FUNNAME__TAIL := [fname] + lamex := second x + $CLOSEDFNS := [] + lamex := COMP_-TRAN lamex + COMP_-NEWNAM lamex + if FBOUNDP fname then + FORMAT(true,'"~&~%;;; *** ~S REDEFINED~%",fname) + [[fname,lamex],:$CLOSEDFNS] + --% Register compilers for special forms. -- Those compilers are on the `SPECIAL' property of the corresponding |