diff options
55 files changed, 217 insertions, 209 deletions
diff --git a/src/algebra/sex.spad.pamphlet b/src/algebra/sex.spad.pamphlet index 2c0a019d..cf7d13fb 100644 --- a/src/algebra/sex.spad.pamphlet +++ b/src/algebra/sex.spad.pamphlet @@ -96,6 +96,7 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where Body ==> add import %integer?: % -> Boolean from Foreign Builtin import %string?: % -> Boolean from Foreign Builtin + import %ident?: % -> Boolean from Foreign Builtin import %pair?: % -> Boolean from Foreign Builtin import %peq: (%,%) -> Boolean from Foreign Builtin import %head: % -> % from Foreign Builtin @@ -130,13 +131,13 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where list? b == pair? b or null? b string? b == %string? b - symbol? b == IDENTP(b)$Lisp + symbol? b == %ident? b integer? b == %integer? b float? b == RNUMP(b)$Lisp destruct b == (list? b => b pretend List %; error "Non-list") string b == (%string? b => b pretend Str; error "Non-string") - symbol b == (IDENTP(b)$Lisp => b pretend Sym;error "Non-symbol") + symbol b == (%ident? b => b pretend Sym;error "Non-symbol") float b == (RNUMP(b)$Lisp => b pretend Flt;error "Non-float") integer b == (INTP(b)$Lisp => b pretend Int;error "Non-integer") expr b == b pretend Expr diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 3cc190ae..670ad2da 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -856,7 +856,7 @@ bfDef1 [op,args,body] == argl := bfTupleP args => rest args [args] - [quotes,control,arglp,body]:=bfInsertLet (argl,body) + [quotes,control,arglp,body] := bfInsertLet (argl,body) quotes => shoeLAM(op,arglp,control,body) [[op,["LAMBDA",arglp,body]]] @@ -955,16 +955,13 @@ shoePROG(v,b)== [["PROG",v,:blist,["RETURN", blast]]] shoeFluids x== - x = nil => nil - symbol? x and bfBeginsDollar x => [x] - atom x => nil - x is ["QUOTE",:.] => nil + ident? x and bfBeginsDollar x => [x] + atomic? x => nil [:shoeFluids first x,:shoeFluids rest x] shoeATOMs x == - x = nil => nil - symbol? x => [x] - atom x => nil + ident? x => [x] + atomic? x => nil [:shoeATOMs first x,:shoeATOMs rest x] ++ Return true if `x' is an identifier name that designates a diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 10dea59c..213414cd 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1791,17 +1791,14 @@ (DEFUN |shoeFluids| (|x|) (COND - ((NULL |x|) NIL) - ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|)) (LIST |x|)) - ((ATOM |x|) NIL) - ((AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE)) NIL) + ((AND (|ident?| |x|) (|bfBeginsDollar| |x|)) (LIST |x|)) + ((|atomic?| |x|) NIL) (T (|append| (|shoeFluids| (CAR |x|)) (|shoeFluids| (CDR |x|)))))) (DEFUN |shoeATOMs| (|x|) (COND - ((NULL |x|) NIL) - ((SYMBOLP |x|) (LIST |x|)) - ((ATOM |x|) NIL) + ((|ident?| |x|) (LIST |x|)) + ((|atomic?| |x|) NIL) (T (|append| (|shoeATOMs| (CAR |x|)) (|shoeATOMs| (CDR |x|)))))) (DEFUN |isDynamicVariable| (|x|) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index bc445495..c939e52b 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -425,7 +425,7 @@ translateToplevel(b,export?) == b is ["TUPLE",:xs] => coreError '"invalid AST" case b of %Signature(op,t) => [genDeclaration(op,t)] - %Definition(op,args,body) => rest bfDef(op,args,body) + %Definition(op,args,body) => bfDef(op,args,body).args %Module(m,ns,ds) => $currentModuleName := m diff --git a/src/boot/utility.boot b/src/boot/utility.boot index 0eca52d2..a0444d0f 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -30,6 +30,13 @@ -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- +--% +--% Definitions in this file provide runtime support for the Boot +--% language. As such, some of the definitions (e.g. reverse, append, etc) +--% use `unusual' style. These functions are used in code generated +--% by the Boot translator. Others are handy library functions. +--% + import initial_-env namespace BOOTTRAN diff --git a/src/interp/astr.boot b/src/interp/astr.boot index 9597e934..466185bb 100644 --- a/src/interp/astr.boot +++ b/src/interp/astr.boot @@ -47,7 +47,7 @@ module astr where ncTag x == atom x => ncBug('S2CB0031,[]) x := first x - IDENTP x => x + ident? x => x atom x => ncBug('S2CB0031,[]) first x @@ -55,7 +55,7 @@ ncTag x == ncAlist x == atom x => ncBug('S2CB0031,[]) x := first x - IDENTP x => nil + ident? x => nil atom x => ncBug('S2CB0031,[]) rest x diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index 9fce6fae..29ad20c5 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -344,7 +344,7 @@ dbSearchOrder(conform,domname,$domain) == --domain = nil or set to live domain -- which = '"attribute" => pred --all categories (pak := catinfo . i) and pred --only those with default packages pakform() == - pak and not IDENTP pak => devaluate pak --in case it has been instantiated + pak and not ident? pak => devaluate pak --in case it has been instantiated catform := kFormatSlotDomain catvec . i -- which = '"attribute" => dbSubConform(rest conform,catform) res := dbSubConform(rest conform,[pak,"$",:rest catform]) diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 25245655..bd04dcf7 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -464,7 +464,7 @@ getImports conname == --called by mkUsersHashTable template := infovec.0 u := [doImport(i,template) for i in 5..(maxIndex template) | test] where - test() == template.i is [op,:.] and IDENTP op + test() == template.i is [op,:.] and ident? op and not (op in '(Mapping Union Record Enumeration CONS QUOTE local)) doImport(x,template) == x is [op,:args] => @@ -739,7 +739,7 @@ sublisFormal(args,exp,:options) == main where nd := lastNode r nd.rest := sublisFormal1(args,y,n) r - IDENTP x => + ident? x => j := or/[i for f in $formals for i in 0..n | sameObject?(f,x)] => args.j x diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index bc9e0049..e29f362f 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -118,7 +118,7 @@ htSayArgument t == --called only for operations not for constructors htSaySaturn '"{\em \%}" htSayStandard '"{\em $}" htSaySaturn '"{\em \%}" - not IDENTP t => bcConform(t,true) + not ident? t => bcConform(t,true) k := position(t,$conargs) if k > -1 then typeOfArg := (rest $signature).k @@ -419,7 +419,7 @@ kFormatSlotDomain x == fn formatSlotDomain x where fn x == (op := first x) is '_$ => '_$ op is 'local => second x op is ":" => [":",second x,fn third x] - IDENTP op and isConstructorName op => [fn y for y in x] + ident? op and isConstructorName op => [fn y for y in x] integer? op => op op is 'QUOTE and atom second x => second x x @@ -581,7 +581,7 @@ modemap2SigConds conds == [conds] hasPatternVar x == - IDENTP x and (x ~= "**") => isPatternVar x + ident? x and (x ~= "**") => isPatternVar x atom x => false or/[hasPatternVar y for y in x] diff --git a/src/interp/br-prof.boot b/src/interp/br-prof.boot index c9eae539..c79b121e 100644 --- a/src/interp/br-prof.boot +++ b/src/interp/br-prof.boot @@ -102,7 +102,7 @@ dbShowInfoOp(htPage,op,sig,alist) == for (p := [x,:y]) in fromAlist repeat x = $ => dollar := [[honestConform,:y]] x = 'Rep => rep := [['Rep,:y]] - IDENTP x => args := [dbInfoFindCat(conform,conArgTypes,p), :args] + ident? x => args := [dbInfoFindCat(conform,conArgTypes,p), :args] cons := [dbInfoTran(x,y), :cons] [:mySort args, :dollar, :rep, :mySort cons] sigAlist := LASSOC(op,opAlist) @@ -122,7 +122,7 @@ dbShowInfoOp(htPage,op,sig,alist) == bincount := 2 for [con,:fns] in fromAlist repeat htSay '"\item" - if IDENTP con then + if ident? con then htSay '"\menuitemstyle{} {\em calls to} " if con ~= 'Rep then htSay '"{\em argument} " htSay con diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index efd037e3..f0297eed 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -1164,13 +1164,13 @@ htShowPageStarSaturn() == ++ returns true if op designate a niladic constructor. Note that ++ constructors are symbols whereas ordinary operations are strings. operationIsNiladicConstructor op == - IDENTP op => niladicConstructorFromDB op + ident? op => niladicConstructorFromDB op false ++ Like operationIsNiladicConstructor() except that we just want ++ to know whether `op' is a constructor, arity is unimportant. operationIsConstructor op == - IDENTP op => getDualSignatureFromDB op + ident? op => getDualSignatureFromDB op nil --------------> NEW DEFINITION (see br-op2.boot.pamphlet) @@ -1240,7 +1240,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, $sig := which = '"attribute" or which = '"constructor" => sig $conkind ~= '"package" => sig - symbolsUsed := [x for x in rest conform | IDENTP x] + symbolsUsed := [x for x in rest conform | ident? x] $DomainList := SETDIFFERENCE($DomainList,symbolsUsed) getSubstSigIfPossible sig ----------------------------------------------------------- @@ -1615,7 +1615,7 @@ bcConform1 form == main where atom form => -- string literals, e.g. "failed", are constructor arguments -- too, until we fix that. - string? form or not (IDENTP form and isConstructorName form) => + string? form or not (ident? form and isConstructorName form) => s := string? form => strconc('"_"",form,'"_"") STRINGIMAGE form diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index fd0eef31..3622b118 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -369,7 +369,7 @@ looksLikeDomainForm x == and/[p for key in rest coSig for arg in rest x] where p() == key => looksLikeDomainForm arg - not IDENTP arg + not ident? arg spadSys(x) == --called by \spadsyscom{x} s := PNAME x @@ -716,7 +716,7 @@ dbWordFrom(l,i) == [buf,k] conLowerCaseConTran x == - IDENTP x => IFCAR tableValue($lowerCaseConTb, x) or x + ident? x => IFCAR tableValue($lowerCaseConTb, x) or x atom x => x [conLowerCaseConTran y for y in x] @@ -725,7 +725,7 @@ string2Constructor x == IFCAR tableValue($lowerCaseConTb, makeSymbol DOWNCASE x) or x conLowerCaseConTranTryHarder x == - IDENTP x => IFCAR tableValue($lowerCaseConTb,DOWNCASE x) or x + ident? x => IFCAR tableValue($lowerCaseConTb,DOWNCASE x) or x atom x => x [conLowerCaseConTranTryHarder y for y in x] diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot index e82f2042..98a290c1 100644 --- a/src/interp/br-util.boot +++ b/src/interp/br-util.boot @@ -147,7 +147,7 @@ htPred2English(x,:options) == gn(x,op,l,prec) if prec < 5 then htSay '")" x = 'etc => htSay '"..." - IDENTP x and not symbolMember?(x,$emList) => + ident? x and not symbolMember?(x,$emList) => htSay escapeSpecialIds symbolName x htSay form2HtString(x,$emList) gn(x,op,l,prec) == @@ -180,7 +180,7 @@ unMkEvalable u == u lisp2HT u == ['"_'",:fn u] where fn u == - IDENTP u => escapeSpecialIds symbolName u + ident? u => escapeSpecialIds symbolName u string? u => escapeString u atom u => systemError() ['"_(",:"append"/[fn x for x in u],'")"] diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index df276d9d..511ff5e9 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -126,7 +126,7 @@ compareSigEqual(s,t,dollar,domain) == vector? domain => instantiationArgs(domain).(POSN1(t,$FormalMapVariableList)) domain.args.(POSN1(t,$FormalMapVariableList)) - string? t and IDENTP s => (s := symbolName s; t) + string? t and ident? s => (s := symbolName s; t) nil s is '$ => compareSigEqual(dollar,u,dollar,domain) u => compareSigEqual(s,u,dollar,domain) @@ -261,7 +261,7 @@ defaultingFunction op == not vector? dom => false not (#dom > 0) => false canonicalForm dom isnt [packageName,:.] => false - not IDENTP packageName => false + not ident? packageName => false isDefaultPackageName packageName lookupInAddChain(op,sig,addFormDomain,dollar) == diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index dd597a88..ffcbe321 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -508,14 +508,14 @@ lhsOfAssignment x == getSuccessEnvironment(a,e) == a is ["is",id,m] => id := lhsOfAssignment id - IDENTP id and isDomainForm(m,$EmptyEnvironment) => + ident? id and isDomainForm(m,$EmptyEnvironment) => e:=put(id,"specialCase",m,e) currentProplist:= getProplist(id,e) [.,.,e] := T := comp(m,$EmptyMode,e) or return nil -- duplicates compIs newProplist:= consProplistOf(id,currentProplist,"value",[m,:rest removeEnv T]) addBinding(id,newProplist,e) e - a is ["case",x,m] and (x := lhsOfAssignment x) and IDENTP x => + a is ["case",x,m] and (x := lhsOfAssignment x) and ident? x => put(x,"condition",[a,:get(x,"condition",e)],e) a is ["and",:args] => for form in args repeat @@ -553,7 +553,7 @@ unionProperty(x,e) == nil getInverseEnvironment(a,e) == - a is ["case",x,m] and (x := lhsOfAssignment x) and IDENTP x => + a is ["case",x,m] and (x := lhsOfAssignment x) and ident? x => --the next two lines are necessary to get 3-branched Unions to work -- old-style unions, that is (get(x,"condition",e) is [["OR",:oldpred]]) and listMember?(a,oldpred) => @@ -685,7 +685,7 @@ diagnoseUnknownType(t,e) == t ctor is "Enumeration" => for t' in args repeat - IDENTP t' => nil + ident? t' => nil stackSemanticError(['"Enumerators must be symbols."], nil) -- Make sure we don't have repeated symbolic values for [sym,:syms] in tails args repeat @@ -710,7 +710,7 @@ diagnoseUnknownType(t,e) == isConstantId(name,e) == - IDENTP name => + ident? name => pl:= getProplist(name,e) => (symbolLassoc("value",pl) or symbolLassoc("mode",pl) => false; true) true @@ -736,7 +736,7 @@ makeLiteral(x,e) == put(x,"isLiteral","true",e) isSomeDomainVariable s == - IDENTP s and #(x:= symbolName s) > 2 and + ident? s and #(x:= symbolName s) > 2 and stringChar(x,0) = char "#" and stringChar(x,1) = char "#" ++ Return non-nil is the domain form `x' is a `subset' of domain @@ -766,7 +766,7 @@ isDomainInScope(domain,e) == domainList:= getDomainsInScope e atom domain => symbolMember?(domain,domainList) => true - not IDENTP domain or isSomeDomainVariable domain => true + not ident? domain or isSomeDomainVariable domain => true false (name:= first domain)="Category" => true ASSQ(name,domainList) => true @@ -781,7 +781,7 @@ isSimple x == isSideEffectFree op == op is ["elt",.,op'] => isSideEffectFree op' - not IDENTP op => false + not ident? op => false listMember?(op,$SideEffectFreeFunctionList) or constructor? op isAlmostSimple x == @@ -795,9 +795,9 @@ isAlmostSimple x == op="has" => x op="is" => x op="%LET" => - IDENTP y => (setAssignment [x]; y) + ident? y => (setAssignment [x]; y) (setAssignment [["%LET",g:= genVariable(),:l],["%LET",y,g]]; g) - op = "case" and IDENTP y => x + op = "case" and ident? y => x isSideEffectFree op => [op,:mapInto(rest x, function fn)] $assignmentList:= "failed" setAssignment x == @@ -864,7 +864,7 @@ genSomeVariable() == INTERNL strconc('"##",STRINGIMAGE ($genSDVar:= $genSDVar+1)) listOfIdentifiersIn x == - IDENTP x => [x] + ident? x => [x] x is [op,:l] => removeDuplicates ("append"/[listOfIdentifiersIn y for y in l]) nil @@ -1181,10 +1181,10 @@ $middleEndMacroList == --middleEndExpand: %Form -> %Code middleEndExpand x == x is '%false or x is '%nil => 'NIL - IDENTP x and (x' := x has %Rename) => x' + ident? x and (x' := x has %Rename) => x' atomic? x => x [op,:args] := x - IDENTP op and (fun := getOpcodeExpander op) => + ident? op and (fun := getOpcodeExpander op) => middleEndExpand apply(fun,x,nil) symbol? op and symbolMember?(op,$middleEndMacroList) => middleEndExpand MACROEXPAND_-1 x @@ -1286,7 +1286,7 @@ replaceSimpleFunctions form == ++ and body given by `body'. If `body' is a forwarding function call, ++ return the target function. Otherwise, return nil. forwardingCall?(vars,body) == - vars is [:vars',.] and body is [fun,: =vars'] and IDENTP fun => fun + vars is [:vars',.] and body is [fun,: =vars'] and ident? fun => fun nil @@ -1320,7 +1320,7 @@ expandableDefinition?(vars,body) == atomic? body => true [op,:args] := body - not IDENTP op or symbolMember?(op,$NonExpandableOperators) => false + not ident? op or symbolMember?(op,$NonExpandableOperators) => false and/[atomic? x for x in args] or semiSimpleRelativeTo?(body,$simpleVMoperators) => usesVariablesLinearly?(body,vars') @@ -1510,7 +1510,7 @@ backendCompile2 code == ++ returns all fuild variables contained in `x'. Fuild variables are ++ identifiers starting with '$', except domain variable names. backendFluidize x == - IDENTP x and x ~= "$" and x ~= "$$" and + ident? x and x ~= "$" and x ~= "$$" and stringChar(symbolName x,0) = char "$" and not digit? stringChar(symbolName x,1) => x atomic? x => nil @@ -1547,7 +1547,7 @@ noteSpecialVariable x == ++ Replace every middle end sub-forms in `x' with Lisp code. massageBackendCode: %Code -> %Void massageBackendCode x == - IDENTP x and isLispSpecialVariable x => noteSpecialVariable x + ident? x and isLispSpecialVariable x => noteSpecialVariable x atomic? x => nil -- temporarily have TRACELET report MAKEPROPs. if (u := first x) = "MAKEPROP" and $TRACELETFLAG then @@ -1558,7 +1558,7 @@ massageBackendCode x == x.first := "LETT" massageBackendCode CDDR x if not (u in '(SETQ RELET)) then - IDENTP second x => pushLocalVariable second x + ident? second x => pushLocalVariable second x second x is ["FLUID",:.] => PUSH(CADADR x, $FluidVars) x.rest.first := CADADR x @@ -1569,7 +1569,7 @@ massageBackendCode x == -- special variable. u is 'SETQ and isLispSpecialVariable second x => noteSpecialVariable second x - IDENTP u and GET(u,"ILAM") ~= nil => + ident? u and GET(u,"ILAM") ~= nil => x.first := eval u massageBackendCode x u in '(LET LET_*) => diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index 947db52f..231accef 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -120,9 +120,9 @@ simpHasPred(pred,:options) == main where simpHas(pred,a,b) == b is ['ATTRIBUTE,attr] => simpHasAttribute(pred,a,attr) b is ['SIGNATURE,op,sig] => simpHasSignature(pred,a,op,sig) - IDENTP a or hasIdent b => pred + ident? a or hasIdent b => pred npred := evalHas pred - IDENTP npred or null hasIdent npred => npred + ident? npred or null hasIdent npred => npred pred evalHas (pred := ["has",d,cat]) == x := hasCat(d,cat) @@ -132,7 +132,7 @@ simpHasPred(pred,:options) == main where x simpHasSignature(pred,conform,op,sig) == --eval w/o loading - IDENTP conform => pred + ident? conform => pred [conname,:args] := conform n := #sig u := symbolLassoc(op,getConstructorOperationsFromDB conname) @@ -142,7 +142,7 @@ simpHasSignature(pred,conform,op,sig) == --eval w/o loading simpHasPred(match is [sig,.,:p] and sublisFormal(args,p) or true) simpHasAttribute(pred,conform,attr) == --eval w/o loading - IDENTP conform => pred + ident? conform => pred conname := conform.op getConstructorKindFromDB conname is "category" => simpCatHasAttribute(conform,attr) @@ -169,7 +169,7 @@ hasIdent pred == op is 'QUOTE => false or/[hasIdent x for x in r] pred is '_$ => false - IDENTP pred => true + ident? pred => true false addDomainToTable(id,catl) == diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 1532e182..d0eefed6 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -87,9 +87,9 @@ compClam(op,argl,body,$clamList) == countFl := 'count in options if #argl > 1 and eqEtc= 'EQ then keyedSystemError("S2GE0007",[op]) - (not IDENTP kind) and (not integer? kind or kind < 1) => + (not ident? kind) and (not integer? kind or kind < 1) => keyedSystemError("S2GE0005",[op]) - IDENTP kind => + ident? kind => shiftFl => keyedSystemError("S2GE0008",[op]) compHash(op,argl,body,(kind='hash => nil; kind),eqEtc,countFl) cacheCount:= kind diff --git a/src/interp/clammed.boot b/src/interp/clammed.boot index 50618179..479d8ba5 100644 --- a/src/interp/clammed.boot +++ b/src/interp/clammed.boot @@ -78,12 +78,12 @@ isValidType form == -- cause problems with the interpreter. Thus things like P P I -- are not valid. string? form => true - IDENTP form => false + ident? form => false member(form,$LangSupportTypes) => true form is ['Record,:selectors] => and/[isValidType type for [:.,type] in selectors] form is ['Enumeration,:args] => - null (and/[IDENTP x for x in args]) => false + null (and/[ident? x for x in args]) => false ((# args) = (# removeDuplicates args)) => true false form is ['Mapping,:mapargs] => @@ -125,7 +125,7 @@ isValidType form == -- Arguments to constructors are general expressions. Below -- domain constructors are not considered valid arguments (yet). x' := opOf x - cons? x' or not IDENTP x' => true -- surely not constructors + cons? x' or not ident? x' => true -- surely not constructors getConstructorKindFromDB x' ~= "domain" selectMms1(op,tar,args1,args2,$Coerce) == @@ -186,7 +186,7 @@ isLegitimateMode(t,hasPolyMode,polyVarList) == poly? := (con is 'Polynomial or con is 'Expression) isLegitimateMode(underDomainOf t,poly?,polyVarList) - IDENTP(op := first t) and constructor? op => + ident?(op := first t) and constructor? op => isLegitimateMode(underDomainOf t,hasPolyMode,polyVarList) => t t is ['Mapping,:ml] => null ml => false @@ -205,7 +205,7 @@ isLegitimateMode(t,hasPolyMode,polyVarList) == false t is ['Record,:r] => isLegitimateRecordOrTaggedUnion r t is ['Enumeration,:r] => - null (and/[IDENTP x for x in r]) => false + null (and/[ident? x for x in r]) => false ((# r) = (# removeDuplicates r)) => true false false diff --git a/src/interp/compat.boot b/src/interp/compat.boot index db897ff2..6fdd592b 100644 --- a/src/interp/compat.boot +++ b/src/interp/compat.boot @@ -40,11 +40,11 @@ namespace BOOT -- RREAD which takes erroval to return if key is missing rread(key,rstream,errorval) == - if IDENTP key then key := symbolName key + if ident? key then key := symbolName key RREAD(key,rstream,errorval) rwrite(key,val,stream) == - if IDENTP key then key := symbolName key + if ident? key then key := symbolName key RWRITE(key,val,stream) -- issuing commands to the operating system diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index aa48b9aa..8f228742 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -277,7 +277,7 @@ freeVarUsage([.,vars,body],env) == freeList(body,vars,nil,env) where freeList(u,bound,free,e) == atom u => - not IDENTP u => free + not ident? u => free symbolMember?(u,bound) => free v := ASSQ(u,free) => v.rest := 1 + rest v @@ -377,7 +377,7 @@ extractCodeAndConstructTriple(u, m, oldE) == compExpression(x,m,e) == $insideExpressionIfTrue: local:= true -- special forms have dedicated compilers. - (op := x.op) and IDENTP op and (fn := property(op,'SPECIAL)) => + (op := x.op) and ident? op and (fn := property(op,'SPECIAL)) => FUNCALL(fn,x,m,e) compForm(x,m,e) @@ -395,9 +395,9 @@ compAtomWithModemap(x,m,e,mmList) == compAtom(x,m,e) == x is "break" => compBreak(x,m,e) x is "iterate" => compIterate(x,m,e) - T := IDENTP x and compAtomWithModemap(x,m,e,get(x,"modemap",e)) => T + T := ident? x and compAtomWithModemap(x,m,e,get(x,"modemap",e)) => T t := - IDENTP x => compSymbol(x,m,e) or return nil + ident? x => compSymbol(x,m,e) or return nil listMember?(m,$IOFormDomains) and primitiveType x => [x,m,e] string? x => [x,x,e] [x,primitiveType x or return nil,e] @@ -607,7 +607,7 @@ compFormWithModemap(form,m,e,modemap) == form':= [f,:[t.expr for t in Tl]] target=$Category or isCategoryForm(target,e) => form' -- try to deal with new-style Unions where we know the conditions - op = "elt" and f is ['XLAM,:.] and IDENTP(z := first argl) and + op = "elt" and f is ['XLAM,:.] and ident?(z := first argl) and (c := get(z,'condition,e)) and c is [["case",=z,c1]] and (c1 is [":",=(second argl),=m] or sameObject?(c1,second argl) ) => @@ -735,7 +735,7 @@ substituteIntoFunctorModemap(argl,modemap is [[dc,:sig],:.],e) == compEnumCat(x,m,e) == for arg in x.args repeat - IDENTP arg => nil -- OK + ident? arg => nil -- OK stackAndThrow('"all arguments to %1b must be identifiers",[x.op]) [x,resolve($Category,m),e] @@ -804,7 +804,7 @@ compSetq(["%LET",form,val],m,E) == compSetq1(form,val,m,E) compSetq1(form,val,m,E) == - IDENTP form => setqSingle(form,val,m,E) + ident? form => setqSingle(form,val,m,E) form is [":",x,y] => [.,.,E']:= compMakeDeclaration(x,y,E) compSetq1(x,val,m,E') @@ -839,7 +839,7 @@ setqSingle(id,val,m,E) == assignError(val,T.mode,id,m'') T':= [x,m',e']:= coerce(T,m) or return nil if $profileCompiler then - not IDENTP id => nil + not ident? id => nil key := symbolMember?(id,$form.args) => "arguments" "locals" @@ -939,7 +939,7 @@ compileQuasiquote(["[||]",:form],m,e) == recordDeclarationInSideCondition(item,e) == item is [":",x,t] => t := macroExpand(t,e) - IDENTP x => $whereDecls := [[x,t],:$whereDecls] + ident? x => $whereDecls := [[x,t],:$whereDecls] x is ['%Comma,:.] => $whereDecls := [:[[x',t] for x' in x.args],:$whereDecls] item is ['SEQ,:stmts,["exit",.,val]] => @@ -984,7 +984,7 @@ compConstruct(form is ["construct",:l],m,e) == ++ Compile a literal (quoted) symbol. compQuote: (%Form,%Mode,%Env) -> %Maybe %Triple compQuote(expr,m,e) == - expr is ["QUOTE",x] and IDENTP x => + expr is ["QUOTE",x] and ident? x => -- Ideally, Identifier should be the default type. However, for -- historical reasons we cannot afford that luxury yet. m = $Identifier or listMember?(m,$IOFormDomains) => [expr,m,e] @@ -1024,7 +1024,7 @@ compMacro(form,m,e) == :formatUnabbreviated lhs,'" ==> ",:prhs,'"%d"] m=$EmptyMode or m=$NoValueMode => -- Macro names shall be identifiers. - not IDENTP lhs.op => + not ident? lhs.op => stackMessage('"invalid left-hand-side in macro definition",nil) e -- We do not have the means, at this late stage, to make a distinction @@ -1449,7 +1449,7 @@ compSignatureImport(["%SignatureImport",id,type,home],m,e) == stackAndThrow('"signature import must be from a %1bp domain",["Foreign"]) args isnt [lang] => stackAndThrow('"%1bp takes exactly one argument",["Foreign"]) - not IDENTP lang => + not ident? lang => stackAndThrow('"Argument to %1bp must be an identifier",["Foreign"]) not (lang in '(Builtin C Lisp)) => stackAndThrow('"Sorry: Only %1bp is valid at the moment",["Foreign C"]) @@ -2077,7 +2077,7 @@ compRecoverGuard(x,t,sn,sm,e) == -- We have a univariate type scheme. At the moment we insist -- that the body of the type scheme be identical to the type -- variable. This restriction should be lifted in future work. - not IDENTP t' or t' ~= var' => + not ident? t' or t' ~= var' => stackAndThrow('"Sorry: type %1b too complex",[t']) not isCategoryForm(cat',e) => stackAndThrow('"Expression %1b does not designate a category",[cat']) @@ -2139,7 +2139,7 @@ defineMatchScrutinee(m,e) == ++ `eF' is the environment for unsuccessful guard compAlternativeGuardItem(sn,sm,pat,e) == pat is [op,x,t] and op in '(_: _@) => - not IDENTP x => + not ident? x => stackAndThrow('"pattern %1b must declare a variable",[pat]) if $catchAllCount > 0 then warnUnreachableAlternative pat @@ -2213,7 +2213,7 @@ compMatch(["%Match",subject,altBlock],m,env) == $catchAllCount = 0 => stackAndThrow('"missing %b otherwise %d alternative in case pattern",nil) code := - IDENTP sn => ['%bind,[[sn,se]],['%when,:reverse! altsCode]] + ident? sn => ['%bind,[[sn,se]],['%when,:reverse! altsCode]] ["%bind",[[n,e] for n in sn for e in rest se], ['%when,:reverse! altsCode]] [code,m,savedEnv] @@ -2570,11 +2570,11 @@ gatherParameterList vars == main(vars,nil,nil) where main(rest vars,[v,:parms],[s,:source]) check var == atom var => - not IDENTP var => + not ident? var => stackAndThrow('"invalid parameter %1b in lambda expression",[var]) [checkVariableName var,nil] var is [":",p,t] => - not IDENTP p => + not ident? p => stackAndThrow('"invalid parameter %1b in lambda expression",[p]) [checkVariableName p,t] stackAndThrow('"invalid parameter for mapping",nil) diff --git a/src/interp/database.boot b/src/interp/database.boot index a2cdd9f1..635e1fea 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -381,7 +381,7 @@ isDomainSubst u == main where u fn(x,alist) == atom x => - IDENTP x and symbolMember?(x,$PatternVariableList) and (s := findSub(x,alist)) => s + ident? x and symbolMember?(x,$PatternVariableList) and (s := findSub(x,alist)) => s x [first x,:[fn(y,alist) for y in rest x]] findSub(x,alist) == diff --git a/src/interp/define.boot b/src/interp/define.boot index 8d249ab5..5f9c4c83 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -609,7 +609,7 @@ getTargetFromRhs(lhs,rhs,e) == (compOrCroak(rhs,$EmptyMode,e)).mode giveFormalParametersValues(argl,e) == - for x in argl | IDENTP x repeat + for x in argl | ident? x repeat e := giveVariableSomeValue(x,get(x,'mode,e),e) e @@ -625,7 +625,7 @@ macroExpandInPlace(x,e) == macroExpand: (%Form,%Env) -> %Form macroExpand(x,e) == --not worked out yet atom x => - not IDENTP x or (u := get(x,"macro",e)) = nil => x + not ident? x or (u := get(x,"macro",e)) = nil => x -- Don't expand a functional macro name by itself. u is ['%mlambda,:.] => x macroExpand(u,e) @@ -634,9 +634,9 @@ macroExpand(x,e) == --not worked out yet macroExpand(rhs,e)] -- macros should override niladic props [op,:args] := x - IDENTP op and args = nil and niladicConstructorFromDB op and + ident? op and args = nil and niladicConstructorFromDB op and (u := get(op,"macro", e)) => macroExpand(u,e) - IDENTP op and (get(op,"macro",e) is ['%mlambda,parms,body]) => + ident? op and (get(op,"macro",e) is ['%mlambda,parms,body]) => nargs := #args nparms := #parms msg := @@ -863,7 +863,7 @@ predicatesFromAttributes attrList == ++ Subroutine of inferConstructorImplicitParameters. typeDependencyPath(m,path,e) == - IDENTP m and assoc(m,$whereDecls) => + ident? m and assoc(m,$whereDecls) => get(m,'value,e) => nil -- parameter was given value [[m,:reverse path],:typeDependencyPath(getmode(m,e),path,e)] atomic? m => nil @@ -1555,7 +1555,7 @@ spadCompileOrSetq (form is [nam,[lam,vl,body]]) == -- parameters are never used in the body. vl := [ renameParameter for v in vl] where renameParameter() == - integer? v or IDENTP v or string? v => v + integer? v or ident? v or string? v => v gensym '"flag" clearReplacement nam -- Make sure we have fresh info if $optReplaceSimpleFunctions then @@ -1607,7 +1607,7 @@ constructMacro: %Form -> %Form constructMacro (form is [nam,[lam,vl,body]]) == not (and/[atom x for x in vl]) => stackSemanticError(["illegal parameters for macro: ",vl],nil) - ["XLAM",vl':= [x for x in vl | IDENTP x],body] + ["XLAM",vl':= [x for x in vl | ident? x],body] listInitialSegment(u,v) == null u => true @@ -1943,7 +1943,7 @@ mkExplicitCategoryFunction(domainOrPackage,sigList,atList) == parameters:= removeDuplicates ("append"/ - [[x for x in sig | IDENTP x and x~='_$] + [[x for x in sig | ident? x and x~='_$] for ["QUOTE",[[.,sig,:.],:.]] in sigList]) wrapDomainSub(parameters,body) diff --git a/src/interp/format.boot b/src/interp/format.boot index 0821333e..449e1322 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -342,7 +342,7 @@ prefix2String0 form == -- atom form => -- form=$EmptyMode or form=$quadSymbol => formWrapId specialChar 'quad -- string? form => formWrapId form --- IDENTP form => +-- ident? form => -- constructor? form => app2StringWrap(formWrapId form, [form]) -- formWrapId form -- formWrapId STRINGIMAGE form @@ -385,7 +385,7 @@ constructorName con == form2String1 u == atom u => u=$EmptyMode or u=$quadSymbol => formWrapId specialChar 'quad - IDENTP u => + ident? u => constructor? u => app2StringWrap(formWrapId u, [u]) formWrapId u SUBRP u => formWrapId BPINAME u @@ -396,7 +396,7 @@ form2String1 u == -- string literals (e.g. "failed") masquerading as constructors stringImage op op='Join or op= 'mkCategory => formJoin1(op,argl) - $InteractiveMode and IDENTP op and (u:= getConstructorAbbreviationFromDB op) => + $InteractiveMode and ident? op and (u:= getConstructorAbbreviationFromDB op) => null argl => app2StringWrap(formWrapId constructorName op, u1) op = "NTuple" => [ form2String1 first argl, '"*"] op = "Map" => ['"(",:formatSignature0([argl.1,argl.0],'ELT),'")"] @@ -460,7 +460,7 @@ formWrapId id == formArguments2String(argl,ml) == [fn(x,m) for x in argl for m in ml] where fn(x,m) == x=$EmptyMode or x=$quadSymbol => specialChar 'quad - string?(x) or IDENTP(x) => x + string?(x) or ident?(x) => x x is ['_:,:.] => form2String1 x isValidType(m) and cons?(m) and (getConstructorKindFromDB first(m) = "domain") => @@ -624,7 +624,7 @@ formTuple2String argl == string isInternalFunctionName(op) == - (not IDENTP(op)) or (op = "*") or (op = "**") => nil + (not ident?(op)) or (op = "*") or (op = "**") => nil op' := symbolName op 1 = #op' or char "*" ~= stringChar(op',0) => nil -- if there is a semicolon in the name then it is the name of @@ -746,7 +746,7 @@ object2String x == toString x object2Identifier x == - IDENTP x => x + ident? x => x makeSymbol object2String x blankList x == "append"/[[BLANK,y] for y in x] @@ -792,7 +792,7 @@ form2Fence1 x == op = "QUOTE" => ['"(QUOTE ",:form2FenceQuote first argl,'")"] ['"(", FORMAT(nil, '"|~a|", op),:"append"/[form2Fence1 y for y in argl],'")"] null x => '"" - IDENTP x => FORMAT(nil, '"|~a|", x) + ident? x => FORMAT(nil, '"|~a|", x) ['" ", x] form2FenceQuote x == diff --git a/src/interp/functor.boot b/src/interp/functor.boot index d6848716..106a1557 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -914,7 +914,7 @@ mkRepititionAssoc l == encodeItem x == x is [op,:argl] => getCaps op - IDENTP x => symbolName x + ident? x => symbolName x STRINGIMAGE x getCaps x == diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot index f5a4492a..ce9ff96b 100644 --- a/src/interp/g-cndata.boot +++ b/src/interp/g-cndata.boot @@ -56,7 +56,7 @@ augmentLowerCaseConTable x == tableValue($lowerCaseConTb,y) := item getCDTEntry(info,isName) == - not IDENTP info => nil + not ident? info => nil (entry := tableValue($lowerCaseConTb,info)) => [name,abb,:.] := entry isName and sameObject?(name,info) => entry @@ -175,7 +175,7 @@ isNameOfType x == unabbrev1(u,modeIfTrue) == atom u => - not IDENTP u => u -- surely not constructor abbrev + not ident? u => u -- surely not constructor abbrev modeIfTrue => d:= isDomainValuedVariable u => u a := abbreviation? u => diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 8dfff858..f571be7f 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -194,7 +194,7 @@ simplifyVMForm x == x subrname u == - IDENTP u => u + ident? u => u COMPILED_-FUNCTION_-P u or MBPIP u => BPINAME u nil @@ -400,7 +400,7 @@ optSuchthat [.,:u] == ["SUCHTHAT",:u] ++ List of VM side effect free operators. $VMsideEffectFreeOperators == '(FUNCALL - SPADfirst ASH IDENTP FLOAT_-RADIX FLOAT FLOAT_-SIGN + SPADfirst ASH FLOAT_-RADIX FLOAT FLOAT_-SIGN %funcall %nothing %when %false %true %otherwise %2bit %2bool %and %or %not %peq %ieq %ilt %ile %igt %ige %head %tail %integer? %beq %blt %ble %bgt %bge %bitand %bitior %bitxor %bitnot %bcompl @@ -478,7 +478,7 @@ isVMConstantForm form == ++ Return the set of free variables in the VM form `form'. findVMFreeVars form == - IDENTP form => [form] + ident? form => [form] form isnt [op,:args] => nil op is "QUOTE" => nil vars := union/[findVMFreeVars arg for arg in args] @@ -498,7 +498,7 @@ varIsAssigned(var,form) == ++ Return the list of variables referenced in `expr'. dependentVars expr == main(expr,nil) where main(x,vars) == - IDENTP x => + ident? x => symbolMember?(x,vars) => vars [x,:vars] atomic? x => vars @@ -528,7 +528,7 @@ canInlineVarDefinition(var,expr,body) == -- If the initializer is a variable and the body is -- a series of choices with side-effect free predicates, then -- no harm is done by removing the local `var'. - IDENTP expr and body is ['%when,:branches] => + ident? expr and body is ['%when,:branches] => and/[sideEffectFree? pred for [pred,:.] in branches] false diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 486a7b34..115aa242 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -93,7 +93,7 @@ homogeneousListToVector(t,l) == ++ tests if x is an identifier beginning with # isSharpVar x == - IDENTP x and stringChar(symbolName x,0) = char "#" + ident? x and stringChar(symbolName x,0) = char "#" isSharpVarWithNum x == not isSharpVar x => nil @@ -231,7 +231,7 @@ get1(x,prop,e) == LASSOC(prop,getProplist(x,e)) or get2(x,prop) get2(x,prop) == - prop="modemap" and IDENTP x and constructor? x => + prop="modemap" and ident? x and constructor? x => (u := getConstructorModemapFromDB x) => [u] nil nil @@ -303,13 +303,13 @@ isQuasiquote m == ++ returns the inferred domain for the syntactic object t. getTypeOfSyntax t == atom t => - IDENTP t => '(Identifier) + ident? t => '(Identifier) (m := getBasicMode t) and not member(m,[$EmptyMode,$NoValueMode]) => ["Literal",m] $Syntax [op,:.] := t op = "Mapping" => '(MappingAst) - op = "QUOTE" and #t = 2 and IDENTP second t => ["Literal",$Symbol] + op = "QUOTE" and #t = 2 and ident? second t => ["Literal",$Symbol] op = "IF" => '(IfAst) op = "REPEAT" => '(RepeatAst) op = "WHILE" => '(WhileAst) @@ -483,7 +483,7 @@ stringPrefix?(pref,str) == stringChar2Integer(str,pos) == -- returns small integer represented by character in position pos -- in string str. Returns nil if not a digit or other error. - if IDENTP str then str := symbolName str + if ident? str then str := symbolName str not (string?(str) and integer?(pos) and (pos >= 0) and (pos < #str)) => nil not digit?(d := stringChar(str,pos)) => nil @@ -543,7 +543,7 @@ listOfPatternIds x == isPatternVar v == -- a pattern variable consists of a star followed by a star or digit(s) - IDENTP(v) and v in '(_*_* _*1 _*2 _*3 _*4 _*5 _*6 _*7 _*8 _*9 _*10 + ident?(v) and v in '(_*_* _*1 _*2 _*3 _*4 _*5 _*6 _*7 _*8 _*9 _*10 _*11 _*12 _*13 _*14 _*15 _*16 _*17 _*18 _*19 _*20) and true removeZeroOne x == @@ -872,7 +872,7 @@ isDefaultPackageName x == stringChar(s,maxIndex s) = char "&" isDefaultPackageForm? x == - x is [op,:.] and IDENTP op and isDefaultPackageName op + x is [op,:.] and ident? op and isDefaultPackageName op makeDefaultPackageName x == makeSymbol strconc(x,'"&") diff --git a/src/interp/htsetvar.boot b/src/interp/htsetvar.boot index 14c5dee1..058fcc8c 100644 --- a/src/interp/htsetvar.boot +++ b/src/interp/htsetvar.boot @@ -301,7 +301,7 @@ translateYesNoToTrueFalse x == chkNameList x == u := bcString2ListWords x parsedNames := [ncParseFromString x for x in u] - and/[IDENTP x for x in parsedNames] => parsedNames + and/[ident? x for x in parsedNames] => parsedNames '"Please enter a list of identifiers separated by blanks" chkPosInteger s == diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index 6fea2735..9f4ce9a7 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -62,7 +62,7 @@ putCallInfo(t,op,arg,nargs) == getMinimalVariableTower(var,t) == -- gets the minimal polynomial subtower of t that contains the -- given variable. Returns nil if none. - string?(t) or IDENTP(t) => nil + string?(t) or ident?(t) => nil t = $Symbol => t t is ['Variable,u] => (u = var) => t @@ -264,7 +264,7 @@ bottomUp t == bottomUpWithArgModesets(t,op,opName,argl,argModeSetList) m := getBasicMode t => [m] - IDENTP (id := getUnname t) => + ident? (id := getUnname t) => putModeSet(t,bottomUpIdentifier(t,id)) keyedSystemError("S2GE0016",['"bottomUp",'"unknown object form"]) diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index b8984de1..aae60c58 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -71,7 +71,7 @@ mkEvalable form == MKQ x [op,:[mkEvalable x for x in argl]] form=$EmptyMode => $Integer - IDENTP form and constructor?(form) => [form] + ident? form and constructor?(form) => [form] FBPIP form => BPINAME form form @@ -102,8 +102,8 @@ evaluateType0 form == builtinConstructor? op => [op,:[evaluateType arg for arg in argl]] constructor? op => evaluateType1 form nil - IDENTP form and niladicConstructorFromDB form => evaluateType [form] - IDENTP form and (constructor? form or builtinConstructor? form) => + ident? form and niladicConstructorFromDB form => evaluateType [form] + ident? form and (constructor? form or builtinConstructor? form) => throwEvalTypeMsg("S2IE0003",[form,form]) ++ Check for duplicate fields in a Union or Record domain form. @@ -144,14 +144,14 @@ evaluateType form == op='Enumeration => -- only symbols, and they must not be repeated. for arg in argl repeat - IDENTP arg => nil + ident? arg => nil throwKeyedMsg("S2IL0031",nil) for [arg,:args] in tails argl repeat symbolMember?(arg,args) => throwKeyedMsg("S2IL0032",[arg]) form evaluateFormAsType form - IDENTP form and niladicConstructorFromDB form => evaluateType [form] - IDENTP form and (constructor? form or builtinConstructor? form) => + ident? form and niladicConstructorFromDB form => evaluateType [form] + ident? form and (constructor? form or builtinConstructor? form) => throwEvalTypeMsg("S2IE0003",[form,form]) evaluateFormAsType form diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 1dd0d74a..d5cbcb91 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -1692,7 +1692,7 @@ ofCategory(dom,cat) == -- the result is true or nil $Subst:local:= nil $hope:local := nil - IDENTP dom => nil + ident? dom => nil cat is ['Join,:cats] => and/[ofCategory(dom,c) for c in cats] (hasCaty(dom,cat,nil) isnt 'failed) diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index 0c4a6141..fb9528e3 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -111,7 +111,7 @@ mkAtree1 x == v := mkAtreeNode $immediateDataSymbol putValue(v,getBasicObject x) v - IDENTP x => mkAtreeNode x + ident? x => mkAtreeNode x keyedSystemError("S2II0002",[x]) x is [op,:argl] => mkAtree2(x,op,argl) systemErrorHere ["mkAtree1",x] @@ -319,7 +319,7 @@ collectDefTypesAndPreds args == -- slot 2: a predicate for all arguments pred := types := vars := nil junk := - IDENTP args => + ident? args => types := [nil] vars := [args] args is [":",var,type] => @@ -362,7 +362,7 @@ mkAtreeValueOf l == mkAtreeValueOf1 l == null l or atom l or null rest l => l - l is ["valueOf",u] and IDENTP u => + l is ["valueOf",u] and ident? u => v := mkAtreeNode $immediateDataSymbol putValue(v,get(u,"value",$InteractiveFrame) or objNewWrap(u,['Variable,u])) diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index 6a5f905f..e8e9525f 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -58,7 +58,7 @@ makeInternalMapName(userName,numArgs,numMms,extraPart) == isInternalMapName name == -- this only returns true or false as a "best guess" - (not IDENTP(name)) or (name = "*") or (name = "**") => false + (not ident?(name)) or (name = "*") or (name = "**") => false sz := # (name' := symbolName name) (sz < 7) or (char "*" ~= name'.0) => false not digit? name'.1 => false @@ -115,7 +115,7 @@ addDefMap(['DEF,lhs,mapsig,.,rhs],pred) == -- get the formal parameters. These should only be atomic symbols -- that are not numbers. - parameters := [p for p in rest lhs | IDENTP(p)] + parameters := [p for p in rest lhs | ident?(p)] -- see if a signature has been given. if anything in mapsig is nil, -- then declaration was omitted. @@ -222,7 +222,7 @@ deleteMap(op,pattern,map) == getUserIdentifiersIn body == null body => nil - IDENTP body => + ident? body => isSharpVarWithNum body => nil body = $ClearBodyToken => nil [body] @@ -335,7 +335,7 @@ makeRuleForm(op,pattern)== mkFormalArg(x,s) == isConstantArgument x => ["SUCHTHAT",s,["=",s,x]] isPatternArgument x => ["SUCHTHAT",s,["is",s,x]] - IDENTP x => + ident? x => y:= LASSOC(x,$sl) => ["SUCHTHAT",s,["=",s,y]] $sl:= [[x,:s],:$sl] s @@ -400,7 +400,7 @@ displayRule(op,rule) == outputFormat(x,m) == -- this is largely junk and is being phased out - IDENTP m => x + ident? m => x m=$OutputForm or m=$EmptyMode => x categoryForm?(m) => x isMapExpr x => x @@ -478,8 +478,8 @@ getEqualSublis pred == fn(pred,nil) where fn(x,sl) == sl x is ["is",a,b] => [[a,:b],:sl] x is ["=",a,b] => - IDENTP a and not CONTAINED(a,b) => [[a,:b],:sl] - IDENTP b and not CONTAINED(b,a) => [[b,:a],:sl] + ident? a and not CONTAINED(a,b) => [[a,:b],:sl] + ident? b and not CONTAINED(b,a) => [[b,:a],:sl] sl sl @@ -1009,7 +1009,7 @@ findLocalVars(op,form) == findLocalVars1(op,form) == -- sets the two lists $localVars and $freeVars atom form => - not IDENTP form or isSharpVarWithNum form => nil + not ident? form or isSharpVarWithNum form => nil isLocallyBound form or isFreeVar form => nil mkFreeVar($mapName,form) form is ['local, :vars] => @@ -1098,7 +1098,7 @@ mkFreeVar(op,var) == listOfVariables pat == -- return a list of the variables in pat, which is an "is" pattern - IDENTP pat => (pat='_. => nil ; [pat]) + ident? pat => (pat='_. => nil ; [pat]) pat is ['_:,var] or pat is ['_=,var] => (var='_. => nil ; [var]) cons? pat => removeDuplicates [:listOfVariables p for p in pat] diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot index b8560f59..c2bf03ff 100644 --- a/src/interp/i-object.boot +++ b/src/interp/i-object.boot @@ -116,7 +116,7 @@ getValueNormalForm obj == atom val => val [op,:argl] := val op is "WRAPPED" => MKQ argl - IDENTP op and isConstructorName op => + ident? op and isConstructorName op => isConceptualCategory objMode obj => instantiationNormalForm(op,argl) MKQ val -- This is not the final value of `obj', rather something that needs @@ -127,7 +127,7 @@ instantiationNormalForm(op,argl) == [op,:[normalVal for arg in argl]] where normalVal() == atom arg => arg [h,:t] := arg - IDENTP h and isConstructorName h => instantiationNormalForm(h,t) + ident? h and isConstructorName h => instantiationNormalForm(h,t) MKQ arg diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index 56f164a2..1231614b 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -432,7 +432,7 @@ APP(u,x,y,d) == appelse(u,x,y,d) atom2String x == - IDENTP x => symbolName x + ident? x => symbolName x string? x => x stringer x @@ -608,7 +608,7 @@ outputTran x == ['PAREN,["|",['AGGLST,:l],pred]] op="tuple" => ['PAREN,['AGGLST,:l]] op='LISTOF => ['AGGLST,:l] - IDENTP op and not (op in '(_* _*_*) ) and + ident? op and not (op in '(_* _*_*) ) and char "*" = stringChar(symbolName op,0) => mkSuperSub(op,l) [outputTran op,:l] @@ -1168,7 +1168,7 @@ maprinChk x == $MatrixList is [[name,:value]] and y=name => $MatrixList:=[] -- we are pulling this one off maPrin ['EQUATNUM,n, deMatrix value] - IDENTP y => --------this part is never called + ident? y => --------this part is never called -- Not true: JHD 28/2/93 -- m:=[[1,2,3],[4,5,6],[7,8,9]] -- mm:=[[m,1,0],[0,m,1],[0,1,m]] @@ -1666,7 +1666,7 @@ printMap1(x,initialFlag) == printBasic x == x=$One => writeInteger(1,$algebraOutputStream) x=$Zero => writeInteger(0,$algebraOutputStream) - IDENTP x => writeString(symbolName x,$algebraOutputStream) + ident? x => writeString(symbolName x,$algebraOutputStream) atom x => PRIN1(x,$algebraOutputStream) PRIN1(x,$algebraOutputStream) @@ -2597,7 +2597,7 @@ primaryForm2String x == x = nil => '"" string? x => x x = $EmptyMode => specialChar 'quad - IDENTP x => + ident? x => x = "$" => '"%" x = "$$" => '"%%" symbolName x @@ -2664,7 +2664,7 @@ minusForm2String x == parms2String x == null x => "()" - IDENTP x => x + ident? x => x x is [var] => var if x is ["tuple",:.] then x := rest x paren [parm xs for xs in tails x] where diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot index a266737d..a8c4f44c 100644 --- a/src/interp/i-resolv.boot +++ b/src/interp/i-resolv.boot @@ -729,7 +729,7 @@ getUnderModeOf d == deconstructT(t) == -- M is a type, which may contain type variables -- results in a pair (type constructor . mode arguments) - KDR t and (op := first t) and IDENTP op and constructor? op => + KDR t and (op := first t) and ident? op and constructor? op => dt := destructT op args := [ x for d in dt for y in t | ( x := d and y ) ] c := [ x for d in dt for y in t | ( x := not d and y ) ] diff --git a/src/interp/i-special.boot b/src/interp/i-special.boot index db86d8db..54729eb6 100644 --- a/src/interp/i-special.boot +++ b/src/interp/i-special.boot @@ -63,7 +63,7 @@ upADEF t == t isnt [.,[vars,types,.,body],pred,.] => nil -- do some checking on what we got for var in vars repeat - if not IDENTP(var) then throwKeyedMsg("S2IS0057",[var]) + if not ident?(var) then throwKeyedMsg("S2IS0057",[var]) -- unabbreviate types types := [(if t then evaluateType unabbrev t else nil) for t in types] -- we do not allow partial types @@ -502,7 +502,7 @@ upLoopIters itrl == upLoopIterIN(iter,index,s) == iterMs := bottomUp s - not IDENTP index => throwKeyedMsg("S2IS0005",[index]) + not ident? index => throwKeyedMsg("S2IS0005",[index]) if $genValue and first iterMs is ['Union,:.] then v := coerceUnion2Branch getValue s @@ -529,7 +529,7 @@ upLoopIterIN(iter,index,s) == mkIteratorVariable index upLoopIterSTEP(index,lower,step,upperList) == - not IDENTP index => throwKeyedMsg("S2IS0005",[index]) + not ident? index => throwKeyedMsg("S2IS0005",[index]) ltype := IFCAR bottomUpUseSubdomain(lower) not (typeIsASmallInteger(ltype) or isEqualOrSubDomain(ltype,$Integer))=> throwKeyedMsg("S2IS0007",['"lower"]) @@ -1114,7 +1114,7 @@ upDeclare t == packageForm?(mode) => throwKeyedMsgSP("S2IE0011",[mode, 'package],op) getAtree(op,"callingFunction") => -- This isn't a real declaration, rather a field specification. - not IDENTP lhs => throwKeyedMsg("S2IE0020",nil) + not ident? lhs => throwKeyedMsg("S2IE0020",nil) -- ??? When we come to support field spec as type, change this. putValue(op,objNewWrap([":",lhs,mode],mode)) putModeSet(op,[mode]) @@ -1197,7 +1197,7 @@ replaceSharps(x,d) == isDomainValuedVariable form == -- returns the value of form if form is a variable with a type value - IDENTP form and (val := ( + ident? form and (val := ( get(form,'value,$InteractiveFrame) or _ (cons?($env) and get(form,'value,$env)) or _ (cons?($e) and get(form,'value,$e)))) and @@ -1224,7 +1224,7 @@ evalCategory(d,c) == isPartialMode d => true -- maybe too generous -- If this is a local variable then, its declared type -- must imply category `c' satisfaction. - IDENTP d and (m := getmode(d,$env)) => categoryImplies(m,c) + ident? d and (m := getmode(d,$env)) => categoryImplies(m,c) ofCategory(d,c) isOkInterpMode m == @@ -1610,7 +1610,7 @@ putPvarModes(pattern,m) == -- Puts the modes for the pattern variables into $env m isnt ["List",um] => throwKeyedMsg("S2IS0030",nil) for pvar in pattern repeat - IDENTP pvar => (not (pvar=$quadSymbol)) and put(pvar,'mode,um,$env) + ident? pvar => (not (pvar=$quadSymbol)) and put(pvar,'mode,um,$env) pvar is ['_:,var] => null (var=$quadSymbol) and put(var,"mode",m,$env) pvar is ['_=,var] => @@ -1632,7 +1632,7 @@ evalis(op,[a,pattern],mode) == isLocalPred pattern == -- returns true if this predicate is to be compiled for pat in pattern repeat - IDENTP pat and isLocallyBound pat => return true + ident? pat and isLocallyBound pat => return true pat is [":",var] and isLocallyBound var => return true pat is ["=",var] and isLocallyBound var => return true @@ -1641,7 +1641,7 @@ compileIs(val,pattern) == -- into local variables of the function vars:= nil for pat in rest pattern repeat - IDENTP(pat) and isLocallyBound pat => vars:=[pat,:vars] + ident?(pat) and isLocallyBound pat => vars:=[pat,:vars] pat is [":",var] => vars:= [var,:vars] pat is ["=",var] => vars:= [var,:vars] predCode:=["%LET",g:=gensym(),["isPatternMatch", @@ -1693,7 +1693,7 @@ isPatMatch(l,pats) == $subs := [[var],:$subs] $subs:='failed pats is [pat,:restPats] => - IDENTP pat => + ident? pat => $subs:=[[pat,:first l],:$subs] isPatMatch(rest l,restPats) pat is ["=",var] => @@ -1754,7 +1754,7 @@ up%LET t == throwKeyedMsg("S2IS0027",[obj]) var in '(% %%) => -- for history throwKeyedMsg("S2IS0027",[var]) - (IDENTP var) and not (var in '(true false elt QUOTE)) => + (ident? var) and not (var in '(true false elt QUOTE)) => var ~= (var' := unabbrev(var)) => -- constructor abbreviation throwKeyedMsg("S2IS0028",[var,var']) if get(var,'isInterpreterFunction,$e) then @@ -2036,7 +2036,7 @@ getInterpMacroNames() == isInterpMacro name == -- look in local and then global environment for a macro - not IDENTP name => nil + not ident? name => nil symbolMember?(name,$specialOps) => nil (m := get("--macros--",name,$env)) => m (m := get("--macros--",name,$e)) => m @@ -2051,7 +2051,7 @@ upQUOTE t == t isnt [op,expr] => nil ms:= list m:= getBasicMode expr => m - IDENTP expr => + ident? expr => -- $useSymbolNotVariable => $Symbol getTarget t = $Identifier => $Identifier ['Variable,expr] diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index a0c288c8..1cbdc3a7 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -159,7 +159,7 @@ selectOptionLC(x,l,errorFunction) == selectOption(x,l,errorFunction) == member(x,l) => x --exact spellings are always OK - not IDENTP x => + not ident? x => errorFunction => FUNCALL(errorFunction,x,u) nil u := [y for y in l | stringPrefix?(PNAME x,PNAME y)] @@ -985,7 +985,7 @@ displayValue($op,u,omitVariableNameIfTrue) == strconc('"Value of ", PNAME $op,'": ") labmode := prefix2String objMode(u) if atom labmode then labmode := [labmode] - IDENTP expr and getConstructorKindFromDB expr = "domain" => + ident? expr and getConstructorKindFromDB expr = "domain" => sayMSG concat('" ",label,labmode,rhs,form2String expr) mathprint ['CONCAT,label,:labmode,rhs, outputFormat(expr,objMode(u))] @@ -1577,7 +1577,7 @@ restoreHistory(fn) == -- uses fn $historyFileType to recover an old session -- if fn = nil, then use $oldHistoryFileName if null fn then fn' := $oldHistoryFileName - else if fn is [fn'] and IDENTP(fn') then fn' := fn' + else if fn is [fn'] and ident?(fn') then fn' := fn' else throwKeyedMsg("S2IH0023",[fn']) restfile := makeHistFileName(fn') null MAKE_-INPUT_-FILENAME restfile => @@ -2368,7 +2368,7 @@ undo(l) == n := null l => -1 first l - if IDENTP n then + if ident? n then n := readInteger PNAME n if not integer? n then userError '"undo argument must be an integer" $InteractiveFrame := undoSteps(undoCount n,undoWhen) diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot index 6971bca7..4084ff67 100644 --- a/src/interp/i-util.boot +++ b/src/interp/i-util.boot @@ -153,7 +153,7 @@ mkPredList listOfEntries == ++ Validate variable name `var', or abort analysis. validateVariableNameOrElse var == - not IDENTP var => throwKeyedMsg("S2IS0016",[STRINGIMAGE var]) + not ident? var => throwKeyedMsg("S2IS0016",[STRINGIMAGE var]) var in '(% %%) => throwKeyedMsg("S2IS0050",[var]) true diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 742d1546..561edc19 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -543,7 +543,7 @@ hashNewLookupInCategories(op,sig,dom,dollar) == if $monitorNewWorld then sayLooking1('"already instantiated cat package",entry) entry - IDENTP entry => + ident? entry => cat := catVec.i packageForm := nil if not property(entry,'LOADED) then loadLib entry diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index 7bbbb22f..ceeed354 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -583,7 +583,7 @@ for x in [ -- symbol unary functions ['%gensym, :'GENSYM], ['%sname, :'SYMBOL_-NAME], - ['%ident?, :'IDENTP], + ['%ident?, :'ident?], ['%property,:'GET], -- string functions @@ -690,10 +690,10 @@ getOpcodeExpander op == ++ suitable for evaluation by the VM. expandToVMForm x == x = '%false or x = '%nil => 'NIL - IDENTP x and (x' := x has %Rename) => x' + ident? x and (x' := x has %Rename) => x' atomic? x => x [op,:args] := x - IDENTP op and (fun:= getOpcodeExpander op) => apply(fun,x,nil) + ident? op and (fun:= getOpcodeExpander op) => apply(fun,x,nil) op' := expandToVMForm op args' := expandToVMForm args sameObject?(op,op') and sameObject?(args,args') => x diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 053fdf0d..7cae8dcb 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -782,7 +782,7 @@ isDomainConstructorForm(D,e) == isFunctor x == op:= opOf x - not IDENTP op => false + not ident? op => false $InteractiveMode => builtinFunctorName? op => true getConstructorKindFromDB op in '(domain package) diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index a99a13ef..fd5d56bb 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -48,7 +48,7 @@ addDomain(domain,e) == atom domain => domain="$EmptyMode" => e domain="$NoValueMode" => e - not IDENTP domain or 2 < #(s:= STRINGIMAGE domain) and + not ident? domain or 2 < #(s:= STRINGIMAGE domain) and char "#" = stringChar(s,0) and char "#" = stringChar(s,1) => e symbolMember?(domain,getDomainsInScope e) => e isLiteral(domain,e) => e diff --git a/src/interp/msg.boot b/src/interp/msg.boot index a3029fcd..23826171 100644 --- a/src/interp/msg.boot +++ b/src/interp/msg.boot @@ -546,7 +546,7 @@ getMsgFTTag? msg == IFCAR member (IFCAR getMsgPosTagOb msg,_ getMsgKey msg == msg.2 -getMsgKey? msg == IDENTP (val := getMsgKey msg) => val +getMsgKey? msg == ident? (val := getMsgKey msg) => val getMsgArgL msg == msg.3 diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index 3aa2dbfe..6abdf340 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -578,7 +578,7 @@ brightPrint(x,out == $OutputStream) == brightPrint0(x,out == $OutputStream) == $texFormatting => brightPrint0AsTeX(x,out) - if IDENTP x then x := symbolName x + if ident? x then x := symbolName x not string? x => brightPrintHighlight(x,out) -- if the first character is a backslash and the second is a percent sign, @@ -644,7 +644,7 @@ brightPrint0AsTeX(x, out == $OutputStream) == brightPrintHighlight(x,out) blankIndicator x == - if IDENTP x then x := symbolName x + if ident? x then x := symbolName x not string? x or maxIndex x < 1 => nil stringChar(x,0) = char "%" and stringChar(x,1) = char "x" => maxIndex x > 1 => readInteger subString(x,2) @@ -660,7 +660,7 @@ brightPrint1(x, out == $OutputStream) == brightPrintHighlight(x, out == $OutputStream) == $texFormatting => brightPrintHighlightAsTeX(x,out) x is [key,:rst] => - if IDENTP key then key := symbolName key + if ident? key then key := symbolName key key is '"%m" => mathprint(rst,out) string? key and key in '("%p" "%s") => PRETTYPRIN0(rst,out) key is '"%ce" => brightPrintCenter(rst,out) @@ -677,7 +677,7 @@ brightPrintHighlight(x, out == $OutputStream) == sayString('" . ",out) brightPrint1(la,out) sayString('")",out) - IDENTP x => sayString(symbolName x,out) + ident? x => sayString(symbolName x,out) -- following line helps find certain bugs that slip through -- also see sayBrightlyLength1 vector? x => sayString('"UNPRINTABLE",out) @@ -704,7 +704,7 @@ brightPrintHighlightAsTeX(x, out == $OutputStream) == sayString('" . ",out) brightPrint1(la,out) sayString('")",out) - IDENTP x => sayString(symbolName x,out) + ident? x => sayString(symbolName x,out) vector? x => sayString('"UNPRINTABLE",out) sayString(object2String x,out) @@ -802,7 +802,7 @@ sayBrightlyLength1 x == string? x and # x > 2 and stringChar(x,0) = char "%" and stringChar(x,1) = char "x" => readInteger subString(x,2) string? x => # x - IDENTP x => # symbolName x + ident? x => # symbolName x -- following line helps find certain bugs that slip through -- also see brightPrintHighlight vector? x => # '"UNPRINTABLE" diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index b4064de1..b536b201 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -802,7 +802,7 @@ fortPre1 e == member(op,["**" , '"**"]) => [rand,exponent] := args rand = "%e" => fortPre1 ["exp", exponent] - (IDENTP rand or string? rand) and exponent=2 => ["*", rand, rand] + (ident? rand or string? rand) and exponent=2 => ["*", rand, rand] (integer? exponent and abs(exponent) < 32768) => ["**",fortPre1 rand,exponent] ["**", fortPre1 rand,fortPre1 exponent] op = "ROOT" => diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 746a7067..f3ee3e09 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -122,7 +122,7 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) == (x' := isQuasiquote x) => quasiquote encode(x',isQuasiquote compForm,false) op is "Enumeration" => x - IDENTP op and (constructor? op or builtinConstructor? op) => + ident? op and (constructor? op or builtinConstructor? op) => [op,:[encode(y,z,false) for y in x.args for z in compForm.args]] -- enumeration constants are like field names, they do not need -- to be encoded. @@ -139,7 +139,7 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) == listOfBoundVars form == -- Only called from the function genDeltaEntry below form is '$ => [] - IDENTP form and (u:=get(form,'value,$e)) => + ident? form and (u:=get(form,'value,$e)) => u:=u.expr builtinConstructor? KAR u => listOfBoundVars u [form] @@ -157,7 +157,7 @@ listOfBoundVars form == needToQuoteFlags?(sig,env) == or/[selector?(t,env) for t in sig] where selector?(t,e) == - IDENTP t and null get(t,"value",e) + ident? t and null get(t,"value",e) optDeltaEntry(op,sig,dc,eltOrConst) == $killOptimizeIfTrue => nil @@ -176,7 +176,7 @@ optDeltaEntry(op,sig,dc,eltOrConst) == if fun = nil and needToQuoteFlags?(sig,$e) then nsig := [quoteSelector tt for tt in sig] where quoteSelector(x) == - not(IDENTP x) => x + not(ident? x) => x get(x,'value,$e) => x x='$ => x MKQ x @@ -291,7 +291,7 @@ NRTassignCapsuleFunctionSlot(op,sig) == NRTinnerGetLocalIndex x == atom x => x op := x.op - IDENTP op and (constructor? op or builtinConstructor? op) => + ident? op and (constructor? op or builtinConstructor? op) => NRTgetLocalIndex x op is "[||]" => NRTgetLocalIndex x NRTaddInner x diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 52cda675..4b1d036f 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -97,7 +97,7 @@ evalSlotDomain(u,dollar) == --lazy domains need to marked; this is dangerous? y is [v,:.] => vector? v => lazyDomainSet(y,dollar,u) --old style has [$,code,:lazyt] - IDENTP v and constructor? v + ident? v and constructor? v or v in '(Record Union Mapping Enumeration) => lazyDomainSet(y,dollar,u) --new style has lazyt y @@ -287,7 +287,7 @@ newLookupInCategories(op,sig,dom,dollar) == if $monitorNewWorld then sayLooking1('"already instantiated cat package",entry) entry - IDENTP entry => + ident? entry => cat := vectorRef(catVec,i) packageForm := nil if not property(entry,'LOADED) then loadLib entry @@ -366,7 +366,7 @@ newLookupInCategories1(op,sig,dom,dollar) == if $monitorNewWorld then sayLooking1('"already instantiated cat package",entry) entry - IDENTP entry => + ident? entry => cat := first node packageForm := nil if not property(entry,'LOADED) then loadLib entry @@ -449,7 +449,7 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) == string? a => string? s => a = s s is ['QUOTE,y] and PNAME y = a - IDENTP s and symbolName s = a + ident? s and symbolName s = a atom a => a = s op := opOf a op is 'NRTEVAL => s = nrtEval(second a,domain) @@ -609,7 +609,7 @@ lazyDomainSet(lazyForm,thisDomain,slot) == ++ resolved to constructor calls. Note: it is assumed that no ++ such resolution has already occured. resolveNiladicConstructors form == - IDENTP form and niladicConstructorFromDB form => [form] + ident? form and niladicConstructorFromDB form => [form] atom form => form form is ["QUOTE",:.] => form for args in tails rest form repeat diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index 7f78ed47..7f18be08 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -55,7 +55,7 @@ postTransform: %ParseTree -> %ParseForm postTransform y == x:= y u:= postTran x - if u is ["%Comma",:l,[":",y,t]] and (and/[IDENTP x for x in l]) then u:= + if u is ["%Comma",:l,[":",y,t]] and (and/[ident? x for x in l]) then u:= [":",["LISTOF",:l,y],t] postTransformCheck u u @@ -177,7 +177,7 @@ postAtom x == x=0 => $Zero x=1 => $One x='T => "T$" -- rename T in spad code to T$ - IDENTP x and niladicConstructorFromDB x => [x] + ident? x and niladicConstructorFromDB x => [x] x="," => "%Comma" x = "^" => "**" -- always use `**' internally for exponentiation x @@ -194,7 +194,7 @@ postBlockItemList l == postBlockItem: %ParseTree -> %ParseForm postBlockItem x == x:= postTran x - x is ["%Comma",:l,[":",y,t]] and (and/[IDENTP x for x in l]) => + x is ["%Comma",:l,[":",y,t]] and (and/[ident? x for x in l]) => [":",["LISTOF",:l,y],t] x @@ -257,7 +257,7 @@ postMDef(t) == [.,lhs,rhs] := t $InteractiveMode => lhs := postTran lhs - not IDENTP lhs => throwKeyedMsg("S2IP0001",nil) + not ident? lhs => throwKeyedMsg("S2IP0001",nil) ["MDEF",lhs,nil,nil,postTran rhs] lhs:= postTran lhs [form,targetType]:= @@ -328,7 +328,7 @@ postScripts t == getScriptName: (%Symbol,%ParseTree, %Short) -> %ParseForm getScriptName(op,a,numberOfFunctionalArgs) == - if not IDENTP op then + if not ident? op then postError ['" ",op,'" cannot have scripts"] INTERNL("*",STRINGIMAGE numberOfFunctionalArgs, decodeScripts a,symbolName op) diff --git a/src/interp/setvars.boot b/src/interp/setvars.boot index 4b459db5..2cea7a29 100644 --- a/src/interp/setvars.boot +++ b/src/interp/setvars.boot @@ -775,7 +775,7 @@ countCache n == $options => $options is [["vars",:l]] => for x in l repeat - not IDENTP x => sayKeyedMsg("S2IF0007",[x]) + not ident? x => sayKeyedMsg("S2IF0007",[x]) $cacheAlist:= insertAlist(x,n,$cacheAlist) cacheCountName:= INTERNL(x,'";COUNT") symbolValue(cacheCountName) := n diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot index e19a4540..ae6c65ad 100644 --- a/src/interp/showimp.boot +++ b/src/interp/showimp.boot @@ -413,7 +413,7 @@ dcCats con == [:bright '"if",:pred2English $predvec.(predNumber - 1)] extra := null (info := catinfo.i) => nil - IDENTP info => bright '"package" + ident? info => bright '"package" bright '"instantiated" sayBrightly concat(form2String formatSlotDomain form,suffix,extra) @@ -430,7 +430,7 @@ dcCats1 con == [:bright '"if",:pred2English $predvec.(predNumber - 1)] extra := null (info := catinfo.i) => nil - IDENTP info => bright '"package" + ident? info => bright '"package" bright '"instantiated" sayBrightly concat(form2String formatSlotDomain form,suffix,extra) diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index 53114135..b6c0ba0e 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -63,7 +63,7 @@ $COMBLOCKLIST := nil ++ representation of a domain, as a Lisp type specifier as seen by ++ the runtime system. getVMType d == - IDENTP d => + ident? d => d is "*" => d "%Thing" string? d => "%Thing" -- literal flag parameter @@ -102,12 +102,12 @@ getVMType d == ++ returns true if `f' is bound to a macro. macrop: %Thing -> %Boolean macrop f == - IDENTP f and not null MACRO_-FUNCTION f + ident? f and not null MACRO_-FUNCTION f ++ returns true if `f' is bound to a function functionp: %Thing -> %Boolean functionp f == - IDENTP f => FBOUNDP f and null MACRO_-FUNCTION f + ident? f => FBOUNDP f and null MACRO_-FUNCTION f function? f ++ returns true if `x' is contained in `y'. diff --git a/src/interp/trace.boot b/src/interp/trace.boot index c689a91d..9465a19a 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -183,14 +183,14 @@ getTraceOption (x is [key,:l]) == key='break => null l => ['break,'before] opts := [selectOptionLC(y,'(before after),nil) for y in l] - and/[IDENTP y for y in opts] => ['break,:opts] + and/[ident? y for y in opts] => ['break,:opts] stackTraceOptionError ["S2IT0008",nil] key='restore => null l => x stackTraceOptionError ["S2IT0009",[strconc('")",object2String key)]] key='only => ['only,:transOnlyOption l] key='within => - l is [a] and IDENTP a => x + l is [a] and ident? a => x stackTraceOptionError ["S2IT0010",['")within"]] key in '(cond before after) => key:= @@ -356,9 +356,9 @@ coerceSpadFunValue2E(value) == objValUnwrap coerceInteractive(objNewWrap(value,first $tracedSpadModemap), $OutputForm) -isListOfIdentifiers l == and/[IDENTP x for x in l] +isListOfIdentifiers l == and/[ident? x for x in l] -isListOfIdentifiersOrStrings l == and/[IDENTP x or string? x for x in l] +isListOfIdentifiersOrStrings l == and/[ident? x or string? x for x in l] getMapSubNames(l) == subs:= nil diff --git a/src/interp/word.boot b/src/interp/word.boot index be576794..304ad784 100644 --- a/src/interp/word.boot +++ b/src/interp/word.boot @@ -400,5 +400,5 @@ obSearch x == vec:= OBARRAY() pattern:= PNAME x [y for i in 0..maxIndex OBARRAY() | - (IDENTP (y := vec.i) or CVEC y) and match?(pattern,COPY y)] + (ident? (y := vec.i) or CVEC y) and match?(pattern,COPY y)] diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in index 338d37ee..46d5306f 100644 --- a/src/lisp/core.lisp.in +++ b/src/lisp/core.lisp.in @@ -183,6 +183,7 @@ "CONCAT" "$EditorProgram" + "ident?" ;; numeric support "%fNaN?" )) @@ -1320,6 +1321,11 @@ (eval-when (:load-toplevel :execute) (pushnew #'shoe-provide-module sb-ext:*module-provider-functions*)) +;; Return true if `x' designates an identifier. +(defun |ident?| (x) + (and (symbolp x) + (not (null x)))) + ;; ;; -*-* Numerics support -*- ;; |