diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/interp/ChangeLog | 22 | ||||
| -rw-r--r-- | src/interp/Makefile.in | 4 | ||||
| -rw-r--r-- | src/interp/Makefile.pamphlet | 10 | ||||
| -rw-r--r-- | src/interp/g-util.boot.pamphlet | 5 | ||||
| -rw-r--r-- | src/interp/i-output.boot.pamphlet | 53 | ||||
| -rw-r--r-- | src/interp/macros.lisp.pamphlet | 11 | ||||
| -rw-r--r-- | src/interp/patches.lisp.pamphlet | 1 |
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|) |