aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-06-03 10:01:32 +0000
committerdos-reis <gdr@axiomatics.org>2008-06-03 10:01:32 +0000
commitc9d86f3d7a1bd950ee0d04aacd3eadcdd5bb7361 (patch)
tree34a2f30611a5efcdaf2c18cb30382e3512e15f22
parent6ee2b7e330751ab22c70d3abbef9e9523fa86036 (diff)
downloadopen-axiom-c9d86f3d7a1bd950ee0d04aacd3eadcdd5bb7361.tar.gz
* interp/comp.lisp (|compAndDefine|): Move to interp/compiler.boot
(COMP): Likewise. (|compQuietly|): Likewise. (|compileQuietly|): Likewise. (COMP-1): Likewise.
-rw-r--r--src/ChangeLog6
-rw-r--r--src/algebra/catdef.spad.pamphlet1
-rw-r--r--src/interp/comp.lisp70
-rw-r--r--src/interp/compiler.boot43
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