aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog9
-rw-r--r--src/interp/buildom.boot9
-rw-r--r--src/interp/debug.lisp7
-rw-r--r--src/interp/spad.lisp175
-rw-r--r--src/interp/sys-globals.boot3
-rw-r--r--src/interp/vmlisp.lisp4
6 files changed, 18 insertions, 189 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index c05e953d..cce2e321 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
2012-05-24 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/sys-globals.boot ($compCount): Remove.
+ * interp/spad.lisp (knownEqualPred): Move to buildom.boot
+ (hashable): Likewise.
+ Remove junk.
+ * interp/debug.lisp: Remove junk.
+ * interp/vmlisp.lisp: Likewise.
+
+2012-05-24 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* algebra/Makefile.in (initdb.$(FASLEXT)): Add --syslib to fix thinko.
2012-05-24 Gabriel Dos Reis <gdr@cs.tamu.edu>
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index d6437cd5..9856c5e6 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -308,6 +308,15 @@ lookupInTable(op,sig,dollar,[domain,table]) ==
someMatch => lookupInAddChain(op,sig,domain,dollar)
nil
+knownEqualPred dom ==
+ fun := compiledLookup("=",[$Boolean,"$","$"],dom) =>
+ getFunctionReplacement BPINAME first fun
+ nil
+
+hashable dom ==
+ -- FIXME: there should test for OIL opcodes.
+ symbolMember?(knownEqualPred dom,'(EQ EQL EQUAL))
+
--% Record
-- Want to eventually have the elts and setelts.
-- Record is a macro in BUILDOM LISP. It takes out the colons.
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index 917c91ff..18b3d2f6 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -62,13 +62,6 @@
(MAKEPROP 'INPUT '/TERMCHR '(#\: #\< #\ #\())
(MAKEPROP 'SPAD '/TERMCHR '(#\: #\< #\ #\())
(MAKEPROP 'BOOT '/TERMCHR '(#\: #\< #\ #\())
-(MAKEPROP 'META '/READFUN 'META\,RULE)
-(MAKEPROP 'INPUT '/READFUN '|New,LEXPR,Interactive|)
-(MAKEPROP 'INPUT '/TRAN '/TRANSPAD)
-(MAKEPROP 'BOOT '/READFUN '|New,LEXPR1|)
-(MAKEPROP 'BOOT '/TRAN '/TRANSNBOOT)
-(MAKEPROP 'SPAD '/READFUN '|New,LEXPR|)
-(MAKEPROP 'SPAD '/TRAN '/TRANSPAD)
(defmacro |/C,LIB| (&rest L &aux optionlist /editfile
($prettyprint 't) ($reportCompilation 't))
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index fd2cedd6..4b203e9b 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -54,24 +54,8 @@
(defvar |$HiFiAccess| nil "if true maintain history file")
(DEFVAR _ '&)
-(defvar /EDIT-FM 'A1)
-(defvar /EDIT-FT 'SPAD)
-(defvar /RELEASE '"UNKNOWN")
(defvar error-print)
-(defvar ind)
-(defvar INITCOLUMN 0)
-(defvar JUNKTOKLIST '(FOR IN AS INTO OF TO))
-(defvar m-chrbuffer)
-(defvar m-chrindex)
(defvar MARG 0 "Margin for testing by ?OP")
-(defvar RLGENSYMFG NIL)
-(defvar RLGENSYMLST NIL)
-(defvar S-SPADTOK 'SPADSYSTOK)
-(defvar sortpred)
-(defvar SPADSYSKEY '(EOI EOL))
-(defvar STAKCOLUMN -1)
-(defvar |$IOAlist| '((|%i| . (|gauss| 0 1))))
-(defvar |InteractiveMode|)
(defvar |uc| 'UC)
(defun init-boot/spad-reader ()
@@ -139,70 +123,10 @@
(DEFUN INTEGER-BIT (N I) (LOGBITP I N))
-(DEFUN /TRANSPAD (X)
- (PROG (proplist)
- (setq proplist (LIST '(FLUID . |true|)
- (CONS '|special|
- (COPY-TREE |$InitialDomainsInScope|))))
- (SETQ |$InteractiveFrame|
- (|addBinding| '|$DomainsInScope| proplist
- (|addBinding| '|$Information| NIL
- (COPY-TREE |$InitialModemapFrame|))))
- (RETURN (PROGN (|translateSpad| X) NIL))))
-
- ;; NIL needed below since END\_UNIT is not generated by current parser
-
-(defun |traceComp| ()
- (SETQ |$compCount| 0)
- (EMBED '|comp|
- '(LAMBDA (X Y Z)
- (PROG (U)
- (SETQ |$compCount| (1+ |$compCount|))
- (SETQ |yesOrNo| (if (SETQ U (|comp| X Y Z))
- (if (EQUAL (SECOND U) Y) '|yes| (SECOND U))
- ('T '|no|)))
- (|sayBrightly| (CONS (MAKE-FULL-CVEC |$compCount| " ")
- (LIST X " --> " Y '|%b| |yesOrNo| '|%d|)))
- (SETQ |$compCount| (1- |$compCount|))
- (RETURN U) )))
- (|comp| |$x| |$m| |$f|)
- (UNEMBED '|comp|))
-
-(defun UNCONS (X)
- (COND ((ATOM X) X)
- ((EQCAR X 'CONS) (CONS (SECOND X) (UNCONS (THIRD X))))
- (T (ERROR "UNCONS"))))
-
-(defun OPTIMIZE\&PRINT (X) (PRETTYPRINT (/MDEF X)))
-
-(defun SPAD-PRINTTIME (A B)
- (let (c msg)
- (setq C (+ A B))
- (setq MSG (STRCONC "(" (STRINGIMAGE A) " + " (STRINGIMAGE B)
- " = " (STRINGIMAGE C) " MS.)"))
- (PRINT (STRCONC (STRINGPAD "" (DIFFERENCE 80 (SIZE MSG))) MSG))))
-
-(defun SPAD-MODETRAN (X) (D-TRAN X))
-
-(defun SPAD-EVAL (X)
- (COND ((ATOM X) (EVAL X))
- ((CONS (FIRST X) (MAPCAR #'SPAD-EVAL (CDR X))))))
-
;************************************************************************
; SYSTEM COMMANDS
;************************************************************************
-(defun READLISP (UPPER_CASE_FG)
- (let (v expr val )
- (setq EXPR (READ-FROM-STRING
- (IF UPPER_CASE_FG (string-upcase (line-buffer |$spadLine|))
- (line-buffer |$spadLine|))
- t nil :start (Line-CURRENT-INDEX |$spadLine|)))
- (VMPRINT EXPR)
- (setq VAL ((LAMBDA (|$InteractiveMode|) (EVAL EXPR)) NIL))
- (FORMAT t "~&VALUE = ~S" VAL)
- (TERSYSCOMMAND)))
-
(defun TERSYSCOMMAND ()
(FRESH-LINE)
(SETQ CHR 'ENDOFLINECHR)
@@ -210,52 +134,16 @@
(|spadThrow|))
(defun /READ (L Q)
-; (SETQ /EDIT-FN (OR (KAR L) /EDIT-FN))
-; (SETQ /EDIT-FT (OR (KAR (KDR L)) 'INPUT))
-; (SETQ /EDIT-FM (OR (KAR (KDR (KDR L))) '*))
-; (SETQ /EDITFILE (LIST /EDIT-FN /EDIT-FT /EDIT-FM))
(SETQ /EDITFILE L)
(COND
(Q (/RQ))
('T (/RF)) )
(|terminateSystemCommand|))
-(defun /EF (&rest foo)
- (|runCommand| (concat "vi " (namestring (make-input-filename /EDITFILE)))))
-
-(defun /EDIT (L)
- (SETQ /EDITFILE L)
- (/EF)
- (|terminateSystemCommand|))
-
-(defun /COMPINTERP (L OPTS)
- (SETQ /EDITFILE (/MKINFILENAM L))
- (COND ((EQUAL OPTS "rf") (/RF))
- ((EQUAL OPTS "rq") (/RQ))
- ('T (/RQ-LIB)))
- (|terminateSystemCommand|))
-
(defun |fin| ()
(SETQ *EOF* 'T)
(THROW 'SPAD_READER NIL))
-
-(defun STRINGREST (X) (if (EQ (SIZE X) 1) (make-string 0) (SUBSTRING X 1 NIL)))
-
-(defun STREAM2UC (STRM)
- (LET ((X (ELT (LASTATOM STRM) 1))) (SETF (ELT X 0) (LC2UC (ELT X 0)))))
-
-(defun GP2COND (L)
- (COND ((NOT L) (ERROR "GP2COND"))
- ((NOT (CDR L))
- (COND ((EQCAR (FIRST L) 'COLON)
- (CONS (SECOND L) (LIST (LIST T 'FAIL))))
- (T (LIST (LIST T (FIRST L)))) ))
- ((EQCAR (FIRST L) 'COLON) (CONS (CDAR L) (GP2COND (CDR L))))
- (T (ERROR "GP2COND"))))
-
-(FLAG JUNKTOKLIST 'KEY)
-
(defmacro |DomainSubstitutionMacro| (&rest L)
(|DomainSubstitutionFunction| (first L) (second L)))
@@ -291,76 +179,22 @@
(declare (special |$autoLine|))
(|tryToFit| (|saveState|) ,X)))
-(defun SETELTFIRST (A B C) (declare (ignore b)) (RPLACA A C))
-
-(defun SETELTREST (A B C) (declare (ignore b)) (RPLACD A C))
-
(DEFUN ASSOCIATER (FN LST)
(COND ((NULL LST) NIL)
((NULL (CDR LST)) (CAR LST))
((LIST FN (CAR LST) (ASSOCIATER FN (CDR LST))))))
-(defun ISLOCALOP-1 (IND)
- "Curindex points at character after '.'"
- (prog (selector buf termtok (NEWCHR (NEXTCHARACTER)))
- (if (TERMINATOR NEWCHR) (RETURN NIL))
- (setq SELECTOR
- (do ((x nil))
- (nil)
- (if (terminator newchr)
- (reverse x)
- (push (setq newchr (nextcharacter)) x))))
- (if (EQUAL NEWCHR '\.) (RETURN (ISLOCALOP-1 IND)))
- (setq BUF (|makeString| (LENGTH SELECTOR)))
- (mapc #'(lambda (x) (suffix x buf)) selector)
- (setq buf (copy-seq selector))
- (setq TERMTOK (INTERN BUF))
- (if (NOT (GET TERMTOK 'GENERIC)) (RETURN NIL))
- (if (OR (GET TERMTOK '|Led|) (GET TERMTOK '|Nud|))
- (GET TERMTOK IND))
- (return TERMTOK)))
; **** X. Random tables
(defvar $MARGIN 3)
-(defvar TEMPGENSYMLIST '(|s| |r| |q| |p|))
-(defvar ALPHLIST '(|a| |b| |c| |d| |e| |f| |g|))
-(defvar LITTLEIN " in ")
-(defvar INITALPHLIST ALPHLIST)
-(defvar INITXPARLST '(|i| |j| |k| |l| |m| |n| |p| |q|))
-(defvar PORDLST (COPY-tree INITXPARLST))
-(defvar INITPARLST '(|x| |y| |z| |u| |v| |w| |r| |s| |t|))
-(defvar LITTLEA '|a|)
-(defvar LITTLEI '|i|)
-(defvar ALLSTAR NIL)
(defvar PLUSS "+")
-(defvar PERIOD ".")
(defvar SLASH "/")
(defvar COMMA ",")
-(defvar LPAR "(")
-(defvar RPAR ")")
-(defvar EQSIGN "=")
(defvar DASH "-")
(defvar STAR "*")
(defvar DOLLAR "$")
(defvar COLON ":")
-(FLAG TEMPGENSYMLIST 'IS-GENSYM)
-
-
-;; NAME: DECIMAL-LENGTH
-;; PURPOSE: Computes number of decimal digits in print representation of x
-;; This should made as efficient as possible.
-
-(DEFUN DECIMAL-LENGTH (X)
- (LET* ((K (FIX (* #.(LOG 2.0 10.) (INTEGER-LENGTH X))))
- (X (TRUNCATE (ABS X) (EXPT 10 (1- K)))))
- (IF (< X 10) K (1+ K))))
-
-;(DEFUN DECIMAL-LENGTH2 (X)
-; (LET ((K (FIX (* #.(LOG 2.0 10.) (INTEGER-LENGTH X)))))
-; (IF (< (ABS X) (EXPT 10 K)) K (1+ K))))
-
-
;; function to create byte and half-word vectors in new runtime system 8/90
(defun |makeByteWordVec| (initialvalue)
@@ -375,15 +209,6 @@
:element-type (list 'mod (1+ n))
:initial-contents initialvalue)))
-(defun |knownEqualPred| (dom)
- (let ((fun (|compiledLookup| '= '((|Boolean|) $ $) dom)))
- (if fun (|getFunctionReplacement| (bpiname (car fun)))
- nil)))
-
-(defun |hashable| (dom)
- (|symbolMember?| (|knownEqualPred| dom)
- '(EQ EQL EQUAL)))
-
;; simpler interpface to RDEFIOSTREAM
(defun RDEFINSTREAM (&rest fn)
;; following line prevents rdefiostream from adding a default filetype
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 397bd16e..f28f5f8d 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -61,9 +61,6 @@ $cacheAlist := nil
$cacheCount := 0
++
-$compCount := 0
-
-++
$createUpdateFiles := false
++
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 002a8812..a6a0aa3a 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -342,7 +342,6 @@
(t (mapcar #'upcase l))))
(define-function 'U-CASE #'upcase)
-(define-function 'LC2UC #'upcase)
(defun downcase (l)
(cond ((stringp l) (string-downcase l))
@@ -914,9 +913,6 @@
(let ((*print-pretty* t) (*print-array* t))
(prin1 x stream)))
-(defun vmprint (x &optional (stream |$OutputStream|))
- (prin1 x stream) (terpri stream))
-
(defun tab (sint &optional (stream t))
(format stream "~vT" sint))