From 406b6c0a38ee0e9ea1ba6657b76391f1c15f0b95 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sat, 16 Feb 2008 04:52:45 +0000
Subject: 	* interp/unlisp.lisp (|CatchAsCan|): Tidy. 	*
 interp/sys-utility.boot (delete): Fix thinko. 	* interp/sys-globals.boot
 ($sourceFiles): Define here. 	(INPUTSTREAM): Likewise. 	*
 interp/i-syscmd.boot (UNDERBAR): Move to sys-globals.boot. 	*
 interp/fname.lisp: Import "macros". 	* interp/debug.lisp: Import "parsing".
 	Replace $PRETTYPRINT with $PrettyPrint. 	(/FN): Define. 
 (depthAlist): Likewise. 	* interp/br-search.boot (docSearch1): Fix
 thinko. 	* interp/Makefile.pamphlet (debug.$(FASLEXT)): Depend on 
 parsing.$(FASLEXT). 	* interp/i-output.boot (starstarcond): Remove used
 function. 	(transcomparg): Likewise. 	(MATBORCH): Define here. 
 (*TALLPAR): Likewise. 	* interp/vmlisp.lisp (|char|): Remove duplicate
 definition.

---
 src/interp/Makefile.in        |  2 +-
 src/interp/Makefile.pamphlet  |  2 +-
 src/interp/br-search.boot     |  2 +-
 src/interp/compiler.boot      |  2 +-
 src/interp/debug.lisp         | 42 ++++++++++++++++++++++++++---------------
 src/interp/fname.lisp         |  3 ++-
 src/interp/i-output.boot      | 44 +++++++------------------------------------
 src/interp/i-syscmd.boot      |  2 --
 src/interp/lisplib.boot       |  2 +-
 src/interp/patches.lisp       |  2 --
 src/interp/setvart.boot       |  2 +-
 src/interp/spad.lisp          |  8 +++-----
 src/interp/sys-constants.boot |  5 ++++-
 src/interp/sys-globals.boot   |  7 +++++++
 src/interp/sys-utility.boot   |  2 +-
 src/interp/unlisp.lisp        |  3 +--
 src/interp/vmlisp.lisp        |  4 ----
 17 files changed, 58 insertions(+), 76 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 1ccb76b5..cabc92d7 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -622,7 +622,7 @@ daase.$(FASLEXT): daase.lisp macros.$(FASLEXT) foam_l.$(FASLEXT)
 spaderror.$(FASLEXT): spaderror.lisp macros.$(FASLEXT)
 	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
 
-debug.$(FASLEXT): debug.lisp macros.$(FASLEXT)
+debug.$(FASLEXT): debug.lisp macros.$(FASLEXT) parsing.$(FASLEXT)
 	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
 
 spad.$(FASLEXT): spad.lisp bootlex.$(FASLEXT)
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index 23192b9c..6e4ff654 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -936,7 +936,7 @@ daase.$(FASLEXT): daase.lisp macros.$(FASLEXT) foam_l.$(FASLEXT)
 spaderror.$(FASLEXT): spaderror.lisp macros.$(FASLEXT)
 	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
 
-debug.$(FASLEXT): debug.lisp macros.$(FASLEXT)
+debug.$(FASLEXT): debug.lisp macros.$(FASLEXT) parsing.$(FASLEXT)
 	$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
 
 spad.$(FASLEXT): spad.lisp bootlex.$(FASLEXT)
diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot
index 55d449e5..3cc6fd86 100644
--- a/src/interp/br-search.boot
+++ b/src/interp/br-search.boot
@@ -562,7 +562,7 @@ docSearch1(filter,doc) ==
   docSearchAlist := searchDropUnexposedLines doc
   count := searchCount docSearchAlist
   count = 0 => emptySearchPage('"entry",filter,true)
-  count = 1 => showNamedConstruct(or/[x for x in docSearchAlist | CADR x],1)
+  count = 1 => showNamedConstruct(or/[x for x in docSearchAlist | CADR x])
   prefix := pluralSay(count,'"entry matches",'"entries match")
   emfilter := ['"{\em ",escapeSpecialChars STRINGIMAGE filter,'"}"]
   header := [:prefix,'" ",:emfilter]
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 0a59bdcf..a215cbf9 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1129,7 +1129,7 @@ compileNot(x,m,e) ==
   -- do this special case here.
   [xcode, xmode, xtrueEnv, xfalseEnv] := compBoolean(y, $Boolean, e)
      or return nil
-  convert([["NOT", xcode], $Boolean, xfalseEnv], m)
+  convert([["NOT", xcode], xmode, xfalseEnv], m)
  
 
 --% Case
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index dbf35df7..8eeef9b1 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -44,6 +44,7 @@
 ; PURPOSE: Debugging hooks for Boot code
 
 (import-module "macros") 
+(import-module "parsing")
 (in-package "BOOT")
 
 (defvar S-SPADKEY NIL) ;" this is augmented by MAKESPADOP"
@@ -54,7 +55,7 @@
 (DEFVAR CURSTRM *TERMINAL-IO*)
 (DEFVAR /TRACELETNAMES ())
 (DEFVAR /PRETTY () "controls pretty printing of trace output")
-(SETANDFILEQ /ECHO NIL) ;;"prevents echo of SPAD or BOOT code with /c"
+(defparameter /ECHO NIL) ;;"prevents echo of SPAD or BOOT code with /c"
 (MAKEPROP 'LISP '/TERMCHR '(#\  #\())
 (MAKEPROP 'LSP '/TERMCHR '(#\  #\())
 (MAKEPROP 'META '/TERMCHR '(#\:  #\())
@@ -99,6 +100,8 @@
  
 (defun /COMP () (if (fboundp 'COMP) 'COMP 'COMP370))
  
+(defvar /fn nil)
+
 (DEFUN /D-1 (L OP EFLG TFLG)
   (CATCH 'FILENAM
     (PROG (TO OPTIONL OPTIONS FNL INFILE OUTSTREAM FN )
@@ -280,7 +283,7 @@
         (OR (KAR (KAR (KDR DEF))) NIL)
         OP)
       (COND
-        ( (OR /ECHO $PRETTYPRINT)
+        ( (OR /ECHO $|PrettyPrint|)
           (PRETTYPRINT DEF OUTPUTSTREAM) ) )
       (COND
         ( (EQ oft 'LISP)
@@ -333,11 +336,15 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
                             (or (get type '/termchr) '(#\space ))))))))
  
 (define-function '|/D,1| #'/D-1)
+
+(defvar /UPDATESTREAM nil)
+
  
 (DEFUN /INITUPDATES (/VERSION)
-   (SETQ FILENAME (STRINGIMAGE /VERSION))
-   (SETQ /UPDATESTREAM (open (strconc "/tmp/update." FILENAME) :direction :output
-                             :if-exists :append :if-does-not-exist :create))
+  (LET ((FILENAME (STRINGIMAGE /VERSION)))
+       (SETQ /UPDATESTREAM (open (strconc "/tmp/update." FILENAME) 
+			      :direction :output
+			      :if-exists :append :if-does-not-exist :create)))
    (PRINTEXP
  "       Function Name                    Filename             Date   Time"
       /UPDATESTREAM)
@@ -388,7 +395,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
 ;;;If A disk is not read-write, then issue msg and return.
 ;;;If /UPDATESTREAM not set or current /UPDATES file doesnt exist, initialize.
  
-   (PROG (IFT KEY RECNO ORECNO DATE TIME)
+   (PROG (IFT KEY RECNO ORECNO DATE TIME DATETIME)
 ;         (if (EQ 0 /VERSION) (RETURN NIL))
          (if (EQ 'INPUT FT) (RETURN NIL))
          (if (NOT |$createUpdateFiles|) (RETURN NIL))
@@ -468,7 +475,8 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
   (PROG (U FNVAL COUNTNAM TRACECODE BEFORE AFTER CONDITION
          TRACENAME CALLER VARS BREAK FROM_CONDITION VARBREAK TIMERNAM
          ONLYS G WITHIN_CONDITION  DEPTH_CONDITION COUNT_CONDITION
-         LETFUNCODE MATHTRACE )
+         LETFUNCODE MATHTRACE |$traceNoisely|)
+	(declare (special |$traceNoisely|))
         (if (member FN /TRACENAMES :test #'eq) (/UNTRACE-2 FN NIL))
         (SETQ OPTIONS (OPTIONS2UC OPTIONS))
         (if (AND |$traceDomains| (|isFunctor| FN) (ATOM FN))
@@ -655,7 +663,8 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
 (DEFUN /UNTRACE-REDUCE (X) (if (ATOM X) X (first X))) ; (CAR X) is now a domain
  
 (DEFUN /UNTRACE-2 (X OPTIONS)
- (let (u y)
+ (let (u y |$traceNoisely|)
+   (declare (special |$traceNoisely|))
   (COND ((AND (|isFunctor| X) (ATOM X))
          (|untraceDomainConstructor| X))
         ((OR (|isDomainOrPackage| (SETQ U X))
@@ -744,6 +753,8 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
        (INTEGERP (parse-integer (symbol-name X) :start 1))))
  
 (DEFUN MONITOR-GETVALUE (N FG)
+  (PROG (/VALUE /caller /args /name)
+	(declare (special /value /caller /args /name))
   (COND ((= N 0)
          (if FG
              (MKQ /VALUE)
@@ -751,7 +762,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
         ((= N 9) (MKQ /CALLER))
         ((<= N (SIZE /ARGS)) (MKQ (ELT /ARGS (1- N))))
         ((|spadThrowBrightly| (LIST 'function '|%b| /NAME '|%d|
-                              "does not have" '|%b| N '|%d| "arguments")))))
+                              "does not have" '|%b| N '|%d| "arguments"))))))
  
 (DEFUN MONITOR-PRINARGS (L CODE /TRANSFORM)
   (let (N)
@@ -953,6 +964,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
         (RETURN G1)))
 
 (defvar |$TraceFlag| t)
+(defvar |depthAlist| nil)
  
 (defun /MONITORX (/ARGS FUNCT OPTS &AUX NAME TYPE TRACECODE COUNTNAM TIMERNAM
                         BEFORE AFTER CONDITION BREAK TRACEDMODEMAP
@@ -1072,12 +1084,12 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
    (RPLACA PAIR (BPITRACE (CAR PAIR) ALIAS )) NIL)
  
 (defun BPITRACE (BPI ALIAS &optional OPTIONS)
-  (SETQ NEWNAME (GENSYM))
-  (IF (identp bpi) (setq bpi (symbol-function bpi)))
-  (SET NEWNAME BPI)
-  (SETF (symbol-function NEWNAME) BPI)
-  (/TRACE-0 (APPEND (LIST NEWNAME (LIST 'ALIAS ALIAS)) OPTIONS))
-  NEWNAME)
+  (let ((NEWNAME (GENSYM)))
+    (IF (identp bpi) (setq bpi (symbol-function bpi)))
+    (SET NEWNAME BPI)
+    (SETF (symbol-function NEWNAME) BPI)
+    (/TRACE-0 (APPEND (LIST NEWNAME (LIST 'ALIAS ALIAS)) OPTIONS))
+    NEWNAME))
  
 (defun BPIUNTRACE (X ALIAS) (/UNTRACE-0 (LIST X (LIST 'ALIAS ALIAS))))
  
diff --git a/src/interp/fname.lisp b/src/interp/fname.lisp
index 926aba92..a3c622d5 100644
--- a/src/interp/fname.lisp
+++ b/src/interp/fname.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007, Gabriel Dos Reis.
+;; Copyright (C) 2007-2008, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -38,6 +38,7 @@
 ;; Created: June 20, 1991 (Stephen Watt)
 ;; 
 
+(import-module "macros")
 (in-package "BOOT")
 
 ;; E.g.  "/"  "/u/smwatt"  "../src"
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index b9f6e3d4..52073696 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -208,6 +208,11 @@ $specialCharacterAlist == '(
   (bslash . 16)_
   )
 
+
+MATBORCH == '"*"
+
+_*TALLPAR := false
+
 $collectOutput := nil
 
 $algebraOutputStream :=
@@ -1850,20 +1855,6 @@ appsub(u, x, y, d) ==
   temparg3 := APP(CADR u, x, y, d)
   appagg(CDDR u, temparg1, temparg2, temparg3)
 
-starstarcond(l, iforwhen) ==
-    null l => l
-    EQ((a := CAAR l), 1) =>
-       LIST('CONCAT, CADR first l, '" OTHERWISE")
-    EQCAR(a, 'COMPARG) =>
-      starstarcond(CONS(transcomparg(CADR a),  rest l), iforwhen)
-    null rest l =>
-      LIST('CONCAT, CADR first l,
-           LIST('CONCAT, iforwhen, CAAR l))
-    true => LIST('VCONCAT,
-                 starstarcond(CONS(first l, nil), iforwhen),
-                 LIST('VCONCAT, '"  ",
-                      starstarcond(rest l, iforwhen)))
-
 eq0(u) == 0
 
 height(u) ==
@@ -1992,7 +1983,6 @@ boxLApp(u, x, y, d) ==
   a := superspan u.1+1
   b := subspan u.1+1
   w := MAX(lw, 2 + WIDTH u.1)
-  -- next line used to have h instead of lh
   top := y + a + lh
   d := appvertline(MATBORCH, x, y - b, top, d)
   d := appHorizLine(x + 1, x + w, top, d)
@@ -2001,7 +1991,7 @@ boxLApp(u, x, y, d) ==
   nil or
      lw < w => d := appvertline(MATBORCH, x + lw + 1, y + a, top - 1, d)
   d := APP(u.1, 2 + x, y, d)
-  d := appHorizLine(x + 1, x + w, y - b, top, d)
+  d := appHorizLine(x + 1, x + w, y - b, d)
   d := appvertline(MATBORCH, x + w + 1, y - b, top, d)
 
 boxSub(x) ==
@@ -2357,26 +2347,6 @@ superSubSuper u ==
 suScWidth u ==
   WIDTH u.1 + aggwidth CDDR u
 
-transcomparg(x) ==
-  y := first x
-  args := first _*NTH(STANDARGLIST, 1 + LENGTH y)
-  repeat
-    if true then
-       null y => return(nil)
-       (atom first y) and member(first y, FRLIS_*) =>
-            conds := CONS(LIST('EQUAL1, first args, first y), conds)
-            y := SUBST(first args, first y, y)
-            x := SUBST(first args, first y, x)
-       (first y = first args) => nil
-       true => conds := CONS(LIST('EQUAL1, first args, first y), conds)
-    y := rest y
-    args := rest args
-  conds :=
-       null conds => rest CADR x
-       ANDSIMP(CONS('AND, APPEND(REVERSEWOC conds,
-                                         LIST(rest CADR x) ) ) )
-  LIST((conds => conds; true => 1), CADR rest x)
-
 vconcatapp(u, x, y, d) ==
   w := vConcatWidth u
   y := y + superspan u.1 + 1
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index c738fda3..6a942e06 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -46,8 +46,6 @@ $existingFiles := MAKE_-HASHTABLE "UEQUAL"
 
 $SYSCOMMANDS := [CAR x for x in $systemCommands]
 
-UNDERBAR == '"__"
-
 $NonNullStream ==
   '"NonNullStream"
 
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 8f46262c..5c75ede6 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -277,7 +277,7 @@ compileConstructorLib(l,op,editFlag,traceFlag) ==
   res
  
 compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) ==
-  $PRETTYPRINT: local := 'T
+  $PrettyPrint: local := 'T
   $LISPLIB: local := 'T
   $lisplibAttributes: local := NIL
   $lisplibPredicates: local := NIL
diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp
index 8a882005..5bce910d 100644
--- a/src/interp/patches.lisp
+++ b/src/interp/patches.lisp
@@ -176,8 +176,6 @@
        (READSPADEXPR))
       (t (|parseTransform| (|postTransform| (|string2SpadTree| line)))))))
 
-(setq |$sourceFiles| ()) ;; set in readSpad2Cmd
-
 (define-function 'SUBSTQ #'SUBSTEQ) ;; needed for substNames (always copy)
 #+(and :lucid (not :ibm/370))
  (define-function 'RUN-AIX-PROGRAM #'SYS:RUN-AIX-PROGRAM)
diff --git a/src/interp/setvart.boot b/src/interp/setvart.boot
index 2ddc7bcf..e2c3ca28 100644
--- a/src/interp/setvart.boot
+++ b/src/interp/setvart.boot
@@ -1639,7 +1639,7 @@ $setOptions := '(
      "prettyprint BOOT func's as they compile"
      development
      LITERALS
-     $PRETTYPRINT
+     $PrettyPrint
      (on off)
      off)
    ))
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index e8ceeec2..21b3d8b8 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -71,8 +71,6 @@
 (defvar |$HiFiAccess| nil "if true maintain history file")
 (defvar |$mapReturnTypes| nil)
 
-(defvar INPUTSTREAM t "bogus initialization for now")
-
 (defvar |boot-NewKEY| NIL)
 
 (DEFVAR _ '&)
@@ -386,7 +384,9 @@
       (REMFLAG |boot-NewKEY| 'KEY)
       INPUTSTREAM))
 
-(defun INITIALIZE () (init-boot/spad-reader) (initialize-preparse INPUTSTREAM))
+(defun INITIALIZE () 
+  (init-boot/spad-reader)
+  (initialize-preparse INPUTSTREAM))
 
 (setq *prompt* 'new)
 
@@ -456,7 +456,6 @@
     (return TERMTOK)))
 ; **** X. Random tables
 
-(defvar MATBORCH "*")
 (defvar $MARGIN 3)
 (defvar TEMPGENSYMLIST '(|s| |r| |q| |p|))
 (defvar ALPHLIST '(|a| |b| |c| |d| |e| |f| |g|))
@@ -467,7 +466,6 @@
 (defvar INITPARLST '(|x| |y| |z| |u| |v| |w| |r| |s| |t|))
 (defvar LITTLEA '|a|)
 (defvar LITTLEI '|i|)
-(defvar *TALLPAR NIL)
 (defvar ALLSTAR NIL)
 (defvar PLUSS "+")
 (defvar PERIOD ".")
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index 0f008f5a..5a9196ec 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -629,3 +629,6 @@ _*ATTRIBUTES_* ==
 
 +++
 BLANK == '" "
+
+++
+UNDERBAR == '"__"
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index eb642e79..4d326287 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -442,3 +442,10 @@ $useRepresentationHack := true
 
 ++
 $insideCanCoerceFrom := nil
+
+++
+$sourceFiles := []
+
+++ ??? bogus initialization for now
+INPUTSTREAM := "T"
+
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index ab20480b..faf4708d 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -53,7 +53,7 @@ delete(item,sequence) ==
   SYMBOLP item => 
     REMOVE(item,sequence,KEYWORD::TEST,function EQ)
   atom item and not ARRAYP item =>
-    REMOVE(item,SEQUENCE)
+    REMOVE(item,sequence)
   REMOVE(item,sequence,KEYWORD::TEST,function EQUALP)
 
 ++ returns true if `x' is contained in `y'.
diff --git a/src/interp/unlisp.lisp b/src/interp/unlisp.lisp
index fcef6fd0..146a27ce 100644
--- a/src/interp/unlisp.lisp
+++ b/src/interp/unlisp.lisp
@@ -66,8 +66,7 @@
 
 #-:Lucid 
 (defmacro |CatchAsCan| (tagvar expr)
-  `(progn 
-      (setq ,tagvar nil) 
+  `(let ((,tagvar nil))
       ,expr ))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index b70d317e..4be165ea 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -101,10 +101,6 @@
 #+:CCL
 (defun bintp (n) (and (integerp n) (not (fixp n))))
 
-(defmacro |char| (x)
-  (if (and (consp x) (eq (car x) 'quote)) (character (cadr x))
-    `(character ,x)))
-
 (defmacro closedfn (form)
  `(function ,form))
 
-- 
cgit v1.2.3