aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog4
-rw-r--r--src/boot/strap/tokens.clisp17
-rw-r--r--src/boot/tokens.boot2
-rw-r--r--src/interp/ax.boot2
-rw-r--r--src/interp/br-saturn.boot2
-rw-r--r--src/interp/c-doc.boot2
-rw-r--r--src/interp/g-opt.boot4
-rw-r--r--src/interp/g-util.boot2
-rw-r--r--src/interp/i-eval.boot2
-rw-r--r--src/interp/i-syscmd.boot24
-rw-r--r--src/interp/incl.boot2
-rw-r--r--src/interp/lisp-backend.boot2
-rw-r--r--src/interp/newfort.boot2
-rw-r--r--src/interp/postpar.boot2
-rw-r--r--src/interp/topics.boot6
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) ==