diff options
| -rw-r--r-- | src/ChangeLog | 21 | ||||
| -rw-r--r-- | src/boot/ast.boot | 8 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 9 | ||||
| -rw-r--r-- | src/interp/alql.boot | 4 | ||||
| -rw-r--r-- | src/interp/br-con.boot | 4 | ||||
| -rw-r--r-- | src/interp/br-op1.boot | 8 | ||||
| -rw-r--r-- | src/interp/br-op2.boot | 2 | ||||
| -rw-r--r-- | src/interp/br-saturn.boot | 56 | ||||
| -rw-r--r-- | src/interp/br-search.boot | 12 | ||||
| -rw-r--r-- | src/interp/br-util.boot | 3 | ||||
| -rw-r--r-- | src/interp/c-doc.boot | 20 | ||||
| -rw-r--r-- | src/interp/format.boot | 46 | ||||
| -rw-r--r-- | src/interp/g-error.boot | 6 | ||||
| -rw-r--r-- | src/interp/i-funsel.boot | 12 | ||||
| -rw-r--r-- | src/interp/i-syscmd.boot | 10 | ||||
| -rw-r--r-- | src/interp/mark.boot | 2 | ||||
| -rw-r--r-- | src/interp/msgdb.boot | 26 | ||||
| -rw-r--r-- | src/interp/newfort.boot | 2 | ||||
| -rw-r--r-- | src/interp/pspad1.boot | 2 | ||||
| -rw-r--r-- | src/interp/pspad2.boot | 2 | ||||
| -rw-r--r-- | src/interp/trace.boot | 2 |
21 files changed, 141 insertions, 116 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 7d7e91d9..13f89e98 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,24 @@ +2010-12-10 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * boot/ast.boot (bfMmeber): Tidy. + * interp/alql.boot: Clean up. + * interp/br-con.boot: Likewise. + * interp/br-op1.boot: Likewise. + * interp/br-op2.boot: Likewise. + * interp/br-saturn.boot: Likewise. + * interp/br-search.boot: Likewise. + * interp/br-util.boot: Likewise. + * interp/c-doc.boot: Likewise. + * interp/format.boot: Likewise. + * interp/g-error.boot: Likewise. + * interp/i-funsel.boot: Likewise. + * interp/i-syscmd.boot: Likewise. + * interp/mark.boot: Likewise. + * interp/msgdb.boot: Likewise. + * interp/newfort.boot: Likewise. + * interp/pspad1.boot: Likewise. + * interp/trace.boot: Likewise. + 2010-12-09 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/vmlisp.lisp (reclaim): Remove duplicate. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 5822f3d9..052ae2d6 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -696,12 +696,12 @@ sequence?(x,pred) == ++ Generate code for a membership test `x in seq' where `seq' ++ is a sequence (e.g. a list) bfMember(var,seq) == - var is ["char",.] or sequence?(seq,function integer?) => - ["MEMBER",var,seq,KEYWORD::TEST,"EQL"] + integer? var or var is ["char",.] or sequence?(seq,function integer?) => + ["MEMBER",var,seq,KEYWORD::TEST, ["FUNCTION", "EQL"]] defQuoteId var or sequence?(seq,function symbol?) => ["MEMQ",var,seq] - sequence?(seq,function string?) => - ["MEMBER",var,seq,KEYWORD::TEST,"STRING="] + string? var or sequence?(seq,function string?) => + ["MEMBER",var,seq,KEYWORD::TEST,["FUNCTION", "STRING="]] ["MEMBER",var,seq] bfInfApplication(op,left,right)== diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 54e3f4f5..220253f9 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1103,16 +1103,17 @@ (PROG (|ISTMP#1|) (RETURN (COND - ((OR (AND (CONSP |var|) (EQ (CAR |var|) '|char|) + ((OR (INTEGERP |var|) + (AND (CONSP |var|) (EQ (CAR |var|) '|char|) (PROGN (SETQ |ISTMP#1| (CDR |var|)) (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))))) (|sequence?| |seq| #'INTEGERP)) - (LIST 'MEMBER |var| |seq| :TEST 'EQL)) + (LIST 'MEMBER |var| |seq| :TEST (LIST 'FUNCTION 'EQL))) ((OR (|defQuoteId| |var|) (|sequence?| |seq| #'SYMBOLP)) (LIST 'MEMQ |var| |seq|)) - ((|sequence?| |seq| #'STRINGP) - (LIST 'MEMBER |var| |seq| :TEST 'STRING=)) + ((OR (STRINGP |var|) (|sequence?| |seq| #'STRINGP)) + (LIST 'MEMBER |var| |seq| :TEST (LIST 'FUNCTION 'STRING=))) (T (LIST 'MEMBER |var| |seq|)))))) (DEFUN |bfInfApplication| (|op| |left| |right|) diff --git a/src/interp/alql.boot b/src/interp/alql.boot index 5b7431ad..56358a87 100644 --- a/src/interp/alql.boot +++ b/src/interp/alql.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 @@ -35,7 +37,7 @@ namespace BOOT getBrowseDatabase(kind) == $includeUnexposed? : local := true - not member(kind,'("o" "k" "c" "d" "p")) => nil + not (kind in '("o" "k" "c" "d" "p")) => nil grepConstruct('"*",INTERN kind) stringMatches?(pattern,subject) == diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index f8413bfa..064060d3 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -1126,9 +1126,9 @@ dbConsHeading(htPage,conlist,view,kind) == nil heading := [:prefix,:placepart] connective := - member(view,'(abbrs files kinds)) => '" as " + view in '(abbrs files kinds) => '" as " '" with " - if count ~= 0 and member(view,'(abbrs files parameters conditions)) then heading:= [:heading,'" viewed",connective,'"{\em ",STRINGIMAGE view,'"}"] + if count ~= 0 and view in '(abbrs files parameters conditions) then heading:= [:heading,'" viewed",connective,'"{\em ",STRINGIMAGE view,'"}"] heading dbShowConstructorLines lines == diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index c880a704..2740fb17 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -370,12 +370,12 @@ dbGatherData(htPage,opAlist,which,key) == u data := [y := [entry,exposeFlag,:tail],:data] y --no, create new entry in DATA - if member(key,'(origins conditions)) then + if key in '(origins conditions) then r := CDDR newEntry if atom r then r := nil --clear out possible 'ASCONST newEntry.rest.rest := --store op/sigs under key if needed insert([dbMakeSignature(op,item),exposeFlag,:tail],r) - if member(key,'(origins conditions)) then + if key in '(origins conditions) then for entry in data repeat --sort list of entries (after the 2nd) tail := CDDR entry tail := @@ -618,7 +618,7 @@ dbShowOpParameters(htPage,opAlist,which,data) == dbShowOpParameterJump(ops,which,count,single?) htSay('" {\em ",KAR KDR args,'"}") dbShowOpParameterJump(ops,which,count,single?) - tail = 'ASCONST or member(op,'(0 1)) or which = '"attribute" and null IFCAR args => 'skip + tail = 'ASCONST or op in '(0 1) or which = '"attribute" and null IFCAR args => 'skip htSay('"(") if IFCAR args then htSay('"{\em ",IFCAR args,'"}") for x in IFCDR args repeat @@ -658,7 +658,7 @@ dbShowOpDocumentation(htPage,opAlist,which,data) == exposeFlag or not $exposedOnlyIfTrue => if comments ~= '"" and string? comments and (k := string2Integer comments) then comments := - MEMQ(k,'(0 1)) => '"" + k in '(0 1) => '"" dbReadComments k tail := CDDDDR item tail.first := comments diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index 15453e12..6b6c11e4 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -95,7 +95,7 @@ htSayExplicitExports r == systemError() displayBreakIntoAnds pred == - pred is [op,:u] and member(op,'(and AND)) => u + pred is [op,:u] and op in '(and AND) => u [pred] htSayValue t == diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index a270151d..e0a3bcd4 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -769,15 +769,15 @@ dbPresentCons(htPage,kind,:exclusions) == star? := true --always include information on exposed/unexposed 4/92 if $standard then htBeginTable() htSay '"{" - if one? or member('abbrs,exclusions) + if one? or 'abbrs in exclusions then htSay '"{\em Abbreviations}" else htMakePage [['bcLispLinks,['"Abbreviations",'"",'dbShowCons,'abbrs]]] htSay '"}{" - if one? or member('conditions,exclusions) or "and"/[rest x = true for x in cAlist] + if one? or 'conditions in exclusions or "and"/[rest x = true for x in cAlist] then htSay '"{\em Conditions}" else htMakePage [['bcLispLinks,['"Conditions",'"",'dbShowCons,'conditions]]] htSay '"}{" - if empty? or member('documentation,exclusions) + if empty? or 'documentation in exclusions then htSay '"{\em Descriptions}" else htMakePage [['bcLispLinks,['"Descriptions",'"",'dbShowCons,'documentation]]] htSay '"}{" @@ -786,15 +786,15 @@ dbPresentCons(htPage,kind,:exclusions) == else htMakePage [['bcLinks,['"Filter",'"",'htFilterPage,['dbShowCons,'filter]]]] htSay '"}{" - if one? or member('kinds,exclusions) or kind ~= 'constructor + if one? or 'kinds in exclusions or kind ~= 'constructor then htSay '"{\em Kinds}" else htMakePage [['bcLispLinks,['"Kinds",'"",'dbShowCons,'kinds]]] htSay '"}{" - if one? or member('names,exclusions) + if one? or 'names in exclusions then htSay '"{\em Names}" else htMakePage [['bcLispLinks,['"Names",'"",'dbShowCons,'names]]] htSay '"}{" - if one? or member('parameters,exclusions) or not ("or"/[CDAR x for x in cAlist]) + if one? or 'parameters in exclusions or not ("or"/[CDAR x for x in cAlist]) then htSay '"{\em Parameters}" else htMakePage [['bcLispLinks,['"Parameters",'"",'dbShowCons,'parameters]]] htSay '"}{" @@ -821,25 +821,25 @@ dbPresentConsSaturn(htPage,kind,exclusions) == exposedUnexposedFlag := $includeUnexposed? --used to be star? 4/92 star? := true --always include information on exposed/unexposed 4/92 if $standard then htBeginTable() - if one? or member('abbrs,exclusions) + if one? or 'abbrs in exclusions then htSayCold '"\&Abbreviations" else htMakePage [['bcLispLinks,['"\&Abbreviations",'"",'dbShowCons,'abbrs]]] - if one? or member('conditions,exclusions) or "and"/[rest x = true for x in cAlist] + if one? or 'conditions in exclusions or "and"/[rest x = true for x in cAlist] then htSayCold '"\&Conditions" else htMakePage [['bcLispLinks,['"\&Conditions",'"",'dbShowCons,'conditions]]] - if empty? or member('documentation,exclusions) + if empty? or 'documentation in exclusions then htSayCold '"\&Descriptions" else htMakePage [['bcLispLinks,['"\&Descriptions",'"",'dbShowCons,'documentation]]] if one? or null rest cAlist then htSayCold '"\&Filter" else htMakeSaturnFilterPage ['dbShowCons, 'filter] - if one? or member('kinds,exclusions) or kind ~= 'constructor + if one? or 'kinds in exclusions or kind ~= 'constructor then htSayCold '"\&Kinds" else htMakePage [['bcLispLinks,['"\&Kinds",'"",'dbShowCons,'kinds]]] - if one? or member('names,exclusions) + if one? or 'names in exclusions then htSayCold '"\&Names" else htMakePage [['bcLispLinks,['"\&Names",'"",'dbShowCons,'names]]] - if one? or member('parameters,exclusions) or not ("or"/[CDAR x for x in cAlist]) + if one? or 'parameters in exclusions or not ("or"/[CDAR x for x in cAlist]) then htSayCold '"\&Parameters" else htMakePage [['bcLispLinks,['"\&Parameters",'"",'dbShowCons,'parameters]]] htSaySaturn '"\hrule" @@ -1040,12 +1040,12 @@ dbPresentOps(htPage,which,:exclusions) == one? := empty? or one? htBeginTable() htSay '"{" - if one? or member('conditions,exclusions) + if one? or 'conditions in exclusions or (htpProperty(htPage,'condition?) = 'no) then htSay '"{\em Conditions}" else htMakePage [['bcLispLinks,['"Conditions",'"",'dbShowOps,which,'conditions]]] htSay '"}{" - if empty? or member('documentation,exclusions) + if empty? or 'documentation in exclusions then htSay '"{\em Descriptions}" else htMakePage [['bcLispLinks,['"Descriptions",'"",'dbShowOps,which,'documentation]]] htSay '"}{" @@ -1053,29 +1053,29 @@ dbPresentOps(htPage,which,:exclusions) == then htSay '"{\em Filter}" else htMakePage [['bcLinks,['"Filter ",'"",'htFilterPage,['dbShowOps,which,'filter]]]] htSay '"}{" - if one? or member('names,exclusions) or null KDR opAlist + if one? or 'names in exclusions or null KDR opAlist then htSay '"{\em Names}" else htMakePage [['bcLispLinks,['"Names",'"",'dbShowOps,which,'names]]] if not star? then htSay '"}{" - if not implementation? or member('implementation,exclusions) or which = '"attribute" or + if not implementation? or 'implementation in exclusions or which = '"attribute" or ((conname := opOf htpProperty(htPage,'conform)) and getConstructorKindFromDB conname = "category") then htSay '"{\em Implementations}" else htMakePage [['bcLispLinks,['"Implementations",'"",'dbShowOps,which,'implementation]]] htSay '"}{" - if one? or member('origins,exclusions) + if one? or 'origins in exclusions then htSay '"{\em Origins}" else htMakePage [['bcLispLinks,['"Origins",'"",'dbShowOps,which,'origins]]] htSay '"}{" - if one? or member('parameters,exclusions) --also test for some parameter + if one? or 'parameters in exclusions --also test for some parameter or not dbDoesOneOpHaveParameters? opAlist then htSay '"{\em Parameters}" else htMakePage [['bcLispLinks,['"Parameters",'"",'dbShowOps,which,'parameters]]] htSay '"}{" if which ~= '"attribute" then - if one? or member('signatures,exclusions) + if one? or 'signatures in exclusions then htSay '"{\em Signatures}" else htMakePage [['bcLispLinks,['"Signatures",'"",'dbShowOps,which,'signatures]]] htSay '"}" @@ -1109,34 +1109,34 @@ dbPresentOpsSaturn(htPage,which,exclusions) == empty? := null opAlist one? := opAlist is [entry] and 2 = #entry one? := empty? or one? - if one? or member('conditions,exclusions) + if one? or 'conditions in exclusions or (htpProperty(htPage,'condition?) = 'no) then htSayCold '"\&Conditions" else htMakePage [['bcLispLinks,['"\&Conditions",'"",'dbShowOps,which,'conditions]]] - if empty? or member('documentation,exclusions) + if empty? or 'documentation in exclusions then htSayCold '"\&Descriptions" else htMakePage [['bcLispLinks,['"\&Descriptions",'"",'dbShowOps,which,'documentation]]] if null IFCDR opAlist then htSayCold '"\&Filter" else htMakeSaturnFilterPage ['dbShowOps, which, 'filter] - if not implementation? or member('implementation,exclusions) or which = '"attribute" or + if not implementation? or 'implementation in exclusions or which = '"attribute" or ((conname := opOf htpProperty(htPage,'conform)) and getConstructorKindFromDB conname = "category") then htSayCold '"\&Implementations" else htMakePage [['bcLispLinks,['"\&Implementations",'"",'dbShowOps,which,'implementation]]] - if one? or member('names,exclusions) or null KDR opAlist + if one? or 'names in exclusions or null KDR opAlist then htSayCold '"\&Names" else htMakePage [['bcLispLinks,['"\&Names",'"",'dbShowOps,which,'names]]] - if one? or member('origins,exclusions) + if one? or 'origins in exclusions then htSayCold '"\&Origins" else htMakePage [['bcLispLinks,['"\&Origins",'"",'dbShowOps,which,'origins]]] - if one? or member('parameters,exclusions) --also test for some parameter + if one? or 'parameters in exclusions --also test for some parameter or not dbDoesOneOpHaveParameters? opAlist then htSayCold '"\&Parameters" else htMakePage [['bcLispLinks,['"\&Parameters",'"",'dbShowOps,which,'parameters]]] if which ~= '"attribute" then - if one? or member('signatures,exclusions) + if one? or 'signatures in exclusions then htSayCold '"\&Signatures" else htMakePage [['bcLispLinks,['"\&Signatures",'"",'dbShowOps,which,'signatures]]] if star? then @@ -1228,7 +1228,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, if unexposed? and $includeUnexposed? then htSayUnexposed() htSay(ops) - predicate='ASCONST or operationIsNiladicConstructor op or member(op,'(0 1)) => 'skip + predicate='ASCONST or operationIsNiladicConstructor op or op in '(0 1) => 'skip which = '"attribute" and null args => 'skip htSay('"(") if IFCAR args then htSay('"{\em ",quickForm2HtString IFCAR args,'"}") @@ -1261,7 +1261,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, ----------------------------------------------------------- htSaySaturn '"\begin{tabular}{lp{0in}}" ----------------------------------------------------------- - if member(which,'("operation" "constructor")) then + if which in '("operation" "constructor") then $displayReturnValue: local := nil if args then htSayStandard('"\newline\tab{2}{\em Arguments:}") diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index 7e8ea376..0279c51e 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -188,7 +188,7 @@ pmPreparse s == hn fn(s,0,#s) where--stupid insertion of chars to get correct pa j := firstDelim(s,i + 1) or siz t := gn(s,i,j - 1) middle := - member(t,'("and" "or" "not")) => t + t in '("and" "or" "not") => t --the following 2 lines make commutative("*") parse correctly!!!! t.0 = char '_" => t j < siz - 1 and s.j = char '_( => t @@ -258,7 +258,7 @@ mkGrepPattern1(x,:options) == --called by mkGrepPattern (and grepConstructName?) IFCAR sl = '"" => h(IFCDR sl,[$wild1]) h(sl,nil) g s == --remove "*"s around pattern for text match - not MEMQ('w,$options) => s + not ('w in $options) => s if s.0 = char '_* then s := SUBSTRING(s,1,nil) if s.(k := MAXINDEX s) = char '_* then s := SUBSTRING(s,0,k) s @@ -681,7 +681,7 @@ conSpecialString?(filter,:options) == secondTime := IFCAR options parse := words := string2Words filter is [s] => ncParseFromString s - and/[not member(x,'("and" "or" "not")) for x in words] => ncParseFromString filter + and/[not (x in '("and" "or" "not")) for x in words] => ncParseFromString filter false null parse => nil form := conLowerCaseConTran parse @@ -740,11 +740,11 @@ dbSearch(lines,kind,filter) == --called by attribute, operation, constructor sea lines is ['error,:.] => bcErrorPage lines null filter => nil --means filter error lines is ['Abbreviations,:r] => dbSearchAbbrev(lines,kind,filter) - if member(kind,'("attribute" "operation")) then --should not be necessary!! + if kind in '("attribute" "operation") then --should not be necessary!! lines := dbScreenForDefaultFunctions lines count := #lines count = 0 => emptySearchPage(kind,filter) - member(kind,'("attribute" "operation")) => dbShowOperationLines(kind,lines) + kind in '("attribute" "operation") => dbShowOperationLines(kind,lines) dbShowConstructorLines lines dbSearchAbbrev([.,:conlist],kind,filter) == @@ -975,7 +975,7 @@ grepFile(pattern,:options) == '"-i" command := strconc('"grep ",casepart,'" _'",pattern,'"_' ",source) runCommand - member(key,'(a o c d p x)) => + key in '(a o c d p x) => strconc(command, '" | sed 's/~/", STRINGIMAGE key, '"/' > ", target) strconc(command, '" > ",target) dbReadLines target diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot index 648c0e18..55d8776a 100644 --- a/src/interp/br-util.boot +++ b/src/interp/br-util.boot @@ -505,7 +505,8 @@ dbSayItems(countOrPrefix,singular,plural,:options) == for x in options repeat bcHt x if count ~= 0 then bcHt '":" -dbBasicConstructor? conname == member(dbSourceFile conname,'("catdef" "coerce")) +dbBasicConstructor? conname == + dbSourceFile conname in '("catdef" "coerce") nothingFoundPage(:options) == htInitPage('"Sorry, no match found",nil) diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 5364f38f..bb92d222 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -396,7 +396,7 @@ checkRecordHash u == checkDocError ['"Unknown \spadtype: ", s] atom key => 'ok checkDocError ['"Wrong number of arguments: ",form2HtString key] - else if member(x,'("\spadop" "\keyword")) and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then + else if x in '("\spadop" "\keyword") and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then x := intern checkGetStringBeforeRightBrace u not (GETL(x,'Led) or GETL(x,'Nud)) => checkDocError ['"Unknown \spadop: ",x] @@ -773,15 +773,15 @@ checkDecorate u == mathSymbolsOk := count - 1 spadflag := count - 1 else checkDocError ['"\em must be enclosed in braces"] - if member(x,'("\spadpaste" "\spad" "\spadop")) then mathSymbolsOk := count - if member(x,'("\s" "\spadtype" "\spadsys" "\example" "\andexample" "\spadop" "\spad" "\spadignore" "\spadpaste" "\spadcommand" "\footnote")) then spadflag := count + if x in '("\spadpaste" "\spad" "\spadop") then mathSymbolsOk := count + if x in '("\s" "\spadtype" "\spadsys" "\example" "\andexample" "\spadop" "\spad" "\spadignore" "\spadpaste" "\spadcommand" "\footnote") then spadflag := count else if x = $charLbrace then count := count + 1 else if x = $charRbrace then count := count - 1 if mathSymbolsOk = count then mathSymbolsOk := false if spadflag = count then spadflag := false - else if not mathSymbolsOk and member(x,'("+" "*" "=" "==" "->")) then + else if not mathSymbolsOk and x in '("+" "*" "=" "==" "->") then if $checkingXmptex? then checkDocError ["Symbol ",x,'" appearing outside \spad{}"] @@ -814,7 +814,7 @@ checkDecorate u == not spadflag and (CHARP x and alphabetic? x and not MEMQ(x,$charExclusions) or member(x,$argl)) => [$charRbrace,x,$charLbrace,'"\spad",:acc] - not spadflag and ((string? x and not x.0 = $charBack and digit?(x.(MAXINDEX x))) or member(x,'("true" "false"))) => + not spadflag and ((string? x and not x.0 = $charBack and digit?(x.(MAXINDEX x))) or x in '("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 => @@ -822,7 +822,7 @@ checkDecorate u == xcount = 4 and x.1 = char '_- and x.2 = char 't and x.3 = char 'h => ['"-th",$charRbrace,x.0,$charLbrace,'"\spad",:acc] not spadflag and (xcount = 2 and x.1 = char 'i or --wrap ei, xi, hi - xcount > 0 and xcount < 4 and not member(x,'("th" "rd" "st")) and + xcount > 0 and xcount < 4 and not x in '("th" "rd" "st") and hasNoVowels x) => --wrap words with no vowels [$charRbrace,x,$charLbrace,'"\spad",:acc] [checkAddBackSlashes x,:acc] @@ -1293,19 +1293,19 @@ checkDecorateForHt u == if x = '"\em" then if count > 0 then spadflag := count - 1 else checkDocError ['"\em must be enclosed in braces"] - if member(x,'("\s" "\spadop" "\spadtype" "\spad" "\spadpaste" "\spadcommand" "\footnote")) then spadflag := count + if x in '("\s" "\spadop" "\spadtype" "\spad" "\spadpaste" "\spadcommand" "\footnote") then spadflag := count else if x = $charLbrace then count := count + 1 else if x = $charRbrace then count := count - 1 if spadflag = count then spadflag := false - else if not spadflag and member(x,'("+" "*" "=" "==" "->")) then + else if not spadflag and x in '("+" "*" "=" "==" "->") then if $checkingXmptex? then checkDocError ["Symbol ",x,'" appearing outside \spad{}"] x = '"$" or x = '"%" => checkDocError ['"Unescaped ",x] -- not spadflag and string? x and (member(x,$argl) or #x = 1 --- and alphabetic? x.0) and not member(x,'("a" "A")) => +-- and alphabetic? x.0) and not (x in '("a" "A")) => -- checkDocError1 ['"Naked ",x] --- not spadflag and string? x and (not x.0 = $charBack and not digit?(x.0) and digit?(x.(MAXINDEX x))or member(x,'("true" "false"))) +-- not spadflag and string? x and (not x.0 = $charBack and not digit?(x.0) and digit?(x.(MAXINDEX x))or x in '("true" "false")) -- => checkDocError1 ["Naked ",x] u := rest u u diff --git a/src/interp/format.boot b/src/interp/format.boot index 4f502e9e..9f58ceb6 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -389,17 +389,17 @@ form2String1 u == u=$EmptyMode or u=$quadSymbol => formWrapId specialChar 'quad IDENTP u => constructor? u => app2StringWrap(formWrapId u, [u]) - u + formWrapId u SUBRP u => formWrapId BPINAME u string? u => formWrapId u - WRITE_-TO_-STRING formWrapId u + formWrapId WRITE_-TO_-STRING u u1 := u [op,:argl] := u op='Join or op= 'mkCategory => formJoin1(op,argl) $InteractiveMode and IDENTP op and (u:= constructor? op) => null argl => app2StringWrap(formWrapId constructorName op, u1) - op = "NTuple" => [ form2String1 first argl, "*"] - op = "Map" => ["(",:formatSignature0 [argl.1,argl.0],")"] + op = "NTuple" => [ form2String1 first argl, '"*"] + op = "Map" => ['"(",:formatSignature0 [argl.1,argl.0],'")"] op = "Record" => record2String(argl) null (conSig := getConstructorSignature op) => application2String(constructorName op,[form2String1(a) for a in argl], u1) @@ -411,7 +411,7 @@ form2String1 u == -- extra null check to handle mutable domain hack. null argl => constructorName op application2String(constructorName op,argl, u1) - op = "Mapping" => ["(",:formatSignature argl,")"] + op = "Mapping" => ['"(",:formatSignature argl,'")"] op = "Record" => record2String(argl) op = "Union" => application2String(op,[form2String1 x for x in argl], u1) @@ -420,18 +420,18 @@ form2String1 u == null rest argl => [ '":", form2String1 first argl ] formDecl2String(argl.0,argl.1) op = "#" and cons? argl and LISTP first argl => - STRINGIMAGE SIZE first argl + STRINGIMAGE #first argl op = 'Join => formJoin2String argl op = "ATTRIBUTE" => form2String1 first argl - op='Zero => 0 - op='One => 1 + op='Zero => '"0" + op='One => '"1" op = 'AGGLST => tuple2String argl op = 'BRACKET => argl' := form2String1 first argl - ["[",:(atom argl' => [argl']; argl'),"]"] + ['"[",:(atom argl' => [argl']; argl'),'"]"] op = 'PAREN => argl' := form2String1 first argl - ["(",:(atom argl' => [argl']; argl'),")"] + ['"(",:(atom argl' => [argl']; argl'),'")"] op = "SIGNATURE" => [operation,sig] := argl concat(operation,'": ",formatSignature sig) @@ -450,11 +450,11 @@ form2String1 u == application2String(op,[form2String1 x for x in argl], u1) formWrapId id == - $formatSigAsTeX = 1 => id + $formatSigAsTeX = 1 => PNAME id $formatSigAsTeX = 2 => sep := '"`" FORMAT(NIL,'"\verb~a~a~a",sep, id, sep) - error "Bad formatSigValue" + error '"Bad formatSigValue" formArguments2String(argl,ml) == [fn(x,m) for x in argl for m in ml] where fn(x,m) == @@ -519,23 +519,23 @@ formJoin2 argl == formJoin2String (u:=[:argl,last]) == last is ["CATEGORY",.,:atsigList] => - postString:= concat("_(",formTuple2String atsigList,"_)") + postString:= concat('"_(",formTuple2String atsigList,'"_)") #argl=1 => concat(first argl,'" with ",postString) concat(application2String('Join,argl, NIL)," with ",postString) application2String('Join,u, NIL) formCollect2String [:itl,body] == - ["_(",body,:"append"/[formIterator2String x for x in itl],"_)"] + ['"_(",body,:"append"/[formIterator2String x for x in itl],'"_)"] formIterator2String x == x is ["STEP",y,s,.,:l] => tail:= (l is [f] => form2StringLocal f; nil) - concat("for ",y," in ",s,'"..",tail) - x is ["tails",y] => concat("tails ",formatIterator y) - x is ["reverse",y] => concat("reverse ",formatIterator y) - x is ["|",y,p] => concat(formatIterator y," | ",form2StringLocal p) - x is ["until",p] => concat("until ",form2StringLocal p) - x is ["while",p] => concat("while ",form2StringLocal p) + concat('"for ",y,'" in ",s,'"..",tail) + x is ["tails",y] => concat('"tails ",formatIterator y) + x is ["reverse",y] => concat('"reverse ",formatIterator y) + x is ["|",y,p] => concat(formatIterator y,'" | ",form2StringLocal p) + x is ["until",p] => concat('"until ",form2StringLocal p) + x is ["while",p] => concat('"while ",form2StringLocal p) systemErrorHere ["formatIterator",x] tuple2String argl == @@ -633,7 +633,7 @@ application2String(op,argl, linkInfo) == null argl => (op' := isInternalFunctionName(op)) => op' app2StringWrap(formWrapId op, linkInfo) - op = "[||]" => concat("[|",concat(prefix2String0 argl,"|]")) + op = "[||]" => concat('"[|",concat(prefix2String0 argl,'"|]")) 1=#argl => arg := first argl arg is ["<",:.] or arg is ["(",:.] => concat(op,arg) @@ -668,9 +668,9 @@ app2StringWrap(string, linkInfo) == record2String x == argPart := NIL for [":",a,b] in x repeat argPart:= - concat(argPart,",",a,": ",form2StringLocal b) + concat(argPart,'",",a,'": ",form2StringLocal b) null argPart => '"Record()" - concat("Record_(",rest argPart,"_)") + concat('"Record_(",rest argPart,'"_)") plural(n,string) == suffix:= diff --git a/src/interp/g-error.boot b/src/interp/g-error.boot index 4964e4da..3841f295 100644 --- a/src/interp/g-error.boot +++ b/src/interp/g-error.boot @@ -79,9 +79,9 @@ errorSupervisor(errorType,errorMsg) == errorSupervisor1(errorType,errorMsg,$BreakMode) needsToSplitMessage msg == - member("%b", msg) or member('"%b",msg) => false - member("%d",msg) or member('"%d",msg) => false - member("%l",msg) or member('"%l",msg) => false + "%b" in msg or '"%b" in msg => false + "%d" in msg or '"%d" in msg => false + "%l" in msg or '"%l" in msg => false true errorSupervisor1(errorType,errorMsg,$BreakMode) == diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 5bf952e7..dfaaef34 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -265,7 +265,7 @@ defaultTarget(opNode,op,nargs,args) == op = 'infinity => putTarget(opNode, target := ['OnePointCompletion, $Integer]) target - member(op, '(plusInfinity minusInfinity)) => + op in '(plusInfinity minusInfinity) => putTarget(opNode, target := ['OrderedCompletion, $Integer]) target target @@ -773,7 +773,7 @@ findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) == -- tar may be NIL (= unknown) null isLegitimateMode(tar, nil, nil) => nil dcName:= first dc - member(dcName,'(Union Record Mapping Enumeration)) => + dcName in '(Union Record Mapping Enumeration) => -- First cut code that ignores args2, $Coerce and $SubDom -- When domains no longer have to have Set, the hard coded 6 and 7 -- should go. @@ -788,7 +788,7 @@ findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) == args1.0 ~= dc => NIL tar and tar ~= $Expression => NIL [[[dc, $Expression, dc], [$Expression,'$], [NIL, NIL]]] - member(dcName,'(Record Union)) => + dcName in '(Record Union) => findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) NIL fun:= NIL @@ -1421,14 +1421,14 @@ hasCateSpecial(v,dom,cat,SL) == -- to be used in $newSystem only hasCateSpecialNew(v,dom,cat,SL) == - fe := member(cat.op, '(ElementaryFunctionCategory + fe := cat.op in '(ElementaryFunctionCategory TrigonometricFunctionCategory ArcTrigonometricFunctionCategory HyperbolicFunctionCategory ArcHyperbolicFunctionCategory PrimitiveFunctionCategory SpecialFunctionCategory Evalable CombinatorialOpsCategory TranscendentalFunctionCategory AlgebraicallyClosedFunctionSpace ExpressionSpace - LiouvillianFunctionCategory FunctionSpace)) - alg := member(cat.op, '(RadicalCategory AlgebraicallyClosedField)) + LiouvillianFunctionCategory FunctionSpace) + alg := cat.op in '(RadicalCategory AlgebraicallyClosedField) fefull := fe or alg or cat = $CombinatorialFunctionCategory partialResult := dom is ["Variable",:.] or dom = $Symbol => diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 81fee035..d1674279 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -3139,11 +3139,11 @@ handleNoParseCommands(unab, string) == npsynonym(unab, (null spaceIndex => '""; SUBSEQ(string, spaceIndex+1))) null spaceIndex => FUNCALL unab - member(unab, '( quit _ - fin _ - pquit _ - credits _ - copyright )) => + unab in '( quit _ + fin _ + pquit _ + credits _ + copyright ) => sayKeyedMsg("S2IV0005", NIL) nil funName := INTERN strconc('"np",STRING unab) diff --git a/src/interp/mark.boot b/src/interp/mark.boot index cd7997d4..ba127ef7 100644 --- a/src/interp/mark.boot +++ b/src/interp/mark.boot @@ -1469,7 +1469,7 @@ buildNewDefinition(op,theSig,formPredAlist) == theAlist := [[pred, first form, :theArgl] for [pred,:form] in alist] theNils := [nil for x in theForm] thePred := - member(outerPred, '(T %true)) => nil + outerPred in '(T %true) => nil outerPred def := ['DEF, theForm, theSig, theNils, ifize theAlist] value := diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index 07651a6b..dbb08f18 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -182,40 +182,40 @@ substituteSegmentedMsg(msg,args) == q := NIL for i in 2..(n-1) repeat q := [x.i,:q] -- Note 'f processing must come first. - if MEMQ(char 'f,q) then + if char 'f in q then 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]] - if MEMQ(char 'p,q) then + if char 'm in q then arg := [['"%m",:arg]] + if char 's in q then arg := [['"%s",:arg]] + if char 'p in q then $texFormatting => arg := prefix2StringAsTeX arg arg := prefix2String arg - if MEMQ(char 'P,q) then + if char 'P in q then $texFormatting => arg := [prefix2StringAsTeX x for x in arg] arg := [prefix2String x for x in arg] - if MEMQ(char 'o, q) and $texFormatting then arg := operationLink(arg) + if char 'o in q and $texFormatting then arg := operationLink(arg) - if MEMQ(char 'c,q) then arg := [['"%ce",:arg]] - if MEMQ(char 'r,q) then arg := [['"%rj",:arg]] + if char 'c in q then arg := [['"%ce",:arg]] + if char 'r in q then arg := [['"%rj",:arg]] - if MEMQ(char 'l,q) then l := ['"%l",:l] - if MEMQ(char 'b,q) then l := ['"%b",:l] + if char 'l in q then l := ['"%l",:l] + if char 'b in q then l := ['"%b",:l] --we splice in arguments that are lists --if y is not specified, then the adding of blanks is --stifled after the first item in the list until the --end of the list. (using %n and %y) l := cons?(arg) => - MEMQ(char 'y,q) or (first arg = '"%y") or ((# arg) = 1) => + char 'y in q or (first arg = '"%y") or ((# arg) = 1) => append(reverse arg, l) head := first arg tail := rest arg ['"%y",:append(reverse tail, ['"%n",head,:l ]) ] [arg,:l] - if MEMQ(char 'b,q) then l := ['"%d",:l] + if char 'b in q then l := ['"%d",:l] for ch in '(_. _, _! _: _; _?) repeat - if MEMQ(char ch,q) then l := [ch,:l] + if char ch in q then l := [ch,:l] c = char "%" and n > 1 and x.1 = char "x" and digit? x.2 => l := [fillerSpaces(DIG2FIX x.2, '" "),:l] diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index a5c73202..e83ce7c7 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -240,7 +240,7 @@ exp2FortOptimizeCS1 e == f := NIL f := g - MEMQ(object2Identifier first e,'(ROW AGGLST)) => e + object2Identifier first e in '(ROW AGGLST) => e -- see if we have already seen this expression n := HGET($fortCsHash,e) diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot index 663881a3..124a2e46 100644 --- a/src/interp/pspad1.boot +++ b/src/interp/pspad1.boot @@ -366,7 +366,7 @@ formatForm (u) == [op,:argl] := u if op in '(Record Union) then $fieldNames := union(getFieldNames argl,$fieldNames) - MEMQ(op,'(true %true)) => format "true" + op in '(true %true) => format "true" op in '(false nil) => format op u='(Zero) => format 0 u='(One) => format 1 diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot index ed99dbd6..ecbcedb0 100644 --- a/src/interp/pspad2.boot +++ b/src/interp/pspad2.boot @@ -558,7 +558,7 @@ nary2Binary(u,op) == string2PrintImage s == u:= GETSTR (2*SIZE s) for i in 0..MAXINDEX s repeat - (if MEMQ(s.i,'(_( _{ _) _} _! _")) then + (if s.i in '(_( _{ _) _} _! _") then SUFFIX('__,u); u:= SUFFIX(s.i,u)) u diff --git a/src/interp/trace.boot b/src/interp/trace.boot index e970f0af..8335b4b9 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -633,7 +633,7 @@ letPrint3(x,xval,printfn,currentFunction) == if flag='letPrint2 then print xval if (y:= hasPair("BREAK",y)) and (y="all" or MEMQ(x,y) and - (not MEMQ(PNAME(x).0,'($ _#)) and not GENSYMP x)) then + (not (PNAME(x).0 in '($ _#)) and not GENSYMP x)) then break [:bright currentFunction,'"breaks after",:bright x,'":= ", xval] x |