aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-09-10 22:09:28 +0000
committerdos-reis <gdr@axiomatics.org>2007-09-10 22:09:28 +0000
commitef3f39b528532d50813b8754c8ca6ff3fce4f710 (patch)
tree33ab580b4d422f3ad5f6c0511ec141b68baf4831 /src/interp
parent4c3b04a147779490fe4d0550eed178a8e5abda4c (diff)
downloadopen-axiom-ef3f39b528532d50813b8754c8ca6ff3fce4f710.tar.gz
* i-output.boot.pamphlet ($defaultSpecialCharacters): Define as
constant. ($plainSpecialCharacters0): Likewise. ($plainSpecialCharacters1): Likewise. ($plainSpecialCharacters2): Likewise. ($plainSpecialCharacters3): Likewise. ($plainRTspecialCharacters): Likewise. ($RTspecialCharacters): Likewise. ($specialCharacterAlist): Likewise. (makeCharacter): Define as macro. (leftBindingPowerOf): Move from macros.lisp.pamphlet. Define as Boot code. (rightBindingPowerOf): Likewise. * patches.lisp.pamphlet (|$specialCharacters|): Don't set here. * Makefile.pamphlet (<<i-output.clisp>>): Remove. * Makefile.in: Regenerate. * macros.lisp.pamphlet (ELEMN): Move to g-util.boot.pamphlet. (|leftBindingPowerOf|): Move to i-output.boot.pamphlet. (|rightBindingPowerOf|): Likewise.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/ChangeLog22
-rw-r--r--src/interp/Makefile.in4
-rw-r--r--src/interp/Makefile.pamphlet10
-rw-r--r--src/interp/g-util.boot.pamphlet5
-rw-r--r--src/interp/i-output.boot.pamphlet53
-rw-r--r--src/interp/macros.lisp.pamphlet11
-rw-r--r--src/interp/patches.lisp.pamphlet1
7 files changed, 60 insertions, 46 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
index 3e3e8447..43c20c12 100644
--- a/src/interp/ChangeLog
+++ b/src/interp/ChangeLog
@@ -1,3 +1,25 @@
+2007-09-10 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * i-output.boot.pamphlet ($defaultSpecialCharacters): Define as
+ constant.
+ ($plainSpecialCharacters0): Likewise.
+ ($plainSpecialCharacters1): Likewise.
+ ($plainSpecialCharacters2): Likewise.
+ ($plainSpecialCharacters3): Likewise.
+ ($plainRTspecialCharacters): Likewise.
+ ($RTspecialCharacters): Likewise.
+ ($specialCharacterAlist): Likewise.
+ (makeCharacter): Define as macro.
+ (leftBindingPowerOf): Move from macros.lisp.pamphlet. Define as
+ Boot code.
+ (rightBindingPowerOf): Likewise.
+ * patches.lisp.pamphlet (|$specialCharacters|): Don't set here.
+ * Makefile.pamphlet (<<i-output.clisp>>): Remove.
+ * Makefile.in: Regenerate.
+ * macros.lisp.pamphlet (ELEMN): Move to g-util.boot.pamphlet.
+ (|leftBindingPowerOf|): Move to i-output.boot.pamphlet.
+ (|rightBindingPowerOf|): Likewise.
+
2007-09-09 Gabriel Dos Reis <gdr@cs.tamu.edu>
* Makefile.pamphlet (DEP): Adjust path to comp.lisp.
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 7978cb3c..3027455a 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -663,10 +663,6 @@ info.clisp: info.boot
@ echo 329 making $@ from $<
@ echo '(progn (old-boot::boot "info.boot"))' | ${DEPSYS}
-i-output.clisp: i-output.boot
- @ echo 307 making $@ from $<
- @ echo '(progn (old-boot::boot "i-output.boot"))' | ${DEPSYS}
-
i-resolv.clisp: i-resolv.boot
@ echo 310 making $@ from $<
@ echo '(progn (old-boot::boot "i-resolv.boot"))' | ${DEPSYS}
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index 583bb05d..165922ab 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -1520,14 +1520,6 @@ i-map.clisp: i-map.boot
@ echo '(progn (old-boot::boot "i-map.boot"))' | ${DEPSYS}
@
-\subsection{i-output.boot}
-
-<<i-output.clisp>>=
-i-output.clisp: i-output.boot
- @ echo 307 making $@ from $<
- @ echo '(progn (old-boot::boot "i-output.boot"))' | ${DEPSYS}
-@
-
\subsection{i-resolv.boot}
<<i-resolv.clisp>>=
@@ -2109,8 +2101,6 @@ $(AUTO)/%.$(FASLEXT): %.$(FASLEXT)
<<info.clisp>>
-<<i-output.clisp>>
-
<<i-resolv.clisp>>
<<i-spec1.clisp>>
diff --git a/src/interp/g-util.boot.pamphlet b/src/interp/g-util.boot.pamphlet
index deaf2b5c..05e262c8 100644
--- a/src/interp/g-util.boot.pamphlet
+++ b/src/interp/g-util.boot.pamphlet
@@ -54,6 +54,11 @@
--% Utility Functions of General Use
+ELEMN(x, n, d) ==
+ null x => d
+ n = 1 => car x
+ ELEMN(cdr x, SUB1 n, d)
+
PPtoFile(x, fname) ==
stream := DEFIOSTREAM([['MODE, :'OUTPUT], ['FILE, :fname]], 80, 0)
PRETTYPRINT(x, stream)
diff --git a/src/interp/i-output.boot.pamphlet b/src/interp/i-output.boot.pamphlet
index bb0d87b1..431d0b63 100644
--- a/src/interp/i-output.boot.pamphlet
+++ b/src/interp/i-output.boot.pamphlet
@@ -70,6 +70,9 @@ and should be restored when the GCL bug is fixed.
<<*>>=
<<license>>
+import '"sys-macros"
+)package "BOOT"
+
--Modified JHD February 1993: see files miscout.input for some tests of this
-- General principle is that maprin0 is the top-level routine,
-- which calls maprinChk to print the object (placing certain large
@@ -79,7 +82,7 @@ and should be restored when the GCL bug is fixed.
--% Output display routines
-SETANDFILEQ($defaultSpecialCharacters,[
+$defaultSpecialCharacters == [
EBCDIC( 28), -- upper left corner
EBCDIC( 27), -- upper right corner
EBCDIC( 30), -- lower left corner
@@ -97,9 +100,9 @@ SETANDFILEQ($defaultSpecialCharacters,[
EBCDIC( 61), -- left box tee
EBCDIC( 44), -- center box tee
EBCDIC(224) -- back slash
- ])
+ ]
-SETANDFILEQ($plainSpecialCharacters0,[
+$plainSpecialCharacters0 == [
EBCDIC( 78), -- upper left corner (+)
EBCDIC( 78), -- upper right corner (+)
EBCDIC( 78), -- lower left corner (+)
@@ -117,9 +120,9 @@ SETANDFILEQ($plainSpecialCharacters0,[
EBCDIC( 78), -- left box tee (+)
EBCDIC( 78), -- center box tee (+)
EBCDIC(224) -- back slash
- ])
+ ]
-SETANDFILEQ($plainSpecialCharacters1,[
+$plainSpecialCharacters1 == [
EBCDIC(107), -- upper left corner (,)
EBCDIC(107), -- upper right corner (,)
EBCDIC(125), -- lower left corner (')
@@ -137,9 +140,9 @@ SETANDFILEQ($plainSpecialCharacters1,[
EBCDIC( 78), -- left box tee (+)
EBCDIC( 78), -- center box tee (+)
EBCDIC(224) -- back slash
- ])
+ ]
-SETANDFILEQ($plainSpecialCharacters2,[
+$plainSpecialCharacters2 == [
EBCDIC( 79), -- upper left corner (|)
EBCDIC( 79), -- upper right corner (|)
EBCDIC( 79), -- lower left corner (|)
@@ -157,9 +160,9 @@ SETANDFILEQ($plainSpecialCharacters2,[
EBCDIC( 78), -- left box tee (+)
EBCDIC( 78), -- center box tee (+)
EBCDIC(224) -- back slash
- ])
+ ]
-SETANDFILEQ($plainSpecialCharacters3,[
+$plainSpecialCharacters3 == [
EBCDIC( 96), -- upper left corner (-)
EBCDIC( 96), -- upper right corner (-)
EBCDIC( 96), -- lower left corner (-)
@@ -177,9 +180,9 @@ SETANDFILEQ($plainSpecialCharacters3,[
EBCDIC( 78), -- left box tee (+)
EBCDIC( 78), -- center box tee (+)
EBCDIC(224) -- back slash
- ])
+ ]
-SETANDFILEQ($plainRTspecialCharacters,[
+$plainRTspecialCharacters == [
'_+, -- upper left corner (+)
'_+, -- upper right corner (+)
'_+, -- lower left corner (+)
@@ -197,11 +200,11 @@ SETANDFILEQ($plainRTspecialCharacters,[
'_+, -- left box tee (+)
'_+, -- center box tee (+)
'_\ -- back slash
- ])
+ ]
-makeCharacter n == INTERN(STRING(CODE_-CHAR n))
+makeCharacter n ==> INTERN(STRING(CODE_-CHAR n))
-SETANDFILEQ($RTspecialCharacters,[
+$RTspecialCharacters == [
makeCharacter 218, -- upper left corner (+)
makeCharacter 191, -- upper right corner (+)
makeCharacter 192, -- lower left corner (+)
@@ -219,11 +222,11 @@ SETANDFILEQ($RTspecialCharacters,[
makeCharacter 195, -- left box tee (+)
makeCharacter 197, -- center box tee (+)
'_\ -- back slash
- ])
+ ]
-SETANDFILEQ($specialCharacters,$RTspecialCharacters)
+$specialCharacters := $RTspecialCharacters
-SETANDFILEQ($specialCharacterAlist, '(
+$specialCharacterAlist == '(
(ulc . 0)_
(urc . 1)_
(llc . 2)_
@@ -241,7 +244,7 @@ SETANDFILEQ($specialCharacterAlist, '(
(ltee . 14)_
(ctee . 15)_
(bslash . 16)_
- ))
+ )
$collectOutput := nil
@@ -806,6 +809,16 @@ appInfixArg(u,x,y,d,prec,leftOrRight,string) ==
if string then d:= appconc(d,x,y,string)
[d,(insertPrensIfTrue => x+2; x)]
+leftBindingPowerOf(x, ind) ==
+ y := GETL(x, ind)
+ y => ELEMN(y, 3, 0)
+ 0
+
+rightBindingPowerOf(x, ind) ==
+ y := GETL(x, ind)
+ y => ELEMN(y, 4, 105)
+ 105
+
getBindingPowerOf(key,x) ==
--binding powers can be found in file NEWAUX LISP
x is ['REDUCE,:.] => (key='left => 130; key='right => 0)
@@ -923,7 +936,7 @@ putWidth u ==
0=interSpace and infixArgNeedsParens(firstArg,leftPrec,"right")=>
2+WIDTH firstArg
WIDTH firstArg
- widthFirstArg + +/[interSpace+w for x in restArg] where w ==
+ widthFirstArg + +/[interSpace+w for x in restArg] where w() ==
0=interSpace and infixArgNeedsParens(x, rightPrec, "left") =>
2+WIDTH x
WIDTH x
@@ -1467,7 +1480,7 @@ getOutputAbbreviatedForm form ==
u:= constructor? op or op
null argl => u
ml:= getPartialConstructorModemapSig(op)
- argl:= [fn for x in argl for m in ml] where fn ==
+ argl:= [fn for x in argl for m in ml] where fn() ==
categoryForm?(m) => outputDomainConstructor x
x' := coerceInteractive(objNewWrap(x,m),$OutputForm)
x' => objValUnwrap x'
diff --git a/src/interp/macros.lisp.pamphlet b/src/interp/macros.lisp.pamphlet
index 1cd2f731..e1a67392 100644
--- a/src/interp/macros.lisp.pamphlet
+++ b/src/interp/macros.lisp.pamphlet
@@ -327,11 +327,6 @@ This version is needed so that (COLLECT (IN X Y) ... (RETURN 'JUNK))=>JUNK."
; 15.2 Lists
-(defun ELEMN (X N DEFAULT)
- (COND ((NULL X) DEFAULT)
- ((EQL N 1) (CAR X))
- ((ELEMN (CDR X) (SUB1 N) DEFAULT))))
-
(defmacro TL (&rest L) `(tail . ,L))
@@ -827,12 +822,6 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size
(defun |deleteWOC| (item list) (lisp::delete item list :test #'equal))
-(DEFUN |leftBindingPowerOf| (X IND &AUX (Y (GETL X IND)))
- (IF Y (ELEMN Y 3 0) 0))
-
-(DEFUN |rightBindingPowerOf| (X IND &AUX (Y (GETL X IND)))
- (IF Y (ELEMN Y 4 105) 105))
-
;;---- Added by WFS.
(proclaim '(ftype (function (t t) t) |subWord|)) ;hack for bug in akcl-478
diff --git a/src/interp/patches.lisp.pamphlet b/src/interp/patches.lisp.pamphlet
index 82977f1f..82961a1e 100644
--- a/src/interp/patches.lisp.pamphlet
+++ b/src/interp/patches.lisp.pamphlet
@@ -221,7 +221,6 @@ previous definition.
(define-function 'SUBSTQ #'SUBSTEQ) ;; needed for substNames (always copy)
#+(and :lucid (not :ibm/370))
(define-function 'RUN-AIX-PROGRAM #'SYS:RUN-AIX-PROGRAM)
-(setq |$specialCharacters| |$plainRTspecialCharacters|)
;; following should be no longer necessary
;; (eval-when (eval load compile) (shadow 'delete))
;; (define-function 'boot::delete #'|delete|)