From 5986d1ca9a814c4c7da81cebd3fb152e4592036e Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sat, 16 Apr 2011 14:51:48 +0000 Subject: * boot/tokens.boot (shoeIdChar): Accept "!" too. --- src/ChangeLog | 4 ++++ src/boot/strap/tokens.clisp | 17 ++++++++++------- src/boot/tokens.boot | 2 +- src/interp/ax.boot | 2 +- src/interp/br-saturn.boot | 2 +- src/interp/c-doc.boot | 2 +- src/interp/g-opt.boot | 4 ++-- src/interp/g-util.boot | 2 +- src/interp/i-eval.boot | 2 +- src/interp/i-syscmd.boot | 24 ++++++++++++------------ src/interp/incl.boot | 2 +- src/interp/lisp-backend.boot | 2 +- src/interp/newfort.boot | 2 +- src/interp/postpar.boot | 2 +- src/interp/topics.boot | 6 +++--- 15 files changed, 41 insertions(+), 34 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index ab07af01..9c754c8e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2011-04-16 Gabriel Dos Reis + + * boot/tokens.boot (shoeIdChar): Accept "!" too. + 2011-04-14 Gabriel Dos Reis * interp/msgdb.boot: Use stringChar more often. diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 3ba257e5..6d251628 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -13,7 +13,8 @@ (DEFUN |shoeIdChar| (|x|) (OR (ALPHANUMERICP |x|) - (MEMBER |x| (LIST (|char| '|'|) (|char| '?) (|char| '%))))) + (MEMBER |x| + (LIST (|char| '|'|) (|char| '?) (|char| '%) (|char| '!))))) (DEFUN |subString| (|s| |f| &OPTIONAL (|n| NIL)) (COND @@ -211,11 +212,12 @@ (LIST '|copy| 'COPY) (LIST '|croak| 'CROAK) (LIST '|digit?| 'DIGIT-CHAR-P) (LIST '|drop| 'DROP) (LIST '|exit| 'EXIT) (LIST '|false| 'NIL) - (LIST '|first| 'CAR) (LIST '|fourth| 'CADDDR) - (LIST '|function| 'FUNCTION) (LIST '|gensym| 'GENSYM) - (LIST '|genvar| 'GENVAR) (LIST '|integer?| 'INTEGERP) - (LIST '|lastNode| 'LAST) (LIST 'LAST '|last|) - (LIST '|list| 'LIST) + (LIST '|first| 'CAR) (LIST '|float?| 'FLOATP) + (LIST '|fourth| 'CADDDR) (LIST '|function| 'FUNCTION) + (LIST '|function?| 'FUNCTIONP) + (LIST '|gensym| 'GENSYM) (LIST '|genvar| 'GENVAR) + (LIST '|integer?| 'INTEGERP) (LIST '|lastNode| 'LAST) + (LIST 'LAST '|last|) (LIST '|list| 'LIST) (LIST '|lowerCase?| 'LOWER-CASE-P) (LIST '|makeSymbol| 'INTERN) (LIST '|mkpf| 'MKPF) (LIST '|nconc| 'NCONC) @@ -231,7 +233,8 @@ (LIST '|readOnly?| 'CONSTANTP) (LIST '|removeDuplicates| 'REMDUP) (LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE) - (LIST '|sameObject?| 'EQ) (LIST '|second| 'CADR) + (LIST '|sameObject?| 'EQ) (LIST '|scalarEqual?| 'EQL) + (LIST '|second| 'CADR) (LIST '|setDifference| 'SETDIFFERENCE) (LIST '|setIntersection| 'INTERSECTION) (LIST '|setPart| 'SETELT) (LIST '|setUnion| 'UNION) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index c4cf1664..307da560 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -44,7 +44,7 @@ shoeStartsId x == alphabetic? x or x in [char "$", char "?", char "%"] shoeIdChar x == - alphanumeric? x or x in [char "'", char "?", char "%"] + alphanumeric? x or x in [char "'", char "?", char "%", char "!"] ++ return the sub-string of `s' starting from `f'. ++ When non-nil, `n' designates the length of the sub-string. diff --git a/src/interp/ax.boot b/src/interp/ax.boot index 19bd6154..6f3fe6bd 100644 --- a/src/interp/ax.boot +++ b/src/interp/ax.boot @@ -244,7 +244,7 @@ axFormatOpList ops == ['Sequence,:[axFormatOp o for o in ops]] axOpTran(name) == atom name => name = 'elt => 'apply - name = 'setelt => 'set_! + name = 'setelt => 'set! name = 'SEGMENT => ".." name = 1 => '_1 name = 0 => '_0 diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index 08ad1bb9..72babbea 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -319,7 +319,7 @@ isBreakSegment?(line, k, n) == line.k = char "{" => 6 substring?('"table",line,k - 3) => 5 nil - char2 = (char '_!) => 7 + char2 = char "!" => 7 char2 = char 'b => substring?('"begin",line,k) => 8 nil diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 41450e08..2e57a549 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -642,7 +642,7 @@ newWordFrom(l,i,m) == checkAddPeriod s == --No, just leave blank at the end (rdj: 10/18/91) m := MAXINDEX s lastChar := s . m - lastChar = char '_! or lastChar = char '_? or lastChar = char '_. => s + lastChar = char "!" or lastChar = char '_? or lastChar = char '_. => s lastChar = char '_, or lastChar = char '_; => s . m := (char '_.) s diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 46faf47b..2c529ec3 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -457,7 +457,7 @@ $VMsideEffectFreeOperators == ++ List of simple VM operators $simpleVMoperators == append($VMsideEffectFreeOperators, - ['STRINGIMAGE,'FUNCALL,'%gensym, '%lreverse_!, + ['STRINGIMAGE,'FUNCALL,'%gensym, '%lreverse!, '%strstc,"MAKE-FULL-CVEC","BVEC-MAKE-FULL"]) ++ Return true if the `form' is semi-simple with respect to @@ -620,7 +620,7 @@ optBind form == usedSymbol?(var,rest inits) => ok := false -- no dependency, please. body := third form canInlineVarDefinition(var,expr,body) and isSimpleVMForm expr => - third(form) := substitute_!(expr,var,body) + third(form) := substitute!(expr,var,body) inits := rest inits ok := false null inits => third form -- no local var left diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 89aceabc..6e5da354 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -836,7 +836,7 @@ $charComma == char '_, $charPeriod == char '_. $checkPrenAlist := [[char '_(,:char '_)],[char '_{,:char '_}],[char '_[,:char '_]]] $charEscapeList:= [char '_%,char '_#,$charBack] -$charIdentifierEndings := [char '__, char '_!, char '_?] +$charIdentifierEndings := [char '__, char "!", char '_?] $charSplitList := [$charComma,$charPeriod,char '_[, char '_],$charLbrace, $charRbrace, char '_(, char '_), char '_$, char '_%] $charDelimiters := [$charBlank, char '_(, char '_), $charBack] $HTspadmacros := '("\spadtype" "\spadcommand" "\spadop" "\spadfun" "\spadatt" "\spadsyscom" "\spad" "\s") diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index 67b076fa..adbcf313 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -277,7 +277,7 @@ evalForm(op,opName,argl,mmS) == sideEffectedArg?(t,sig,opName) == opString := symbolName opName - (opName ~= 'setelt) and (opString.(#opString-1) ~= char '_!) => nil + (opName ~= 'setelt) and (opString.(#opString-1) ~= char "!") => nil dc := first sig t = dc diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 378d8059..0722bef6 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -2017,7 +2017,7 @@ writify ob == qcdr := rest ob (name := spadClosure? ob) => d := writifyInner rest ob - nob := ['WRITIFIED_!_!, 'SPADCLOSURE, d, name] + nob := ['WRITIFIED!!, 'SPADCLOSURE, d, name] HPUT($seen, ob, nob) HPUT($seen, nob, nob) nob @@ -2034,7 +2034,7 @@ writify ob == vector? ob => isDomainOrPackage ob => d := mkEvalable devaluate ob - nob := ['WRITIFIED_!_!, 'DEVALUATED, writifyInner d] + nob := ['WRITIFIED!!, 'DEVALUATED, writifyInner d] HPUT($seen, ob, nob) HPUT($seen, nob, nob) nob @@ -2045,15 +2045,15 @@ writify ob == for i in 0..n repeat vectorRef(nob, i) := writifyInner vectorRef(ob,i) nob - ob = 'WRITIFIED_!_! => - ['WRITIFIED_!_!, 'SELF] + ob = 'WRITIFIED!! => + ['WRITIFIED!!, 'SELF] -- In CCL constructors are also compiled functions, so we -- need this line: constructor? ob => ob COMPILED_-FUNCTION_-P ob => THROW('writifyTag, 'writifyFailed) HASHTABLEP ob => - nob := ['WRITIFIED_!_!] + nob := ['WRITIFIED!!] HPUT($seen, ob, nob) HPUT($seen, nob, nob) keys := HKEYS ob @@ -2064,7 +2064,7 @@ writify ob == [writifyInner HGET(ob,k) for k in keys]] nob PLACEP ob => - nob := ['WRITIFIED_!_!, 'PLACE] + nob := ['WRITIFIED!!, 'PLACE] HPUT($seen, ob, nob) HPUT($seen, nob, nob) nob @@ -2074,12 +2074,12 @@ writify ob == THROW('writifyTag, 'writifyFailed) -- Default case: return the object itself. string? ob => - sameObject?(ob, $NullStream) => ['WRITIFIED_!_!, 'NULLSTREAM] - sameObject?(ob, $NonNullStream) => ['WRITIFIED_!_!, 'NONNULLSTREAM] + sameObject?(ob, $NullStream) => ['WRITIFIED!!, 'NULLSTREAM] + sameObject?(ob, $NonNullStream) => ['WRITIFIED!!, 'NONNULLSTREAM] ob FLOATP ob => ob = READ_-FROM_-STRING STRINGIMAGE ob => ob - ['WRITIFIED_!_!, 'FLOAT, ob,: + ['WRITIFIED!!, 'FLOAT, ob,: MULTIPLE_-VALUE_-LIST INTEGER_-DECODE_-FLOAT ob] ob @@ -2110,7 +2110,7 @@ spadClosure? ob == dewritify ob == (not ScanOrPairVec(function is?, ob) - where is? a == a = 'WRITIFIED_!_!) => ob + where is? a == a = 'WRITIFIED!!) => ob $seen: local := hashTable 'EQ @@ -2119,10 +2119,10 @@ dewritify ob == null ob => nil e := HGET($seen, ob) => e - cons? ob and first ob = 'WRITIFIED_!_! => + cons? ob and first ob = 'WRITIFIED!! => type := ob.1 type = 'SELF => - 'WRITIFIED_!_! + 'WRITIFIED!! type = 'BPI => oname := ob.2 f := diff --git a/src/interp/incl.boot b/src/interp/incl.boot index f0eca48e..b2e9ca78 100644 --- a/src/interp/incl.boot +++ b/src/interp/incl.boot @@ -118,7 +118,7 @@ incCommands := $inputLineNumber := nil incClassify(s) == - $inputLineNumber = 0 and incPrefix?('"#_!",0,s) => + $inputLineNumber = 0 and incPrefix?('"#!",0,s) => [true,0,'"magicNumber"] not incCommand? s => [false,0, '""] i := 1; n := #s diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index eee7acd5..e992553c 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -563,7 +563,7 @@ for x in [ ['%lfirst, :'CAR], ['%llength, :'LIST_-LENGTH], ['%lreverse, :'REVERSE], - ['%lreverse_!,:'NREVERSE], + ['%lreverse!, :'NREVERSE], ['%lsecond, :'CADR], ['%lthird, :'CADDR], ['%pair?, :'CONSP], diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index e85042a9..e5c92359 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -741,7 +741,7 @@ currentSP () == $currentSubprogram or "MAIN" updateSymbolTable(name,type) == - fun := ['$elt,'SYMS,'declare_!] + fun := ['$elt,'SYMS,'declare!] coercion := ['_:_:,STRING type,'FST] $insideCompileBodyIfTrue: local := false interpret([fun,["QUOTE",name],coercion]) diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index 596a3c49..cf5f60e7 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -305,7 +305,7 @@ postForm u == u:= postTranList u if u is [["%Comma",:.],:.] then postError ['" ",:bright u, - '"is illegal because tuples cannot be applied_!",'"%l", + '"is illegal because tuples cannot be applied!",'"%l", '" Did you misuse infix dot?"] u x is [.,["%Comma",:y]] => [first x,:y] diff --git a/src/interp/topics.boot b/src/interp/topics.boot index 0a87eb00..0f2091f0 100644 --- a/src/interp/topics.boot +++ b/src/interp/topics.boot @@ -35,7 +35,7 @@ import macros namespace BOOT $topicsDefaults := '( - (basic elt setelt qelt qsetelt eval xRange yRange zRange map map_! qsetelt_!) + (basic elt setelt qelt qsetelt eval xRange yRange zRange map map! qsetelt!) (conversion coerce convert retract) (hidden retractIfCan Zero One) (predicate _< _=) @@ -44,7 +44,7 @@ $topicsDefaults := '( (hyperbolic acosh acoth acsch asech asinh atanh cosh coth csch sech sinh tanh) (destructive setelt qsetelt) (extraction xRange yRange zRange elt qelt) - (transformation map map_!)) + (transformation map map!)) $topicSynonyms := '( (b . basic) @@ -146,7 +146,7 @@ string2OpAlist s == getDefaultProps name == u := HGET($defaultsHash,name) if (s := PNAME name).(m := MAXINDEX s) = char '? then u := ['p,:u] - if s.m = char '_! then u := ['destructive,:u] + if s.m = char "!" then u := ['destructive,:u] u skipBlanks(u,i,m) == -- cgit v1.2.3