From 1d71a43cca77e1576cc1568298d5886a60c9b884 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Wed, 19 Sep 2007 15:30:04 +0000 Subject: 2007-09-19 Gabriel Dos Reis * Makefile.pamphlet (all-interpsys): Now depend on all-depsys. src/interp/ 2007-09-19 Gabriel Dos Reis * util.lisp.pamphlet ($directory-list): Move to sys-globals.boot. ($library-directory-list): Likewise. * spad.lisp.pamphlet: Import "bootlex". * preparse.lisp.pamphlet: Import "fnewmeta". * postprop.lisp: Import "macros". * postpar.boot.pamphlet: Import "postprop". * nlib.lisp.pamphlet (rdefiostream): Define unconditionally. (get-io-index-stream): Likewise. (makedir): Likewise. (get-directory-list): Don't use $current-diretory. ($filetype-table): Move to sys-constants.boot. * patches.lisp.pamphlet ($current-directory): Remove. (|cd|): Simplify implementation. * newaux.lisp.pamphlet: Import "macros". (|PARSE-NewKEY|): Define. * metalex.lisp: Move various file, line, stack, character utilities to here. * macros.lisp.pamphlet (NREVERSE0): Move to sys-macros.lisp. Tidy. * fnewmeta.lisp.pamphlet: Import "parsing". * comp.lisp: Import "macros". * def.lisp: Likewise. (B-MDEF): Fix thinko. * bootlex.lisp: Import "preparse", "def", and "nlib". (BOOT-LINE-STACK): Move to metalex.lisp. (NEXT-LINES-CLEAR): Likewise. (NEXT-LINES-SHOW): Likewise. (XCAPE): Likewise. (KEYWORDS): Likewise. * Makefile.pamphlet (${DEPSYS}): Now have all Lisp in compiled form and load them. * bookvol5.pamphlet ($current-directory): Remove. --- src/interp/macros.lisp.pamphlet | 31 ++++++++++--------------------- 1 file changed, 10 insertions(+), 21 deletions(-) (limited to 'src/interp/macros.lisp.pamphlet') diff --git a/src/interp/macros.lisp.pamphlet b/src/interp/macros.lisp.pamphlet index c9234dcd..2799b0e9 100644 --- a/src/interp/macros.lisp.pamphlet +++ b/src/interp/macros.lisp.pamphlet @@ -214,13 +214,6 @@ ends up being [[CONTAINED |$EmptyMode| Y]]. "Needed by spadCompileOrSetq" 1) - -#-:CCL -(defun NREVERSE0 (X) ; Already built-in to CCL - "Returns LST, reversed. The argument is modified. -This version is needed so that (COLLECT (IN X Y) ... (RETURN 'JUNK))=>JUNK." - (if (ATOM X) X (NREVERSE X))) - ; 7.8.4 Mapping @@ -732,12 +725,6 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (defmacro |do| (&rest args) (CONS 'PROGN args)) (defun DROPTRAILINGBLANKS (LINE) (string-right-trim " " LINE)) - -; # Gives the number of elements of a list, 0 for atoms. -; If we quote it, then an interpreter trip is necessary every time -; we call #, and this costs us - 4% in the RATINT DEMO." - -(define-function '\# #'SIZE) (defun print-and-eval-defun (name body) (eval body) @@ -797,7 +784,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (defun compile-defun (name body) (eval body) (compile name)) -(defun |deleteWOC| (item list) (lisp::delete item list :test #'equal)) +(defun |deleteWOC| (item list) (delete item list :test #'equal)) ;;---- Added by WFS. @@ -892,14 +879,14 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (defun |applyWithOutputToString| (func args) ;; returns the cons of applying func to args and a string produced ;; from standard-output while executing. - (let* ((*standard-output* (make-string-output-stream)) - (curoutstream *standard-output*) - (*terminal-io* *standard-output*) - (|$algebraOutputStream| *standard-output*) - (erroroutstream *standard-output*) + (let* ((out-stream (make-string-output-stream)) + (curoutstream out-stream) + (|$algebraOutputStream| out-stream) + (erroroutstream out-stream) val) - (declare (special *standard-output* curoutstream - *terminal-io* |$algebraOutputStream|)) + (declare (special curoutstream |$algebraOutputStream|)) + (setq *standard-output* out-stream) + (setq *terminal-io* out-stream) (setq val (catch 'spad_reader (catch 'TOP_LEVEL (apply (symbol-function func) args)))) @@ -980,6 +967,8 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size ))) +(defvar HT nil) + (defun markhash (key n) (progn (cond ((equal n 3) (remhash key ht)) ('t (hput ht key n)) ) nil)) -- cgit v1.2.3