diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/ChangeLog | 14 | ||||
-rw-r--r-- | src/interp/br-data.boot | 5 | ||||
-rw-r--r-- | src/interp/br-op1.boot | 9 | ||||
-rw-r--r-- | src/interp/c-doc.boot | 13 | ||||
-rw-r--r-- | src/interp/category.boot | 2 | ||||
-rw-r--r-- | src/interp/functor.boot | 3 | ||||
-rw-r--r-- | src/interp/g-cndata.boot | 2 | ||||
-rw-r--r-- | src/interp/i-util.boot | 5 | ||||
-rw-r--r-- | src/interp/lisplib.boot | 5 | ||||
-rw-r--r-- | src/interp/mark.boot | 37 | ||||
-rw-r--r-- | src/interp/wi1.boot | 10 | ||||
-rw-r--r-- | src/interp/wi2.boot | 6 |
12 files changed, 68 insertions, 43 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 2a942da0..43370af4 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,19 @@ 2008-11-03 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/br-data.boot: Remove uses of BOUNDP. + * interp/br-op1.boot: Likewise. + * interp/c-doc.boot: Likewise. + * interp/functor.boot: Likewise. + * interp/category.boot: Likewise. + * interp/g-cndata.boot: Likewise. + * interp/i-util.boot: Likewise. + * interp/lisplib.boot: Likewise. + * interp/mark.boot: Likewise. + * interp/wi1.boot: Likewise. + * interp/wi2.boot: Likewise. + +2008-11-03 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/postpar.boot (postcheckTarget): Likewise. (isPackageType): Likewise. * interp/lisplib.boot (getSlotFromDomain): Remove. diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 5d892800..1fe1de2b 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -512,8 +512,11 @@ getParentsFor(cname,formalParams,constructorCategory) == acc := [:explodeIfs x,:acc] NREVERSE acc +$parentsCache := nil + parentsOf con == --called by kcpPage, ancestorsRecur - if null BOUNDP '$parentsCache then SETQ($parentsCache,MAKE_-HASHTABLE 'ID) + if null $parentsCache then + $parentsCache := MAKE_-HASHTABLE 'ID HGET($parentsCache,con) or parents := getParentsForDomain con HPUT($parentsCache,con,parents) diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 1f9825bb..38f83e2f 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -697,11 +697,6 @@ htSayExpose(op,flag) == dbShowOperationsFromConform(htPage,which,opAlist) == --branch in with lists $groupChoice := nil conform := htpProperty(htPage,'conform) - --prepare opAlist for possible filtering of groups - if null BOUNDP '$topicHash then - $topicHash := MAKE_-HASHTABLE 'ID - for [x,:c] in '((extended . 0) (basic . 1) (hidden . 2)) repeat - HPUT($topicHash,x,c) if domform := htpProperty(htPage,'domname) then $conformsAreDomains : local := true reduceOpAlistForDomain(opAlist,domform,conform) @@ -747,6 +742,8 @@ reduceOpAlistForDomain(opAlist,domform,conform) == item opAlist +$attributeArgs := nil + dbShowOperationLines(which,linelist) == --branch in with lines htPage := htInitPage(nil,nil) --create empty page opAlist := nil @@ -766,7 +763,7 @@ dbShowOperationLines(which,linelist) == --branch in with lines 'expandAttributes htpSetProperty(htPage,expandProperty,'strings) dbResetOpAlistCondition(htPage,which,opAlist) - if which = '"attribute" and BOUNDP '$attributeArgs and $attributeArgs then + if which = '"attribute" and $attributeArgs then --code needed to handle commutative("*"); called from aPage --must completely expand the opAlist then check for those with --arguments equal to $attributeArgs diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 3d1c448b..c99b359b 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -202,6 +202,8 @@ transDocList($constructorName,doclist) == --returns ((key line)...) checkDocError1 ['"Missing Description"] acc +$attribute? := nil + ++ Given a functor `conname', and a list of documenation strings, ++ sanity-check the documentation. In particular extract information ++ such as `Description', etc. @@ -562,8 +564,8 @@ checkComments(nameSig,lines) == main where main() == $checkErrorFlag: local := false margin := checkGetMargin lines - if (null BOUNDP '$attribute? or null $attribute?) - and nameSig ^= 'constructor then lines := + if null $attribute? and nameSig ^= 'constructor then + lines := [checkTransformFirsts(first nameSig,first lines,margin),:rest lines] u := checkIndentedLines(lines, margin) $argl := checkGetArgs first u --set $argl @@ -1246,9 +1248,12 @@ whoOwns(con) == --======================================================================= -- Report Documentation Error --======================================================================= +++ True if we are compiling only documentation. +$compileDocumentation := false + checkDocError1 u == --when compiling for documentation, ignore certain errors - BOUNDP '$compileDocumentation and $compileDocumentation => nil + $compileDocumentation => nil checkDocError u checkDocError u == @@ -1273,7 +1278,7 @@ checkDocMessage u == sourcefile := getConstructorSourceFileFromDB $constructorName person := whoOwns $constructorName or '"---" middle := - BOUNDP '$x => ['"(",$x,'"): "] + not null $x => ['"(",$x,'"): "] ['": "] concat(person,'">",sourcefile,'"-->",$constructorName,middle,u) diff --git a/src/interp/category.boot b/src/interp/category.boot index 63e42c75..20a4c686 100644 --- a/src/interp/category.boot +++ b/src/interp/category.boot @@ -573,7 +573,7 @@ JoinInner(l,$e) == Join(:l) == e := - (not BOUNDP '$e) or null $e or $InteractiveMode => $CategoryFrame + null $e or $InteractiveMode => $CategoryFrame $e JoinInner(l, e) diff --git a/src/interp/functor.boot b/src/interp/functor.boot index a3e122c6..c5a55ae3 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -54,8 +54,7 @@ DomainPrint(D,brief) == $Sublis: local := nil $WhereCounter: local := 1 env:= - not BOUNDP '$e => $EmptyEnvironment - $e='$e => $EmptyEnvironment + null $e => $EmptyEnvironment $e --in case we are called from top level isCategory D => CategoryPrint(D,env) $Sublis:= [[keyItem D,:'original]] diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot index ee0f44a4..d6788b88 100644 --- a/src/interp/g-cndata.boot +++ b/src/interp/g-cndata.boot @@ -127,7 +127,7 @@ abbQuery(x) == installConstructor(cname,type) == (entry := getCDTEntry(cname,true)) => entry item := [cname,getConstructorAbbreviationFromDB cname,nil] - if BOUNDP '$lowerCaseConTb and $lowerCaseConTb then + if $lowerCaseConTb then HPUT($lowerCaseConTb,cname,item) HPUT($lowerCaseConTb,DOWNCASE cname,item) diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot index 8107c37b..cdfa2cfe 100644 --- a/src/interp/i-util.boot +++ b/src/interp/i-util.boot @@ -86,9 +86,10 @@ printPrompt(flush? == false) == --% Miscellaneous +$ZeroVecCache := nil Zeros n == - BOUNDP '$ZeroVecCache and #$ZeroVecCache=n => $ZeroVecCache - $ZeroVecCache:= MAKE_-VEC n + #$ZeroVecCache = n => $ZeroVecCache + $ZeroVecCache := MAKE_-VEC n for i in 0..n-1 repeat $ZeroVecCache.i:=0 $ZeroVecCache diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 4d614d81..f491569e 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -331,7 +331,7 @@ compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) == val compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) == - --fn= compDefineCategory OR compDefineFunctor + --fn= compDefineCategory1 OR compDefineFunctor1 sayMSG fillerSpaces(72,'"-") $LISPLIB: local := 'T $op: local := op @@ -358,8 +358,7 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) == --will eventually become the "constructorCategory" property in lisplib --set in compDefineCategory1 if category, otherwise in finalizeLisplib libName := getConstructorAbbreviation op - BOUNDP '$compileDocumentation and $compileDocumentation => - compileDocumentation libName + $compileDocumentation => compileDocumentation libName sayMSG ['" initializing ",$spadLibFT,:bright libName, '"for",:bright op] initializeLisplib libName diff --git a/src/interp/mark.boot b/src/interp/mark.boot index 11dfefe3..fd3bf0cd 100644 --- a/src/interp/mark.boot +++ b/src/interp/mark.boot @@ -133,7 +133,7 @@ markSimpleReduce(x,T) == markCompAtom(x,T) == --for compAtom tcheck T - BOUNDP '$convert2NewCompiler and $convert2NewCompiler => + $convert2NewCompiler => [mkWi('compAtom,'ATOM,nil,['REPLACE,[x]],T.expr),:CDR T] T @@ -205,13 +205,13 @@ markAt(T) == markCompColonInside(op,T) == --for compColonInside tcheck T - BOUNDP '$convert2NewCompiler and $convert2NewCompiler => + $convert2NewCompiler => [mkWi('compColonInside,'COLON,op,T.mode,T.expr),:CDR T] T markLisp(T,m) == --for compForm1 tcheck T - BOUNDP '$convert2NewCompiler and $convert2NewCompiler => + $convert2NewCompiler => [mkWi('compForm1,'COLON,'Lisp,T.mode,T.expr),:CDR T] T @@ -224,7 +224,7 @@ markLambda(vl,body,mode,T) == --for compWithMappingMode [mkWi('compWithMappingMode,'LAMBDA,nil,['REPLACE,fun],T.expr),:CDR T] markMacro(before,after) == --for compMacro - BOUNDP '$convert2NewCompiler and $convert2NewCompiler => + $convert2NewCompiler => if before is [x] then before := x $def := ['MDEF,before,'(NIL),'(NIL),after] if $insideFunctorIfTrue @@ -294,7 +294,7 @@ markImport(d,:option) == --from compFormWithModemap/genDeltaEntry/compImport $insideCapsuleFunctionIfTrue => $localImportStack := insert(dom,$localImportStack) if IFCAR option then $localDeclareStack := insert(dom,$localDeclareStack) - if BOUNDP '$globalImportStack then + if $globalImportStack then $globalImportStack := insert(dom,$globalImportStack) if IFCAR option then $globalDeclareStack := insert(dom,$globalDeclareStack) @@ -309,7 +309,7 @@ markMacroTran name == --called by markImport [op,:[markMacroTran x for x in argl]] markSetq(originalLet,T) == --for compSetq - BOUNDP '$convert2NewCompiler and $convert2NewCompiler => + $convert2NewCompiler => $coerceList : local := nil ["%LET",form,originalBody] := originalLet id := markLhs form @@ -370,7 +370,7 @@ foobum(x) == x --from doIT --====================================================================== --called from compDefineCapsuleFunction markChanges(originalDef,T,sig) == - BOUNDP '$convert2NewCompiler and $convert2NewCompiler => + $convert2NewCompiler => if $insideCategoryIfTrue and $insideFunctorIfTrue then originalDef := markCatsub(originalDef) T := [markCatsub(T.expr), @@ -553,6 +553,9 @@ getTargetWI x == x is ['WI,a,b] or x is ['MI,a,b] => getTargetWI b x is ['PART,.,a] => getTargetWI a x + +$shout1 := false +$shout2 := false markRecord(source,target,u) == --Record changes on $coerceList @@ -572,7 +575,7 @@ markRecord(source,target,u) == path := path = 0 => nil --wrap the WHOLE thing path - if BOUNDP '$shout2 and $shout2 then + if $shout2 then pp '"=========" pp path ipath := reverse path @@ -618,7 +621,7 @@ markPath1 u == u is [a,b,:r] => -- a < b < ... a = b => markPath1 CDR u ---> allow duplicates on path path := markGetPath(a,b) or return nil -----> early exit - if BOUNDP '$shout1 and $shout1 then + if $shout1 then pp '"=========" pp path pp a @@ -626,6 +629,8 @@ markPath1 u == [:first path,:markPath1 CDR u] nil +$pathErrorStack := nil + markGetPath(x,y) == -- x < y ---> find its location u := markGetPaths(x,y) u is [w] => u @@ -634,8 +639,7 @@ markGetPath(x,y) == -- x < y ---> find its location null u => '"no match" '"ambiguous" sayBrightly ['"-----",key,'"--------"] - if not BOUNDP '$pathErrorStack then SETQ($pathErrorStack,nil) - SETQ($pathErrorStack,[$path,:$pathErrorStack]) + $pathErrorStack := [$path,:$pathErrorStack] pp "CAUTION: this can cause RPLAC errors" pp "Paths are: " pp u @@ -655,7 +659,7 @@ markTryPaths() == markGetPaths($x,$y) markPaths(x,y,s) == --x < y; find location s of x in y (initially s=nil) --NOTES: This location is what it will be in the source program with -- all PART information removed. - if BOUNDP '$shout and $shout then + if $shout then pp '"-----" pp x pp y @@ -709,6 +713,7 @@ markPathsMacro y == -- Capsule Function: DO the transformations --====================================================================== --called by markChanges (inside capsule), markSetq (outside capsule) +$hohum := false markSpliceInChanges body == -- pp '"before---->" -- pp $coerceList @@ -728,7 +733,7 @@ markSpliceInChanges body == --entries can have duplicate codes for [code,target,:loc] in $coerceList repeat $data: local := [code, target, loc] - if BOUNDP '$hohum and $hohum then + if $hohum then pp '"---------->>>>>" pp $data pp body @@ -762,7 +767,7 @@ markInsertChanges(code,form,t,loc) == pp $data foobum form form - if BOUNDP '$hohum and $hohum then pp [i, '" >>> ", x] + if $hohum then pp [i, '" >>> ", x] SETQ($CHANGE,COPY x) if x is ['elt,:y] and r then x := y RPLACA(x,markInsertChanges(code,CAR x,t,rest loc)) @@ -1344,9 +1349,11 @@ markConstructorForm name == --------> same as getConstructorForm --====================================================================== -- new path functions --====================================================================== + +$newPaths := false markGetPaths(x,y) == - BOUNDP '$newPaths and $newPaths => + $newPaths => -- res := reverseDown mkGetPaths(x, y) res := mkGetPaths(x, y) -- oldRes := markPaths(x,y,[nil]) diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot index f711677d..7f11de54 100644 --- a/src/interp/wi1.boot +++ b/src/interp/wi1.boot @@ -42,6 +42,7 @@ spad2AsTranslatorAutoloadOnceTrigger() == nil --====================================================================== -- Temporary definitions---for tracing and debugging --====================================================================== +$convertingSpadFile := false tr fn == $convertingSpadFile : local := true $options: local := nil @@ -144,8 +145,7 @@ compDefineLisplib(df,m,e,prefix,fal,fn) == --will eventually become the "constructorCategory" property in lisplib --set in compDefineCategory if category, otherwise in finalizeLisplib libName := getConstructorAbbreviation op - BOUNDP '$compileDocumentation and $compileDocumentation => - compileDocumentation libName + $compileDocumentation => compileDocumentation libName sayMSG ['" initializing ",$spadLibFT,:bright libName, '"for",:bright op] initializeLisplib libName @@ -668,7 +668,7 @@ canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends for v in rest expr] op="IF" => expr is [.,a,b,c] - if not canReturn(a,0,0,true) and not (BOUNDP '$convert2NewCompiler and $convert2NewCompiler) then + if not canReturn(a,0,0,true) and not $convert2NewCompiler then SAY "IF statement can not cause consequents to be executed" pp expr canReturn(a,level,exitCount,nil) or canReturn(b,level,exitCount,ValueFlag) @@ -1143,7 +1143,7 @@ compDefineCategory1(df,m,e,prefix,fal) == nil [d,m,e]:= compDefineCategory2(form,sig,sc,body,m,e,prefix,fal) --+ next two lines --- if BOUNDP '$convertingSpadFile and $convertingSpadFile then nil +-- if $convertingSpadFile then nil -- else if categoryCapsule and not $bootStrapMode then [.,.,e] := @@ -1238,7 +1238,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e, -- 6. put modemaps into InteractiveModemapFrame $domainShell := - BOUNDP '$convertingSpadFile and $convertingSpadFile => nil + $convertingSpadFile => nil eval [op',:MAPCAR('MKQ,sargl)] $lisplibCategory:= formalBody ---- if $LISPLIB then diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index 421223fc..0dfed4bc 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -88,7 +88,7 @@ compDefineFunctor1(df, m,$e,$prefix,$formalArgList) == $mutableDomain: local := -- all defaulting packages should have caching turned off isCategoryPackageName $op or - (if BOUNDP '$mutableDomains then MEMQ($op,$mutableDomains) + (if $mutableDomains then MEMQ($op,$mutableDomains) else false ) --true if domain has mutable state signature':= [first signature,:[getArgumentModeOrMoan(a,form,$e) for a in argl]] @@ -175,7 +175,7 @@ compDefineFunctor1(df, m,$e,$prefix,$formalArgList) == SETQ($myFunctorBody, body) --------> new <-------- T:= compFunctorBody(body,rettype,$e,parForm) ---------------> new <--------------------- - BOUNDP '$convert2NewCompiler and $convert2NewCompiler => + $convert2NewCompiler => return markFinish($originalBody,[$form,['Mapping,:signature'],T.env]) ---------------> new <--------------------- -- If only compiling certain items, then ignore the body shell. @@ -372,7 +372,7 @@ compCapsuleInner(itemList,m,e) == data:= ["PROGN",:itemList] --RPLACd by compCapsuleItems and Friends e:= compCapsuleItems(itemList,nil,e) - BOUNDP '$convert2NewCompiler and $convert2NewCompiler => + $convert2NewCompiler => [nil,m,e] --nonsense but that's fine localParList:= $functorLocalParameters if $addForm then data:= ['add,$addForm,data] |