diff options
| author | dos-reis <gdr@axiomatics.org> | 2010-05-06 15:23:36 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2010-05-06 15:23:36 +0000 |
| commit | 62fb1ed88e7c6a94e1ba833a2078cc162e1a44f9 (patch) | |
| tree | c78458eff7f895c11fc5e714e579ffd152eb5786 | |
| parent | 1747742ca654ed7b8907a3622a3e5dffeff9931e (diff) | |
| download | open-axiom-62fb1ed88e7c6a94e1ba833a2078cc162e1a44f9.tar.gz | |
* interp/wi2.boot: Replace INTEGERP, STRINGP, SYMBOLP, CONSP with
integer?, string?, symbol?, and cons? respectively.
* interp/wi1.boot: Likewise.
* interp/trace.boot: Likewise.
* interp/sys-utility.boot: Likewise.
* interp/showimp.boot: Likewise.
* interp/setvars.boot: Likewise.
* interp/record.boot: Likewise.
* interp/pspad2.boot: Likewise.
* interp/pspad1.boot: Likewise.
* interp/postpar.boot: Likewise.
* interp/posit.boot: Likewise.
* interp/pf2sex.boot: Likewise.
* interp/pf2atree.boot: Likewise.
* interp/parse.boot: Likewise.
* interp/packtran.boot: Likewise.
* interp/nrunopt.boot: Likewise.
* interp/nrungo.boot: Likewise.
* interp/nrunfast.boot: Likewise.
* interp/nruncomp.boot: Likewise.
* interp/newfort.boot: Likewise.
* interp/msgdb.boot: Likewise.
* interp/msg.boot: Likewise.
* interp/modemap.boot: Likewise.
* interp/match.boot: Likewise.
* interp/mark.boot: Likewise.
* interp/interop.boot: Likewise.
* interp/int-top.boot: Likewise.
* interp/i-toplev.boot: Likewise.
* interp/i-syscmd.boot: Likewise.
* interp/i-spec2.boot: Likewise.
* interp/i-spec1.boot: Likewise.
* interp/i-resolv.boot: Likewise.
* interp/i-output.boot: Likewise.
* interp/i-object.boot: Likewise.
* interp/i-map.boot: Likewise.
* interp/i-intern.boot: Likewise.
* interp/i-funsel.boot: Likewise.
* interp/i-eval.boot: Likewise.
* interp/i-coerfn.boot: Likewise.
* interp/i-coerce.boot: Likewise.
* interp/i-analy.boot: Likewise.
* interp/htsetvar.boot: Likewise.
* interp/htcheck.boot: Likewise.
* interp/ht-util.boot: Likewise.
* interp/ht-root.boot: Likewise.
* interp/g-util.boot: Likewise.
* interp/g-opt.boot: Likewise.
* interp/g-error.boot: Likewise.
* interp/g-boot.boot: Likewise.
* interp/functor.boot: Likewise.
* interp/fortcall.boot: Likewise.
* interp/format.boot: Likewise.
* interp/diagnostics.boot: Likewise.
* interp/define.boot: Likewise.
* interp/compress.boot: Likewise.
* interp/compiler.boot: Likewise.
* interp/clammed.boot: Likewise.
* interp/clam.boot: Likewise.
* interp/cformat.boot: Likewise.
* interp/cattable.boot: Likewise.
* interp/category.boot: Likewise.
* interp/c-util.boot: Likewise.
* interp/c-doc.boot: Likewise.
* interp/buildom.boot: Likewise.
* interp/br-util.boot: Likewise.
* interp/br-search.boot: Likewise.
* interp/br-saturn.boot: Likewise.
* interp/br-op2.boot: Likewise.
* interp/br-op1.boot: Likewise.
* interp/br-data.boot: Likewise.
* interp/br-con.boot: Likewise.
* interp/bc-util.boot: Likewise.
* interp/ax.boot: Likewise.
* interp/as.boot: Likewise.
* boot/translator.boot: Likewise.
* boot/ast.boot: Likewise.
* boot/includer.boot: Likewise.
* boot/tokens.boot: Add new replacement for integer?, string?,
symbol? and cons?
81 files changed, 606 insertions, 513 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 09c1710a..ca73592e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,86 @@ +2010-05-06 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/wi2.boot: Replace INTEGERP, STRINGP, SYMBOLP, CONSP with + integer?, string?, symbol?, and cons? respectively. + * interp/wi1.boot: Likewise. + * interp/trace.boot: Likewise. + * interp/sys-utility.boot: Likewise. + * interp/showimp.boot: Likewise. + * interp/setvars.boot: Likewise. + * interp/record.boot: Likewise. + * interp/pspad2.boot: Likewise. + * interp/pspad1.boot: Likewise. + * interp/postpar.boot: Likewise. + * interp/posit.boot: Likewise. + * interp/pf2sex.boot: Likewise. + * interp/pf2atree.boot: Likewise. + * interp/parse.boot: Likewise. + * interp/packtran.boot: Likewise. + * interp/nrunopt.boot: Likewise. + * interp/nrungo.boot: Likewise. + * interp/nrunfast.boot: Likewise. + * interp/nruncomp.boot: Likewise. + * interp/newfort.boot: Likewise. + * interp/msgdb.boot: Likewise. + * interp/msg.boot: Likewise. + * interp/modemap.boot: Likewise. + * interp/match.boot: Likewise. + * interp/mark.boot: Likewise. + * interp/interop.boot: Likewise. + * interp/int-top.boot: Likewise. + * interp/i-toplev.boot: Likewise. + * interp/i-syscmd.boot: Likewise. + * interp/i-spec2.boot: Likewise. + * interp/i-spec1.boot: Likewise. + * interp/i-resolv.boot: Likewise. + * interp/i-output.boot: Likewise. + * interp/i-object.boot: Likewise. + * interp/i-map.boot: Likewise. + * interp/i-intern.boot: Likewise. + * interp/i-funsel.boot: Likewise. + * interp/i-eval.boot: Likewise. + * interp/i-coerfn.boot: Likewise. + * interp/i-coerce.boot: Likewise. + * interp/i-analy.boot: Likewise. + * interp/htsetvar.boot: Likewise. + * interp/htcheck.boot: Likewise. + * interp/ht-util.boot: Likewise. + * interp/ht-root.boot: Likewise. + * interp/g-util.boot: Likewise. + * interp/g-opt.boot: Likewise. + * interp/g-error.boot: Likewise. + * interp/g-boot.boot: Likewise. + * interp/functor.boot: Likewise. + * interp/fortcall.boot: Likewise. + * interp/format.boot: Likewise. + * interp/diagnostics.boot: Likewise. + * interp/define.boot: Likewise. + * interp/compress.boot: Likewise. + * interp/compiler.boot: Likewise. + * interp/clammed.boot: Likewise. + * interp/clam.boot: Likewise. + * interp/cformat.boot: Likewise. + * interp/cattable.boot: Likewise. + * interp/category.boot: Likewise. + * interp/c-util.boot: Likewise. + * interp/c-doc.boot: Likewise. + * interp/buildom.boot: Likewise. + * interp/br-util.boot: Likewise. + * interp/br-search.boot: Likewise. + * interp/br-saturn.boot: Likewise. + * interp/br-op2.boot: Likewise. + * interp/br-op1.boot: Likewise. + * interp/br-data.boot: Likewise. + * interp/br-con.boot: Likewise. + * interp/bc-util.boot: Likewise. + * interp/ax.boot: Likewise. + * interp/as.boot: Likewise. + * boot/translator.boot: Likewise. + * boot/ast.boot: Likewise. + * boot/includer.boot: Likewise. + * boot/tokens.boot: Add new replacement for integer?, string?, + symbol? and cons? + 2010-05-05 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/compiler.boot (setqSingle): Ignore $QuickLet. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 6f3e701f..04a2888b 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -159,7 +159,7 @@ bfColonColon(package, name) == bfSymbol: %Thing -> %Thing bfSymbol x== - STRINGP x=> x + string? x=> x ['QUOTE,x] @@ -279,7 +279,7 @@ bfSTEP(id,fst,step,lst)== g2 ex := null lst=> [] - INTEGERP inc => + integer? inc => pred := MINUSP inc => "<" ">" @@ -541,18 +541,18 @@ bfLET2(lhs,rhs) == a := bfLET2(a,rhs) null (b := bfLET2(b,rhs)) => a atom b => [a,b] - CONSP first b => CONS(a,b) + cons? first b => CONS(a,b) [a,b] lhs is ['CONS,var1,var2] => var1 = "DOT" or var1 is ["QUOTE",:.] => bfLET2(var2,addCARorCDR('CDR,rhs)) l1 := bfLET2(var1,addCARorCDR('CAR,rhs)) null var2 or var2 = "DOT" =>l1 - if CONSP l1 and atom first l1 then l1 := cons(l1,nil) + if cons? l1 and atom first l1 then l1 := cons(l1,nil) IDENTP var2 => [:l1,bfLetForm(var2,addCARorCDR('CDR,rhs))] l2 := bfLET2(var2,addCARorCDR('CDR,rhs)) - if CONSP l2 and atom first l2 then l2 := cons(l2,nil) + if cons? l2 and atom first l2 then l2 := cons(l2,nil) APPEND(l1,l2) lhs is ['APPEND,var1,var2] => patrev := bfISReverse(var2,var1) @@ -560,7 +560,7 @@ bfLET2(lhs,rhs) == g := INTERN CONCAT('"LETTMP#", STRINGIMAGE $letGenVarCounter) $letGenVarCounter := $letGenVarCounter + 1 l2 := bfLET2(patrev,g) - if CONSP l2 and atom first l2 then l2 := cons(l2,nil) + if cons? l2 and atom first l2 then l2 := cons(l2,nil) var1 = "DOT" => [['L%T,g,rev],:l2] last l2 is ['L%T, =var1, val1] => [['L%T,g,rev],:REVERSE rest REVERSE l2, @@ -585,7 +585,7 @@ bfLET(lhs,rhs) == bfLET1(lhs,rhs) addCARorCDR(acc,expr) == - NULL CONSP expr => [acc,expr] + NULL cons? expr => [acc,expr] acc = 'CAR and expr is ["REVERSE",:.] => ["CAR",["LAST",:rest expr]] -- cons('last,rest expr) @@ -629,7 +629,7 @@ bfISReverse(x,a) == bfIS1(lhs,rhs) == null rhs => ['NULL,lhs] - STRINGP rhs => ['EQ,lhs,['QUOTE,INTERN rhs]] + string? rhs => ['EQ,lhs,['QUOTE,INTERN rhs]] NUMBERP rhs => ["EQUAL",lhs,rhs] atom rhs => ['PROGN,bfLetForm(rhs,lhs),'T] rhs is ['QUOTE,a] => @@ -639,7 +639,7 @@ bfIS1(lhs,rhs) == l := bfLET(c,lhs) bfAND [bfIS1(lhs,d),bfMKPROGN [l,'T]] rhs is ["EQUAL",a] => bfQ(lhs,a) - CONSP lhs => + cons? lhs => g := INTERN CONCAT('"ISTMP#",STRINGIMAGE $isGenVarCounter) $isGenVarCounter := $isGenVarCounter + 1 bfMKPROGN [['L%T,g,lhs],bfIS1(g,rhs)] @@ -661,7 +661,7 @@ bfIS1(lhs,rhs) == $isGenVarCounter := $isGenVarCounter + 1 rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['REVERSE,lhs]],'T]] l2 := bfIS1(g,patrev) - if CONSP l2 and atom first l2 then l2 := cons(l2,nil) + if cons? l2 and atom first l2 then l2 := cons(l2,nil) a = "DOT" => bfAND [rev,:l2] bfAND [rev,:l2,['PROGN,bfLetForm(a,['NREVERSE,a]),'T]] bpSpecificErrorHere '"bad IS code is generated" @@ -685,9 +685,9 @@ bfReName x== ++ Generate code for a membership test `x in seq' where `seq' ++ is a sequence (e.g. a list) bfMember(var,seq) == - seq is ["QUOTE",seq'] and "and"/[SYMBOLP x for x in seq'] => + seq is ["QUOTE",seq'] and "and"/[symbol? x for x in seq'] => ["MEMQ",var,seq] - var is ["QUOTE",var'] and SYMBOLP var' => + var is ["QUOTE",var'] and symbol? var' => ["MEMQ",var,seq] var is ["char",.] => ["MEMBER",var,seq,KEYWORD::TEST,"EQL"] ["MEMBER",var,seq] @@ -728,7 +728,7 @@ defQuoteId x== x is ["QUOTE",:.] and IDENTP second x bfSmintable x== - INTEGERP x or CONSP x and first x in '(SIZE LENGTH char) + integer? x or cons? x and first x in '(SIZE LENGTH char) bfQ(l,r)== bfSmintable l or bfSmintable r => ["EQL",l,r] @@ -949,16 +949,16 @@ bfSetelt(e,l,r)== bfSetelt(bfElt(e,first l),rest l,r) bfElt(expr,sel)== - y:=SYMBOLP sel and sel has SHOESELFUNCTION + y:=symbol? sel and sel has SHOESELFUNCTION y => - INTEGERP y => ["ELT",expr,y] + integer? y => ["ELT",expr,y] [y,expr] ["ELT",expr,sel] defSETELT(var,sel,expr)== - y := SYMBOLP sel and sel has SHOESELFUNCTION + y := symbol? sel and sel has SHOESELFUNCTION y => - INTEGERP y => ["SETF",["ELT",var,y],expr] + integer? y => ["SETF",["ELT",var,y],expr] ["SETF",[y,var],expr] ["SETF",["ELT",var,sel],expr] @@ -1626,7 +1626,7 @@ genCLOZUREnativeTranslation(op,s,t,op') == genImportDeclaration(op, sig) == sig isnt ["%Signature", op', m] => coreError '"invalid signature" m isnt ["%Mapping", t, s] => coreError '"invalid function type" - if not null s and SYMBOLP s then s := [s] + if not null s and symbol? s then s := [s] %hasFeature KEYWORD::GCL => genGCLnativeTranslation(op,s,t,op') %hasFeature KEYWORD::SBCL => genSBCLnativeTranslation(op,s,t,op') diff --git a/src/boot/includer.boot b/src/boot/includer.boot index b7ee1dd7..a2d10d25 100644 --- a/src/boot/includer.boot +++ b/src/boot/includer.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -69,7 +69,7 @@ module includer -- returns a printable representation of X, when it is a symbol -- or a character, as string. Otherwise, returns nil. PNAME x == - SYMBOLP x => SYMBOL_-NAME x + symbol? x => SYMBOL_-NAME x CHARACTERP x => STRING x nil diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 518c43ef..21e9f7a0 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -202,12 +202,14 @@ (LET ((|bfVar#9| (LIST (LIST '|and| 'AND) (LIST '|append| 'APPEND) (LIST '|apply| 'APPLY) (LIST '|atom| 'ATOM) (LIST '|car| 'CAR) (LIST '|cdr| 'CDR) - (LIST '|cons| 'CONS) (LIST '|copy| 'COPY) - (LIST '|croak| 'CROAK) (LIST '|drop| 'DROP) - (LIST '|exit| 'EXIT) (LIST '|false| 'NIL) - (LIST '|first| 'CAR) (LIST '|fourth| 'CADDDR) + (LIST '|cons| 'CONS) (LIST '|cons?| 'CONSP) + (LIST '|copy| 'COPY) (LIST '|croak| 'CROAK) + (LIST '|drop| 'DROP) (LIST '|exit| 'EXIT) + (LIST '|false| 'NIL) (LIST '|first| 'CAR) + (LIST '|fourth| 'CADDDR) (LIST '|function| 'FUNCTION) (LIST '|genvar| 'GENVAR) + (LIST '|integer?| 'INTEGERP) (LIST '|lastNode| 'LAST) (LIST 'LAST '|last|) (LIST '|list| 'LIST) (LIST '|mkpf| 'MKPF) (LIST '|nconc| 'NCONC) (LIST '|nil| NIL) @@ -223,7 +225,9 @@ (LIST '|setPart| 'SETELT) (LIST '|setUnion| 'UNION) (LIST '|strconc| 'CONCAT) + (LIST '|string?| 'STRINGP) (LIST '|substitute| 'SUBST) + (LIST '|symbol?| 'SYMBOLP) (LIST '|take| 'TAKE) (LIST '|third| 'CADDR) (LIST '|true| 'T) (LIST 'PLUS '+) (LIST 'MINUS '-) (LIST 'TIMES '*) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index ef860684..38310ce0 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -240,6 +240,7 @@ for i in [ _ ["car", "CAR"] , _ ["cdr", "CDR"] , _ ["cons", "CONS"] , _ + ["cons?", "CONSP"] , _ ["copy", "COPY"] , _ ["croak", "CROAK"] , _ ["drop", "DROP"] , _ @@ -249,6 +250,7 @@ for i in [ _ ["fourth", "CADDDR"] , _ ["function","FUNCTION"] , _ ["genvar", "GENVAR"] , _ + ["integer?","INTEGERP"] , _ ["lastNode", "LAST"] , _ ["LAST", "last"] , _ ["list", "LIST"] , _ @@ -270,7 +272,9 @@ for i in [ _ ["setPart", "SETELT"] , _ ["setUnion", "UNION"] , _ ["strconc", "CONCAT"] , _ + ["string?", "STRINGP"] ,_ ["substitute", "SUBST"] , _ + ["symbol?", "SYMBOLP"] , _ ["take", "TAKE"] , ["third", "CADDR"] , _ ["true", "T"] , _ diff --git a/src/boot/translator.boot b/src/boot/translator.boot index c23debbd..c49c8209 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -377,7 +377,7 @@ shoeOutParse stream == genDeclaration(n,t) == t is ["%Mapping",valType,argTypes] => if bfTupleP argTypes then argTypes := rest argTypes - if not null argTypes and SYMBOLP argTypes + if not null argTypes and symbol? argTypes then argTypes := [argTypes] ["DECLAIM",["FTYPE",["FUNCTION",argTypes,valType],n]] ["DECLAIM",["TYPE",t,n]] diff --git a/src/interp/as.boot b/src/interp/as.boot index 7b36f74a..cfb7ce97 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -753,7 +753,7 @@ asySplit(name,end) == [SUBSTRING(name,0,k),:asySplit(SUBSTRING(name,k,nil),end-k)] createAbbreviation s == - if STRINGP s then s := INTERN s + if string? s then s := INTERN s a := constructor? s a ~= s => a nil @@ -974,7 +974,7 @@ asyFindAttrs l == notattrs := [] for x in l repeat x0 := x - while CONSP x repeat x := first x + while cons? x repeat x := first x if MEMQ(x, $BuiltinAttributes) then attrs := [:attrs, x] else notattrs := [:notattrs, x0] [attrs, notattrs] diff --git a/src/interp/ax.boot b/src/interp/ax.boot index d4e8d87a..57831a7c 100644 --- a/src/interp/ax.boot +++ b/src/interp/ax.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -166,9 +166,9 @@ axFormatAttrib(typeform) == axFormatType(typeform) == atom typeform => typeform = '$ => '% - STRINGP typeform => + string? typeform => ['Apply,'Enumeration, INTERN typeform] - INTEGERP typeform => + integer? typeform => -- need to test for PositiveInteger vs Integer axAddLiteral('integer, 'PositiveInteger, 'Literal) ['RestrictTo, ['LitInteger, STRINGIMAGE typeform ], 'PositiveInteger] @@ -211,8 +211,8 @@ axFormatType(typeform) == valueCount := 0 for x in args repeat tag := - STRINGP x => INTERN x - x is ['QUOTE,val] and STRINGP val => INTERN val + string? x => INTERN x + x is ['QUOTE,val] and string? val => INTERN val valueCount := valueCount + 1 INTERNL("value", STRINGIMAGE valueCount) taglist := [tag ,: taglist] diff --git a/src/interp/bc-util.boot b/src/interp/bc-util.boot index bc8719b1..2cd0ae5f 100644 --- a/src/interp/bc-util.boot +++ b/src/interp/bc-util.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -50,7 +50,7 @@ bcMkFunction(name,arg,args) == STRCONC(name,'"(",arg,"STRCONC"/[STRCONC('",", x) for x in args],'")") bcString2HyString2 s == - (STRINGP s) and (s.0 = char '_") => + (string? s) and (s.0 = char '_") => len := #s STRCONC('"\_"", SUBSTRING(s, 1, len-2), '"\_"") s @@ -97,9 +97,9 @@ bcString2WordList s == fn(s,0,MAXINDEX s) where fn(s,i,n) == i > n => nil k := or/[j for j in i..n | s.j ~= char '_ ] - null INTEGERP k => nil + null integer? k => nil l := bcFindString(s,k + 1,n,char '_ ) - null INTEGERP l => [SUBSTRING(s,k,nil)] + null integer? l => [SUBSTRING(s,k,nil)] [SUBSTRING(s,k,l-k),:fn(s,l + 1,n)] diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index 7789d71b..b4360039 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -77,7 +77,7 @@ conPageFastPath x == --called by conPage and constructorSearch --gets line quickly for constructor name or abbreviation s := STRINGIMAGE x charPosition(char '_*,s,0) < #s => nil --quit if name has * in it - name := (STRINGP x => INTERN x; x) + name := (string? x => INTERN x; x) entry := HGET($lowerCaseConTb,name) or return nil lineNumber := LASSQ('dbLineNumber,CDDR entry) => --'dbLineNumbers property is set by function dbAugmentConstructorDataTable diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 9ab84687..a06c9d82 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -155,7 +155,7 @@ concatWithBlanks r == '"" writedb(u) == - not STRINGP u => nil --skip if not a string + not string? u => nil --skip if not a string PRINTEXP(addPatchesToLongLines(u,500),$outStream) --positions for tick(1), dashes(2), and address(9), i.e. 12 TERPRI $outStream @@ -489,10 +489,10 @@ getImports conname == --called by mkUsersHashTable [op,:[doImport(y,template) for y in args]] [op,:[doImport(y,template) for y in args]] - INTEGERP x => doImport(template.x,template) + integer? x => doImport(template.x,template) x = '$ => '$ x = "$$" => "$$" - STRINGP x => x + string? x => x systemError '"bad argument in template" listSort(function GLESSEQP,SUBLISLIS(rest conform,$FormalMapVariableList,u)) @@ -555,7 +555,7 @@ folks u == --called by getParents and getParentsForDomain u is ['SIGNATURE,:.] => nil u is ['TYPE,:.] => nil u is ['ATTRIBUTE,a] => - CONSP a and constructor? opOf a => folks a + cons? a and constructor? opOf a => folks a nil u is ['IF,p,q,r] => q1 := folks q diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 13604dd4..3bc64cf3 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -47,7 +47,7 @@ dbFromConstructor?(htPage) == htpProperty(htPage,'conform) dbDoesOneOpHaveParameters? opAlist == or/[(or/[fn for x in items]) for [op,:items] in opAlist] where fn() == - STRINGP x => dbPart(x,2,1) ~= '"0" + string? x => dbPart(x,2,1) ~= '"0" KAR x --============================================================================ -- Master Switch Functions for Operation Views @@ -105,12 +105,12 @@ reduceByGroup(htPage,opAlist) == dbShowOp1(htPage,opAlist,which,key) == --set up for filtering below in dbGatherData $which: local := which - if INTEGERP key then + if integer? key then opAlist := dbSelectData(htPage,opAlist,key) ------> Jump out for constructor names in file <-------- - INTEGERP key and opAlist is [[con,:.]] and htpProperty(htPage,'isFile) + integer? key and opAlist is [[con,:.]] and htpProperty(htPage,'isFile) and constructor? con => return conPageChoose con - if INTEGERP key then + if integer? key then htPage := htInitPageNoScroll(htCopyProplist htPage) if which = '"operation" then htpSetProperty(htPage,'opAlist,opAlist) @@ -129,7 +129,7 @@ dbShowOp1(htPage,opAlist,which,key) == $conformsAreDomains : local := htpProperty(htPage,'domname) opCount := opAlistCount(opAlist, which) branch := - INTEGERP key => + integer? key => opCount <= $opDescriptionThreshold => 'documentation 'names key = 'names and null rest opAlist => --means a single op @@ -235,13 +235,13 @@ conform2StringList(form,opFn,argFn,exception) == res := x = exception => dbOpsForm exception pred => - STRINGP x => [x] + string? x => [x] u := APPLY(argFn,[x]) atom u and [u] or u typ := sublisFormal(args,atype) if x is ['QUOTE,a] then x := a u := mathform2HtString algCoerceInteractive(x,typ,'(OutputForm)) => [u] - NUMBERP x or STRINGP x => [x] + NUMBERP x or string? x => [x] systemError() keyword => [keyword,'": ",:res] res @@ -277,7 +277,7 @@ dbOuttran form == x is ['QUOTE,a] => a x res := mathform2HtString algCoerceInteractive(arg,typ,'(OutputForm)) - NUMBERP res or STRINGP res => res + NUMBERP res or string? res => res ['QUOTE,res] [op,:argl] @@ -342,7 +342,7 @@ dbGatherData(htPage,opAlist,which,key) == while alist repeat item := first alist isExposed? := - STRINGP item => dbExposed?(item,char 'o) --unexpanded case + string? item => dbExposed?(item,char 'o) --unexpanded case null (r := rest rest item) => true --assume true if unexpanded r . 1 --expanded case if isExposed? then return (exposureFlag := true) @@ -401,7 +401,7 @@ dbGatherDataImplementation(htPage,opAlist) == for (x := [.,.,:key]) in u for i in 0.. repeat key = domainForm => domexports := [x,:domexports] - INTEGERP key => unexports := [x,:unexports] + integer? key => unexports := [x,:unexports] isDefaultPackageForm? key => defexports := [x,:defexports] key = 'nowhere => nowheres := [x,:nowheres] key = 'constant =>constants := [x,:constants] @@ -655,13 +655,13 @@ dbShowOpDocumentation(htPage,opAlist,which,data) == for item in alist for j in 0.. repeat [sig,predicate,origin,exposeFlag,comments] := item exposeFlag or not $exposedOnlyIfTrue => - if comments ~= '"" and STRINGP comments and (k := string2Integer comments) then + if comments ~= '"" and string? comments and (k := string2Integer comments) then comments := MEMQ(k,'(0 1)) => '"" dbReadComments k tail := CDDDDR item RPLACA(tail,comments) - doc := (STRINGP comments and comments ~= '"" => comments; nil) + doc := (string? comments and comments ~= '"" => comments; nil) pred := predicate or true index := (exactlyOneOpSig => nil; base + j) if which = '"package operation" then @@ -815,7 +815,7 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == --NOTE: we must expand all lines here for a given op -- since below we will change opAlist --Case 1: Already expanded; just cons it onto ACC - null STRINGP line => --already expanded + null string? line => --already expanded if condition? then --this could have been expanded at a lower level if null atom (pred := second line) then value := pred acc := [line,:acc] --this one is already expanded; record it anyway diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index 266bdb89..2ad1c5bc 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -144,8 +144,8 @@ dbGetDisplayFormForOp(op,sig,doc) == dbGetFormFromDocumentation(op,sig,doc) or dbGetContrivedForm(op,sig) dbGetFormFromDocumentation(op,sig,x) == - doc := (STRINGP x => x; first x) - STRINGP doc and + doc := (string? x => x; first x) + string? doc and (stringPrefix?('"\spad{",doc) and (k := 6) or stringPrefix?('"\s{",doc) and (k := 3)) => n := charPosition($charRbrace,doc,k) @@ -425,7 +425,7 @@ kFormatSlotDomain x == fn formatSlotDomain x where fn x == op = 'local => second x op = ":" => [":",second x,fn third x] isConstructorName op => [fn y for y in x] - INTEGERP op => op + integer? op => op op = 'QUOTE and atom second x => second x x @@ -433,7 +433,7 @@ koCatOps(conform,domname) == conname := opOf conform oplist := reverse getConstructorOperationsFromDB conname oplist := sublisFormal(IFCDR domname or IFCDR conform ,oplist) - --check below for INTEGERP key to avoid subsumed signatures + --check below for integer? key to avoid subsumed signatures [[zeroOneConvert op,:nalist] for [op,:alist] in oplist | nalist := koCatOps1(alist)] koCatOps1 alist == [x for item in alist | x := pair] where @@ -545,7 +545,7 @@ opPageFastPath opstring == --return nil x := STRINGIMAGE opstring charPosition(char '_*,x,0) < #x => nil --quit if name has * in it - op := (STRINGP x => INTERN x; x) + op := (string? x => INTERN x; x) mmList := getAllModemapsFromDatabase(op,nil) or return nil opAlist := [[op,:[item for mm in mmList]]] where item() == [predList, origin, sig] := modemap2Sig(op, mm) diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index a8841075..83933fd5 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -151,12 +151,12 @@ htSayBind(x, options) == bcHt line == $newPage => --this path affects both saturn and old lines text := - CONSP line => [['text, :line]] - STRINGP line => line + cons? line => [['text, :line]] + string? line => line [['text, line]] if $saturn then htpAddToPageDescription($saturnPage, text) if $standard then htpAddToPageDescription($curPage, text) - CONSP line => + cons? line => $htLineList := NCONC(nreverse mapStringize COPY_-LIST line, $htLineList) $htLineList := [basicStringize line, :$htLineList] @@ -383,9 +383,9 @@ htMakePage1 itemList == for u in itemList repeat itemType := 'text items := - STRINGP u => u + string? u => u atom u => STRINGIMAGE u - STRINGP first u => u + string? first u => u u is ['text, :s] => s itemType := first u rest u @@ -447,7 +447,7 @@ mkDocLink(code,s) == ['"\lispLink[d]{\verb!", :code, '"!}{", :s, '"}"] saturnTranText x == - STRINGP x => [unTab x] + string? x => [unTab x] null x => nil r is [s,fn,:.] and s = '"\unixcommand{" => ['"{\it ",s,'".spad}"] x is [['text, :s],:r] => unTab [:s, :saturnTranText r] @@ -548,7 +548,7 @@ htMakeButtonSaturn(htCommand, message, func,options) == htpAddToPageDescription(htPage, pageDescrip) == newDescript := - STRINGP pageDescrip => [pageDescrip, :ELT(htPage, 7)] + string? pageDescrip => [pageDescrip, :ELT(htPage, 7)] nconc(nreverse COPY_-LIST pageDescrip, ELT(htPage, 7)) SETELT(htPage, 7, newDescript) @@ -1004,7 +1004,7 @@ dbGatherThenShow(htPage,opAlist,which,data,constructorIfTrue,word,fn) == thing = 'nowhere => '"implemented nowhere" thing = 'constant => '"constant" thing = '_$ => '"by the domain" - INTEGERP thing => '"unexported" + integer? thing => '"unexported" constructorIfTrue => htSay word atom thing => '" an unknown constructor" @@ -1030,7 +1030,7 @@ dbPresentOps(htPage,which,:exclusions) == implementation? := not asharp? and $UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed? rightmost? := star? or (implementation? and not $includeUnexposed?) - if INTEGERP first exclusions then exclusions := ['documentation] + if integer? first exclusions then exclusions := ['documentation] htpSetProperty(htPage,'exclusion,first exclusions) opAlist := which = '"operation" => htpProperty(htPage,'opAlist) @@ -1101,7 +1101,7 @@ dbPresentOpsSaturn(htPage,which,exclusions) == implementation? := not asharp? and $UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed? rightmost? := star? or (implementation? and not $includeUnexposed?) - if INTEGERP first exclusions then exclusions := ['documentation] + if integer? first exclusions then exclusions := ['documentation] htpSetProperty(htPage,'exclusion,first exclusions) opAlist := which = '"operation" => htpProperty(htPage,'opAlist) @@ -1358,7 +1358,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, else ndoc:= -- we are confused whether doc is a string or a list of strings - CONSP doc => [SUBSTITUTE($charNewline, $charFauxNewline, i) for i in doc] + cons? doc => [SUBSTITUTE($charNewline, $charFauxNewline, i) for i in doc] SUBSTITUTE($charNewline, $charFauxNewline,doc) htSay ndoc -- htSaySaturn '"\\" @@ -1494,7 +1494,7 @@ htBlank(:options) == htSayStandard '"\space{1}" unTab s == - STRINGP s => unTab1 s + string? s => unTab1 s atom s => s [unTab1 first s, :rest s] @@ -1631,9 +1631,9 @@ bcConform1 form == main where atom form => -- string literals, e.g. "failed", are constructor arguments -- too, until we fix that. - STRINGP form or not isConstructorName form => + string? form or not isConstructorName form => s := - STRINGP form => strconc("_"",form,"_"") + string? form => strconc("_"",form,"_"") STRINGIMAGE form (s.0 = char '_#) => (n := POSN1(form, $FormalFunctionParameterList)) => diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index d796eec9..0fefccb3 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -148,16 +148,16 @@ pmTransFilter s == s checkPmParse parse == - STRINGP parse => parse + string? parse => parse (fn parse => parse) where fn(u) == u is [op,:args] => op in '(and or not) and "and"/[checkPmParse x for x in args] - STRINGP u => true + string? u => true false nil dnForm x == - STRINGP x => x + string? x => x x is ['not,argl] => argl is ['or,:orargs]=> ['and, :[dnForm negate u for u in orargs]] where negate s == @@ -176,7 +176,7 @@ pmParseFromString s == u := ncParseFromString pmPreparse s dnForm flatten u where flatten s == s is [op,:argl] => - STRINGP op => STRCONC(op,"STRCONC"/[STRCONC('" ",x) for x in argl]) + string? op => STRCONC(op,"STRCONC"/[STRCONC('" ",x) for x in argl]) [op,:[flatten x for x in argl]] s @@ -654,7 +654,7 @@ constructorSearch(filter,key,kind) == (parse := conSpecialString? filter) => conPage parse pageName := LASSOC(DOWNCASE filter,'(("union" . DomainUnion)("record" . DomainRecord)("mapping" . DomainMapping) ("enumeration" . DomainEnumeration))) => downlink pageName - name := (STRINGP filter => INTERN filter; filter) + name := (string? filter => INTERN filter; filter) if u := HGET($lowerCaseConTb,name) then filter := STRINGIMAGE first u line := conPageFastPath DOWNCASE filter => code := dbKind line @@ -717,7 +717,7 @@ conLowerCaseConTran x == [conLowerCaseConTran y for y in x] string2Constructor x == - not STRINGP x => x + not string? x => x IFCAR HGET($lowerCaseConTb, INTERN DOWNCASE x) or x conLowerCaseConTranTryHarder x == diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot index 5becaedb..0a6c06d4 100644 --- a/src/interp/br-util.boot +++ b/src/interp/br-util.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -183,7 +183,7 @@ unMkEvalable u == lisp2HT u == ['"_'",:fn u] where fn u == IDENTP u => escapeSpecialIds PNAME u - STRINGP u => escapeString u + string? u => escapeString u ATOM u => systemError() ['"_(",:"append"/[fn x for x in u],'")"] @@ -205,7 +205,7 @@ form2HtString(x,:options) == MEMQ(x,$FormalMapVariableList) => STRCONC('"\",STRINGIMAGE x) u := escapeSpecialChars STRINGIMAGE x MEMQ(x,$emList) => STRCONC('"{\em ",u,'"}") - STRINGP x => STRCONC('"_"",u,'"_"") + string? x => STRCONC('"_"",u,'"_"") u first x = 'QUOTE => STRCONC('"'",sexpr2HtString second x) first x = ":" => STRCONC(fn second x,'": ",fn third x) @@ -237,7 +237,7 @@ form2LispString(x) == atom x => x = '_$ => '"__$" MEMQ(x,$FormalMapVariableList) => STRCONC(STRINGIMAGE '__, STRINGIMAGE x) - STRINGP x => STRCONC('"_"",STRINGIMAGE x,'"_"") + string? x => STRCONC('"_"",STRINGIMAGE x,'"_"") STRINGIMAGE x x is ['QUOTE,a] => STRCONC('"'",sexpr2LispString a) x is [":",a,b] => STRCONC(form2LispString a,'":",form2LispString b) @@ -282,7 +282,7 @@ getConstructorArgs conname == rest getConstructorForm conname bcComments(comments,:options) == italics? := not IFCAR options - STRINGP comments => + string? comments => comments = '"" => nil htSay('"\newline ") if italics? then htSay '"{\em " @@ -318,7 +318,7 @@ dbEvalableConstructor? form == null argl => true op = 'QUOTE => 'T --is a domain valued object and/[dbEvalableConstructor? x for x in argl] - INTEGERP form => true + integer? form => true false htSayItalics s == htSay('"{\em ",s,'"}") diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index 0aff103a..94d9a775 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -110,7 +110,7 @@ Record(:args) == RecordEqual(x,y,dom) == nargs := #rest(dom.0) - CONSP x => + cons? x => b:= SPADCALL(first x, first y, first(dom.(nargs + 9)) or first RPLACA(dom.(nargs + 9),findEqualFun(dom.$FirstParamSlot))) @@ -185,7 +185,7 @@ UnionEqual(x, y, dom) == for b in stripUnionTags branches for p in predlist while not same repeat typeFun := COERCE(["LAMBDA", '(_#1), p],"FUNCTION") FUNCALL(typeFun,x) and FUNCALL(typeFun,y) => - STRINGP b => same := (x = y) + string? b => same := (x = y) if p is ["EQCAR", :.] then (x := rest x; y := rest y) same := SPADCALL(x, y, findEqualFun(evalDomain b)) same @@ -200,8 +200,8 @@ coerceUn2E(x,source) == typeFun := COERCE(["LAMBDA", '(_#1), p],"FUNCTION") if FUNCALL(typeFun,x) then return if p is ["EQCAR", :.] then x := rest x --- STRINGP b => return x -- to catch "failed" etc. - STRINGP b => byGeorge := x -- to catch "failed" etc. +-- string? b => return x -- to catch "failed" etc. + string? b => byGeorge := x -- to catch "failed" etc. byGeorge := coerceVal2E(x,b) byGeorge = byJane => error '"Union bug: Cannot find appropriate branch for coerce to E" diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 37c50535..bee36a7f 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -217,7 +217,7 @@ transDoc(conname,doclist) == null lines => $attribute? => nil checkDocError1 ['"Not documented!!!!"] - u := checkTrim($x,(STRINGP lines => [lines]; $x = 'constructor => first lines; lines)) + u := checkTrim($x,(string? lines => [lines]; $x = 'constructor => first lines; lines)) $argl : local := nil --set by checkGetArgs -- tpd: related domain information doesn't exist -- if v := checkExtract('"Related Domains:",u) then @@ -349,7 +349,7 @@ checkTexht u == checkRecordHash u == while u repeat x := first u - if STRINGP x and x.0 = $charBack then + if string? x and x.0 = $charBack then if member(x,$HTlinks) and (u := checkLookForLeftBrace IFCDR u) and (u := checkLookForRightBrace IFCDR u) and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then @@ -617,7 +617,7 @@ checkIndentedLines(u, margin) == u2 newString2Words l == - not STRINGP l => [l] + not string? l => [l] m := MAXINDEX l m = -1 => NIL i := 0 @@ -647,7 +647,7 @@ checkAddPeriod s == --No, just leave blank at the end (rdj: 10/18/91) s checkGetArgs u == - NOT STRINGP u => nil + NOT string? u => nil m := MAXINDEX u k := firstNonBlankPosition(u) k > 0 => checkGetArgs SUBSTRING(u,k,nil) @@ -810,11 +810,11 @@ checkDecorate u == spadflag => ['",",:acc] ['",{}",:acc] x = '"\spad" => ['"\spad",:acc] - STRINGP x and DIGITP x.0 => [x,:acc] + string? x and DIGITP x.0 => [x,:acc] not spadflag and (CHARP x and ALPHA_-CHAR_-P x and not MEMQ(x,$charExclusions) or member(x,$argl)) => [$charRbrace,x,$charLbrace,'"\spad",:acc] - not spadflag and ((STRINGP x and not x.0 = $charBack and DIGITP(x.(MAXINDEX x))) or member(x,'("true" "false"))) => + not spadflag and ((string? x and not x.0 = $charBack and DIGITP(x.(MAXINDEX x))) or member(x,'("true" "false"))) => [$charRbrace,x,$charLbrace,'"\spad",:acc] --wrap x1, alpha3, etc xcount := SIZE x xcount = 3 and x.1 = char 't and x.2 = char 'h => @@ -938,7 +938,7 @@ checkSplitBrace x == [x] checkSplitBackslash x == - not STRINGP x => [x] + not string? x => [x] m := MAXINDEX x (k := charPosition($charBack,x,0)) < m => m = 1 or ALPHA_-CHAR_-P(x . (k + 1)) => --starts with a backslash so.. @@ -1033,7 +1033,7 @@ checkBeginEnd u == while u repeat IDENTITY x := first u - STRINGP x and x.0 = $charBack and #x > 2 and not HGET($htMacroTable,x) + string? x and x.0 = $charBack and #x > 2 and not HGET($htMacroTable,x) and not (x = '"\spadignore") and IFCAR IFCDR u = $charLbrace and not (substring?('"\radiobox",x,0) or substring?('"\inputbox",x,0))=> @@ -1302,10 +1302,10 @@ checkDecorateForHt u == if $checkingXmptex? then checkDocError ["Symbol ",x,'" appearing outside \spad{}"] x = '"$" or x = '"%" => checkDocError ['"Unescaped ",x] --- null spadflag and STRINGP x and (member(x,$argl) or #x = 1 +-- null spadflag and string? x and (member(x,$argl) or #x = 1 -- and ALPHA_-CHAR_-P x.0) and not member(x,'("a" "A")) => -- checkDocError1 ['"Naked ",x] --- null spadflag and STRINGP x and (not x.0 = $charBack and not DIGITP(x.0) and DIGITP(x.(MAXINDEX x))or member(x,'("true" "false"))) +-- null spadflag and string? x and (not x.0 = $charBack and not DIGITP(x.0) and DIGITP(x.(MAXINDEX x))or member(x,'("true" "false"))) -- => checkDocError1 ["Naked ",x] u := rest u u diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 46417f08..f65b5dd6 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -92,7 +92,7 @@ $optExportedFunctionReference := false ++ Quote form, if not a basic value. quoteMinimally form == - FIXP form or STRINGP form or form = nil or form = true => form + FIXP form or string? form or form = nil or form = true => form ["QUOTE",form] ++ If using old `Rep' definition semantics, return `$' when m is `Rep'. @@ -177,7 +177,7 @@ continue() == FIN comp($x,$m,$f) LEVEL(:l) == APPLY('level,l) level(:l) == null l => same() - l is [n] and INTEGERP n => displayComp ($level:= n) + l is [n] and integer? n => displayComp ($level:= n) SAY '"Correct format: (level n) where n is the level you want to go to" UP() == up() @@ -507,7 +507,7 @@ diagnoseUnknownType(t,e) == t in '($ constant) => t t' := assoc(t,getDomainsInScope e) => t' (m := getmode(t,e)) and isKnownCategory(m,$CategoryFrame) => t - STRINGP t => t + string? t => t -- ??? We should not to check for $$ at this stage. -- ??? This is a bug in the compiler that needs to be fixed. t = "$$" => t @@ -775,7 +775,7 @@ stackAndThrow(msg, args == nil) == $compErrorMessageStack:= [msg,:$compErrorMessageStack] THROW("compOrCroak",nil) -printString x == PRINTEXP (STRINGP x => x; PNAME x) +printString x == PRINTEXP (string? x => x; PNAME x) printAny x == if atom x then printString x else PRIN1 x @@ -882,7 +882,7 @@ substituteOp(op',op,x) == sublisV(p,e) == (atom p => e; suba(p,e)) where suba(p,e) == - STRINGP e => e + string? e => e -- no need to descend vectors unless they are categories isCategory e => LIST2VEC [suba(p,e.i) for i in 0..MAXINDEX e] atom e => (y:= ASSQ(e,p) => rest y; e) @@ -1220,7 +1220,7 @@ foldExportedFunctionReferences defs == ++ record optimizations permitted at level `level'. setCompilerOptimizations level == level = nil => nil - INTEGERP level => + integer? level => if level = 0 then -- explicit request for no optimization. $optProclaim := false @@ -1654,7 +1654,7 @@ expandFormTemplate(shell,args,slot) == args.n -- FIXME: we should probably expand with dual signature slot is ["NRTEVAL",val] => val slot is ["QUOTE",val] => - STRINGP val => val + string? val => val slot [expandFormTemplate(shell,args,i) for i in slot] @@ -1669,7 +1669,7 @@ equalFormTemplate(shell,args,slot,form) == equalFormTemplate(shell,args,args.n,form) slot is ["NTREVAL",val] => form = val slot is ["QUOTE",val] => - STRINGP val => val = form + string? val => val = form slot = form atom slot or atom form => form = slot #slot ~= #form => false diff --git a/src/interp/category.boot b/src/interp/category.boot index c01116fb..728faa85 100644 --- a/src/interp/category.boot +++ b/src/interp/category.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -112,7 +112,7 @@ mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) == Prepare u == "union"/[Prepare2 v for v in u] Prepare2 v == v is "$" => nil - STRINGP v => nil + string? v => nil atom v => [v] MEMQ(first v,$PrimitiveDomainNames) => nil --This variable is set in INIT LISP @@ -203,7 +203,7 @@ SigListUnion(extra,original) == -- present under certain conditions -- We must pick up the previous implementation, if any --+ - if ximplem is [[q,.,index]] and INTEGERP index and (q="ELT" or q="CONST") + if ximplem is [[q,.,index]] and integer? index and (q="ELT" or q="CONST") then $NewCatVec. index:= e original:= [e,:original] original @@ -316,7 +316,7 @@ MachineLevelSubset(a,b) == --true if a is a machine-level subset of b a=b => true b is ["Union",:blist] and member(a,blist) and - (and/[STRINGP x for x in blist | x~=a]) => true + (and/[string? x for x in blist | x~=a]) => true --all other branches must be distinct objects not null isSubDomain(a,b) --we assume all subsets are true at the machine level diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index 07e04afd..39e6f699 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -1,6 +1,6 @@ -- Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -277,7 +277,7 @@ isFormalArgumentList argl == and/[x=fa for x in argl for fa in $FormalMapVariableList] mkCategoryExtensionAlist cform == - not CONSP cform => nil + not cons? cform => nil cop := first cform MEMQ(cop, $CategoryNames) => mkCategoryExtensionAlistBasic cform catlist := formalSubstitute(cform, first getConstructorExports(cform, true)) diff --git a/src/interp/cformat.boot b/src/interp/cformat.boot index 29bb555b..4a8939d2 100644 --- a/src/interp/cformat.boot +++ b/src/interp/cformat.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copryight (C) 2007, Gabriel Dos Reis +-- Copryight (C) 2007-2010, Gabriel Dos Reis -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -47,7 +47,7 @@ namespace BOOT %origin x == [function porigin, x] porigin x == - (STRINGP x => x; pfname x) + (string? x => x; pfname x) %fname x == [function pfname, x] diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 56347798..0028ffe1 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -87,7 +87,7 @@ compClam(op,argl,body,$clamList) == countFl := 'count in options if #argl > 1 and eqEtc= 'EQ then keyedSystemError("S2GE0007",[op]) - (not IDENTP kind) and (not INTEGERP kind or kind < 1) => + (not IDENTP kind) and (not integer? kind or kind < 1) => keyedSystemError("S2GE0005",[op]) IDENTP kind => shiftFl => keyedSystemError("S2GE0008",[op]) @@ -328,7 +328,7 @@ HGETandCount(hashTable,prop) == u clearClams() == - for [fn,kind,:.] in $clamList | kind = 'hash or INTEGERP kind repeat + for [fn,kind,:.] in $clamList | kind = 'hash or integer? kind repeat clearClam fn clearClam fn == @@ -374,7 +374,7 @@ cacheStats() == for [fn,kind,:u] in $clamList repeat not ('count in u) => sayBrightly ["%b",fn,"%d","does not keep reference counts"] - INTEGERP kind => reportCircularCacheStats(fn,kind) + integer? kind => reportCircularCacheStats(fn,kind) kind = 'hash => reportHashCacheStats fn sayBrightly ["Unknown cache type for","%b",fn,"%d"] @@ -396,7 +396,7 @@ displayCacheFrequency al == mkCircularCountAlist(cl,len) == for [x,count,:.] in cl for i in 1..len while x ~= '_$failed repeat u:= assoc(count,al) => RPLACD(u,1 + rest u) - if INTEGERP $reportFavoritesIfNumber and count >= $reportFavoritesIfNumber then + if integer? $reportFavoritesIfNumber and count >= $reportFavoritesIfNumber then sayBrightlyNT [" ",count," "] pp x al:= [[count,:1],:al] @@ -674,7 +674,7 @@ globalHashtableStats(x,sortFn) == for key in keys repeat u:= HGET(x,key) for [argList,n,:.] in u repeat - not INTEGERP n => keyedSystemError("S2GE0013",[x]) + not integer? n => keyedSystemError("S2GE0013",[x]) argList1:= [constructor2ConstructorForm x for x in argList] reportList:= [[n,key,argList1],:reportList] sayBrightly ["%b"," USE NAME ARGS","%d"] diff --git a/src/interp/clammed.boot b/src/interp/clammed.boot index b985ab6b..9cf3d5c4 100644 --- a/src/interp/clammed.boot +++ b/src/interp/clammed.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -75,7 +75,7 @@ isValidType form == -- Note that some forms are said to be invalid because they would -- cause problems with the interpreter. Thus things like P P I -- are not valid. - STRINGP form => true + string? form => true IDENTP form => false member(form,$LangSupportTypes) => true form is ['Record,:selectors] => @@ -163,7 +163,7 @@ isLegitimateMode(t,hasPolyMode,polyVarList) == -- variables, or two levels of Polynomial null t => true -- a terminating condition with underDomainOf t = $EmptyMode => true - STRINGP t => true + string? t => true ATOM t => false badDoubles := CONS($QuotientField, '(Gaussian Complex Polynomial Expression)) diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 1c181546..bb50ac19 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -183,7 +183,7 @@ comp3(x,m,$e) == e:= $e --for debugging purposes m is ["Mapping",:.] => compWithMappingMode(x,m,e) m is ["QUOTE",a] => (x=a => [x,m,$e]; nil) - STRINGP m => (atom x => (m=x or m=STRINGIMAGE x => [m,m,e]; nil); nil) + string? m => (atom x => (m=x or m=STRINGIMAGE x => [m,m,e]; nil); nil) -- In quasiquote mode, x should match exactly (y := isQuasiquote m) => y = x => [["QUOTE",x], m, $e] @@ -277,7 +277,7 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) == if get(x,"modemap",$CategoryFrame) is [[[.,target,:argModeList],.],:.] and (and/[extendsCategoryForm("$",s,mode) for mode in argModeList for s in sl] ) and extendsCategoryForm("$",target,m') then return [x,m,e] - if STRINGP x then x:= INTERN x + if string? x then x:= INTERN x for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat [.,.,e]:= compMakeDeclaration(v,m,e) (vl ~= nil) and not hasFormalMapVariable(x, vl) => return @@ -398,14 +398,14 @@ compAtom(x,m,e) == t:= IDENTP x => compSymbol(x,m,e) or return nil member(m,$IOFormDomains) and primitiveType x => [x,m,e] - STRINGP x => [x,x,e] + string? x => [x,x,e] [x,primitiveType x or return nil,e] convert(t,m) primitiveType x == x is nil => $EmptyMode - STRINGP x => $String - INTEGERP x => + string? x => $String + integer? x => x=0 => $NonNegativeInteger x>0 => $PositiveInteger $Integer @@ -828,7 +828,7 @@ setqSingle(id,val,m,E) == newProplist := consProplistOf(id,currentProplist,"value",removeEnv [val,:rest T]) e':= - CONSP id => e' + cons? id => e' addBinding(id,newProplist,e') if isDomainForm(val,e') then if isDomainInScope(id,e') then @@ -1502,7 +1502,7 @@ compColon([":",f,t],m,e) == (if not member(t,getDomainsInScope e) then e:= addDomain(t,e); t) isDomainForm(t,e) or isCategoryForm(t,e) => t t is ["Mapping",m',:r] => t - STRINGP t => t -- literal flag types are OK + string? t => t -- literal flag types are OK unknownTypeError t t f is ["LISTOF",:l] => @@ -1632,7 +1632,7 @@ commonSuperType(m,m') == coerceSubset: (%Triple,%Mode) -> %Maybe %Triple coerceSubset([x,m,e],m') == isSubset(m,m',e) => [x,m',e] - INTEGERP x and (m'' := commonSuperType(m,m')) => + integer? x and (m'' := commonSuperType(m,m')) => -- obviously this is temporary satisfies(x,isSubDomain(m',m'')) => [x,m',e] nil @@ -1642,13 +1642,13 @@ coerceHard: (%Triple,%Mode) -> %Maybe %Triple coerceHard(T,m) == $e: local:= T.env m':= T.mode - STRINGP m' and modeEqual(m,$String) => [T.expr,m,$e] + string? m' and modeEqual(m,$String) => [T.expr,m,$e] modeEqual(m',m) or (get(m',"value",$e) is [m'',:.] or getmode(m',$e) is ["Mapping",m'']) and modeEqual(m'',m) or (get(m,"value",$e) is [m'',:.] or getmode(m,$e) is ["Mapping",m'']) and modeEqual(m'',m') => [T.expr,m,T.env] - STRINGP T.expr and T.expr=m => [T.expr,m,$e] + string? T.expr and T.expr=m => [T.expr,m,$e] isCategoryForm(m,$e) => $bootStrapMode = true => [T.expr,m,$e] extendsCategoryForm(T.expr,T.mode,m) => [T.expr,m,$e] @@ -1728,7 +1728,7 @@ coerceSuperset(T,sub) == compCoerce1(x,m',e) == T:= comp(x,m',e) or comp(x,$EmptyMode,e) or return nil m1:= - STRINGP T.mode => $String + string? T.mode => $String T.mode m':=resolve(m1,m') T:=[T.expr,m1,T.env] @@ -1796,7 +1796,7 @@ compComma(form,m,e) == resolve(din,dout) == din=$NoValueMode or dout=$NoValueMode => $NoValueMode dout=$EmptyMode => din - din~=dout and (STRINGP din or STRINGP dout) => + din~=dout and (string? din or string? dout) => modeEqual(dout,$String) => dout modeEqual(din,$String) => nil mkUnion(din,dout) @@ -2096,7 +2096,7 @@ compAlternativeGuard(sn,sm,pat,e) == warnTooManyOtherwise() $catchAllCount := $catchAllCount + 1 [true,nil,e,e] - CONSP sn => + cons? sn => pat isnt ["%Comma",:.] => stackAndThrow('"Pattern must be a tuple for a tuple scrutinee",nil) #sn ~= #rest pat => @@ -2190,7 +2190,7 @@ compReduce(form,m,e) == compReduce1(form is ["REDUCE",op,.,collectForm],m,e,$formalArgList) == [collectOp,:itl,body]:= collectForm - if STRINGP op then op:= INTERN op + if string? op then op:= INTERN op collectOp ~= "COLLECT" => systemError ['"illegal reduction form:",form] $sideEffectsList: local := nil $until: local := nil @@ -2436,7 +2436,7 @@ compPer(["per",x],m,e) == T := comp(x,inType,e) or return nil if $subdomain then T := - INTEGERP T.expr and satisfies(T.expr,domainVMPredicate "$") => + integer? T.expr and satisfies(T.expr,domainVMPredicate "$") => [T.expr,"$",e] coerceSuperset(T,"$") or return nil else diff --git a/src/interp/compress.boot b/src/interp/compress.boot index 43b7a102..1d32a223 100644 --- a/src/interp/compress.boot +++ b/src/interp/compress.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -44,7 +44,7 @@ minimalise x == min x == y:=HGET($hash,x) y => y - CONSP x => + cons? x => x = '(QUOTE T) => '(QUOTE T) -- copes with a particular Lucid-ism, God knows why -- This circular way of doing things is an attempt to deal with Lucid @@ -58,7 +58,7 @@ minimalise x == for i in 0..MAXINDEX x repeat x.i:=min (x.i) HashCheck x - STRINGP x => HashCheck x + string? x => HashCheck x x HashCheck x == y:=HGET($hash,x) diff --git a/src/interp/define.boot b/src/interp/define.boot index f9d2aeeb..bdaf06d6 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1081,7 +1081,7 @@ getArgumentModeOrMoan(x,form,e) == getArgumentMode: (%Form,%Env) -> %Mode getArgumentMode(x,e) == - STRINGP x => x + string? x => x m:= get(x,'mode,e) => m checkAndDeclare(argl,form,sig,e) == @@ -1240,7 +1240,7 @@ spadCompileOrSetq (form is [nam,[lam,vl,body]]) == -- parameters are never used in the body. vl := [ renameParameter for v in vl] where renameParameter() == - NUMBERP v or IDENTP v or STRINGP v => v + NUMBERP v or IDENTP v or string? v => v GENSYM '"flag" clearReplacement nam -- Make sure we have fresh info if $optReplaceSimpleFunctions then @@ -1633,7 +1633,7 @@ DomainSubstitutionFunction(parameters,body) == --For categories, bound and used in compDefineCategory MKQ g first body="QUOTE" => body - CONSP $definition and + cons? $definition and isFunctor first body and first body ~= first $definition => ['QUOTE,optimize body] diff --git a/src/interp/diagnostics.boot b/src/interp/diagnostics.boot index 33111966..600244f8 100644 --- a/src/interp/diagnostics.boot +++ b/src/interp/diagnostics.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis +-- Copyright (C) 2007-2010, Gabriel Dos Reis -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -81,7 +81,7 @@ MESSAGEPRINT x == MESSAGEPRINT_-1 x == x = "%l" or x = '"%l" => TERPRI() - STRINGP x => PRINC x + string? x => PRINC x IDENTP x => PRINC x ATOM x => PRINC x PRINC '"(" diff --git a/src/interp/format.boot b/src/interp/format.boot index 416ecab4..f2f45437 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -175,7 +175,7 @@ reportOpSymbol op1 == if op1 = "^" then sayMessage ['" ",op1, '" is another name for", :bright '"**"] op1 := "**" - op := (STRINGP op1 => INTERN op1; op1) + op := (string? op1 => INTERN op1; op1) modemaps := getAllModemapsFromDatabase(op,nil) null modemaps => ok := true @@ -227,8 +227,8 @@ formatOperationAlistEntry (entry:= [op,:modemaps]) == formatOperation([[op,sig],.,[fn,.,n]],domain) == opSigString := formatOpSignature(op,sig) - INTEGERP n and function Undef = KAR domain.n => - if INTEGERP $commentedOps then $commentedOps := $commentedOps + 1 + integer? n and function Undef = KAR domain.n => + if integer? $commentedOps then $commentedOps := $commentedOps + 1 concat(" --",opSigString) opSigString @@ -246,11 +246,11 @@ formatOpSymbol(op,sig) == n := #sig (op = 'elt) and (n = 3) => (second(sig) = '_$) => - STRINGP (sel := third(sig)) => + string? (sel := third(sig)) => [quad,".",sel] [quad,".",quad] op - STRINGP op or GETL(op,"Led") or GETL(op,"Nud") => + string? op or GETL(op,"Led") or GETL(op,"Nud") => n = 3 => if op = 'SEGMENT then op := '".." op = 'in => [quad,'" ",op,'" ",quad] @@ -273,7 +273,7 @@ formatAttribute x == [" ",op] formatAttributeArg x == - STRINGP x and x ='"*" => "_"*_"" + string? x and x ='"*" => "_"*_"" atom x => formatOpSymbol (x,nil) x is [":",op,["Mapping",:sig]] => concat('%b,formatOpSymbol(op,sig),": ",'%d,formatMapping sig) @@ -308,7 +308,7 @@ formatSignatureArgs sml == formatSignature0 sig == null sig => "() -> ()" - INTEGERP sig => '"hashcode" + integer? sig => '"hashcode" [tm,:sml] := sig sourcePart:= formatSignatureArgs0 sml targetPart:= prefix2String0 tm @@ -343,7 +343,7 @@ prefix2String0 form == -- SUBRP form => formWrapId BPINAME form -- atom form => -- form=$EmptyMode or form=$quadSymbol => formWrapId specialChar 'quad --- STRINGP form => formWrapId form +-- string? form => formWrapId form -- IDENTP form => -- constructor? form => app2StringWrap(formWrapId form, [form]) -- formWrapId form @@ -391,7 +391,7 @@ form2String1 u == constructor? u => app2StringWrap(formWrapId u, [u]) u SUBRP u => formWrapId BPINAME u - STRINGP u => formWrapId u + string? u => formWrapId u WRITE_-TO_-STRING formWrapId u u1 := u [op,:argl] := u @@ -419,7 +419,7 @@ form2String1 u == null argl => [ '":" ] null rest argl => [ '":", form2String1 first argl ] formDecl2String(argl.0,argl.1) - op = "#" and CONSP argl and LISTP first argl => + op = "#" and cons? argl and LISTP first argl => STRINGIMAGE SIZE first argl op = 'Join => formJoin2String argl op = "ATTRIBUTE" => form2String1 first argl @@ -459,9 +459,9 @@ 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 - STRINGP(x) or IDENTP(x) => x + string?(x) or IDENTP(x) => x x is [ ='_:,:.] => form2String1 x - isValidType(m) and CONSP(m) and + isValidType(m) and cons?(m) and (getConstructorKindFromDB first(m) = "domain") => (x' := coerceInteractive(objNewWrap(x,m),$OutputForm)) => form2String1 objValUnwrap x' @@ -577,7 +577,7 @@ linearFormat x == numOfSpadArguments id == char("*") = (s:= PNAME id).0 => - +/[n for i in 1.. while INTEGERP (n:=PARSE_-INTEGER PNAME s.i)] + +/[n for i in 1.. while integer? (n:=PARSE_-INTEGER PNAME s.i)] keyedSystemError("S2IF0012",[id]) linearFormatForm(op,argl) == @@ -599,7 +599,7 @@ linearFormatForm(op,argl) == scriptArgs:= scriptArgs => concat(specialChar 'lbrk,scriptArgs, specialChar 'rbrk) nil - l := [(STRINGP f => f; STRINGIMAGE f) for f in + l := [(string? f => f; STRINGIMAGE f) for f in concat(cleanOp,scriptArgs,fnArgs)] "STRCONC"/l @@ -731,15 +731,15 @@ mathObject2String x == object2String x object2String x == - STRINGP x => x + string? x => x IDENTP x => PNAME x NULL x => '"" - CONSP x => STRCONC(object2String first x, object2String rest x) + cons? x => STRCONC(object2String first x, object2String rest x) WRITE_-TO_-STRING x object2Identifier x == IDENTP x => x - STRINGP x => INTERN x + string? x => INTERN x INTERN WRITE_-TO_-STRING x blankList x == "append"/[[BLANK,y] for y in x] @@ -753,7 +753,7 @@ pkey keyStuff == key := first keyStuff keyStuff := IFCDR keyStuff next := IFCAR keyStuff - while CONSP next repeat + while cons? next repeat if first next = 'dbN then dbN := second next else argL := next keyStuff := IFCDR keyStuff @@ -790,8 +790,8 @@ form2Fence1 x == form2FenceQuote x == NUMBERP x => [STRINGIMAGE x] - SYMBOLP x => [FORMAT(NIL, '"|~a|", x)] - STRINGP x => ['"_"",x,'"_""] + symbol? x => [FORMAT(NIL, '"|~a|", x)] + string? x => ['"_"",x,'"_""] atom x => systemErrorHere ["form2FenceQuote",x] ['"(",:form2FenceQuote first x,:form2FenceQuoteTail rest x] diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot index 1cd9a62e..52179838 100644 --- a/src/interp/fortcall.boot +++ b/src/interp/fortcall.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -444,7 +444,7 @@ spadify(l,results,decls,names,actual) == name := NTH(i,results) ty := getFortranType(name,decls) -- Result is a string - STRINGP fort => + string? fort => spadForms := [makeResultRecord(name,ty,fort), :spadForms] -- Result is a Complex Scalar ty in ["double complex" , "complex"] => @@ -622,7 +622,7 @@ writeData(tmpFile,indata) == NULL v => xdrWrite(xstr,0) -- characters - STRINGP v => + string? v => xdrWrite(xstr,v) -- some array VECTORP v => @@ -652,7 +652,7 @@ writeData(tmpFile,indata) == for el in v repeat if el then xdrWrite(xstr,1) else xdrWrite(xstr,0) -- integers - INTEGERP v => + integer? v => xdrWrite(xstr,v) -- floats FLOATP v => @@ -750,7 +750,7 @@ multiToUnivariate f == -- Take an AnonymousFunction, replace the bound variables by references to -- elements of a vector, and compile it. (first f) ~= "+->" => error "in multiToUnivariate: not an AnonymousFunction" - if CONSP second f then + if cons? second f then vars := CDADR f -- throw away '%Comma at start of variable list else vars := [second f] @@ -767,7 +767,7 @@ functionAndJacobian f == -- Take a mapping into n functions of n variables, produce code which will -- evaluate function and jacobian values. (first f) ~= "+->" => error "in functionAndJacobian: not an AnonymousFunction" - if CONSP second f then + if cons? second f then vars := CDADR f -- throw away '%Comma at start of variable list else vars := [second f] @@ -795,7 +795,7 @@ vectorOfFunctions f == -- Take a mapping into n functions of m variables, produce code which will -- evaluate function values. (first f) ~= "+->" => error "in vectorOfFunctions: not an AnonymousFunction" - if CONSP second f then + if cons? second f then vars := CDADR f -- throw away '%Comma at start of variable list else vars := [second f] diff --git a/src/interp/functor.boot b/src/interp/functor.boot index c1563b72..13dc8c96 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -135,7 +135,7 @@ PacPrint v == $Sublis:= [first Sublis,:$Sublis] $WhereList:= [[name,:vv.j],:$WhereList] vv.j:= name - if CONSP vv.j and REFVECP(u:=rest vv.j) then + if cons? vv.j and REFVECP(u:=rest vv.j) then l:= ASSQ(keyItem u,Sublis) if l then name:= rest l @@ -228,7 +228,7 @@ compCategories1(u,v) == NewbFVectorCopy(u,domName) == v:= newShell SIZE u for i in 0..5 repeat v.i:= u.i - for i in 6..MAXINDEX v | CONSP u.i repeat v.i:= [function Undef,[domName,i],:first u.i] + for i in 6..MAXINDEX v | cons? u.i repeat v.i:= [function Undef,[domName,i],:first u.i] v mkVector u == @@ -641,7 +641,7 @@ ConstantCreator u == ProcessCond cond == ncond := SUBLIS($pairlis,cond) - INTEGERP POSN1(ncond,$NRTslot1PredicateList) => predicateBitRef ncond + integer? POSN1(ncond,$NRTslot1PredicateList) => predicateBitRef ncond cond TryGDC cond == @@ -948,7 +948,7 @@ splitEncodedFunctionName(encodedName, sep) == -- [encodedPackage, encodedItem, encodedSig, sequenceNo] or NIL -- sep0 is the separator used in "encodeFunctionName". sep0 := '";" - if not STRINGP encodedName then + if not string? encodedName then encodedName := STRINGIMAGE encodedName null (p1 := STRPOS(sep0, encodedName, 0, '"*")) => nil null (p2 := STRPOS(sep0, encodedName, p1+1, '"*")) => 'inner diff --git a/src/interp/g-boot.boot b/src/interp/g-boot.boot index 6a6c1a0e..a38ad917 100644 --- a/src/interp/g-boot.boot +++ b/src/interp/g-boot.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -68,7 +68,7 @@ mergeableCOND x == ok := true while (cls and ok) repeat [[p,:r],:cls] := cls - CONSP QCDR r => ok := NIL + cons? QCDR r => ok := NIL first(r) isnt ['EXIT,.] => ok := NIL NULL(cls) and ATOM(p) => ok := NIL NULL(cls) and (p = ''T) => ok := NIL @@ -283,18 +283,18 @@ defLET2(lhs,rhs) == a := defLET2(a,rhs) null (b := defLET2(b,rhs)) => a ATOM b => [a,b] - CONSP QCAR b => CONS(a,b) + cons? QCAR b => CONS(a,b) [a,b] lhs is ['CONS,var1,var2] => var1 = "." or (var1 is ["QUOTE",:.]) => defLET2(var2,addCARorCDR('CDR,rhs)) l1 := defLET2(var1,addCARorCDR('CAR,rhs)) var2 in '(NIL _.) => l1 - if CONSP l1 and ATOM first l1 then l1 := cons(l1,nil) + if cons? l1 and ATOM first l1 then l1 := cons(l1,nil) IDENTP var2 => [:l1,defLetForm(var2,addCARorCDR('CDR,rhs))] l2 := defLET2(var2,addCARorCDR('CDR,rhs)) - if CONSP l2 and ATOM first l2 then l2 := cons(l2,nil) + if cons? l2 and ATOM first l2 then l2 := cons(l2,nil) append(l1,l2) lhs is ['APPEND,var1,var2] => patrev := defISReverse(var2,var1) @@ -302,7 +302,7 @@ defLET2(lhs,rhs) == g := INTERN STRCONC('"LETTMP#",STRINGIMAGE $letGenVarCounter) $letGenVarCounter := $letGenVarCounter + 1 l2 := defLET2(patrev,g) - if CONSP l2 and ATOM first l2 then l2 := cons(l2,nil) + if cons? l2 and ATOM first l2 then l2 := cons(l2,nil) var1 = "." => [[$LET,g,rev],:l2] last l2 is [=$LET, =var1, val1] => [[$LET,g,rev],:reverse rest reverse l2, @@ -352,7 +352,7 @@ defISReverse(x,a) == defIS1(lhs,rhs) == NULL rhs => ['NULL,lhs] - STRINGP rhs => + string? rhs => ['EQ,lhs,['QUOTE,INTERN rhs]] NUMBERP rhs => ['EQUAL,lhs,rhs] @@ -368,7 +368,7 @@ defIS1(lhs,rhs) == ['AND,defIS1(lhs,d),MKPROGN [l,''T]] rhs is ['EQUAL,a] => ['EQUAL,lhs,a] - CONSP lhs => + cons? lhs => g := INTERN STRCONC('"ISTMP#",STRINGIMAGE $isGenVarCounter) $isGenVarCounter := $isGenVarCounter + 1 MKPROGN [[$LET,g,lhs],defIS1(g,rhs)] @@ -396,7 +396,7 @@ defIS1(lhs,rhs) == $isGenVarCounter := $isGenVarCounter + 1 rev := ['AND,['CONSP,lhs],['PROGN,[$LET,g,['REVERSE,lhs]],''T]] l2 := defIS1(g,patrev) - if CONSP l2 and ATOM first l2 then l2 := cons(l2,nil) + if cons? l2 and ATOM first l2 then l2 := cons(l2,nil) a = "." => ['AND,rev,:l2] ['AND,rev,:l2,['PROGN,defLetForm(a,['NREVERSE,a]),''T]] SAY '"WARNING (defIS1): possibly bad IS code being generated" diff --git a/src/interp/g-error.boot b/src/interp/g-error.boot index 3b5c67d6..6828e1ff 100644 --- a/src/interp/g-error.boot +++ b/src/interp/g-error.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -91,7 +91,7 @@ errorSupervisor1(errorType,errorMsg,$BreakMode) == errorType = $UserError => '"Apparent user error" errorType = $AlgebraError => '"Error detected within library code" - STRINGP errorType => errorType + string? errorType => errorType '"Error with unknown classification" msg := errorMsg is ['mathprint, :.] => errorMsg diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index cfaa3730..3b9976f2 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -268,7 +268,7 @@ optCond (x is ['COND,:l]) == AssocBarGensym(key,l) == for x in l repeat - CONSP x => + cons? x => EqualBarGensym(key,first x) => return x EqualBarGensym(x,y) == @@ -437,7 +437,7 @@ isFloatableVMForm form == ++ fairly conservative approximation of compile time constants. isVMConstantForm: %Code -> %Boolean isVMConstantForm form == - INTEGERP form or STRINGP form => true + integer? form or string? form => true form=nil or form=true => true form isnt [op,:args] => false op = "QUOTE" => true diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index a2815575..97e4e45c 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -157,7 +157,7 @@ ScanOrPairVec(f, ob) == CATCH('ScanOrPairVecAnswer, ScanOrInner(f, ob)) where ScanOrInner(f, ob) == HGET($seen, ob) => nil - CONSP ob => + cons? ob => HPUT($seen, ob, true) ScanOrInner(f, QCAR ob) ScanOrInner(f, QCDR ob) @@ -337,9 +337,9 @@ getUnionOrRecordTags u == Identity x == x -length1? l == CONSP l and not CONSP QCDR l +length1? l == cons? l and not cons? QCDR l -length2? l == CONSP l and CONSP (l := QCDR l) and not CONSP QCDR l +length2? l == cons? l and cons? (l := QCDR l) and not cons? QCDR l pairList(u,v) == [[x,:y] for x in u for y in v] @@ -429,7 +429,7 @@ centerString(text,width,fillchar) == stringPrefix?(pref,str) == -- sees if the first #pref letters of str are pref -- replaces STRINGPREFIXP - null (STRINGP(pref) and STRINGP(str)) => NIL + null (string?(pref) and string?(str)) => NIL (lp := QCSIZE pref) = 0 => true lp > QCSIZE str => NIL ok := true @@ -444,8 +444,8 @@ 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 := PNAME str - null (STRINGP(str) and - INTEGERP(pos) and (pos >= 0) and (pos < QCSIZE(str))) => NIL + null (string?(str) and + integer?(pos) and (pos >= 0) and (pos < QCSIZE(str))) => NIL not DIGITP(d := SCHAR(str,pos)) => NIL DIG2FIX d @@ -803,13 +803,13 @@ quickOr(a,b) == simpCatPredicate simpBool ['OR,a,b] intern x == - STRINGP x => + string? x => DIGITP x.0 => string2Integer x INTERN x x isDomain a == - CONSP a and VECP(first a) and + cons? a and VECP(first a) and member(first(a).0, $domainTypeTokens) -- variables used by browser diff --git a/src/interp/hashcode.boot b/src/interp/hashcode.boot index 16c42a95..96161cc9 100644 --- a/src/interp/hashcode.boot +++ b/src/interp/hashcode.boot @@ -45,11 +45,11 @@ $DomainsWithoutLisplibs == getDomainHash dom == SPADCALL(rest dom, (first dom).4) hashType(type, percentHash) == - SYMBOLP type => + symbol? type => type = '$ => percentHash type = "%" => percentHash hashString SYMBOL_-NAME type - STRINGP type => hashCombine(hashString type, + string? type => hashCombine(hashString type, hashString('"Enumeration")) type is ['QUOTE, val] => hashType(val, percentHash) type is [dom] => hashString SYMBOL_-NAME dom diff --git a/src/interp/ht-root.boot b/src/interp/ht-root.boot index 7fbff9dd..3f3f5c85 100644 --- a/src/interp/ht-root.boot +++ b/src/interp/ht-root.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -124,7 +124,7 @@ htSystemVariables() == main where htSetSystemVariableKind(htPage,[variable,name,fun]) == value := htpLabelInputString(htPage,name) - if STRINGP value and fun then value := FUNCALL(fun,value) + if string? value and fun then value := FUNCALL(fun,value) --SCM::what to do??? if not FIXP value then userError ??? setDynamicBinding(variable,value) htSystemVariables () diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot index 22667c3c..79543cfc 100644 --- a/src/interp/ht-util.boot +++ b/src/interp/ht-util.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -120,7 +120,7 @@ htpSetProperty(htPage, propName, val) == htpLabelInputString(htPage, label) == -- value user typed as input string on page props := LASSOC(label, htpInputAreaAlist htPage) - props and STRINGP (s := ELT(props,0)) => + props and string? (s := ELT(props,0)) => s = '"" => s trimString s nil @@ -210,12 +210,12 @@ htpSetPageDescription(htPage, pageDescription) == iht line == -- issue a single hyperteTeX line, or a group of lines $newPage => nil - CONSP line => + cons? line => $htLineList := NCONC(nreverse mapStringize COPY_-LIST line, $htLineList) $htLineList := [basicStringize line, :$htLineList] bcIssueHt line == - CONSP line => htMakePage1 line + cons? line => htMakePage1 line iht line mapStringize l == @@ -225,7 +225,7 @@ mapStringize l == l basicStringize s == - STRINGP s => + string? s => s = '"\$" => '"\%" s = '"{\em $}" => '"{\em \%}" s @@ -233,7 +233,7 @@ basicStringize s == PRINC_-TO_-STRING s stringize s == - STRINGP s => s + string? s => s PRINC_-TO_-STRING s --htInitPageNoHeading(propList) == @@ -404,12 +404,12 @@ htMakeTemplates(templateList, numLabels) == templateList := [templateParts template for template in templateList] [[substLabel(i, template) for template in templateList] for i in 1..numLabels] where substLabel(i, template) == - CONSP template => + cons? template => INTERN CONCAT(first template, PRINC_-TO_-STRING i, rest template) template templateParts template == - NULL STRINGP template => template + NULL string? template => template i := SEARCH('"%l", template) null i => template [SUBSEQ(template, 0, i), : SUBSEQ(template, i+2)] @@ -494,7 +494,7 @@ typeCheckInputAreas htPage == nil val := checkCondition(htpLabelInputString(htPage, stringName), string, condList) - STRINGP val => + string? val => errorCondition := true htpSetLabelErrorMsg(htPage, stringName, val) htpSetLabelSpadValue(htPage, stringName, val) @@ -503,13 +503,13 @@ typeCheckInputAreas htPage == checkCondition(s1, string, condList) == condList is [['Satisfies, pvar, pred]] => val := FUNCALL(pred, string) - STRINGP val => val + string? val => val ['(String), :wrap s1] condList isnt [['isDomain, pvar, pattern]] => systemError '"currently invalid domain condition" pattern is '(String) => ['(String), :wrap s1] val := parseAndEval string - STRINGP val => + string? val => val = '"Syntax Error " => '"Error: Syntax Error " condErrorMsg pattern [type, : data] := val @@ -520,7 +520,7 @@ checkCondition(s1, string, condList) == condErrorMsg type == typeString := form2String type - if CONSP typeString then typeString := APPLY(function CONCAT, typeString) + if cons? typeString then typeString := APPLY(function CONCAT, typeString) CONCAT('"Error: Could not make your input into a ", typeString) parseAndEval string == @@ -578,10 +578,10 @@ htEscapeString str == SUBSTITUTE($funnyBacks, char '_\, str) unescapeStringsInForm form == - STRINGP form => + string? form => str := NSUBSTITUTE(char '_", $funnyQuote, form) NSUBSTITUTE(char '_\, $funnyBacks, str) - CONSP form => + cons? form => unescapeStringsInForm first form unescapeStringsInForm rest form form diff --git a/src/interp/htcheck.boot b/src/interp/htcheck.boot index 978a0eb5..67de7673 100644 --- a/src/interp/htcheck.boot +++ b/src/interp/htcheck.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -126,6 +126,6 @@ spadSysBranch(tree,arg) == --tree is (msg kind TREEorSomethingElse ...) kind := tree.2 kind = 'TREE => spadSysChoose(tree.4,arg) kind = 'LITERALS => member(arg,tree.4) - kind = 'INTEGER => INTEGERP arg + kind = 'INTEGER => integer? arg kind = 'FUNCTION => atom arg systemError '"unknown tree branch" diff --git a/src/interp/htsetvar.boot b/src/interp/htsetvar.boot index 7076e003..1f82625b 100644 --- a/src/interp/htsetvar.boot +++ b/src/interp/htsetvar.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -170,7 +170,7 @@ htShowIntegerPage(htPage, setData) == htSetInteger(htPage) == htInitPage(mkSetTitle(), nil) val := chkRange htpLabelInputString(htPage,'value) - not INTEGERP val => + not integer? val => errorPage(htPage,['"Value Error",nil,'"\vspace{3}\centerline{{\em ",val,'"}}\vspace{2}\newline\centerline{Click on \UpBitmap{} to re-enter value}"]) setDynamicBinding(htpProperty(htPage, 'variable), val) htKill(htPage,val) @@ -266,11 +266,11 @@ htSetNotAvailable(htPage,whatToType) == htDoNothing(htPage,command) == nil htCheck(checker,value) == - CONSP checker => htCheckList(checker,parseWord value) + cons? checker => htCheckList(checker,parseWord value) FUNCALL(checker,value) parseWord x == - STRINGP x => + string? x => and/[DIGITP x.i for i in 0..MAXINDEX x] => PARSE_-INTEGER x INTERN x x @@ -278,15 +278,15 @@ parseWord x == htCheckList(checker,value) == if value in '(y ye yes Y YE YES) then value := 'yes if value in '(n no N NO) then value := 'no - checker is [n,m] and INTEGERP n => + checker is [n,m] and integer? n => m = n + 1 => value in checker => value n null m => - INTEGERP value and value >= n => value + integer? value and value >= n => value n - INTEGERP m => - INTEGERP value and value >= n and value <= m => value + integer? m => + integer? value and value >= n and value <= m => value n value in checker => value first checker @@ -305,7 +305,7 @@ chkNameList x == '"Please enter a list of identifiers separated by blanks" chkPosInteger s == - (u := parseOnly s) and INTEGERP u and u > 0 => u + (u := parseOnly s) and integer? u and u > 0 => u '"Please enter a positive integer" chkOutputFileName s == @@ -315,11 +315,11 @@ chkOutputFileName s == chkDirectory s == s chkNonNegativeInteger s == - (u := ncParseFromString s) and INTEGERP u and u >= 0 => u + (u := ncParseFromString s) and integer? u and u >= 0 => u '"Please enter a non-negative integer" chkRange s == - (u := ncParseFromString s) and INTEGERP u + (u := ncParseFromString s) and integer? u and u >= $htInitial and (NULL $htFinal or u <= $htFinal) => u null $htFinal => diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index 96b11193..44bf2b28 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -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. - STRINGP(t) or IDENTP(t) => NIL + string?(t) or IDENTP(t) => NIL t = $Symbol => t t is ['Variable,u] => (u = var) => t @@ -166,7 +166,7 @@ pushDownTargetInfo(op,target,arglist) == pushDownOnArithmeticVariables(op,target,arglist) == -- tries to push appropriate target information onto variable -- occurring in arithmetic expressions - CONSP(target) and first(target) = 'Variable => NIL + cons?(target) and first(target) = 'Variable => NIL not MEMQ(op,'(_+ _- _* _*_* _/)) => NIL not containsPolynomial(target) => NIL for x in arglist for i in 1.. repeat @@ -175,7 +175,7 @@ pushDownOnArithmeticVariables(op,target,arglist) == getValue(x) or (xn = $immediateDataSymbol) => NIL t := getMinimalVariableTower(xn,target) or target if not getTarget(x) then putTarget(x,t) - CONSP(x) => -- node + cons?(x) => -- node [op',:arglist'] := x pushDownOnArithmeticVariables(getUnname op',target,arglist') arglist @@ -303,7 +303,7 @@ bottomUpUseSubdomain t == $useIntegerSubdomain : local := true ms := bottomUp t ($immediateDataSymbol ~= getUnname(t)) or ($Integer ~= first(ms)) => ms - null INTEGERP(num := objValUnwrap getValue t) => ms + null integer?(num := objValUnwrap getValue t) => ms o := getBasicObject(num) putValue(t,o) ms := [objMode o] @@ -754,7 +754,7 @@ bottomUpFormRetract(t,op,opName,argl,amsl) == (i = 1) and (opName = "set!") => a := [x,:a] ms := [m,:ms] - if CONSP(m) and first(m) = $EmptyMode then return NIL + if cons?(m) and first(m) = $EmptyMode then return NIL object:= retract getValue x a:= [x,:a] object="failed" => diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index f9bb6133..a1dad5ea 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -88,7 +88,7 @@ coerceOrThrowFailure(value, t1, t2) == retract object == type := objMode object - STRINGP type => 'failed + string? type => 'failed type = $EmptyMode => 'failed val := objVal object not isWrapped val and val isnt ["%Map",:.] => 'failed @@ -103,7 +103,7 @@ retract1 object == -- This is mostly for cases such as constant polynomials or -- quotients with 1 in the denominator. type := objMode object - STRINGP type => 'failed + string? type => 'failed val := objVal object type = $PositiveInteger => objNew(val,$NonNegativeInteger) type = $NonNegativeInteger => objNew(val,$Integer) @@ -415,13 +415,13 @@ canCoerce1(t1,t2) == NIL -- next is for tagged union selectors for the time being t1 is ['Variable,=t2] or t2 is ['Variable,=t1] => true - STRINGP t1 => + string? t1 => t2 = $String => true t2 = $OutputForm => true t2 is ['Union,:.] => canCoerceUnion(t1,t2) t2 is ['Variable,v] and (t1 = PNAME(v)) => true NIL - STRINGP t2 => + string? t2 => t1 is ['Variable,v] and (t2 = PNAME(v)) => true NIL atom t1 or atom t2 => NIL @@ -516,7 +516,7 @@ canCoerceExplicit2Mapping(t1,t is ['Mapping,target,:argl]) == funNode := mkAtreeNode fun transferPropsToNode(fun,funNode) mms := CATCH('coerceOrCroaker, selectLocalMms(funNode,fun,argl,target)) - CONSP mms => + cons? mms => mms is [[['interpOnly,:.],:.]] => nil mm := CAAR mms mm is [., targ, :.] => @@ -837,18 +837,18 @@ coerceInt1(triple,t2) == -- next is for tagged union selectors for the time being t1 is ['Variable,=t2] or t2 is ['Variable,=t1] => objNew(val,t2) - STRINGP t2 => + string? t2 => t1 is ['Variable,v] and (t2 = PNAME(v)) => objNewWrap(t2,t2) val' := unwrap val (t2 = val') and ((val' = t1) or (t1 = $String)) => objNew(val,t2) NIL t1 is ['Union,:.] => coerceIntFromUnion(triple,t2) t2 is ['Union,:.] => coerceInt2Union(triple,t2) - (STRINGP t1) and (t2 = $String) => objNew(val,$String) - (STRINGP t1) and (t2 is ['Variable,v]) => + (string? t1) and (t2 = $String) => objNew(val,$String) + (string? t1) and (t2 is ['Variable,v]) => t1 = PNAME(v) => objNewWrap(v,t2) NIL - (STRINGP t1) and (t1 = unwrap val) => + (string? t1) and (t1 = unwrap val) => t2 = $OutputForm => objNew(t1,$OutputForm) NIL atom t1 => NIL @@ -902,7 +902,7 @@ coerceInt1(triple,t2) == NIL NIL - EQ(first(t1),'Variable) and CONSP(t2) and + EQ(first(t1),'Variable) and cons?(t2) and (isEqualOrSubDomain(t2,$Integer) or (t2 = [$QuotientField, $Integer]) or MEMQ(first(t2), '(RationalNumber BigFloat NewFloat Float DoubleFloat))) => NIL diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot index 150e97e4..c0e16277 100644 --- a/src/interp/i-coerfn.boot +++ b/src/interp/i-coerfn.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -1527,7 +1527,7 @@ insertAlist(a,b,l) == Un2E(x,source,target) == ['Union,:branches] := source x = '_$fromCoerceable_$ => - and/[canCoerce(t, target) for t in branches | not STRINGP t] + and/[canCoerce(t, target) for t in branches | not string? t] coerceUn2E(x,source) --% Variable diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index 943f56ad..025d9597 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -96,7 +96,7 @@ evaluateType0 form == domain:= isDomainValuedVariable form => domain form = $EmptyMode => form form = "?" => $EmptyMode - STRINGP form => form + string? form => form form = "$" => form $expandSegments : local := nil form is ['typeOf,.] => @@ -138,7 +138,7 @@ evaluateType form == domain:= isDomainValuedVariable form => domain form = $EmptyMode => form form = "?" => $EmptyMode - STRINGP form => form + string? form => form form = "$" => form $expandSegments : local := nil form is ['typeOf,.] => diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 68c93033..8818d7c8 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -155,7 +155,7 @@ selectMms(op,args,$declaredMode) == selectMms2(op,tar,args1,args2,$Coerce) == -- decides whether to find functions from a domain or package -- or by general modemap evaluation - or/[STRINGP arg for arg in args1] => NIL + or/[string? arg for arg in args1] => NIL if tar = $EmptyMode then tar := NIL nargs := #args1 mmS := NIL @@ -197,7 +197,7 @@ selectMms2(op,tar,args1,args2,$Coerce) == if tar and not isPartialMode tar then if xx := underDomainOf(tar) then a := cons(xx,a) for x in args1 repeat - CONSP(x) and first(x) in '(List Vector Stream FiniteSet Array) => + cons?(x) and first(x) in '(List Vector Stream FiniteSet Array) => xx := underDomainOf(x) => a := cons(xx,a) -- now extend this list with those from the arguments to @@ -221,7 +221,7 @@ selectMms2(op,tar,args1,args2,$Coerce) == (xm := get(name,'mode,$e)) and not isPartialMode xm => a' := cons(xm,a') a := append(a,REMDUP a') - a := [x for x in a | CONSP(x)] + a := [x for x in a | cons?(x)] -- step 1. see if we have one without coercing a' := a @@ -464,7 +464,7 @@ altTypeOf(type,val,$declaredMode) == (a := getMinimalVarMode(objValUnwrap getValue(val),$declaredMode)) => a type is ['OrderedVariableList,vl] and - INTEGERP(val1 := objValUnwrap getValue(val)) and + integer?(val1 := objValUnwrap getValue(val)) and (a := getMinimalVarMode(vl.(val1 - 1),$declaredMode)) => a type = $PositiveInteger => $Integer @@ -532,7 +532,7 @@ CONTAINEDisDomain(symbol,cond) == QCAR cond in '(AND OR and or) => or/[CONTAINEDisDomain(symbol, u) for u in QCDR cond] EQ(QCAR cond,'isDomain) => - EQ(symbol,second cond) and CONSP(dom:=third cond) and + EQ(symbol,second cond) and cons?(dom:=third cond) and dom in '(PositiveInteger NonNegativeInteger) false @@ -741,7 +741,7 @@ findUniqueOpInDomain(op,opName,dom) == $genValue => compiledLookupCheck(opName,sig,evalDomain dom) NRTcompileEvalForm(opName, sig, evalDomain dom) - fun=nil or not CONSP fun => nil + fun=nil or not cons? fun => nil first fun = function(Undef) => throwKeyedMsg("S2IS0023",[opName,dom]) binVal := $genValue => wrap fun @@ -887,7 +887,7 @@ findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == for [a,b,d] in funlist repeat not EQ(a,op) => nil d is ['XLAM,xargs,:.] => - if CONSP(xargs) then maxargs := MAX(maxargs,#xargs) + if cons?(xargs) then maxargs := MAX(maxargs,#xargs) else maxargs := MAX(maxargs,1) impls := cons([b,nil,true,d],impls) d isnt [k,"$",n] => systemErrorHere ["findFunctionInCategory",d] @@ -942,7 +942,7 @@ matchMmSig(mm,tar,args1,args2) == rtc:= NIL if x is ['SubDomain,y,:.] then x:= y b := isEqualOrSubDomain(x1,x) or - (STRINGP(x) and (x1 is ['Variable,v]) and (x = PNAME v)) or + (string?(x) and (x1 is ['Variable,v]) and (x = PNAME v)) or $SubDom and isSubDomain(x,x1) => rtc:= 'T $Coerce => x2=x or canCoerceFrom(x1,x) x1 is ['Variable,:.] and x = $Symbol @@ -989,7 +989,7 @@ filterModemapsFromPackages(mms, names, op) == isFreeFunctionFromMm(mm) => bad := cons(mm, bad) type := getDomainFromMm mm null type => bad := cons(mm,bad) - if CONSP type then type := first type + if cons? type then type := first type getConstructorKindFromDB type = "category" => bad := cons(mm,bad) name := object2String type found := nil @@ -1288,10 +1288,10 @@ evalMmDom(st) == SL:= NIL for mmC in st until SL='failed repeat mmC is ['isDomain,v,d] => - STRINGP d => SL:= 'failed + string? d => SL:= 'failed p:= ASSQ(v,SL) and not (d=rest p) => SL:= 'failed d1:= subCopy(d,SL) - CONSP(d1) and MEMQ(v,d1) => SL:= 'failed + cons?(d1) and MEMQ(v,d1) => SL:= 'failed SL:= augmentSub(v,d1,SL) mmC is ['isFreeFunction,v,fun] => SL:= augmentSub(v,subCopy(fun,SL),SL) @@ -1611,7 +1611,7 @@ hasAtt(dom,att,SL) == $domPvar: local := nil fun:= first dom => atts:= subCopy(getConstructorAttributesFromDB fun,constructSubst dom) => - CONSP (u := getInfovec first dom) => + cons? (u := getInfovec first dom) => --UGH! New world has attributes stored as pairs not as lists!! for [x,:cond] in atts until not (S='failed) repeat S:= unifyStruct(x,att,copy SL) diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index f419f5a4..b12bc1f2 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -1,6 +1,6 @@ -- Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -120,7 +120,7 @@ mkAtree1 x == mkAtree2(x,op,argl) == nargl := #argl - (op= "-") and (nargl = 1) and (INTEGERP first argl) => + (op= "-") and (nargl = 1) and (integer? first argl) => mkAtree1(MINUS first argl) op=":" and argl is [y,z] => [mkAtreeNode "Declare",:argl] op="COLLECT" => [mkAtreeNode op,:transformCollect argl] @@ -150,13 +150,13 @@ mkAtree2(x,op,argl) == t := evaluateType unabbrev type t = $DoubleFloat and expr is [['_$elt, =$Float, 'float], :args] => mkAtree1 [['_$elt, $DoubleFloat, 'float], :args] - t = $DoubleFloat and INTEGERP expr => + t = $DoubleFloat and integer? expr => v := mkAtreeNode $immediateDataSymbol putValue(v,getBasicObject float expr) v - t = $Float and INTEGERP expr => + t = $Float and integer? expr => mkAtree1 ["::", expr, t] - typeIsASmallInteger(t) and INTEGERP expr => + typeIsASmallInteger(t) and integer? expr => mkAtree1 ["::", expr, t] [mkAtreeNode 'TARGET,mkAtree1 expr, type] (op="case") and (nargl = 2) => @@ -173,7 +173,7 @@ mkAtree2(x,op,argl) == [mkAtreeNode "Dollar",D,mkAtree1 [op1,:argl]] op='_$elt => argl is [D,a] => - INTEGERP a => + integer? a => a = 0 => mkAtree1 [['_$elt,D,'Zero]] a = 1 => mkAtree1 [['_$elt,D,'One]] t := evaluateType unabbrev [D] @@ -223,7 +223,7 @@ mkAtree3(x,op,argl) == r := mkAtreeValueOf r v := null arg => VECTOR(NIL,NIL,NIL) - CONSP arg and rest arg and first arg ~= "|" => + cons? arg and rest arg and first arg ~= "|" => collectDefTypesAndPreds ["tuple",:arg] null rest arg => collectDefTypesAndPreds first arg collectDefTypesAndPreds arg @@ -240,7 +240,7 @@ mkAtree3(x,op,argl) == a is [op,:arg] => v := null arg => VECTOR(NIL,NIL,NIL) - CONSP arg and rest arg and first arg ~= "|" => + cons? arg and rest arg and first arg ~= "|" => collectDefTypesAndPreds ["tuple",:arg] null rest arg => collectDefTypesAndPreds first arg collectDefTypesAndPreds arg @@ -395,7 +395,7 @@ getValueFromEnvironment(x,mode) == objValUnwrap v getValueFromSpecificEnvironment(id,mode,e) == - CONSP e => + cons? e => u := get(id,'value,e) => objMode(u) = $EmptyMode => systemErrorHere ["getValueFromSpecificEnvironment",id] diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index 391aea3b..5ca3e726 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -66,7 +66,7 @@ isInternalMapName name == true makeInternalMapMinivectorName(name) == - STRINGP name => + string? name => INTERN STRCONC(name,'";MV") INTERN STRCONC(PNAME name,'";MV") @@ -232,7 +232,7 @@ getUserIdentifiersIn body == append/[getUserIdentifiersIn y for [.,.,y] in l] "append"/[getUserIdentifiersIn y for y in l] bodyIdList := - CONSP op or not (GETL(op,'Nud) or GETL(op,'Led) or GETL(op,'up))=> + cons? op or not (GETL(op,'Nud) or GETL(op,'Led) or GETL(op,'up))=> NCONC(getUserIdentifiersIn op, argIdList) argIdList REMDUP bodyIdList @@ -717,7 +717,7 @@ genMapCode(op,body,sig,fnName,parms,isRecursive) == op if $verbose then if get(op,'isInterpreterRule,$e) then - sayKeyedMsg("S2IM0014",[op0,(CONSP sig =>prefix2String first sig;'"?")]) + sayKeyedMsg("S2IM0014",[op0,(cons? sig =>prefix2String first sig;'"?")]) else sayKeyedMsg("S2IM0015",[op0,formatSignature sig]) $whereCacheList := [op,:$whereCacheList] @@ -1067,7 +1067,7 @@ listOfVariables pat == IDENTP pat => (pat='_. => nil ; [pat]) pat is ['_:,var] or pat is ['_=,var] => (var='_. => NIL ; [var]) - CONSP pat => REMDUP [:listOfVariables p for p in pat] + cons? pat => REMDUP [:listOfVariables p for p in pat] nil getMapBody(op,mapDef) == diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot index b9bdb21d..ab1b1fd8 100644 --- a/src/interp/i-object.boot +++ b/src/interp/i-object.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -162,8 +162,8 @@ getBasicMode x == getBasicMode0(x,$useIntegerSubdomain) ++ Subroutine of getBasicMode. getBasicMode0(x,useIntegerSubdomain) == x is nil => $EmptyMode - STRINGP x => $String - INTEGERP x => + string? x => $String + integer? x => useIntegerSubdomain => x > 0 => $PositiveInteger x = 0 => $NonNegativeInteger @@ -176,14 +176,14 @@ getBasicMode0(x,useIntegerSubdomain) == ++ If x is a literal of the basic types then returns ++ an interpreter object denoting x, and nil otherwise. getBasicObject x == - INTEGERP x => + integer? x => t := not $useIntegerSubdomain => $Integer x > 0 => $PositiveInteger x = 0 => $NonNegativeInteger $Integer objNewWrap(x,t) - STRINGP x => objNewWrap(x,$String) + string? x => objNewWrap(x,$String) FLOATP x => objNewWrap(x,$DoubleFloat) NIL @@ -288,7 +288,7 @@ getUnname1 x == ++ returns the mode-set of VAT node x. getModeSet x == - x and CONSP x => getModeSet first x + x and cons? x => getModeSet first x VECP x => y:= x.aModeSet => (y = [$EmptyMode]) and ((m := getMode x) is ['Mapping,:.]) => @@ -320,7 +320,7 @@ getModeOrFirstModeSetIfThere x == NIL getModeSetUseSubdomain x == - x and CONSP x => getModeSetUseSubdomain first x + x and cons? x => getModeSetUseSubdomain first x VECP(x) => -- don't play subdomain games with retracted args getAtree(x,'retracted) => getModeSet x @@ -336,7 +336,7 @@ getModeSetUseSubdomain x == [m] null val => y isEqualOrSubDomain(objMode(val),$Integer) and - INTEGERP(f := objValUnwrap val) => + integer?(f := objValUnwrap val) => [getBasicMode0(f,true)] y keyedSystemError("S2GE0016", diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index 2720a611..84e22ba6 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -406,7 +406,7 @@ stringWidth u == obj2String o == atom o => - STRINGP o => o + string? o => o o = " " => '" " o = ")" => '")" o = "(" => '"(" @@ -426,7 +426,7 @@ APP(u,x,y,d) == atom2String x == IDENTP x => PNAME x - STRINGP x => x + string? x => x stringer x -- General convention in the "app..." functions: @@ -483,7 +483,7 @@ sayMath u == outputTran x == member(x,'("failed" "nil" "prime" "sqfr" "irred")) => STRCONC('"_"",x,'"_"") - STRINGP x => x + string? x => x VECP x => outputTran ['BRACKET,['AGGLST,:[x.i for i in 0..MAXINDEX x]]] NUMBERP x => @@ -494,7 +494,7 @@ outputTran x == x x is [c,var,mode] and c in '(_pretend _: _:_: _@) => var := outputTran var - if CONSP var then var := ['PAREN,var] + if cons? var then var := ['PAREN,var] ['CONCATB,var,c,obj2String prefix2String mode] x is ['ADEF,vars,.,.,body] => vars := @@ -515,7 +515,7 @@ outputTran x == ['BRACKET,['AGGLST,:[outputTran y for y in l]]] x is [["$elt",domain,"float"], x, y, z] and (domain = $DoubleFloat or - domain is ['Float]) and INTEGERP x and INTEGERP y and INTEGERP z and + domain is ['Float]) and integer? x and integer? y and integer? z and z > 0 and (float := getFunctionFromDomain("float",domain,[$Integer,$Integer,$PositiveInteger])) => f := SPADCALL(x,y,z,float) o := coerceInteractive(objNewWrap(f, domain), '(OutputForm)) @@ -523,7 +523,7 @@ outputTran x == [op,:l]:= flattenOps x --needed since "op" is string in some spad code - if STRINGP op then (op := INTERN op; x:= [op,:l]) + if string? op then (op := INTERN op; x:= [op,:l]) op = 'LAMBDA_-CLOSURE => 'Closure x is ['break,:.] => 'break x is ['SEGMENT,a] => @@ -549,7 +549,7 @@ outputTran x == x is ["-",a,b] => a := outputTran a b := outputTran b - INTEGERP b => + integer? b => b < 0 => ["+",a,-b] ["+",a,["-",b]] b is ["-",c] => ["+",a,c] @@ -557,7 +557,7 @@ outputTran x == -- next stuff translates exp(log(foo4)/foo3) into ROOT(foo4,foo3) (x is ["**", ='"%e",foo1]) and (foo1 is [ ='"/",foo2, foo3]) and - INTEGERP(foo3) and (foo2 is ['log,foo4]) => + integer?(foo3) and (foo2 is ['log,foo4]) => foo3 = 2 => ['ROOT,outputTran foo4] ['ROOT,outputTran foo4,outputTran foo3] (x is ["**", ='"%e",foo1]) and (foo1 is [op',foo2, foo3]) and @@ -730,7 +730,7 @@ outputTranMatrix x == mkSuperSub(op,argl) == $linearFormatScripts => linearFormatForm(op,argl) --- l := [(STRINGP f => f; STRINGIMAGE f) +-- l := [(string? f => f; STRINGIMAGE f) -- for f in linearFormatForm(op,argl)] -- "STRCONC"/l s:= PNAME op @@ -846,7 +846,7 @@ exptApp([.,a,b],x,y,d) == APP(b,x',y',d) exptNeedsPren a == - atom a and null (INTEGERP a and a < 0) => false + atom a and null (integer? a and a < 0) => false key:= keyp a key = "OVER" => true -- added JHD 2/Aug/90 (key="SUB") or (null GETL(key,"Nud") and null GETL(key,"Led")) => false @@ -1025,7 +1025,7 @@ aggregateApp(u,x,y,d,s) == --% Function to compute Width outformWidth u == --WIDTH as called from OUTFORM to do a COPY - STRINGP u => + string? u => u = $EmptyString => 0 u.0="%" and ((u.1 = char 'b) or (u.1 = char 'd)) => 1 #u @@ -1033,11 +1033,11 @@ outformWidth u == --WIDTH as called from OUTFORM to do a COPY WIDTH COPY u WIDTH u == - STRINGP u => + string? u => u = $EmptyString => 0 u.0="%" and ((u.1 = char 'b) or (u.1 = char 'd)) => 1 #u - INTEGERP u => + integer? u => if (u < 1) then negative := 1 u := -u @@ -1062,7 +1062,7 @@ putWidth u == rightPrec:= getBindingPowerOf("right",u) [firstEl,:l] := u interSpace:= - SYMBOLP firstEl and GETL(firstEl,"INFIXOP") => 0 + symbol? firstEl and GETL(firstEl,"INFIXOP") => 0 1 argsWidth:= l is [firstArg,:restArg] => @@ -1659,7 +1659,7 @@ printMap u == if not $collectOutput then TERPRI $algebraOutputStream isInitialMap u == - u is [[[n],.],:l] and INTEGERP n and + u is [[[n],.],:l] and integer? n and (and/[x is [[ =i],.] for x in l for i in n+1..]) printMap1(x,initialFlag) == @@ -1841,7 +1841,7 @@ charyElse(u,v,start,linelength) == scylla(n,v) == y := LASSOC(n,v) null y => nil - if STRINGP(y) then y := DROPTRAILINGBLANKS COPY y + if string?(y) then y := DROPTRAILINGBLANKS COPY y if $collectOutput then $outputLines := [y, :$outputLines] else @@ -2409,7 +2409,7 @@ superSubApp(u, x, y, di) == return di stringer x == - STRINGP x => x + string? x => x EQ('_|, FETCHCHAR(s:= STRINGIMAGE x, 0)) => RPLACSTR(s, 0, 1, "", nil, nil) s @@ -2555,7 +2555,7 @@ binomialWidth u == 2 + MAX(WIDTH u.1, WIDTH u.2) mathPrint u == if not $collectOutput then TERPRI $algebraOutputStream - (u := STRINGP mathPrint1(mathPrintTran u, nil) => + (u := string? mathPrint1(mathPrintTran u, nil) => PSTRING u; nil) mathPrintTran u == @@ -2599,7 +2599,7 @@ isUnaryPrefix op == primaryForm2String x == x = nil => '"" - STRINGP x => x + string? x => x x = $EmptyMode => specialChar 'quad IDENTP x => x = "$" => '"%" diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot index e71472ae..6b803015 100644 --- a/src/interp/i-resolv.boot +++ b/src/interp/i-resolv.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -80,10 +80,10 @@ resolveTT1(t1,t2) == t2 = '(Exit) => t1 t1 is ['Union,:.] => resolveTTUnion(t1,t2) t2 is ['Union,:.] => resolveTTUnion(t2,t1) - STRINGP(t1) => + string?(t1) => t2 = $String => t2 NIL - STRINGP(t2) => + string?(t2) => t1 = $String => t1 NIL null acceptableTypesToResolve(t1,t2) => NIL @@ -164,7 +164,7 @@ resolveTTSpecial(t1,t2) == -- things. (RSS 1/-86) -- following is just an efficiency hack - (t1 = $Symbol or t1 is ['OrderedVariableList,.]) and CONSP(t2) and + (t1 = $Symbol or t1 is ['OrderedVariableList,.]) and cons?(t2) and first(t2) in '(Polynomial RationalFunction) => t2 (t1 = $Symbol) and ofCategory(t2, '(IntegerNumberSystem)) => @@ -344,7 +344,7 @@ resolveTTRed3(t) == for x in t for cs in getDualSignatureFromDB first t ] interpOp?(op) == - CONSP(op) and + cons?(op) and first(op) in '(Incl SetDiff SetComp SetInter SetUnion VarEqual SetEqual) --% Resolve Type with Category @@ -410,7 +410,7 @@ getConditionsForCategoryOnType(t,cat) == getConditionalCategoryOfType(t,[NIL],['ATTRIBUTE,cat]) getConditionalCategoryOfType(t,conditions,match) == - if CONSP t then t := first t + if cons? t then t := first t t in '(Union Mapping Record) => NIL conCat := getConstructorCategoryFromDB t REMDUP rest getConditionalCategoryOfType1(conCat,conditions,match,[NIL]) @@ -447,7 +447,7 @@ matchUpToPatternVars(pat,form,patAlist) == (p := assoc(pat,patAlist)) => EQUAL(form,rest p) patAlist := [[pat,:form],:patAlist] true - CONSP(pat) => + cons?(pat) => atom form => NIL matchUpToPatternVars(first pat, first form,patAlist) and matchUpToPatternVars(rest pat, rest form,patAlist) @@ -595,7 +595,7 @@ resolveTMSpecial(t,m) == t = $AnonymousFunction and m is ['Mapping,:.] => m t is ['Variable,x] and m is ['OrderedVariableList,le] => isPatternVar le => ['OrderedVariableList,[x]] - CONSP(le) and member(x,le) => le + cons?(le) and member(x,le) => le NIL t is ['Fraction, ['Complex, t1]] and m is ['Complex, m1] => resolveTM1(['Complex, ['Fraction, t1]], m) @@ -682,13 +682,13 @@ resolveTMRed1(t) == t is ['Resolve,a,b] => ( a := resolveTMRed1 a ) and ( b := resolveTMRed1 b ) and resolveTM1(a,b) - t is ['Incl,a,b] => CONSP b and member(a,b) and b - t is ['Diff,a,b] => CONSP a and member(b,a) and SETDIFFERENCE(a,[b]) - t is ['SetIncl,a,b] => CONSP b and "and"/[member(x,b) for x in a] and b - t is ['SetDiff,a,b] => CONSP b and CONSP b and + t is ['Incl,a,b] => cons? b and member(a,b) and b + t is ['Diff,a,b] => cons? a and member(b,a) and SETDIFFERENCE(a,[b]) + t is ['SetIncl,a,b] => cons? b and "and"/[member(x,b) for x in a] and b + t is ['SetDiff,a,b] => cons? b and cons? b and intersection(a,b) and SETDIFFERENCE(a,b) t is ['VarEqual,a,b] => (a = b) and b - t is ['SetComp,a,b] => CONSP a and CONSP b and + t is ['SetComp,a,b] => cons? a and cons? b and "and"/[member(x,a) for x in b] and SETDIFFERENCE(a,b) t is ['SimpleAlgebraicExtension,a,b,p] => -- this is a hack. RSS ['SimpleAlgebraicExtension, resolveTMRed1 a, resolveTMRed1 b,p] @@ -711,7 +711,7 @@ equiType(t) == t getUnderModeOf d == - not CONSP d => NIL + not cons? d => NIL -- n := LASSOC(first d,$underDomainAlist) => d.n ----> $underDomainAlist NOW always NIL for a in rest d for m in rest destructT d repeat if m then return a diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot index cfc0ed79..562b10ac 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -798,7 +798,7 @@ checkForFreeVariables(v,locals) == -- be free, or the token ALL, which means that any parameter is a candidate -- to be free. NULL v => v - SYMBOLP v => + symbol? v => v="$$$" => v -- Placeholder for mini-vector MEMQ(v,$boundVariables) => v p := POSITION(v,$freeVariables) => @@ -965,7 +965,7 @@ upconstruct t == tar is ['Record,:types] => upRecordConstruct(op,l,tar) isTaggedUnion tar => upTaggedUnionConstruct(op,l,tar) aggs := '(List) - if tar and CONSP(tar) and not isPartialMode(tar) then + if tar and cons?(tar) and not isPartialMode(tar) then first(tar) in aggs => ud := (l is [[realOp, :.]]) and (getUnname(realOp) = 'COLLECT) => tar @@ -1150,7 +1150,7 @@ declare(var,mode) == -- otherwise it looks like (tuple #1 #2 ...) nargs := null margs => 0 - CONSP margs => -1 + #margs + cons? margs => -1 + #margs 1 nargs ~= #args => throwKeyedMsg("S2IM0008",[var]) if $compilingMap then mkLocalVar($mapName,var) @@ -1196,8 +1196,8 @@ isDomainValuedVariable form == -- returns the value of form if form is a variable with a type value IDENTP form and (val := ( get(form,'value,$InteractiveFrame) or _ - (CONSP($env) and get(form,'value,$env)) or _ - (CONSP($e) and get(form,'value,$e)))) and + (cons?($env) and get(form,'value,$env)) or _ + (cons?($e) and get(form,'value,$e)))) and (member(m := objMode(val),'((Domain) (Category))) or conceptualType m = $Category) => objValUnwrap(val) diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot index 0645635b..3de947f7 100644 --- a/src/interp/i-spec2.boot +++ b/src/interp/i-spec2.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -138,7 +138,7 @@ upDollar t == if x then putTarget(y,x) putAtree(first form,"dollar",t) ms := bottomUp form - f in '(One Zero) and CONSP (ms) and first(ms) = $OutputForm => + f in '(One Zero) and cons? (ms) and first(ms) = $OutputForm => throwKeyedMsg("S2IS0021",[f,t]) putValue(op,getValue first form) putModeSet(op,ms) @@ -500,7 +500,7 @@ up%LET t == -- binding t isnt [op,lhs,rhs] => nil $declaredMode: local := NIL - CONSP lhs => + cons? lhs => var:= getUnname first lhs var = "construct" => upLETWithPatternOnLhs t var = "QUOTE" => throwKeyedMsg("S2IS0027",['"A quoted form"]) @@ -619,7 +619,7 @@ upLETWithPatternOnLhs(t := [op,pattern,a]) == evalLETchangeValue(name,value) == -- write the value of name into the environment, clearing dependent -- maps if its type changes from its last value - localEnv := CONSP $env + localEnv := cons? $env clearCompilationsFlag := val:= (localEnv and get(name,'value,$env)) or get(name,'value,$e) null val => @@ -747,7 +747,7 @@ isType t == op:=opOf t VECP op => isMap(op:= getUnname op) => NIL - op = 'Mapping and CONSP t => + op = 'Mapping and cons? t => argTypes := [isType type for type in rest t] "or"/[null type for type in argTypes] => nil ['Mapping, :argTypes] @@ -1075,7 +1075,7 @@ uptuple t == null l => upNullTuple(op,l,tar) isTaggedUnion tar => upTaggedUnionConstruct(op,l,tar) aggs := '(List) - if tar and CONSP(tar) and not isPartialMode(tar) then + if tar and cons?(tar) and not isPartialMode(tar) then first(tar) in aggs => ud := second tar for x in l repeat if not getTarget(x) then putTarget(x,ud) diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index d5a324ef..6a9ab627 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -362,7 +362,7 @@ clearCmdParts(l is [opt,:vl]) == option='properties => if isMap x then (lm := get(x,'localModemap,$InteractiveFrame)) => - CONSP lm => untraceMapSubNames [CADAR lm] + cons? lm => untraceMapSubNames [CADAR lm] NIL for p2 in rest p1 repeat prop:= first p2 @@ -1377,13 +1377,13 @@ frameSpad2Cmd args == if args is [a] then args := a if ATOM args then args := object2Identifier args arg = 'drop => - args and CONSP(args) => throwKeyedMsg("S2IZ0017",[args]) + args and cons?(args) => throwKeyedMsg("S2IZ0017",[args]) closeInterpreterFrame(args) arg = "import" => importFromFrame args arg = "last" => previousInterpreterFrame() arg = "names" => displayFrameNames() arg = "new" => - args and CONSP(args) => throwKeyedMsg("S2IZ0017",[args]) + args and cons?(args) => throwKeyedMsg("S2IZ0017",[args]) addNewInterpreterFrame(args) arg = "next" => nextInterpreterFrame() @@ -1683,7 +1683,7 @@ writeInputLines(fn,initial) == breakChars := [" ","+"] for i in initial..$IOindex - 1 repeat vecl := first readHiFi i - if STRINGP vecl then vecl := [vecl] + if string? vecl then vecl := [vecl] for vec in vecl repeat n := SIZE vec while n > maxn repeat @@ -1719,7 +1719,7 @@ resetInCoreHist() == changeHistListLen(n) == -- changes the length of $HistList. n must be nonnegative - NULL INTEGERP n => sayKeyedMsg("S2IH0015",[n]) + NULL integer? n => sayKeyedMsg("S2IH0015",[n]) dif:= n-$HistListLen $HistListLen:= n l:= rest $HistList @@ -1924,7 +1924,7 @@ showHistory(arg) == nset := nil if arg then arg1 := first arg - if INTEGERP arg1 then + if integer? arg1 then n := arg1 nset := true KDR arg => arg1 := second arg @@ -1952,7 +1952,7 @@ showInput(mini,maxi) == vec:= UNWIND_-PROTECT(readHiFi(ind),disableHist()) if ind<10 then TAB 2 else if ind<100 then TAB 1 l := first vec - STRINGP l => + string? l => sayMSG ['" [",ind,'"] ",first vec] sayMSG ['" [",ind,'"] " ] for ln in l repeat @@ -2054,7 +2054,7 @@ writify ob == null ob => nil (e := HGET($seen, ob)) => e - CONSP ob => + cons? ob => qcar := QCAR ob qcdr := QCDR ob (name := spadClosure? ob) => @@ -2115,7 +2115,7 @@ writify ob == READTABLEP ob => THROW('writifyTag, 'writifyFailed) -- Default case: return the object itself. - STRINGP ob => + string? ob => EQ(ob, $NullStream) => ['WRITIFIED_!_!, 'NULLSTREAM] EQ(ob, $NonNullStream) => ['WRITIFIED_!_!, 'NONNULLSTREAM] ob @@ -2127,7 +2127,7 @@ writify ob == unwritable? ob == - CONSP ob or VECP ob => false -- first for speed + cons? ob or VECP ob => false -- first for speed COMPILED_-FUNCTION_-P ob or HASHTABLEP ob => true PLACEP ob or READTABLEP ob => true FLOATP ob => true @@ -2161,7 +2161,7 @@ dewritify ob == null ob => nil e := HGET($seen, ob) => e - CONSP ob and first ob = 'WRITIFIED_!_! => + cons? ob and first ob = 'WRITIFIED_!_! => type := ob.1 type = 'SELF => 'WRITIFIED_!_! @@ -2213,7 +2213,7 @@ dewritify ob == fval error '"Unknown type to de-writify." - CONSP ob => + cons? ob => qcar := QCAR ob qcdr := QCDR ob nob := CONS(qcar, qcdr) @@ -2374,7 +2374,7 @@ readSpad2Cmd l == --% )savesystem savesystem l == - #l ~= 1 or not(SYMBOLP first l) => helpSpad2Cmd '(savesystem) + #l ~= 1 or not(symbol? first l) => helpSpad2Cmd '(savesystem) SETQ($SpadServer,false) SETQ($openServerIfTrue,true) )if not %hasFeature KEYWORD::ECL @@ -2803,7 +2803,7 @@ undoLocalModemapHack changeList == removeUndoLines u == --called by writeInputLines xtra := - STRINGP $currentLine => [$currentLine] + string? $currentLine => [$currentLine] reverse $currentLine xtra := [x for x in xtra | not stringPrefix?('")history",x)] u := [:u, :xtra] @@ -3206,7 +3206,7 @@ tokenSystemCommand(unabr, tokList) == systemCommand tokList tokTran tok == - STRINGP tok => + string? tok => #tok = 0 => nil isIntegerString tok => READ_-FROM_-STRING tok STRING tok.0 = '"_"" => diff --git a/src/interp/i-toplev.boot b/src/interp/i-toplev.boot index a71c617b..86ee6ebc 100644 --- a/src/interp/i-toplev.boot +++ b/src/interp/i-toplev.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -247,7 +247,7 @@ printTypeAndTimeSaturn(x, m) == typeString := '"" if $printTypeIfTrue then printAsTeX('"\axPrintType{") - if CONSP typeString then + if cons? typeString then MAPC(FUNCTION printAsTeX, typeString) else printAsTeX(typeString) @@ -302,7 +302,7 @@ interpretTopLevel(x, posnForm) == c interpret(x, :restargs) == - posnForm := if CONSP restargs then first restargs else restargs + posnForm := if cons? restargs then first restargs else restargs --type analyzes and evaluates expression x, returns object $env:local := [[nil]] $eval:local := true --generate code-- don't just type analyze @@ -369,9 +369,9 @@ intSetNeedToSignalSessionManager() == setCurrentLine s == $currentLine := null $currentLine => s - STRINGP $currentLine => - [$currentLine, :(STRINGP s => [s]; s)] - RPLACD(lastNode $currentLine, (STRINGP s => [s]; s)) + string? $currentLine => + [$currentLine, :(string? s => [s]; s)] + RPLACD(lastNode $currentLine, (string? s => [s]; s)) $currentLine diff --git a/src/interp/int-top.boot b/src/interp/int-top.boot index ca52a829..30463f19 100644 --- a/src/interp/int-top.boot +++ b/src/interp/int-top.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -152,7 +152,7 @@ SpadInterpretStream(str, source, interactive?) == intloopReadConsole(b, n)== a:= serverReadLine $InputStream - not STRINGP a => leaveScratchpad() + not string? a => leaveScratchpad() #a=0 => not $leanMode and printPrompt() intloopReadConsole('"", n) diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 42f1db42..36d8c28b 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -41,7 +41,7 @@ namespace BOOT -- pre oldAxiomCategory is (dispatchVector . (cat form)) -- oldAxiomCategory objects are (dispatchVector . ( (cat form) hash defaultpack parentlist)) -hashCode? x == INTEGERP x +hashCode? x == integer? x $domainTypeTokens := ['lazyOldAxiomDomain, 'oldAxiomDomain, 'oldAxiomPreCategory, 'oldAxiomCategory, 0] @@ -83,7 +83,7 @@ DNameToSExpr dname == first dname = DNameOtherID => rest dname sx := DNameToSExpr1 dname - CONSP sx => sx + cons? sx => sx LIST sx DNameFixEnum arg == CompStrToString rest arg @@ -131,7 +131,7 @@ makeLazyOldAxiomDispatchDomain domform == dd makeOldAxiomDispatchDomain dom == - CONSP dom => dom + cons? dom => dom [$oldAxiomDomainDispatch,hashTypeForm(dom.0,0),:dom] closeOldAxiomFunctor(name) == @@ -353,7 +353,7 @@ basicLookupCheckDefaults(op,sig,domain,dollar) == hashCode? sig => sig hashType( ['Mapping,:sig], hashPercent) - if SYMBOLP op then op := hashString SYMBOL_-NAME op + if symbol? op then op := hashString SYMBOL_-NAME op first SPADCALL(rest dollar, dollar, op, hashSig, box, not $lookupDefaults, lookupFun) first SPADCALL(rest dollar, dollar, op, sig, box, not $lookupDefaults, lookupFun) @@ -453,7 +453,7 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) == (success ~= 'failed) and success => if $monitorNewWorld then sayLooking1('"<----",uu) where uu() == - CONSP success => [first success,:devaluate rest success] + cons? success => [first success,:devaluate rest success] success success subsumptionSig and (u:= basicLookup(op,subsumptionSig,domain,dollar)) => u @@ -464,7 +464,7 @@ hashNewLookupInCategories(op,sig,dom,dollar) == slot4 := dom.4 catVec := second slot4 SIZE catVec = 0 => nil --early exit if no categories - INTEGERP KDR catVec.0 => + integer? KDR catVec.0 => newLookupInCategories1(op,sig,dom,dollar) --old style $lookupDefaults : local := nil if $monitorNewWorld = true then sayBrightly concat('"----->", @@ -574,7 +574,7 @@ newHasCategory(domain,catform) == auxvec := first slot4 catvec := second slot4 $isDefaultingPackage: local := isDefaultPackageForm? devaluate domain - #catvec > 0 and INTEGERP KDR catvec.0 => --old style + #catvec > 0 and integer? KDR catvec.0 => --old style predIndex := lazyMatchAssocV1(catform,catvec,domain) null predIndex => false predIndex = 0 => true diff --git a/src/interp/mark.boot b/src/interp/mark.boot index 63befddd..7ba9df49 100644 --- a/src/interp/mark.boot +++ b/src/interp/mark.boot @@ -103,7 +103,7 @@ markCoerce(T,T',kind) == --for coerce tcheck T tcheck T' if kind = 'AUTOSUBSET then yumyum(kind) - STRINGP T.mode and T'.mode = '(String) => T' + string? T.mode and T'.mode = '(String) => T' markKillAll T.mode = T'.mode => T' -- reduce (AUTOSUBSET a b (WI c (AUTOSUBSET b a c))) ==> c u := @@ -172,7 +172,7 @@ markAutoCoerceDown(x,tag,T,killColonColon?) == markAutoCoerceUp(x,T) == -- y := getSourceWI x -- y := --- STRINGP y => INTERN y +-- string? y => INTERN y -- y tcheck T [mkWi('coerceExtraHard,'LAMBDA, nil,["REPLACE",['construct, "##1"]],T.expr), @@ -284,7 +284,7 @@ markImport(d,:option) == --from compFormWithModemap/genDeltaEntry/compImport declared? := IFCAR option null d or d = $Representation => nil d is [op,:.] and op in '(Boolean Mapping Void Segment UniversalSegment) => nil - STRINGP d or (IDENTP d and (PNAME d).0 = char '_#) => nil + string? d or (IDENTP d and (PNAME d).0 = char '_#) => nil d in '(_$ _$NoValueMode _$EmptyMode Void) => nil -------=======+> WHY DOESN'T THIS WORK???????????? --if (d' := macroExpand(d,$e)) ~= d then markImport(d',declared?) @@ -566,7 +566,7 @@ markRecord(source,target,u) == item := first u FIXP item or item = $One or item = $Zero => nil item is ["-",a] and (FIXP a or a = $One or a = $Zero) => nil - STRINGP item => nil + string? item => nil item is [op,.,t] and op in '( _:_: _@ _pretend) and macroExpand(t,$e) = target => nil $source: local := source @@ -1306,7 +1306,7 @@ moveLinesAfter(alist, lines) == n := #lines acc := nil for i in 0..(n - 1) for x in lines repeat - (p := ASSOC(i, alist)) and STRINGP rest p => acc := [rest p, x, :acc] + (p := ASSOC(i, alist)) and string? rest p => acc := [rest p, x, :acc] (p := lookupRight(i, alist)) and (first p) > i => RPLACD(p, x) acc := [x, :acc] reverse acc diff --git a/src/interp/match.boot b/src/interp/match.boot index 3333f863..421f86ad 100644 --- a/src/interp/match.boot +++ b/src/interp/match.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -39,7 +39,7 @@ $wildCard := char "*" maskMatch?(mask,subject) == null mask => true - if null STRINGP subject then subject := PNAME subject + if null string? subject then subject := PNAME subject or/[match?(pattern,subject) for pattern in mask] substring?(part, whole, startpos) == diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index 041289bf..f64ac59e 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -142,7 +142,7 @@ addEltModemap(op,mc,sig,pred,fn,e) == --hack to change selectors from strings to identifiers; and to --add flag identifiers as literals in the envir op='elt and sig is [:lt,sel] => - STRINGP sel => + string? sel => id:= INTERN sel if $insideCapsuleFunctionIfTrue=true then $e:= makeLiteral(id,$e) @@ -151,7 +151,7 @@ addEltModemap(op,mc,sig,pred,fn,e) == -- atom sel => systemErrorHere '"addEltModemap" addModemap1(op,mc,sig,pred,fn,e) op='setelt and sig is [:lt,sel,v] => - STRINGP sel => + string? sel => id:= INTERN sel if $insideCapsuleFunctionIfTrue=true then $e:= makeLiteral(id,$e) diff --git a/src/interp/msg.boot b/src/interp/msg.boot index 667262d6..a13df0c7 100644 --- a/src/interp/msg.boot +++ b/src/interp/msg.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -102,7 +102,7 @@ ncBug (erMsgKey, erArgL,:optAttr) == -- text -- the actual text msgCreate(tag,posWTag,key,argL,optPre,:optAttr) == - if CONSP key then tag := 'old + if cons? key then tag := 'old msg := [tag,posWTag,key,argL,optPre,NIL] if first optAttr then setMsgForcedAttrList(msg,car optAttr) diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index c2af8f3a..3798484f 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -159,7 +159,7 @@ substituteSegmentedMsg(msg,args) == nargs := #args for x in segmentedMsgPreprocess msg repeat -- x is a list - CONSP x => + cons? x => l := cons(substituteSegmentedMsg(x,args),l) c := x.0 n := STRINGLENGTH x @@ -184,7 +184,7 @@ substituteSegmentedMsg(msg,args) == -- Note 'f processing must come first. if MEMQ(char 'f,q) then arg := - CONSP arg => APPLY(first arg, rest arg) + cons? arg => APPLY(first arg, rest arg) arg if MEMQ(char 'm,q) then arg := [['"%m",:arg]] if MEMQ(char 's,q) then arg := [['"%s",:arg]] @@ -206,7 +206,7 @@ substituteSegmentedMsg(msg,args) == --stifled after the first item in the list until the --end of the list. (using %n and %y) l := - CONSP(arg) => + cons?(arg) => MEMQ(char 'y,q) or (first arg = '"%y") or ((LENGTH arg) = 1) => append(reverse arg, l) head := first arg @@ -259,7 +259,7 @@ noBlankBeforeP word== if CVECP word and SIZE word > 1 then word.0 = char '% and word.1 = char 'x => return true word.0 = char " " => return true - (CONSP word) and member(first word,$msgdbListPrims) => true + (cons? word) and member(first word,$msgdbListPrims) => true false $msgdbNoBlanksAfterGroup == ['" ", " ",'"%" ,"%", :$msgdbPrims, @@ -271,7 +271,7 @@ noBlankAfterP word== if CVECP word and (s := SIZE word) > 1 then word.0 = char '% and word.1 = char 'x => return true word.(s-1) = char " " => return true - (CONSP word) and member(first word, $msgdbListPrims) => true + (cons? word) and member(first word, $msgdbListPrims) => true false cleanUpSegmentedMsg msg == @@ -496,7 +496,7 @@ flowSegmentedMsg(msg, len, offset) == off1:= (offset <= 1 => '""; fillerSpaces(offset-1,'" ")) firstLine := true - CONSP msg => + cons? msg => lnl := offset if msg is [a,:.] and member(a,'(%b %d _ "%b" "%d" " ")) then nl := [off1] @@ -507,14 +507,14 @@ flowSegmentedMsg(msg, len, offset) == actualMarg := potentialMarg if lnl = 99999 then nl := ['%l,:nl] lnl := 99999 - CONSP(f) and member(first(f),'("%m" %m '%ce "%ce" %rj "%rj")) => + cons?(f) and member(first(f),'("%m" %m '%ce "%ce" %rj "%rj")) => actualMarg := potentialMarg nl := [f,'%l,:nl] lnl := 199999 member(f,'("%i" %i )) => potentialMarg := potentialMarg + 3 nl := [f,:nl] - CONSP(f) and member(first(f),'("%t" %t)) => + cons?(f) and member(first(f),'("%t" %t)) => potentialMarg := potentialMarg + rest f nl := [f,:nl] sbl := sayBrightlyLength f @@ -571,11 +571,11 @@ throwKeyedMsgCannotCoerceWithValue(val,t1,t2) == --% Some Standard Message Printing Functions -bright x == ['"%b",:(CONSP(x) and NULL rest LASTNODE x => x; [x]),'"%d"] +bright x == ['"%b",:(cons?(x) and NULL rest LASTNODE x => x; [x]),'"%d"] --bright x == ['%b,:(ATOM x => [x]; x),'%d] mkMessage msg == - msg and (CONSP msg) and member((first msg),'(%l "%l")) and + msg and (cons? msg) and member((first msg),'(%l "%l")) and member((last msg),'(%l "%l")) => concat msg concat('%l,msg,'%l) @@ -625,7 +625,7 @@ brightPrint0(x,out == $OutputStream) == -- don't try to give the token any special interpretation. Just print -- it without the backslash. - STRINGP x and STRINGLENGTH x > 1 and x.0 = char "\" and x.1 = char "%" => + string? x and STRINGLENGTH x > 1 and x.0 = char "\" and x.1 = char "%" => sayString(SUBSTRING(x,1,NIL),out) x = '"%l" => sayNewLine(out) @@ -654,7 +654,7 @@ brightPrint0(x,out == $OutputStream) == or stdStreamIsTerminal(1) = 0 => sayString('" ",out) not $highlightAllowed => sayString('" ",out) sayString($highlightFontOff,out) - STRINGP x => sayString(x,out) + string? x => sayString(x,out) brightPrintHighlight(x,out) brightPrint0AsTeX(x, out == $OutputStream) == @@ -681,12 +681,12 @@ brightPrint0AsTeX(x, out == $OutputStream) == sayString('"_"\verb!$!_"",out) x = '"$" => sayString('"\verb!$!",out) - STRINGP x => sayString(x,out) + string? x => sayString(x,out) brightPrintHighlight(x,out) blankIndicator x == if IDENTP x then x := PNAME x - null STRINGP x or MAXINDEX x < 1 => nil + null string? x or MAXINDEX x < 1 => nil x.0 = '% and x.1 = 'x => MAXINDEX x > 1 => PARSE_-INTEGER SUBSTRING(x,2,nil) 1 @@ -694,7 +694,7 @@ blankIndicator x == brightPrint1(x, out == $OutputStream) == if member(x,'(%l "%l")) then sayNewLine(out) - else if STRINGP x then sayString(x,out) + else if string? x then sayString(x,out) else brightPrintHighlight(x,out) NIL @@ -844,9 +844,9 @@ sayBrightlyLength1 x == NULL $highlightAllowed => 1 1 member(x,'("%l" %l)) => 0 - STRINGP x and STRINGLENGTH x > 2 and x.0 = '"%" and x.1 = '"x" => + string? x and STRINGLENGTH x > 2 and x.0 = '"%" and x.1 = '"x" => INTERN x.3 - STRINGP x => STRINGLENGTH x + string? x => STRINGLENGTH x IDENTP x => STRINGLENGTH PNAME x -- following line helps find certain bugs that slip through -- also see brightPrintHighlight @@ -919,7 +919,7 @@ sayDisplayStringWidth x == sayDisplayWidth x sayDisplayWidth x == - CONSP x => + cons? x => +/[fn y for y in x] where fn y == member(y,'(%b %d "%b" "%d")) or y=$quadSymbol => 1 k := blankIndicator y => k diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index 04f83765..21f90651 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -204,7 +204,7 @@ beenHere(e,n) == fun = 'CAR => RPLACA(loc,var) fun = 'CDR => - if CONSP QCDR loc + if cons? QCDR loc then RPLACD(loc,[var]) else RPLACD(loc,var) SAY '"whoops" @@ -783,15 +783,15 @@ fortPre1 e == -- replace N-ary by binary functions -- strip the '%' character off objects like %pi etc.. null e => nil - INTEGERP(e) => + integer?(e) => $fortInts2Floats = true => e >= 0 => fix2FortranFloat(e) ['"-", fix2FortranFloat(-e)] e isFloat(e) => checkPrecision(e) -- Keep strings as strings: - -- STRINGP(e) => STRCONC(STRING(34),e,STRING(34)) - STRINGP(e) => e + -- string?(e) => STRCONC(STRING(34),e,STRING(34)) + string?(e) => e e = "%e" => fortPre1 ["exp" , 1] imags := ['"%i","%i"] member(e, imags) => ['"CMPLX",fortPre1(0),fortPre1(1)] @@ -802,7 +802,7 @@ fortPre1 e == member(op,["**" , '"**"]) => [rand,exponent] := args rand = "%e" => fortPre1 ["exp", exponent] - (IDENTP rand or STRINGP rand) and exponent=2 => ["*", rand, rand] + (IDENTP rand or string? rand) and exponent=2 => ["*", rand, rand] (FIXP exponent and ABS(exponent) < 32768) => ["**",fortPre1 rand,exponent] ["**", fortPre1 rand,fortPre1 exponent] op = "ROOT" => @@ -847,11 +847,11 @@ fix2FortranFloat e == STRCONC(STRINGIMAGE(e),".") isFloat e == - FLOATP(e) or STRINGP(e) and FIND(char ".",e) + FLOATP(e) or string?(e) and FIND(char ".",e) checkPrecision e == -- Do we have a string? - STRINGP(e) and CHAR_-CODE(CHAR(e,0)) = 34 => e + string?(e) and CHAR_-CODE(CHAR(e,0)) = 34 => e e := delete(char " ",STRINGIMAGE e) $fortranPrecision = "double" => iPart := SUBSEQ(e,0,(period:=POSITION(char ".",e))+1) diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index e4612f58..c5b5bbec 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -117,7 +117,7 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) == --the operation name should be assigned a slot not firstTime and (k:= NRTassocIndex x) => k VECP x => systemErrorHere '"NRTencode" - CONSP x => + cons? x => op := first x op = "Record" or x is ['Union,['_:,a,b],:.] => [op,:[['_:,a,encode(b,c,false)] @@ -183,7 +183,7 @@ optDeltaEntry(op,sig,dc,eltOrConst) == MKQ x fun := lookupDefiningFunction(op,nsig,ndc) fun = nil => nil - if CONSP fun then + if cons? fun then eltOrConst = "CONST" => return ['XLAM,'ignore, SPADCALL fun] fun := first fun getFunctionReplacement compileTimeBindingOf fun @@ -657,7 +657,7 @@ slot1Filter opList == --include only those ops which are defined within the capsule [u for x in opList | u := fn x] where fn [op,:l] == - u := [entry for entry in l | INTEGERP second entry] => [op,:u] + u := [entry for entry in l | integer? second entry] => [op,:u] nil NRToptimizeHas u == @@ -730,7 +730,7 @@ NRTsubstDelta(initSig) == sig := [replaceSlotTypes s for s in initSig] where replaceSlotTypes(t) == atom t => - not INTEGERP t => t + not integer? t => t t = 0 => '$ t = 2 => '_$_$ t = 5 => $NRTaddForm @@ -749,7 +749,7 @@ addConsDB x == min x == y:=HGET($consDB,x) y => y - CONSP x => + cons? x => for z in tails x repeat u:=min first z if not EQ(u,first z) then RPLACA(z,u) @@ -758,7 +758,7 @@ addConsDB x == for i in 0..MAXINDEX x repeat x.i:=min (x.i) HashCheck x - STRINGP x => HashCheck x + string? x => HashCheck x x HashCheck x == y:=HGET($consDB,x) diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index c51bc2fe..38a7bd47 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -61,7 +61,7 @@ initNewWorld() == $doNotCompressHashTableIfTrue := true isNewWorldDomain domain == - INTEGERP domain.3 --see HasCategory/Attribute + integer? domain.3 --see HasCategory/Attribute getDomainByteVector dom == CDDR dom.4 @@ -134,7 +134,7 @@ replaceGoGetSlot env == goGetDomain := goGetDomainSlotIndex = 0 => thisDomain thisDomain.goGetDomainSlotIndex - if CONSP goGetDomain then + if cons? goGetDomain then goGetDomain := lazyDomainSet(goGetDomain,thisDomain,goGetDomainSlotIndex) sig := [newExpandTypeSlot(bytevec.(index := QSADD1 index),thisDomain,thisDomain) @@ -231,7 +231,7 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) == NE(success,'failed) and success => if $monitorNewWorld then sayLooking1('"<----",uu) where uu() == - CONSP success => [first success,:devaluate rest success] + cons? success => [first success,:devaluate rest success] success success subsumptionSig and (u:= basicLookup(op,subsumptionSig,domain,dollar)) => u @@ -261,7 +261,7 @@ newLookupInAddChain(op,sig,addFormDomain,dollar) == --======================================================= newLookupInDomain(op,sig,addFormDomain,dollar,index) == addFormCell := addFormDomain.index => - INTEGERP KAR addFormCell => + integer? KAR addFormCell => or/[newLookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell] if null VECP addFormCell then lazyDomainSet(addFormCell,addFormDomain,index) lookupInDomainVector(op,sig,addFormDomain.index,dollar) @@ -274,7 +274,7 @@ newLookupInCategories(op,sig,dom,dollar) == slot4 := dom.4 catVec := second slot4 SIZE catVec = 0 => nil --early exit if no categories - INTEGERP KDR catVec.0 => + integer? KDR catVec.0 => newLookupInCategories1(op,sig,dom,dollar) --old style $lookupDefaults : local := nil if $monitorNewWorld = true then sayBrightly concat('"----->", @@ -439,7 +439,7 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) == if s = '$ then -- a = 0 => return true --needed only if extra call in newGoGet to basicLookup s := devaluate dollar -- calls from HasCategory can have $s - INTEGERP a => + integer? a => not typeFlag => s = domain.a a = 6 and $isDefaultingPackage => s = devaluate dollar VECP (d := domainVal(dollar,domain,a)) => @@ -451,8 +451,8 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) == lazyMatch(replaceSharpCalls s,d,dollar,domain) --new style a = '$ => s = devaluate dollar a = "$$" => s = devaluate domain - STRINGP a => - STRINGP s => a = s + string? a => + string? s => a = s s is ['QUOTE,y] and PNAME y = a IDENTP s and PNAME s = a atom a => a = s @@ -475,7 +475,7 @@ lazyMatch(source,lazyt,dollar,domain) == null coSig => error ["bad Constructor op", op] and/[lazyMatchArg2(s,a,dollar,domain,flag) for s in sargl for a in argl for flag in rest coSig] - STRINGP source and lazyt is ['QUOTE,=source] => true + string? source and lazyt is ['QUOTE,=source] => true NUMBERP source => lazyt is ['_#, slotNum] => source = #(domain.slotNum) lazyt is ["%Call",'LENGTH, slotNum] => source = #(domain.slotNum) @@ -560,7 +560,7 @@ newExpandLocalTypeForm([functorName,:argl],dollar,domain) == newExpandLocalTypeArgs(u,dollar,domain,typeFlag) == u = '$ => u - INTEGERP u => + integer? u => typeFlag => newExpandTypeSlot(u, dollar,domain) domain.u u is ['NRTEVAL,y] => nrtEval(y,domain) diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot index a359fed7..3c5e9026 100644 --- a/src/interp/nrungo.boot +++ b/src/interp/nrungo.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -79,7 +79,7 @@ compiledLookup(op,sig,dollar) == --------------------> NEW DEFINITION (see interop.boot.pamphlet) basicLookup(op,sig,domain,dollar) == item := domain.1 - CONSP item and first item in '(lookupInDomain lookupInTable) => + cons? item and first item in '(lookupInDomain lookupInTable) => lookupInDomainVector(op,sig,domain,dollar) ----------new world code follows------------ u := lookupInDomainAndDefaults(op,sig,domain,dollar,false) => u @@ -116,11 +116,11 @@ goGet(:l) == lookupDomain := domainSlot = 0 => thisDomain thisDomain.domainSlot -- where we look for the operation - if CONSP lookupDomain then lookupDomain := NRTevalDomain lookupDomain + if cons? lookupDomain then lookupDomain := NRTevalDomain lookupDomain dollar := -- what matches $ in signatures explicitLookupDomainIfTrue => lookupDomain thisDomain - if CONSP dollar then dollar := NRTevalDomain dollar + if cons? dollar then dollar := NRTevalDomain dollar fn:= basicLookup(op,sig,lookupDomain,dollar) fn = nil => keyedSystemError("S2NR0001",[op,sig,lookupDomain.0]) val:= APPLY(first fn,[:arglist,rest fn]) @@ -129,9 +129,9 @@ goGet(:l) == NRTreplaceLocalTypes(t,dom) == atom t => - not INTEGERP t => t + not integer? t => t t:= dom.t - if CONSP t then t:= NRTevalDomain t + if cons? t then t:= NRTevalDomain t t.0 first t in '(Mapping Union Record _:) => [first t,:[NRTreplaceLocalTypes(x,dom) for x in rest t]] @@ -202,7 +202,7 @@ defaultingFunction op == --======================================================= lookupInDomain(op,sig,addFormDomain,dollar,index) == addFormCell := addFormDomain.index => - INTEGERP KAR addFormCell => + integer? KAR addFormCell => or/[lookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell] if not VECP addFormCell then addFormCell := eval addFormCell lookupInDomainVector(op,sig,addFormCell,dollar) @@ -275,7 +275,7 @@ compareSig(sig,tableSig,dollar,domain) == lazyCompareSigEqual(s,tslot,dollar,domain) == tslot = '$ => s = "$" or s = devaluate dollar - INTEGERP tslot and CONSP(lazyt:=domain.tslot) and CONSP s => + integer? tslot and cons?(lazyt:=domain.tslot) and cons? s => lazyt is [.,.,.,[.,item,.]] and item is [.,[functorName,:.]] and functorName = first s => compareSigEqual(s,(NRTevalDomain lazyt).0,dollar,domain) @@ -291,7 +291,7 @@ compareSigEqual(s,t,dollar,domain) == isSharpVar t => VECP domain => ELT(rest domain.0,POSN1(t,$FormalMapVariableList)) ELT(rest domain,POSN1(t,$FormalMapVariableList)) - STRINGP t and IDENTP s => (s := PNAME s; t) + string? t and IDENTP s => (s := PNAME s; t) nil s = '$ => compareSigEqual(dollar,u,dollar,domain) u => compareSigEqual(s,u,dollar,domain) @@ -363,7 +363,7 @@ NRTisRecurrenceRelation(op,body,minivectorName) == --Must have at least one special value; insist that they be consecutive null initList => false specialValues:= MSORT ASSOCLEFT initList - or/[null INTEGERP n for n in specialValues] => false + or/[null integer? n for n in specialValues] => false minIndex:= "MIN"/specialValues not (and/[i=x for i in minIndex..(minIndex+n-1) for x in specialValues]) => sayKeyedMsg("S2IX0005", @@ -385,7 +385,7 @@ NRTisRecurrenceRelation(op,body,minivectorName) == generalPred is ['NOT,['SPADCALL,=sharpArg,m,['ELT,=minivectorName, =lesspSlot]]] and EQ(lesspSlot,$minivector.slot) => m return nil - INTEGERP predOk and predOk ~= n => + integer? predOk and predOk ~= n => sayKeyedMsg("S2IX0006",[n,m]) return nil diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot index 568929ee..b6c2a57e 100644 --- a/src/interp/nrunopt.boot +++ b/src/interp/nrunopt.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -141,7 +141,7 @@ makeCompactSigCode sig == [fn for x in sig] where fn() == x = "$$" => 2 x = "$" => 0 - not INTEGERP x => + not integer? x => systemError ['"code vector slot is ",x,'"; must be number"] x @@ -186,7 +186,7 @@ makeSpadConstant [fn,dollar,slot] == stuffSlot(dollar,i,item) == dollar.i := atom item => [SYMBOL_-FUNCTION item,:dollar] - item is [n,:op] and INTEGERP n => ['newGoGet,dollar,:item] + item is [n,:op] and integer? n => ['newGoGet,dollar,:item] item is ['CONS,.,['FUNCALL,a,b]] => b = '$ => ['makeSpadConstant,eval a,dollar,i] sayBrightlyNT '"Unexpected constant environment!!" @@ -474,7 +474,7 @@ dcSlots con == for i in 5..MAXINDEX template repeat sayBrightlyNT bright i item := template.i - item is [n,:op] and INTEGERP n => dcOpLatchPrint(op,n) + item is [n,:op] and integer? n => dcOpLatchPrint(op,n) null item and i > 5 => sayBrightly ['"arg ",STRCONC('"#",STRINGIMAGE(i - 5))] atom item => sayBrightly ['"fun ",item] item is ['CONS,.,['FUNCALL,[.,a],b]] => sayBrightly ['"constant ",a] @@ -511,7 +511,7 @@ getCodeVector() == formatSlotDomain x == x = 0 => ["$"] x = 2 => ["$$"] - INTEGERP x => + integer? x => val := $infovec.0.x null val => [STRCONC('"#",STRINGIMAGE (x - 5))] formatSlotDomain val @@ -631,7 +631,7 @@ dcData con == sayBrightly '"Operation data from slot 1" PRINT_-FULL $infovec.1 vec := getCodeVector() - vec := (CONSP vec => rest vec; vec) + vec := (cons? vec => rest vec; vec) sayBrightly ['"Information vector has ",SIZE vec,'" entries"] dcData1 vec @@ -663,7 +663,7 @@ dcSize(:options) == lazyNodes := 0 --# of nodes needed for lazy domain slots for i in 5..maxindex repeat atom (item := template.i) => fun := fun + 1 - INTEGERP first item => latch := latch + 1 + integer? first item => latch := latch + 1 'T => lazy := lazy + 1 lazyNodes := lazyNodes + numberOfNodes item @@ -902,7 +902,7 @@ expandType(lazyt,template,domform) == expandTypeArgs(u,template,domform) == u = '$ => u --template.0 -------eliminate this as $ is rep by 0 - INTEGERP u => expandType(templateVal(template, domform, u), template,domform) + integer? u => expandType(templateVal(template, domform, u), template,domform) u is ['NRTEVAL,y] => y --eval y u is ['QUOTE,y] => y atom u => u diff --git a/src/interp/packtran.boot b/src/interp/packtran.boot index 53f2aa4c..260cac44 100644 --- a/src/interp/packtran.boot +++ b/src/interp/packtran.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -42,10 +42,10 @@ rePackageTran(sex, package) == packageTran sex == -- destructively translate all the symbols in the given s-expression to the -- current package - SYMBOLP sex => + symbol? sex => EQ(_*PACKAGE_*, SYMBOL_-PACKAGE sex) => sex INTERN STRING sex - CONSP sex => + cons? sex => RPLACA(sex, packageTran first sex) RPLACD(sex, packageTran rest sex) sex diff --git a/src/interp/parse.boot b/src/interp/parse.boot index 64b97afb..5219d63d 100644 --- a/src/interp/parse.boot +++ b/src/interp/parse.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -57,7 +57,7 @@ $parsingType := false --% washOperatorName x == - STRINGP x => + string? x => stackWarning('"String syntax for %1b in signature is deprecated.",[x]) INTERN x x @@ -77,7 +77,7 @@ parseTran x == r:= parseConstruct ["construct",:argl] op is ["elt",:.] => [parseTran op,:rest r] r - SYMBOLP u and (fn:= GET(u,'parseTran)) => FUNCALL(fn,x) + symbol? u and (fn:= GET(u,'parseTran)) => FUNCALL(fn,x) [parseTran op,:parseTranList argl] parseType t == @@ -277,7 +277,7 @@ parseExit t == a:= parseTran a b:= parseTran b b => - not INTEGERP a => + not integer? a => (MOAN('"first arg ",a,'" for exit must be integer"); ["exit",1,a]) ["exit",a,:b] ["exit",1,a] @@ -289,7 +289,7 @@ parseLeave t == a:= parseTran a b:= parseTran b b => - not INTEGERP a => + not integer? a => (MOAN('"first arg ",a,'" for 'leave' must be integer"); ["leave",1,a]) ["leave",a,:b] ["leave",1,a] diff --git a/src/interp/pf2atree.boot b/src/interp/pf2atree.boot index 6002cbf0..d9236313 100644 --- a/src/interp/pf2atree.boot +++ b/src/interp/pf2atree.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -125,7 +125,7 @@ pf2Atree1 pf == [mkAtreeNodeWithSrcPos("Dollar",pf), pf2Sexpr((pfFromdomDomain)(pf)), [mkAtreeNodeWithSrcPos("One",pf)]] - INTEGERP op => + integer? op => -- n$Foo => n * One()$Foo [mkAtreeNodeWithSrcPos("*",pf), mkAtree1WithSrcPos(op,pf), @@ -466,7 +466,7 @@ pfCollect2Atree pf == sex := ["COLLECT", :(loopIters2Sex)((pfParts)((pfCollectIterators)(pf))), pf2Sexpr (pfCollectBody)(pf)] - sex is ["COLLECT", ["|", cond], var] and SYMBOLP var => + sex is ["COLLECT", ["|", cond], var] and symbol? var => [., [., condAtree], varAtree] := atree ["SUCHTHAT", varAtree, condAtree] @@ -525,7 +525,7 @@ pfCollect2Atree pf == -- patternVarsOf1(expr, varList) == -- NULL expr => varList -- ATOM expr => --- null SYMBOLP expr => varList +-- null symbol? expr => varList -- SymMemQ(expr, varList) => varList -- [expr, :varList] -- expr is [op, :argl] => diff --git a/src/interp/pf2sex.boot b/src/interp/pf2sex.boot index 01053dc6..d760baa4 100644 --- a/src/interp/pf2sex.boot +++ b/src/interp/pf2sex.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -407,7 +407,7 @@ loopIters2Sex iterList == pfCollect2Sex pf == sex := ["COLLECT", :loopIters2Sex pfParts pfCollectIterators pf, pf2Sex1 pfCollectBody pf] - sex is ["COLLECT", ["|", cond], var] and SYMBOLP var => + sex is ["COLLECT", ["|", cond], var] and symbol? var => ["|", var, cond] sex @@ -463,7 +463,7 @@ patternVarsOf expr == patternVarsOf1(expr, varList) == NULL expr => varList ATOM expr => - null SYMBOLP expr => varList + null symbol? expr => varList SymMemQ(expr, varList) => varList [expr, :varList] expr is [op, :argl] => diff --git a/src/interp/posit.boot b/src/interp/posit.boot index b8fd4481..0fa56b6d 100644 --- a/src/interp/posit.boot +++ b/src/interp/posit.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -57,7 +57,7 @@ pfPosOrNopos pf == poNoPosition() poIsPos? pos == - CONSP pos and CONSP first pos and #first pos = 5 + cons? pos and cons? first pos and #first pos = 5 lnCreate(extBl, st, gNo, :optFileStuff) == lNo := diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index 82a35c56..311f1117 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -83,7 +83,7 @@ postTran x == atom x => postAtom x op := first x - SYMBOLP op and (f:= GETL(op,'postTran)) => FUNCALL(f,x) + symbol? op and (f:= GETL(op,'postTran)) => FUNCALL(f,x) op is ["elt",a,b] => u:= postTran [b,:rest x] [postTran op,:rest u] @@ -119,7 +119,7 @@ checkWarningIndentation() == postCapsule: %ParseTree -> %ParseForm postCapsule x == x isnt [op,:.] => checkWarningIndentation() - INTEGERP op or op = "==" => ["CAPSULE",postBlockItem x] + integer? op or op = "==" => ["CAPSULE",postBlockItem x] op = ";" => ["CAPSULE",:postBlockItemList postFlatten(x,";")] op = "if" => ["CAPSULE",postBlockItem x] checkWarningIndentation() @@ -489,7 +489,7 @@ postSignature t == t isnt ["%Signature",op,sig] => systemErrorHere ["postSignature",t] sig is ["->",:.] => sig1:= postType sig - op:= postAtom (STRINGP op => INTERN op; op) + op:= postAtom (string? op => INTERN op; op) ["SIGNATURE",op,:removeSuperfluousMapping killColons sig1] ["SIGNATURE",postAtom op,:postType ["->","constant",sig]] @@ -503,7 +503,7 @@ killColons x == postSlash: %ParseTree -> %ParseForm postSlash t == t isnt ['_/,a,b] => systemErrorHere ["postSlash",t] - STRINGP a => postTran ["%Reduce",INTERN a,b] + string? a => postTran ["%Reduce",INTERN a,b] ['_/,postTran a,postTran b] removeSuperfluousMapping: %ParseTree -> %ParseForm diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot index 1b251048..15bf093e 100644 --- a/src/interp/pspad1.boot +++ b/src/interp/pspad1.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -167,7 +167,7 @@ containsString(x,y) == consBuffer item == if item = '"failed" then item := 'failed n:= - STRINGP item => 2+#item + string? item => 2+#item IDENTP item => #PNAME item #STRINGIMAGE item columnsLeft:= $lineLength-$c @@ -185,7 +185,7 @@ consBuffer item == $lineFragmentBuffer:= null item or IDENTP item => [PNAME item,:$lineFragmentBuffer] NUMBERP item or CHARP item => [STRINGIMAGE item,:$lineFragmentBuffer] - STRINGP item => ["_"",string2PrintImage item,"_"",:$lineFragmentBuffer] + string? item => ["_"",string2PrintImage item,"_"",:$lineFragmentBuffer] sayBrightly ['"Unexpected line buffer item: ", STRINGIMAGE item] $lineFragmentBuffer $rightBraceFlag := item = "}" @@ -193,7 +193,7 @@ consBuffer item == $c:= $c+n isSpecialBufferItem item == - item = "; " or STRINGP item => true + item = "; " or string? item => true false isCloseDelimiter item == EQ(item,")") or EQ(item,"]") or EQ(item,"}") @@ -337,7 +337,7 @@ formatUnion(['Union,:r]) == $count : local := 0 formatFormNoColonDecl formatTestForPartial ['Union,:[fn x for x in r]] where fn x == x is [":",y,'Branch] => fn STRINGIMAGE y - STRINGP x => [":", INTERN x, ['Enumeration,x]] + string? x => [":", INTERN x, ['Enumeration,x]] x is [":",:.] => x tag := INTERN STRCONC("value",STRINGIMAGE ($count := $count + 1)) [":", tag, x] diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot index d7a5af0d..97db3788 100644 --- a/src/interp/pspad2.boot +++ b/src/interp/pspad2.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -85,7 +85,7 @@ formatDeftran(u,SEQflag) == ['IF,a,b,c] u is ['Union,:argl] => ['Union,:[x for a in argl - | x := (STRINGP a => [":",INTERN a,'Branch]; formatDeftran(a,nil))]] + | x := (string? a => [":",INTERN a,'Branch]; formatDeftran(a,nil))]] u is [op,:itl,body] and op in '(REPEAT COLLECT) and ([nitl,:nbody] := formatDeftranREPEAT(itl,body)) => formatDeftran([op,:nitl,nbody],SEQflag) @@ -399,7 +399,7 @@ formatREDUCE ["REDUCE",op,.,u] == formatReduce1(op,u) formatreduce ["reduce",op,u] == formatReduce1(op,u) formatReduce1(op,u) == - if STRINGP op then op := INTERN op + if string? op then op := INTERN op id := LASSOC(op, '((_+ Zero)(_* One)(append . NIL)(gcd Zero) (lcm One) (strconc . "")(lcm One))) formatFunctionCall diff --git a/src/interp/record.boot b/src/interp/record.boot index 123e07c0..d987b802 100644 --- a/src/interp/record.boot +++ b/src/interp/record.boot @@ -1,5 +1,7 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are @@ -262,7 +264,7 @@ htFile2RecordFile(pathname,:option) == --======================================================================= recordAndPrintTest md == --called by recordAndPrint input := - STRINGP $currentLine => [$currentLine] + string? $currentLine => [$currentLine] fn $currentLine where fn x == x is [y,:r] => y.(k := MAXINDEX y) = char '__ => diff --git a/src/interp/setvars.boot b/src/interp/setvars.boot index cbe6872a..911fe2ff 100644 --- a/src/interp/setvars.boot +++ b/src/interp/setvars.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -334,7 +334,7 @@ displaySetVariableSettings(setTree,label) == opt := functionp(setData.setVar) => FUNCALL( setData.setVar,"%display%") '"unimplemented" - if CONSP opt then opt := [:[o,'" "] for o in opt] + if cons? opt then opt := [:[o,'" "] for o in opt] sayBrightly concat(setOption,'%b,opt,'%d) st = 'STRING => opt := object2String eval setData.setVar @@ -523,7 +523,7 @@ setExposeAddGroup arg == sayAsManyPerLineAsPossible [object2String first x for x in $globalExposureGroupAlist] for x in arg repeat - if CONSP x then x := QCAR x + if cons? x then x := QCAR x x = 'all => $localExposureData.0 :=[first x for x in $globalExposureGroupAlist] $localExposureData.1 :=NIL @@ -551,7 +551,7 @@ setExposeAddConstr arg == displayExposedConstructors() for x in arg repeat x := unabbrev x - if CONSP x then x := QCAR x + if cons? x then x := QCAR x -- if the constructor is known, we know what type it is null getConstructorKindFromDB x => sayKeyedMsg("S2IZ0049J",[x]) @@ -587,7 +587,7 @@ setExposeDropGroup arg == sayMSG '" " displayExposedGroups() for x in arg repeat - if CONSP x then x := QCAR x + if cons? x then x := QCAR x x = 'all => $localExposureData.0 := NIL $localExposureData.1 := NIL @@ -618,7 +618,7 @@ setExposeDropConstr arg == displayHiddenConstructors() for x in arg repeat x := unabbrev x - if CONSP x then x := QCAR x + if cons? x then x := QCAR x -- if the constructor is known, we know what type it is null getConstructorKindFromDB x => sayKeyedMsg("S2IZ0049J",[x]) @@ -647,7 +647,7 @@ setFortTmpDir arg == $fortranTmpDir := '"/tmp/" arg = "%display%" => - STRINGP $fortranTmpDir => $fortranTmpDir + string? $fortranTmpDir => $fortranTmpDir PNAME $fortranTmpDir (null arg) or (arg = "%describe%") or (first arg = '_?) => @@ -686,7 +686,7 @@ setFortDir arg == $fortranDirectory := '"./" arg = "%display%" => - STRINGP $fortranDirectory => $fortranDirectory + string? $fortranDirectory => $fortranDirectory PNAME $fortranDirectory (null arg) or (arg = "%describe%") or (first arg = '_?) => @@ -721,7 +721,7 @@ setLinkerArgs arg == arg = "%display%" => object2String $fortranLibraries (null arg) or (arg = "%describe%") or (first arg = '_?) => describeSetLinkerArgs() - LISTP(arg) and STRINGP(first arg) => + LISTP(arg) and string?(first arg) => $fortranLibraries := first(arg) describeSetLinkerArgs() diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot index 140c57c3..4ee43028 100644 --- a/src/interp/showimp.boot +++ b/src/interp/showimp.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -193,7 +193,7 @@ showDomainsOp1(u,key) == u getDomainRefName(dom,nam) == - CONSP nam => [getDomainRefName(dom,x) for x in nam] + cons? nam => [getDomainRefName(dom,x) for x in nam] not FIXP nam => nam slot := dom.nam VECP slot => slot.0 diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index 31a3a28b..7fc81299 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -67,7 +67,7 @@ getVMType d == IDENTP d => d = "*" => d "%Thing" - STRINGP d => "%Thing" -- literal flag parameter + string? d => "%Thing" -- literal flag parameter case (d' := devaluate d) of Void => "%Void" Identifier => "%Symbol" @@ -118,7 +118,7 @@ functionp f == ++ remove `item' from `sequence'. delete: (%Thing,%Sequence) -> %Sequence delete(item,sequence) == - SYMBOLP item => + symbol? item => REMOVE(item,sequence,KEYWORD::TEST,function EQ) atom item and not ARRAYP item => REMOVE(item,sequence) @@ -128,7 +128,7 @@ delete(item,sequence) == CONTAINED: (%Thing,%Thing) -> %Boolean CONTAINED(x,y) == main where main() == - SYMBOLP x => eq(x,y) + symbol? x => eq(x,y) equal(x,y) eq(x,y) == atom y => EQ(x,y) diff --git a/src/interp/trace.boot b/src/interp/trace.boot index ead22c21..765fc5bd 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -358,7 +358,7 @@ coerceSpadFunValue2E(value) == isListOfIdentifiers l == and/[IDENTP x for x in l] -isListOfIdentifiersOrStrings l == and/[IDENTP x or STRINGP x for x in l] +isListOfIdentifiersOrStrings l == and/[IDENTP x or string? x for x in l] getMapSubNames(l) == subs:= nil @@ -425,13 +425,13 @@ isTraceGensym x == GENSYMP x spadTrace(domain,options) == $fromSpadTrace:= true $tracedModemap:local:= nil - CONSP domain and REFVECP first domain and (first domain).0 = 0 => + cons? domain and REFVECP first domain and (first domain).0 = 0 => aldorTrace(domain,options) not isDomainOrPackage domain => userError '"bad argument to trace" listOfOperations:= [g x for x in getOption("OPS",options)] where g x == - STRINGP x => INTERN x + string? x => INTERN x x if listOfVariables := getOption("VARS",options) then options := removeOption("VARS",options) diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot index bf86a21c..24236d61 100644 --- a/src/interp/wi1.boot +++ b/src/interp/wi1.boot @@ -319,7 +319,7 @@ compWithMappingMode(x,m,oldE) == if get(x,"modemap",$CategoryFrame) is [[[.,target,:argModeList],.],:.] and (and/[extendsCategoryForm("$",s,mode) for mode in argModeList for s in sl] ) and extendsCategoryForm("$",target,m') then return [x,m,e] - if STRINGP x then x:= INTERN x + if string? x then x:= INTERN x for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat [.,.,e]:= compMakeDeclaration(v,m,e) not null vl and not hasFormalMapVariable(x, vl) => return @@ -349,7 +349,7 @@ compAtom(x,m,e) == t:= IDENTP x => compSymbol(x,m,e) or return nil m = $Expression and primitiveType x => [x,m,e] - STRINGP x => + string? x => x ~= '"failed" and (member($Symbol, $localImportStack) or member($Symbol, $globalImportStack)) => markAt [x, '(String), e] [x, x, e] @@ -575,7 +575,7 @@ setqSingle(id,val,m,E) == 'locals profileRecord(key,id,T.mode) newProplist:= consProplistOf(id,currentProplist,"value",markKillAll removeEnv T) - e':= (CONSP id => e'; addBinding(id,newProplist,e')) + e':= (cons? id => e'; addBinding(id,newProplist,e')) x1 := markKillAll x if isDomainForm(x1,e') then if isDomainInScope(id,e') then @@ -791,9 +791,9 @@ resolve(min, mout) == dout := markKillAll mout din=$NoValueMode or dout=$NoValueMode => $NoValueMode dout=$EmptyMode => din - STRINGP din and dout = $Symbol => dout ------> hack 8/14/94 - STRINGP dout and din = $Symbol => din ------> hack 8/14/94 - din ~= dout and (STRINGP din or STRINGP dout) => + string? din and dout = $Symbol => dout ------> hack 8/14/94 + string? dout and din = $Symbol => din ------> hack 8/14/94 + din ~= dout and (string? din or string? dout) => modeEqual(dout,$String) => dout modeEqual(din,$String) => nil mkUnion(din,dout) @@ -836,7 +836,7 @@ coerceSubset(T := [x,m,e],m') == -- pp [m, m'] isSubset(m,m',e) => [x,m',e] -- if m is a type variable, we can't know. - (pred:= isSubset(m',m,e)) and INTEGERP x and + (pred:= isSubset(m',m,e)) and integer? x and -- obviously this is temporary eval substitute(x,"#1",pred) => [x,m',e] nil @@ -868,13 +868,13 @@ spadCompileOrSetq form == coerceHard(T,m) == $e: local:= T.env m':= T.mode - STRINGP m' and modeEqual(m,$String) => [T.expr,m,$e] + string? m' and modeEqual(m,$String) => [T.expr,m,$e] modeEqual(m',m) or (get(m',"value",$e) is [m'',:.] or getmode(m',$e) is ["Mapping",m'']) and modeEqual(m'',m) or (get(m,"value",$e) is [m'',:.] or getmode(m,$e) is ["Mapping",m'']) and modeEqual(m'',m') => [T.expr,m,T.env] - STRINGP T.expr and T.expr=m => [T.expr,m,$e] + string? T.expr and T.expr=m => [T.expr,m,$e] isCategoryForm(m,$e) => $bootStrapMode = true => [T.expr,m,$e] extendsCategoryForm(T.expr,T.mode,m) => [T.expr,m,$e] @@ -911,7 +911,7 @@ compCoerce1(x,m',e) == if null T then T := comp(x,$EmptyMode,e) null T => return nil m1:= - STRINGP T.mode => $String + string? T.mode => $String T.mode m':=resolve(m1,m') T:=[T.expr,m1,T.env] @@ -954,7 +954,7 @@ comp3(x,m,$e) == e:= $e --for debugging purposes m is ["Mapping",:.] => compWithMappingMode(x,m,e) m is ["QUOTE",a] => (x=a => [x,m,$e]; nil) - STRINGP m => (atom x => (m=x or m=STRINGIMAGE x => [m,m,e]; nil); nil) + string? m => (atom x => (m=x or m=STRINGIMAGE x => [m,m,e]; nil); nil) null x or atom x => compAtom(x,m,e) op:= first x getmode(op,e) is ["Mapping",:ml] and (u:= applyMapping(x,m,e,ml)) => u @@ -1013,10 +1013,10 @@ compCase1(x,m,e) == genCaseTag(t,l,n) == l is [x, :l] => x = t => - STRINGP x => INTERN x + string? x => INTERN x INTERN STRCONC("value", STRINGIMAGE n) x is ["::",=t,:.] => t - STRINGP x => genCaseTag(t, l, n) + string? x => genCaseTag(t, l, n) genCaseTag(t, l, n + 1) nil diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index 3b6d1f12..80e63182 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -385,7 +385,7 @@ mkUnion(a,b) == b is ["Union",:l] => member(a, l) => b ["Union",:setUnion([a],l)] - STRINGP a => ["Union",b,a] + string? a => ["Union",b,a] ["Union",a,b] compForMode(x,m,e) == |