* boot/tokens.boot (shoeIdChar): Accept "!" too.

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  <gdr@cs.tamu.edu>
+
+	* boot/tokens.boot (shoeIdChar): Accept "!" too.
+
 2011-04-14  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* 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) ==