From c75b5923cb35d83910e45f13e9d15c981ea25387 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Thu, 20 Sep 2007 04:57:39 +0000 Subject: remove pamphlets - part 7 --- src/interp/pspad2.boot.pamphlet | 683 ---------------------------------------- 1 file changed, 683 deletions(-) delete mode 100644 src/interp/pspad2.boot.pamphlet (limited to 'src/interp/pspad2.boot.pamphlet') diff --git a/src/interp/pspad2.boot.pamphlet b/src/interp/pspad2.boot.pamphlet deleted file mode 100644 index 54e9a584..00000000 --- a/src/interp/pspad2.boot.pamphlet +++ /dev/null @@ -1,683 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp pspad2.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -)package "BOOT" - ---====================================================================== --- Constructor Transformation Functions ---====================================================================== -formatDeftranForm(form,tlist) == - [ttype,:atypeList] := tlist - if form is [":",f,t] then - form := f - ttype := t - if form is ['elt,a,b] then ----> a.b ====> apply(b,a) - form := - isTypeProbably? a => - atypeList := REVERSE atypeList - ["$$", b, a] - ["apply",a, b] - op := KAR form - argl := KDR form - if or/[t for t in atypeList] then - form := [op,:[(t => [":",a,t]; a) for a in argl for t in atypeList]] - if ttype then form := [":",form,ttype] - form - -formatDeftran(u,SEQflag) == - u is ['Join,:x] => formatDeftranJoin(u,SEQflag) - u is ['CATEGORY,kind,:l,x] => formatDeftran(['with,['SEQ,:l,['exit,n,x]]],SEQflag) - u is ['CAPSULE,:l,x] => formatDeftranCapsule(l,x,SEQflag) - u is [op,:.] and MEMQ(op,'(rep per)) => formatDeftranRepper(u,SEQflag) - u is [op,:.] and MEMQ(op,'(_: _:_: _pretend _@)) => - formatDeftranColon(u,SEQflag) - u is ['PROGN,:l,x] => formatDeftran(['SEQ,:l,['exit,1,x]],SEQflag) - u is ['SEQ,:l,[.,n,x]] => - v := [:l,x] - a := "APPEND"/[formatDeftranSEQ(x,true) for x in l] - b := formatDeftranSEQ(x,false) - if b is [:.,c] and c = '(void) then b := DROP(-1, b) - [:m,y] := [:a,:b] - ['SEQ,:m,['exit,n,y]] --- u is ['not,arg] and (op := LASSOC(KAR arg,'((_= . _^_=) (_< . _>_=)))) => --- formatDeftran([op,:CDR arg],nil) - u is ["^",a] => formatDeftran(['not,a],SEQflag) - u is ["exquo",a,b] => formatDeftran(['xquo,a,b],SEQflag) - u is ['IF,a,b,c] => - a := formatDeftran(a,nil) - b := formatDeftran(b,nil) - c := formatDeftran(c,nil) - null SEQflag and $insideDEF => - [:y,last] := formatDeftranIf(a,b,c) - ['SEQ,:y,['exit,1,last]] - ['IF,a,b,c] - u is ['Union,:argl] => - ['Union,:[x for a in argl - | x := (STRINGP a => [":",INTERN a,'Branch]; formatDeftran(a,nil))]] - u is [op,:itl,body] and MEMQ(op,'(REPEAT COLLECT)) and - ([nitl,:nbody] := formatDeftranREPEAT(itl,body)) => - formatDeftran([op,:nitl,nbody],SEQflag) - u is [":",a,b] => [":",formatDeftran(a,nil),formatDeftran(markMacroTran(b),nil)] - u is ["DEF",:.] => formatCapsuleFunction(u) - u is [op,:argl]=>[formatDeftran(op,nil),:[formatDeftran(x,nil) for x in argl]] - u = 'nil => 'empty - u - -formatCapsuleFunction ["DEF",form,tlist,b,body] == - $insideDEF : local := true - ["DEF", formatDeftran(form,nil),tlist,b,formatDeftran(body,nil)] - -formatDeftranCapsule(l,x,SEQflag) == - $insideCAPSULE: local := true - formatDeftran(['SEQ,:l,['exit,1,x]],SEQflag) - -formatDeftranRepper([op,a],SEQflag) == - a is [op1,b] and MEMQ(op1,'(rep per)) => - op = op1 => formatDeftran(a,SEQflag) - formatDeftran(b,SEQflag) - a is ["::",b,t] => - b := formatDeftran(b,SEQflag) - t := formatDeftran(t,SEQflag) - a := ["::",b,t] - op = 'per and t = "$" or op = 'rep and t = 'Rep => a - [op,a] - a is ['SEQ,:r] => ['SEQ,:[formatSeqRepper(op,x) for x in r]] - a is ['IF,p,b,c] => - formatDeftran(['IF,p,[op,b],[op, c]], SEQflag) - a is ['LET,a,b] => formatDeftran(['LET,a,[op,b]],SEQflag) - a is ['not,[op,a,b]] and (op1 := LASSOC(op,$pspadRelationAlist)) => - formatDeftran [op1,a,b] - a is ['return,n,r] => - MEMQ(opOf r,'(true false)) => a - ['return,n,[op,formatDeftran(r,SEQflag)]] - a is ['error,:.] => a - [op,formatDeftran(a,SEQflag)] - -formatDeftranColon([op,a,t],SEQflag) == --op is one of : :: pretend @ - a := formatDeftran(a,SEQflag) - t := formatDeftran(t,SEQflag) - a is ["UNCOERCE",b] => b - a is [op1,b,t1] and t1 = t and MEMQ(op,'(_: _:_: _pretend _@)) => - op1 = "pretend" or op = "pretend" => ["pretend",b,t] - null SEQflag and op1 = ":" or op = ":" => ["pretend",b,t] - a - a is [=op,b,t1] => - t1 = t => a - [op,b,t] - t = "$" => - a is ['rep,b] => b - a is ['per,b] => a - [op,a,t] - t = "Rep" => - a is ['per,b] => b - a is ['rep,b] => a - [op,a,t] - [op,a,t] - -formatSeqRepper(op,x) == - x is ['exit,n,y] => ['exit,n,[op,formatDeftran(y,nil)]] - x is ["=>",a,b] => ["=>",formatDeftran(a,nil),[op,formatDeftran(b,nil)]] - atom x => x - [formatSeqRepper(op,y) for y in x] - -formatDeftranJoin(u,SEQflag) == - ['Join,:cats,lastcat] := u - lastcat is ['CATEGORY,kind,:l,x] => - cat := - CDR cats => ['Join,:cats] - first cats - formatDeftran(['with,cat,['SEQ,:l,['exit,1,x]]],SEQflag) - u - -formatENUM ['MyENUM, x] == format "'" and format x and format "'" - -formatDeftranREPEAT(itl,body) == ---do nothing unless "itl" contains UNTIL statements - u := [x for x in itl | x is ["UNTIL",p]] or return nil - nitl := SETDIFFERENCE(itl,u) - pred := MKPF([p for ['UNTIL,p] in u],'or) - cond := ['IF,pred,['leave,n,nil],'noBranch] - nbody := - body is ['SEQ,:l,[.,n,x]] => ['SEQ,:l,x,['exit,n,cond]] - ['SEQ,body,['exit,n,cond]] - [nitl,:nbody] - -formatDeftranSEQ(x,flag) == - u := formatDeftran(x,flag) - u is ['SEQ,:.] => rest u - [u] - -formatDeftranIf(a,b,c) == - b = 'noBranch => - a is [op,:r] and (al := '((_= . _~_=) (_< . _>_=) (_> . _<_=)); - iop := LASSOC(op, al) or rassoc(op, al)) => - [["=>",[iop, :r],c]] - a is [op,r] and MEMQ(op,'(NOT not NULL null)) => - [["=>", r, c]] - [["=>", ['not, a], c]] - post := - c = 'noBranch => nil - c is ['SEQ,:.] => CDR c - [c] - [["=>",a,b],:post] - -formatWHERE ["where",a,b] == - $insideTypeExpression: local := nil - $insideCAPSULE: local := false - tryBreak(formatLeft("format",a,"where","Led") and format " where ",b,"where","Led") - ---====================================================================== --- Special Handlers: Categories ---====================================================================== -formatATTRIBUTE ['ATTRIBUTE,att] == format att - -formatDeftranCategory ['CATEGORY,kind,:items,item] == ["SEQ",:items,["exit",1,item]] - -formatCategory ['Category] == format " " and format "Category" - -formatCATEGORY cat == - con := opOf $form - $comments: local := SUBST('_$,'_%,GETDATABASE(con,'DOCUMENTATION)) - $insideEXPORTS : local := true - format ["with",formatDeftranCategory cat] - -formatSIGNATURE ['SIGNATURE,op,types,:r] == - MEMQ('constant,r) => format op and format ": " and (u := format first types) and - formatSC() and formatComments(u,op,types) - format op and format ": " and (u := format ['Mapping,:types]) and formatSC() and - formatComments(u,op,types) - -formatDefault ["default",a] == - $insideCategoryIfTrue : local := false - $insideCAPSULE: local := true - $insideTypeExpression: local := false - tryBreak(format "default ",a,"with","Nud") ---====================================================================== --- Special Handlers: Control Structures ---====================================================================== -formatUNCOERCE ['UNCOERCE,x] == format x - -formatIF ['IF,a,b,c] == - c = 'noBranch => formatIF2(a,b,"if ") - b = 'noBranch => formatIF ['IF,['not,a],c,'noBranch] - formatIF2(a,b,"if ") and newLine() and formatIF3 c - -formatIF2(a,b,prefix) == - tryBreakNB(format prefix and format a and format " then ",b,"then","Nud") - -formatIF3 x == - x is ['IF,a,b,c] => - c = 'noBranch => tryBreak(format "else if " - and format a and format " then ",b,"then","Nud") - formatIF2(a,b,"else if ") and newLine() and formatIF3 c - tryBreak(format "else ",x,"else","Nud") - -formatBlock(l,x) == - null l => format x - $pilesAreOkHere: local - format "{ " and format first l and - (and/[formatSC() and format y for y in rest l]) - and formatSC() and format x and format " }" - -formatExit ["exit",.,u] == format u - -formatvoid ["void"] == format "()" - -formatLeave ["leave",.,u] == format "break" - -formatCOLLECT u == formatSpill("formatCOLLECT1",u) - -formatCOLLECT1 ["COLLECT",:iteratorList,body] == - $pilesAreOkHere: local - format "[" and format body and format " " and - formatSpill("formatIteratorTail",iteratorList) - -formatIteratorTail iteratorList == - formatIterator first iteratorList and - (and/[format " " and formatIterator x for x in rest iteratorList]) and format "]" - ---====================================================================== --- Special Handlers: Keywords ---====================================================================== - -formatColon [":",a,b] == - b is ['with,c,:d] => formatColonWith(a,c,d) - if not $insideTypeExpression then - insideCat() => nil - format - $insideDEF => "local " - "default " - op := - $insideCAPSULE and not $insideDEF => ": " - insideCat() => ": " - ":" - b := (atom b => b; markMacroTran b) - a is ['LISTOF,:c] => formatComma c and format ": " and formatLocal1 b - formatInfix(op,[a, b],formatOpBindingPower(":","Led","left"), - formatOpBindingPower(":","Led","right")) - -formatColonWith(form,a,b) == - con := opOf $form - $comments: local := SUBST('_$,'_%,GETDATABASE(con,'DOCUMENTATION)) - $insideEXPORTS : local := true - $pilesAreOkHere: local := true - $insideTypeExpression : local := false - b => tryBreak(formatDefForm form and format ": " - and format a and format " with ",first b,"with","Led") - tryBreak(formatDefForm form and format ": with ",a,"with","Nud") - -formatCOND ["COND",:l] == - originalC:= $c - and/[x is [a,[.,.,b]] for x in l] => - (originalC=$m or indent() and newLine()) and first l is [a,[.,.,b]] and - formatIfExit(a,b) and - (and/[newLine() and formatIfExit(a,b) for [a,[.,.,b]] in rest l]) and (originalC=$m or undent()) and originalC - formatIfThenElse l - -formatPROGN ["PROGN",:l] == - l is [:u,x] => formatPiles(u,x) - error '"formatPROGN" - -formatELT ["ELT",a,b] == formatApplication [a,b] - -formatCONS ["CONS",a,b] == - $pilesAreOkHere: local - format "[" and formatConstructItem a and formatTail b - -formatTail x == - null x => format "]" - format "," and formatTail1 x - -formatTail1 x == - x is ["CONS",a,b] => formatConstructItem a and formatTail b - x is ["APPEND",a,b] => - null b => formatConstructItem a and format "]" - format ":" and formatConstructItem a and formatTail b - format ":" and formatConstructItem x and format "]" - --- x = "." => format " " -formatConstructItem x == format x - -formatLET ["LET",a,b] == - $insideTypeExpression: local := true - a = "Rep" or atom a and constructor? opOf b => - tryBreakNB(formatAtom a and format " == ",b,":=","Led") - tryBreakNB((IDENTP a => formatAtom a; format a) and format " := ",b,":=","Led") - -formatIfExit(a,b) == - --called from SCOND or COND only - $numberOfSpills: local:= 0 - curMargin:= $m - curMarginStack:= $currentMarginStack - $doNotResetMarginIfTrue:= true - format a and format " => " and formatRight("formatCut",b,"=>","Led") => - ($currentMarginStack:= curMarginStack; $m:= curMargin) - -formatIfThenElse x == formatSpill("formatIf1",x) - -formatIf1 x == - x is [[a,:r],:c] and null c => - b:= - r is [:l,s] and l => ['SEQ,:l,['exit,.,s]] - first r - isTrue a => format b - format "if " and format a and format " then " and format b - format "if " and format a and - (try - (format " then " and format b and format " else " - and formatIfThenElse c) or spillLine() - and format " then " and format b and --- ($c:= $m:= $m+6) and - ($numberOfSpills:= $numberOfSpills-1) - and spillLine() and format " else " and formatIfThenElse c) - -formatQUOTE ["QUOTE",x] == format "('" and format x and format ")" - -formatMI ["MI",a,b] == format a - -formatMapping ['Mapping,target,:sources] == - $noColonDeclaration: local := true - formatTuple ['Tuple,:sources] and format " -> " and format target - -formatTuple ['Tuple,:types] == - null types => format "()" - null rest types => format first types - formatFunctionCallTail types - -formatConstruct(['construct,:u]) == - format "[" and (null u or format first u and - "and"/[format "," and formatCut x for x in rest u]) and format "]" - -formatNextConstructItem x == - try format x or ($m := $m + 2) and newLine() and format x - -formatREPEAT ["REPEAT",:iteratorList,body] == - tryBreakNB(null iteratorList or (formatIterator first iteratorList and - (and/[format " " and formatIterator x for x in rest iteratorList]) and format " ") - and format "repeat ",body,"repeat","Led") - -formatFATARROW ["=>",a,b] == tryBreak(format a and format " => ",b,"=>","Led") - -formatMap ["+->",a,b] == - $noColonDeclaration: local := true - tryBreak(format a and format " +-> ", b, "+->","Led") - -formatREDUCE ["REDUCE",op,.,u] == formatReduce1(op,u) - -formatreduce ["reduce",op,u] == formatReduce1(op,u) - -formatReduce1(op,u) == - if STRINGP op then op := INTERN op - id := LASSOC(op, - '((_+ Zero)(_* One)(append . NIL)(gcd Zero) (lcm One) (strconc . "")(lcm One))) - formatFunctionCall - id => ['reduce,op,u,id] - ['reduce,op,u] - -formatIterator u == - $noColonDeclaration : local := true - u is ["IN",x,y] => - format "for " and formatLeft("format",x,"in","Led") and format " in " and - formatRight("format",y,"in","Led") - u is ["WHILE",x] => format "while " and formatRight("format",x,"while","Nud") - u is ["UNTIL",x] => format "until " and formatRight("format",x,"until","Nud") - u is ["|",x] => format "| " and formatRight("format",x,"|","Led") - u is ["STEP",i,init,step,:v] => - final := IFCAR v - format "for " and formatLeft("format",i,"in","Led") and format " in " and - (seg := ['SEGMENT,init,final]) and (formatStepOne? step => format seg; formatBy ['by,seg,step]) - error "formatIterator" - -formatStepOne? step == - step = 1 or step = '(One) => true - step is [op,n,.] and MEMQ(op,'(_:_: _@)) => n = 1 or n = '(One) - false - -formatBy ['by,seg,step] == format seg and format " by " and format step - -formatSCOND ["SCOND",:l] == - $pilesAreOkHere => - --called from formatPileLine or formatBlock - --if from formatPileLine - initialC:= $c - and/[x is [a,["exit",.,b]] for x in l] => - first l is [a,["exit",.,b]] and formatIfExit(a,b) and - (and/[newLine() and formatIfExit(a,b) for [a,["exit",.,b]] in rest l]) and initialC - formatIfThenElse l and initialC - and/[x is [a,["exit",.,b]] for x in l] => - first l is [a,["exit",.,b]] and formatIfExit(a,b) and - (and/[format "; " and formatIfExit(a,b) for [a,["exit",.,b]] in rest l]) and $c - --warning: and/(...) returns T if there are no entries - formatIfThenElse l - -formatSEGMENT ["SEGMENT",a,b] == - $pilesAreOkHere: local - (if pspadBindingPowerOf("right",a)<750 then formatPren a else format a) and - formatInfixOp ".." and - (null b and $c or - (if 750>pspadBindingPowerOf("left",b) then formatPren b else format b)) - -formatSexpr x == - atom x => - null x or IDENTP x => consBuffer ident2PrintImage PNAME x - consBuffer x - spill("formatNonAtom",x) - -formatNonAtom x == - format "_(" and formatSexpr first x and - (and/[format " " and formatSexpr y for y in rest x]) - and (y:= LASTATOM x => format " . " - and formatSexpr y; true) and format "_)" - -formatCAPSULE ['CAPSULE,:l,x] == - $insideCAPSULE: local := true - try formatBlock(l,x) or formatPiles(l,x) or spillLine() and formatBlock(l,x) - -formatPAREN [.,:argl] == formatFunctionCallTail argl - -formatSEQ ["SEQ",:l,[.,.,x]] == - try formatBlock(l,x) or formatPiles(l,x) or spillLine() and formatBlock(l,x) - ---====================================================================== --- Comment Handlers ---====================================================================== -formatCOMMENT ["COMMENT",x,marg,startXY,endXY,commentStack] == - $commentsToPrint:= [[marg,startXY,endXY,commentStack],:$commentsToPrint] - format x - -formatComments(u,op,types) == - $numberOfSpills :local := $commentIndentation/2 - 1 - not $insideEXPORTS => u - alist := LASSOC(op,$comments) or - sayBrightly ['"No documentation for ",op] - return u - ftypes := SUBLISLIS($FormalMapVariableList,rest $form,types) - consComments(LASSOC(ftypes,alist),'"++ ") - u - -consComments(s,plusPlus) == - s is [word,:r] and null atom r => consComments(r, plusPlus) - s := first s - null s => nil - s := consCommentsTran s - indent() and newLine() or return nil - columnsLeft := $lineLength - $m - 2 - while (m := MAXINDEX s) >= columnsLeft repeat - k := or/[i for i in (columnsLeft - 1)..1 by -1 | s.i = $charBlank] - k := (k => k + 1; columnsLeft) - piece := SUBSTRING(s,0,k) - formatDoCommentLine [plusPlus,piece] - s := SUBSTRING(s,k,nil) - formatDoCommentLine [plusPlus,s] - undent() - $m - -consCommentsTran s == - m := MAXINDEX s - k := or/[i for i in 0..(m - 7) | substring?('"\spad{",s,i)] => - r := charPosition(char '_},s,k + 6) - r = m + 1 => s - STRCONC(SUBSTRING(s,0,k),'"`",SUBSTRING(s,k+6,r-k-6),'"'",consCommentsTran SUBSTRING(s,r+1,nil)) - s - -formatDoCommentLine line == - $lineBuffer := consLineBuffer [nBlanks $c,:line] - $c := $m+2*$numberOfSpills - ---====================================================================== --- Pile Handlers ---====================================================================== -formatPreferPile y == - y is ["SEQ",:l,[.,.,x]] => - (u:= formatPiles(l,x)) => u - formatSpill("format",y) - formatSpill("format",y) - -formatPiles(l,x) == - $insideTypeExpression : local := false - not $pilesAreOkHere => nil - originalC:= $c - lines:= [:l,x] - --piles must begin at margin - originalC=$m or indent() and newLine() or return nil - null (formatPileLine($m,first lines,false)) => nil - not (and/[formatPileLine($m,y,true) for y in rest lines]) => nil - (originalC=$m or undent()) and originalC --==> brace - -formatPileLine($m,x,newLineIfTrue) == - if newLineIfTrue then newLine() or return nil - $numberOfSpills: local:= 0 - $newLineWritten := nil - format x and (x is ['SIGNATURE,:.] or $rightBraceFlag => $c; formatSC()) - and (x is ['DEF,:.] and optNewLine() or $c) - ---====================================================================== --- Utility Functions ---====================================================================== -nBlanks m == "STRCONC"/[char('_ ) for i in 1..m] - -isNewspadOperator op == GET(op,"Led") or GET(op,"Nud") - -isTrue x == x="true" or x is '(QUOTE T) - -nary2Binary(u,op) == - u is [a,b,:t] => (t => nary2Binary([[op,a,b],:t],op); [op,a,b]) - errhuh() - -string2PrintImage s == - u:= GETSTR (2*SIZE s) - for i in 0..MAXINDEX s repeat - (if MEMQ(s.i,'(_( _{ _) _} _! _")) then - SUFFIX('__,u); u:= SUFFIX(s.i,u)) - u - -ident2PrintImage s == - m := MAXINDEX s - if m > 1 and s.(m - 1) = $underScore then s := STRCONC(SUBSTRING(s,0,m-1),s.m) - u:= GETSTR (2*SIZE s) - if not (ALPHA_-CHAR_-P s.(0) or s.(0)=char '"$") then SUFFIX('__,u) - u:= SUFFIX(s.(0),u) - for i in 1..MAXINDEX s repeat - if not (DIGITP s.i or ALPHA_-CHAR_-P s.i or ((c := s.i) = char '?) - or (c = char '_!)) then SUFFIX('__,u) - u:= SUFFIX(s.i,u) - INTERN u - -isIdentifier x == - IDENTP x => - s:= PNAME x - #s = 0 => nil - ALPHA_-CHAR_-P s.(0) => and/[s.i^=char '" " for i in 1..MAXINDEX s] - #s>1 => - or/[ALPHA_-CHAR_-P s.i for i in 1..(m:= MAXINDEX s)] => - and/[s.i^=char '" " for i in 1..m] => true - -isGensym x == - s := STRINGIMAGE x - n := MAXINDEX s - s.0 = char '_G and and/[DIGITP s.i for i in 1..n] - ---====================================================================== --- Macro Helpers ---====================================================================== -tryToFit(s,x) == ---% try to format on current line; see macro try in file PSPADAUX LISP - --returns nil if unable to format stuff in x on a single line - x => ($back:= rest $back; $c) - restoreState() - nil - -restoreState(:options) == - back := IFCAR options or $back - [ - [$lineBuffer, $lineFragmentBuffer,$comments,$marginStack,$braceStack,$DEFdepth, - $bc,$c,$m,$commentsToPrint,$numberOfSpills,flags], :back] - := back - if null options then $back := back - [$newLineWritten, $autoLine, $rightBraceFlag, - $semicolonFlag,$insideDEF,$insideTypeExpression,$pilesAreOkHere, - $insideEXPORTS, $insideCAPSULE, $insideCategoryIfTrue, - $doNotResetMarginIfTrue,$noColonDeclaration] - := flags - nil - -saveState(:options) == - flags := - [$newLineWritten, $autoLine, $rightBraceFlag, - $semicolonFlag,$insideDEF,$insideTypeExpression,$pilesAreOkHere, - $insideEXPORTS, $insideCAPSULE, $insideCategoryIfTrue, - $doNotResetMarginIfTrue,$noColonDeclaration] - newState := - [ - [$lineBuffer, $lineFragmentBuffer,$comments,$marginStack,$braceStack,$DEFdepth, - $bc,$c,$m,$commentsToPrint,$numberOfSpills,flags], :$back] - if not KAR options then $back := newState - newState - -formatSC() == - $pileStyle or $semicolonFlag => $c - format "; " - -wrapBraces(x,y,z) == y - -formatLB() == - $pileStyle => $c - $numberOfSpills := - $c > $lineLength / 2 => $braceIndentation/3 - 1 - $braceIndentation/2 - 1 - format "{" - -restoreC() == --used by macro "embrace" - originalC := CAR $braceStack - $braceStack := CDR $braceStack - formatRB originalC - -saveC() == --used by macro "embrace" - $braceStack := [$c,:$braceStack] - -saveD() == --used by macro "embrace" - $braceStack := [$c,:$braceStack] - -restoreD() == --used by macro "indentNB" - originalC := CAR $braceStack - $braceStack := CDR $braceStack - originalC - -formatRB(originalC) == --called only by restoreC - while $marginStack and $m > originalC repeat undent() - if $m < originalC then $marginStack := [originalC,:$marginStack] - $m := originalC - $pileStyle => $m - newLine() and format "}" and $m --==> brace - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} -- cgit v1.2.3