aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/boot/ast.boot8
-rw-r--r--src/boot/strap/ast.clisp11
-rw-r--r--src/interp/br-op2.boot2
-rw-r--r--src/interp/compiler.boot113
-rw-r--r--src/interp/define.boot41
-rw-r--r--src/interp/g-util.boot3
-rw-r--r--src/interp/nrunfast.boot121
7 files changed, 153 insertions, 146 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 3c921466..0fc4a122 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -641,8 +641,7 @@ bfISReverse(x,a) ==
bfIS1(lhs,rhs) ==
rhs = nil => ['NULL,lhs]
bfString? rhs => bfAND [['STRINGP,lhs],["STRING=",lhs,rhs]]
- bfChar? rhs => bfAND [['CHARACTERP,lhs],["CHAR=",lhs,rhs]]
- integer? rhs => ['EQL,lhs,rhs]
+ bfChar? rhs or integer? rhs => ['EQL,lhs,rhs]
atom rhs => ['PROGN,bfLetForm(rhs,lhs),'T]
rhs is ['QUOTE,a] =>
symbol? a => ['EQ,lhs,rhs]
@@ -745,10 +744,11 @@ defQuoteId x==
x is ["QUOTE",:.] and symbol? second x
bfChar? x ==
- char? x or cons? x and first x in '(char CODE_-CHAR SCHAR)
+ char? x or cons? x and x.op in '(char CODE_-CHAR SCHAR)
bfSmintable x==
- integer? x or cons? x and first x in '(SIZE LENGTH CHAR_-CODE)
+ integer? x or cons? x and
+ x.op in '(SIZE LENGTH CHAR_-CODE MAXINDEX _+ _-)
bfString? x ==
string? x
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 9468fb13..81ae3841 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -907,7 +907,7 @@
CDAAR CDDAR CDADR CDDDR))
(SETQ |p| (|bfPosition| (CAR |expr|) |funs|))
(COND
- ((EQUAL |p| (- 1)) (LIST |acc| |expr|))
+ ((EQL |p| (- 1)) (LIST |acc| |expr|))
(T (SETQ |funsA|
'(CAAR CADR CAAAR CADAR CAADR CADDR CAAAAR CAADAR
CAAADR CAADDR CADAAR CADDAR CADADR CADDDR))
@@ -963,10 +963,8 @@
((|bfString?| |rhs|)
(|bfAND| (LIST (LIST 'STRINGP |lhs|)
(LIST 'STRING= |lhs| |rhs|))))
- ((|bfChar?| |rhs|)
- (|bfAND| (LIST (LIST 'CHARACTERP |lhs|)
- (LIST 'CHAR= |lhs| |rhs|))))
- ((INTEGERP |rhs|) (LIST 'EQL |lhs| |rhs|))
+ ((OR (|bfChar?| |rhs|) (INTEGERP |rhs|))
+ (LIST 'EQL |lhs| |rhs|))
((ATOM |rhs|) (LIST 'PROGN (|bfLetForm| |rhs| |lhs|) 'T))
((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'QUOTE)
(PROGN
@@ -1211,7 +1209,8 @@
(DEFUN |bfSmintable| (|x|)
(OR (INTEGERP |x|)
- (AND (CONSP |x|) (MEMQ (CAR |x|) '(SIZE LENGTH CHAR-CODE)))))
+ (AND (CONSP |x|)
+ (MEMQ (CAR |x|) '(SIZE LENGTH CHAR-CODE MAXINDEX + -)))))
(DEFUN |bfString?| (|x|)
(OR (STRINGP |x|)
diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot
index e6b3de61..399c58fd 100644
--- a/src/interp/br-op2.boot
+++ b/src/interp/br-op2.boot
@@ -148,7 +148,7 @@ dbGetFormFromDocumentation(op,sig,x) ==
string? doc and
(stringPrefix?('"\spad{",doc) and (k := 6) or
stringPrefix?('"\s{",doc) and (k := 3)) =>
- n := charPosition($charRbrace,doc,k)
+ n := charPosition(char "}",doc,k)
s := subString(doc,k,n - k)
parse := ncParseFromString s
parse is [=op,:.] and #parse = #sig => parse
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 5ab85ec7..67dd361c 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -190,8 +190,8 @@ comp3(x,m,$e) ==
atom x => compAtom(x,m,e)
op:= x.op
getmode(op,e) is ["Mapping",:ml] and (u:= applyMapping(x,m,e,ml)) => u
- op=":" => compColon(x,m,e)
- op="::" => compCoerce(x,m,e)
+ op is ":" => compColon(x,m,e)
+ op is "::" => compCoerce(x,m,e)
not ($insideCompTypeOf=true) and stringPrefix?('"TypeOf",PNAME op) =>
compTypeOf(x,m,e)
t:= compExpression(x,m,e)
@@ -216,7 +216,7 @@ emitLocalCallInsn(op,args,e) ==
[op',:args,"$"]
applyMapping([op,:argl],m,e,ml) ==
- #argl~=#ml-1 => nil
+ #argl ~= #ml-1 => nil
isCategoryForm(first ml,e) =>
--is op a functor?
pairlis:= pairList($FormalMapVariableList,argl)
@@ -230,7 +230,7 @@ applyMapping([op,:argl],m,e,ml) ==
argl':=
[T.expr for x in argl for m' in rest ml] where
T() == [.,.,e]:= comp(x,m',e) or return "failed"
- if argl'="failed" then return nil
+ if argl' is "failed" then return nil
form:=
atom op and not(op in $formalArgList) and null (u := get(op,"value",e)) =>
emitLocalCallInsn(op,argl',e)
@@ -347,13 +347,13 @@ finishLambdaExpression(expr is ["LAMBDA",vars,.],env) ==
compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) ==
$killOptimizeIfTrue: local:= true
- e:= oldE
+ e := oldE
isFunctor x =>
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]
x is ["+->",:.] => compLambda(x,m,oldE)
- if string? x then x:= makeSymbol x
+ if string? x then x := makeSymbol 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
@@ -392,10 +392,10 @@ compAtomWithModemap(x,m,e,mmList) ==
CATCH("compUniquely", compForm3([x],m,e,mmList))
compAtom(x,m,e) ==
- x = "break" => compBreak(x,m,e)
- x = "iterate" => compIterate(x,m,e)
- T:= IDENTP x and compAtomWithModemap(x,m,e,get(x,"modemap",e)) => T
- t:=
+ x is "break" => compBreak(x,m,e)
+ x is "iterate" => compIterate(x,m,e)
+ T := IDENTP x and compAtomWithModemap(x,m,e,get(x,"modemap",e)) => T
+ t :=
IDENTP x => compSymbol(x,m,e) or return nil
member(m,$IOFormDomains) and primitiveType x => [x,m,e]
string? x => [x,x,e]
@@ -406,23 +406,23 @@ primitiveType x ==
x is nil => $EmptyMode
string? x => $String
integer? x =>
- x=0 => $NonNegativeInteger
- x>0 => $PositiveInteger
+ x = 0 => $NonNegativeInteger
+ x > 0 => $PositiveInteger
$Integer
FLOATP x => $DoubleFloat
nil
compSymbol(s,m,e) ==
- s="$NoValue" => ["$NoValue",$NoValueMode,e]
+ s is "$NoValue" => ["$NoValue",$NoValueMode,e]
isFluid s => [s,getmode(s,e) or return nil,e]
- s=m or isLiteral(s,e) => [["QUOTE",s],s,e]
+ sameObject?(s,m) or isLiteral(s,e) => [["QUOTE",s],s,e]
v := get(s,"value",e) =>
MEMQ(s,$functorLocalParameters) =>
NRTgetLocalIndex s
[s,v.mode,e] --s will be replaced by an ELT form in beforeCompile
[s,v.mode,e] --s has been SETQd
- m':= getmode(s,e) =>
+ m' := getmode(s,e) =>
if not MEMQ(s,$formalArgList) and not MEMQ(s,$FormalMapVariableList) and
not isFunction(s,e) and null ($compForModeIfTrue=true) then errorRef s
[s,m',e] --s is a declared argument
@@ -437,12 +437,12 @@ compSymbol(s,m,e) ==
hasUniqueCaseView(x,m,e) ==
props := getProplist(x,e)
for [p,:v] in props repeat
- p = "condition" and v is [["case",.,t],:.] => return modeEqual(t,m)
- p = "value" => return false
+ p is "condition" and v is [["case",.,t],:.] => return modeEqual(t,m)
+ p is "value" => return false
convertOrCroak(T,m) ==
- u:= convert(T,m) => u
+ u := convert(T,m) => u
userError ['"CANNOT CONVERT: ",T.expr,"%l",'" OF MODE: ",T.mode,"%l",
'" TO MODE: ",m,"%l"]
@@ -450,7 +450,7 @@ convert(T,m) ==
coerce(T,resolve(T.mode,m) or return nil)
mkUnion(a,b) ==
- b="$" and $Rep is ["Union",:l] => b
+ b is "$" and $Rep is ["Union",:l] => b
a is ["Union",:l] =>
b is ["Union",:l'] => ["Union",:union(l,l')]
["Union",:union([b],l)]
@@ -467,7 +467,7 @@ hasType(x,e) ==
--% General Forms
compForm(form,m,e) ==
- T:=
+ T :=
compForm1(form,m,e) or compArgumentsAndTryAgain(form,m,e) or return
stackMessageIfNone ["cannot compile","%b",form,"%d"]
T
@@ -478,8 +478,8 @@ compArgumentsAndTryAgain(form is [.,:argl],m,e) ==
-- modemap with selector b
form is ["elt",a,.] =>
([.,.,e]:= comp(a,$EmptyMode,e) or return nil; compForm1(form,m,e))
- u:= for x in argl repeat [.,.,e]:= comp(x,$EmptyMode,e) or return "failed"
- u="failed" => nil
+ u := for x in argl repeat [.,.,e]:= comp(x,$EmptyMode,e) or return "failed"
+ u is "failed" => nil
compForm1(form,m,e)
outputComp(x,e) ==
@@ -633,10 +633,10 @@ getFormModemaps(form is [op,:argl],e) ==
-- current domain.
if $insideCategoryPackageIfTrue then
modemapList := [x for x in modemapList | x.mmDC isnt '$]
- if op="elt"
+ if op is "elt"
then modemapList:= eltModemapFilter(last argl,modemapList,e) or return nil
else
- if op="setelt" then modemapList:=
+ if op is "setelt" then modemapList:=
seteltModemapFilter(second argl,modemapList,e) or return nil
nargs := #argl
finalModemapList:= [mm for mm in modemapList
@@ -660,10 +660,11 @@ checkCallingConvention(sigs,nargs) ==
for t in rest sig
for i in 0.. repeat
isQuasiquote t =>
- v.i < 0 => userError '"flag argument restriction violation"
- v.i := v.i + 1
- v.i > 0 => userError '"flag argument restriction violation"
- v.i := v.i - 1
+ arrayRef(v,i) < 0 =>
+ userError '"flag argument restriction violation"
+ arrayRef(v,i) := arrayRef(v,i) + 1
+ arrayRef(v,i) > 0 => userError '"flag argument restriction violation"
+ arrayRef(v,i) := arrayRef(v,i) - 1
v
@@ -699,12 +700,12 @@ compApplication(op,argl,m,T) ==
emitLocalCallInsn(T.expr,[a.expr for a in argTl],e)
['%call, ['applyFun, T.expr], :[a.expr for a in argTl]]
coerce([form, retm, e],resolve(retm,m))
- op = 'elt => nil
+ op is 'elt => nil
eltForm := ['elt, op, :argl]
comp(eltForm, m, e)
compToApply(op,argl,m,e) ==
- T:= compNoStacking(op,$EmptyMode,e) or return nil
+ T := compNoStacking(op,$EmptyMode,e) or return nil
T.expr is ["QUOTE", =T.mode] => nil
compApplication(op,argl,m,T)
@@ -783,8 +784,8 @@ compSetq1(form,val,m,E) ==
[.,.,E']:= compMakeDeclaration(x,y,E)
compSetq1(x,val,m,E')
form is [op,:l] =>
- op="CONS" => setqMultiple(uncons form,val,m,E)
- op="%Comma" => setqMultiple(l,val,m,E)
+ op is "CONS" => setqMultiple(uncons form,val,m,E)
+ op is "%Comma" => setqMultiple(l,val,m,E)
setqSetelt(form,val,m,E)
compMakeDeclaration: (%Form,%Mode,%Env) -> %Maybe %Triple
@@ -930,7 +931,7 @@ compWhere([.,form,:exprList],m,eInit) ==
for item in exprList repeat
recordDeclarationInSideCondition(item,e)
[.,.,e]:= comp(item,$EmptyMode,e) or return "failed"
- u="failed" => return nil
+ u is "failed" => return nil
$insideWhereIfTrue := false
[x,m,eAfter] := comp(macroExpand(form,eBefore := e),m,e) or return nil
eFinal :=
@@ -969,13 +970,13 @@ compList: (%Form,%Mode,%Env) -> %Maybe %Triple
compList(l,m is ["List",mUnder],e) ==
null l => ['%nil,m,e]
Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l]
- Tl="failed" => nil
- T:= [['%list,:[T.expr for T in Tl]],["List",mUnder],e]
+ Tl is "failed" => nil
+ T := [['%list,:[T.expr for T in Tl]],["List",mUnder],e]
compVector: (%Form,%Mode,%Env) -> %Maybe %Triple
compVector(l,m is ["Vector",mUnder],e) ==
- Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l]
- Tl="failed" => nil
+ Tl := [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l]
+ Tl is "failed" => nil
[["MAKE-ARRAY", #Tl, KEYWORD::ELEMENT_-TYPE, quoteForm getVMType mUnder,
KEYWORD::INITIAL_-CONTENTS, ['%list, :[T.expr for T in Tl]]],m,e]
@@ -1100,7 +1101,7 @@ jumpFromLoop(kind,key) ==
compBreak: (%Symbol,%Mode,%Env) -> %Maybe %Triple
compBreak(x,m,e) ==
- x ~= "break" or not jumpFromLoop("REPEAT",x) => nil
+ x isnt "break" or not jumpFromLoop("REPEAT",x) => nil
index:= #$exitModeStack-1-$leaveLevelStack.0
$breakCount := $breakCount + 1
u := coerce(["$NoValue",$Void,e],$exitModeStack.index) or return nil
@@ -1110,7 +1111,7 @@ compBreak(x,m,e) ==
compIterate: (%Symbol,%Mode,%Env) -> %Maybe %Triple
compIterate(x,m,e) ==
- x ~= "iterate" or not jumpFromLoop("REPEAT",x) => nil
+ x isnt "iterate" or not jumpFromLoop("REPEAT",x) => nil
index := #$exitModeStack - 1 - ($leaveLevelStack.0 + 1)
$iterateCount := $iterateCount + 1
u := coerce(['%nil,'$Void,e],$exitModeStack.index) or return nil
@@ -1165,9 +1166,9 @@ compTry(['%Try,x,ys,z],m,e) ==
++ `op' supposedly designate an external entity with language linkage
++ `lang'. Return the mode of its local declaration (import).
getExternalSymbolMode(op,lang,e) ==
- lang = 'Builtin => "%Thing" -- for the time being
- lang = 'Lisp => "%Thing" -- for the time being
- lang ~= "C" =>
+ lang is 'Builtin => "%Thing" -- for the time being
+ lang is 'Lisp => "%Thing" -- for the time being
+ lang is "C" =>
stackAndThrow('"Sorry: %b Foreign %1b %d is invalid at the moment",[lang])
get(op,"%Lang",e) ~= lang =>
stackAndThrow('"%1bp is not known to have language linkage %2bp",[op,lang])
@@ -1176,7 +1177,7 @@ getExternalSymbolMode(op,lang,e) ==
compElt: (%Form,%Mode,%Env) -> %Maybe %Triple
compElt(form,m,E) ==
form isnt ["elt",aDomain,anOp] => compForm(form,m,E)
- aDomain="Lisp" or (aDomain is ["Foreign",lang] and lang="Builtin") =>
+ aDomain is "Lisp" or (aDomain is ["Foreign",lang] and lang="Builtin") =>
[anOp',m,E] where anOp'() == (anOp = $Zero => 0; anOp = $One => 1; anOp)
lang ~= nil =>
opMode := getExternalSymbolMode(anOp,lang,E)
@@ -1251,12 +1252,12 @@ canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends
atom expr => ValueFlag and level=exitCount
op := expr.op
op in '(QUOTE CLOSEDFN) => ValueFlag and level=exitCount
- op="TAGGEDexit" =>
+ op is "TAGGEDexit" =>
expr is [.,count,data] => canReturn(data.expr,level,count,count=level)
level=exitCount and not ValueFlag => nil
- op="SEQ" => or/[canReturn(u,level+1,exitCount,false) for u in rest expr]
- op="TAGGEDreturn" => nil
- op="CATCH" =>
+ op is "SEQ" => or/[canReturn(u,level+1,exitCount,false) for u in rest expr]
+ op is "TAGGEDreturn" => nil
+ op is "CATCH" =>
[.,gs,data]:= expr
(findThrow(gs,data,level,exitCount,ValueFlag) => true) where
findThrow(gs,expr,level,exitCount,ValueFlag) ==
@@ -1267,12 +1268,12 @@ canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends
or/[findThrow(gs,u,level+1,exitCount,ValueFlag) for u in l]
or/[findThrow(gs,u,level,exitCount,ValueFlag) for u in rest expr]
canReturn(data,level,exitCount,ValueFlag)
- op = '%when =>
+ op is '%when =>
level = exitCount =>
or/[canReturn(last u,level,exitCount,ValueFlag) for u in rest expr]
or/[or/[canReturn(u,level,exitCount,ValueFlag) for u in v]
for v in rest expr]
- op="IF" =>
+ op is "IF" =>
expr is [.,a,b,c]
if not canReturn(a,0,0,true) then
SAY "IF statement can not cause consequents to be executed"
@@ -1302,7 +1303,7 @@ compPredicate(p,E) ==
[p',m,getSuccessEnvironment(p,E),getInverseEnvironment(p,E)]
compFromIf(a,m,E) ==
- a="%noBranch" => ["%noBranch",m,E]
+ a is "%noBranch" => ["%noBranch",m,E]
comp(a,m,E)
compImport: (%Form,%Mode,%Env) -> %Triple
@@ -1617,9 +1618,9 @@ tryCourtesyCoercion(T,m) ==
'"function coerce called from the interpreter."])
if $useRepresentationHack then
T.rest.first := MSUBST("$",$Rep,second T)
- T':= coerceEasy(T,m) => T'
- T':= coerceSubset(T,m) => T'
- T':= coerceHard(T,m) => T'
+ T' := coerceEasy(T,m) => T'
+ T' := coerceSubset(T,m) => T'
+ T' := coerceHard(T,m) => T'
nil
coerce(T,m) ==
@@ -1691,7 +1692,7 @@ coerceHard(T,m) ==
$bootStrapMode = true => [T.expr,m,$e]
extendsCategoryForm(T.expr,T.mode,m) => [T.expr,m,$e]
coerceExtraHard(T,m)
- (m' = "$" and m = $functorForm) or (m' = $functorForm and m = "$") =>
+ (m' is "$" and m = $functorForm) or (m' = $functorForm and m = "$") =>
[T.expr,m,$e]
coerceExtraHard(T,m)
@@ -1754,7 +1755,7 @@ compCoerce(["::",x,m'],m,e) ==
++ checked courtesy coercion to `sub'.
coerceSuperset: (%Triple, %Mode) -> %Maybe %Triple
coerceSuperset(T,sub) ==
- sub = "$" =>
+ sub is "$" =>
T' := coerceSuperset(T,$functorForm) or return nil
T'.rest.first := "$"
T'
@@ -2273,7 +2274,7 @@ numberize x ==
++ If there is a local reference to mode `m', return it.
localReferenceIfThere m ==
- m = "$" => m
+ m is "$" => m
idx := NRTassocIndex m => ['%tref,'$,idx]
quoteForm m
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 38f6e9c9..352d1aef 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -135,9 +135,9 @@ makeDomainTemplate vec ==
-- (slot 0 of the infovec); called by getInfovecCode from compDefineFunctor1
newVec := newShell # vec
for index in 0..maxIndex vec repeat
- item := vec.index
+ item := vectorRef(vec,index)
null item => nil
- newVec.index :=
+ vectorRef(newVec,index) :=
atom item => item
cons? first item => makeGoGetSlot(item,index)
item
@@ -321,9 +321,9 @@ extendsCategoryBasic0(dom,u,v) ==
v is ['IF,p,['ATTRIBUTE,c],.] =>
uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr
cons? c and isCategoryForm(c,nil) =>
- slot4 := uVec.4
+ slot4 := vectorRef(uVec,4)
LASSOC(c,second slot4) is [=p,:.]
- slot2 := uVec.2
+ slot2 := vectorRef(uVec,2)
LASSOC(c,slot2) is [=p,:.]
extendsCategoryBasic(dom,u,v)
@@ -333,7 +333,7 @@ extendsCategoryBasic(dom,u,v) ==
uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr
isCategoryForm(v,nil) => catExtendsCat?(u,v,uVec)
v is ['SIGNATURE,op,sig] =>
- or/[uVec.i is [[=op,=sig],:.] for i in 6..maxIndex uVec]
+ or/[vectorRef(uVec,i) is [[=op,=sig],:.] for i in 6..maxIndex uVec]
u is ['CATEGORY,.,:l] =>
v is ['IF,:.] => member(v,l)
nil
@@ -342,7 +342,7 @@ extendsCategoryBasic(dom,u,v) ==
catExtendsCat?(u,v,uvec) ==
u = v => true
uvec := uvec or (compMakeCategoryObject(u,$EmptyEnvironment)).expr
- slot4 := uvec.4
+ slot4 := vectorRef(uvec,4)
prinAncestorList := first slot4
member(v,prinAncestorList) => true
vOp := KAR v
@@ -720,7 +720,7 @@ mkCategoryPackage(form is [op,:argl],cat,def) ==
x is ['DEF,y,:.] => [y,:oplist]
fn(x.args,fn(x.op,oplist))
catvec := eval mkEvalableCategoryForm form
- fullCatOpList:=(JoinInner([catvec],$e)).1
+ fullCatOpList := vectorRef(JoinInner([catvec],$e),1)
catOpList :=
[['SIGNATURE,op1,sig] for [[op1,sig],:.] in fullCatOpList
| assoc(op1,capsuleDefAlist)]
@@ -926,9 +926,10 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
$implicitParameters: local := inferConstructorImplicitParameters(argl,$e)
[ds,.,$e]:= compMakeCategoryObject(target,$e) or return
stackAndThrow('" cannot produce category object: %1pb",[target])
- $compileExportsOnly => compDefineExports(form, ds.1, signature',$e)
+ $compileExportsOnly =>
+ compDefineExports(form, vectorRef(ds,1), signature',$e)
$domainShell: local := COPY_-SEQ ds
- attributeList := ds.2 --see below under "loadTimeAlist"
+ attributeList := vectorRef(ds,2) --see below under "loadTimeAlist"
$condAlist: local := nil
$uncondAlist: local := nil
$NRTslot1PredicateList: local := predicatesFromAttributes attributeList
@@ -998,7 +999,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
$functorTarget is ["CATEGORY",key,:.] and key~="domain" => 'package
'domain
$lisplibForm:= form
- if null $bootStrapMode then
+ if not $bootStrapMode then
$NRTslot1Info := NRTmakeSlot1Info()
$isOpPackageName: local := isCategoryPackageName $op
if $isOpPackageName then lisplibWrite('"slot1DataBase",
@@ -1160,18 +1161,20 @@ genDomainViewList(id,catlist) ==
mkOpVec(dom,siglist) ==
dom:= getPrincipalView dom
- substargs:= [['$,:dom.0],:pairList($FormalMapVariableList,rest dom.0)]
+ substargs := [['$,:vectorRef(dom,0)],
+ :pairList($FormalMapVariableList,rest vectorRef(dom,0))]
oplist:= getConstructorOperationsFromDB opOf dom.0
--new form is (<op> <signature> <slotNumber> <condition> <kind>)
ops := newVector #siglist
for (opSig:= [op,sig]) in siglist for i in 0.. repeat
u:= ASSQ(op,oplist)
- assoc(sig,u) is [.,n,.,'ELT] => ops.i := dom.n
+ assoc(sig,u) is [.,n,.,'ELT] =>
+ vectorRef(ops,i) := vectorRef(dom,n)
noplist:= SUBLIS(substargs,u)
-- following variation on assoc needed for GENSYMS in Mutable domains
AssocBarGensym(substitute(dom.0,'$,sig),noplist) is [.,n,.,'ELT] =>
- ops.i := dom.n
- ops.i := [function Undef,[dom.0,i],:opSig]
+ vectorRef(ops,i) := vectorRef(dom,n)
+ vectorRef(ops,i) := [function Undef,[dom.0,i],:opSig]
ops
@@ -1359,7 +1362,7 @@ candidateSignatures(op,nmodes,slot1) ==
++ is exported. Return the complete signature if yes; otherwise
++ return nil, with diagnostic in ambiguity case.
hasSigInTargetCategory(argl,form,opsig,e) ==
- sigs := candidateSignatures($op,#form,$domainShell.1)
+ sigs := candidateSignatures($op,#form,vectorRef($domainShell,1))
cc := checkCallingConvention(sigs,#argl)
mList:= [(cc.i > 0 => quasiquote x; getArgumentMode(x,e))
for x in argl for i in 0..]
@@ -1501,18 +1504,18 @@ compile u ==
-- If just updating certain functions, check for previous existence.
-- Deduce old sequence number and use it (items have been skipped).
if $LISPLIB and $compileOnlyCertainItems then
- parts := splitEncodedFunctionName(u.0, ";")
+ parts := splitEncodedFunctionName(u.op, ";")
-- Next line JHD/SMWATT 7/17/86 to deal with inner functions
- parts='inner => $savableItems:=[u.0,:$savableItems]
+ parts='inner => $savableItems:=[u.op,:$savableItems]
unew := nil
for [s,t] in $splitUpItemsAlreadyThere repeat
if parts.0=s.0 and parts.1=s.1 and parts.2=s.2 then unew := t
null unew =>
sayBrightly ['" Error: Item did not previously exist"]
- sayBrightly ['" Item not saved: ", :bright u.0]
+ sayBrightly ['" Item not saved: ", :bright u.op]
sayBrightly ['" What's there is: ", $lisplibItemsAlreadyThere]
nil
- sayBrightly ['" Renaming ", u.0, '" as ", unew]
+ sayBrightly ['" Renaming ", u.op, '" as ", unew]
u := [unew, :rest u]
$savableItems := [unew, :$saveableItems] -- tested by embedded RWRITE
optimizedBody:= optimizeFunctionDef u
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 73d2e4a0..ba63390b 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -109,7 +109,8 @@ isSharpVarWithNum x ==
++ Returns true if `x' is either an atom or a quotation.
atomic? x ==
- not cons? x or x.op = 'QUOTE
+ cons? x => x.op is 'QUOTE
+ true
--% Sub-domains information handlers
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 216521a9..36aa4372 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -61,15 +61,15 @@ initNewWorld() ==
$doNotCompressHashTableIfTrue := true
isNewWorldDomain domain ==
- integer? domain.3 --see HasCategory/Attribute
+ integer? vectorRef(domain,3) --see HasCategory/Attribute
getDomainByteVector dom ==
- CDDR dom.4
+ CDDR vectorRef(dom,4)
++ Return the sequence of categories `dom' belongs to, as a vector
++ of lazy category forms.
getDomainCategoriesVector dom ==
- second(dom.4)
+ second vectorRef(dom,4)
++ Same as getDomainCategoriesVector except that we return a list of
++ input forms for the categories.
@@ -77,7 +77,7 @@ getDomainCompleteCategories dom ==
vec := getDomainCategoriesVector dom
cats := nil
for i in 0..maxIndex vec repeat
- cats := [newExpandLocalType(vec.i,dom,dom), :cats]
+ cats := [newExpandLocalType(vectorRef(vec,i),dom,dom), :cats]
nreverse cats
getOpCode(op,vec,max) ==
@@ -91,8 +91,8 @@ evalSlotDomain(u,dollar) ==
$returnNowhereFromGoGet: local := false
$ : fluid := dollar -- ??? substitute
$lookupDefaults : local := false -- new world
- u = '$ => dollar
- u = "$$" => dollar
+ u is '$ => dollar
+ u is "$$" => dollar
integer? u =>
y := dollar.u
vector? y => y
@@ -133,17 +133,17 @@ replaceGoGetSlot env ==
[thisDomain,index,:op] := env
thisDomainForm := devaluate thisDomain
bytevec := getDomainByteVector thisDomain
- numOfArgs := bytevec.index
- goGetDomainSlotIndex := bytevec.(index := index + 1)
+ numOfArgs := arrayRef(bytevec,index)
+ goGetDomainSlotIndex := arrayRef(bytevec,index := index + 1)
goGetDomain :=
goGetDomainSlotIndex = 0 => thisDomain
- thisDomain.goGetDomainSlotIndex
+ vectorRef(thisDomain,goGetDomainSlotIndex)
if cons? goGetDomain then
goGetDomain := lazyDomainSet(goGetDomain,thisDomain,goGetDomainSlotIndex)
sig :=
- [newExpandTypeSlot(bytevec.(index := index + 1),thisDomain,thisDomain)
+ [newExpandTypeSlot(arrayRef(bytevec,index := index + 1),thisDomain,thisDomain)
for i in 0..numOfArgs]
- thisSlot := bytevec.(index + 1)
+ thisSlot := arrayRef(bytevec,index + 1)
if $monitorNewWorld then
sayLooking(concat('"%l","..",form2String thisDomainForm,
'" wants",'"%l",'" "),op,sig,goGetDomain)
@@ -183,7 +183,7 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
'"----> searching op table for:","%l"," "),op,sig,dollar)
someMatch := false
numvec := getDomainByteVector domain
- predvec := domain.3
+ predvec := vectorRef(domain,3)
max := maxIndex opvec
k := getOpCode(op,opvec,max) or return
flag => newLookupInAddChain(op,sig,domain,dollar)
@@ -202,8 +202,8 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
while finish > start repeat
PROGN
i := start
- numArgs ~= (numTableArgs :=numvec.i) => nil
- predIndex := numvec.(i := i + 1)
+ numArgs ~= (numTableArgs := arrayRef(numvec,i)) => nil
+ predIndex := arrayRef(numvec,i := i + 1)
predIndex ~= 0 and not testBitVector(predvec,predIndex) => nil
loc := newCompareSig(sig,numvec,(i := i + 1),dollar,domain)
null loc => nil --signifies no match
@@ -213,13 +213,13 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
i := start + 2
someMatch := true --mark so that if subsumption fails, look for original
subsumptionSig :=
- [newExpandTypeSlot(numvec.(QSPLUS(i,j)),
+ [newExpandTypeSlot(arrayRef(numvec,QSPLUS(i,j)),
dollar,domain) for j in 0..numTableArgs]
if $monitorNewWorld then
sayBrightly [formatOpSignature(op,sig),'"--?-->",
formatOpSignature(op,subsumptionSig)]
nil
- slot := domain.loc
+ slot := vectorRef(domain,loc)
cons? slot =>
slot.op = 'newGoGet => someMatch:=true
--treat as if operation were not there
@@ -247,16 +247,17 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
-- Lookup In Domain (from lookupInAddChain)
--=======================================================
lookupInDomain(op,sig,addFormDomain,dollar,index) ==
- addFormCell := addFormDomain.index =>
+ addFormCell := vectorRef(addFormDomain,index) =>
integer? KAR addFormCell =>
or/[lookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell]
- if not vector? addFormCell then addFormCell := eval addFormCell
+ if not vector? addFormCell then
+ addFormCell := eval addFormCell
lookupInDomainVector(op,sig,addFormCell,dollar)
nil
--------------------> NEW DEFINITION (see interop.boot.pamphlet)
lookupInDomainVector(op,sig,domain,dollar) ==
- slot1 := domain.1
+ slot1 := vectorRef(domain,1)
SPADCALL(op,sig,dollar,slot1)
@@ -290,7 +291,8 @@ newLookupInDomain(op,sig,addFormDomain,dollar,index) ==
addFormCell := addFormDomain.index =>
integer? KAR addFormCell =>
or/[newLookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell]
- if not vector? addFormCell then lazyDomainSet(addFormCell,addFormDomain,index)
+ if not vector? addFormCell then
+ lazyDomainSet(addFormCell,addFormDomain,index)
lookupInDomainVector(op,sig,addFormDomain.index,dollar)
nil
@@ -298,30 +300,30 @@ newLookupInDomain(op,sig,addFormDomain,dollar,index) ==
-- Category Default Lookup (from goGet or lookupInAddChain)
--=======================================================
newLookupInCategories(op,sig,dom,dollar) ==
- slot4 := dom.4
+ slot4 := vectorRef(dom,4)
catVec := second slot4
# catVec = 0 => nil --early exit if no categories
- integer? KDR catVec.0 =>
+ integer? KDR vectorRef(catVec,0) =>
newLookupInCategories1(op,sig,dom,dollar) --old style
$lookupDefaults : local := nil
if $monitorNewWorld = true then sayBrightly concat('"----->",
form2String devaluate dom,'"-----> searching default packages for ",op)
- predvec := dom.3
+ predvec := vectorRef(dom,3)
packageVec := first slot4
--the next three lines can go away with new category world
varList := ['$,:$FormalMapVariableList]
- valueList := [dom,:[dom.(5+i) for i in 1..(# rest dom.0)]]
+ valueList := [dom,:[vectorRef(dom,5+i) for i in 1..(# rest dom.0)]]
valueList := [MKQ val for val in valueList]
nsig := MSUBST(dom.0,dollar.0,sig)
for i in 0..maxIndex packageVec |
- (entry := packageVec.i) and entry ~= 'T repeat
+ (entry := vectorRef(packageVec,i)) and entry ~= 'T repeat
package :=
vector? entry =>
if $monitorNewWorld then
sayLooking1('"already instantiated cat package",entry)
entry
IDENTP entry =>
- cat := catVec.i
+ cat := vectorRef(catVec,i)
packageForm := nil
if not GETL(entry,'LOADED) then loadLib entry
infovec := GETL(entry,'infovec)
@@ -341,7 +343,7 @@ newLookupInCategories(op,sig,dom,dollar) ==
--numOfArgs ~= #sig.source => nil
packageForm := [entry,'$,:rest cat]
package := evalSlotDomain(packageForm,dom)
- packageVec.i := package
+ vectorRef(packageVec,i) := package
package
----old world
table := HGET($Slot1DataBase,entry) or systemError nil
@@ -349,7 +351,7 @@ newLookupInCategories(op,sig,dom,dollar) ==
and (v := or/[rest x for x in u | #sig = #x.0]) =>
packageForm := [entry,'$,:rest cat]
package := evalSlotDomain(packageForm,dom)
- packageVec.i := package
+ vectorRef(packageVec,i) := package
package
nil
not success =>
@@ -373,7 +375,7 @@ newLookupInCategories(op,sig,dom,dollar) ==
nil
nrunNumArgCheck(num,bytevec,start,finish) ==
- args := bytevec.start
+ args := arrayRef(bytevec,start)
num = args => true
(start := start + args + 4) = finish => nil
nrunNumArgCheck(num,bytevec,start,finish)
@@ -382,16 +384,16 @@ newLookupInCategories1(op,sig,dom,dollar) ==
$lookupDefaults : local := nil
if $monitorNewWorld = true then sayBrightly concat('"----->",
form2String devaluate dom,'"-----> searching default packages for ",op)
- predvec := dom.3
- slot4 := dom.4
+ predvec := vectorRef(dom,3)
+ slot4 := vectorRef(dom,4)
packageVec := first slot4
- catVec := first rest slot4
+ catVec := second slot4
--the next three lines can go away with new category world
varList := ['$,:$FormalMapVariableList]
- valueList := [dom,:[dom.(5+i) for i in 1..(# rest dom.0)]]
+ valueList := [dom,:[vectorRef(dom,5+i) for i in 1..(# rest dom.0)]]
valueList := [MKQ val for val in valueList]
nsig := MSUBST(dom.0,dollar.0,sig)
- for i in 0..maxIndex packageVec | (entry := packageVec.i)
+ for i in 0..maxIndex packageVec | (entry := vectorRef(packageVec,i))
and (vector? entry or (predIndex := rest (node := catVec.i)) and
(predIndex = 0 or testBitVector(predvec,predIndex))) repeat
package :=
@@ -411,18 +413,18 @@ newLookupInCategories1(op,sig,dom,dollar) ==
code := getOpCode(op,opvec,max)
null code => nil
byteVector := CDDR infovec.3
- numOfArgs := byteVector.(opvec.code)
+ numOfArgs := arrayRef(byteVector,opvec.code)
numOfArgs ~= #sig.source => nil
packageForm := [entry,'$,:rest cat]
package := evalSlotDomain(packageForm,dom)
- packageVec.i := package
+ vectorRef(packageVec,i) := package
package
table := HGET($Slot1DataBase,entry) or systemError nil
(u := LASSQ(op,table))
and (v := or/[rest x for x in u | #sig = #x.0]) =>
packageForm := [entry,'$,:rest cat]
package := evalSlotDomain(packageForm,dom)
- packageVec.i := package
+ vectorRef(packageVec,i) := package
package
nil
not success =>
@@ -451,9 +453,10 @@ newLookupInCategories1(op,sig,dom,dollar) ==
newCompareSig(sig, numvec, index, dollar, domain) ==
k := index
null (target := first sig)
- or lazyMatchArg(target,numvec.k,dollar,domain) =>
- and/[lazyMatchArg(s,numvec.(k := i),dollar,domain)
- for s in rest sig for i in (index+1)..] => numvec.(k + 1)
+ or lazyMatchArg(target,arrayRef(numvec,k),dollar,domain) =>
+ and/[lazyMatchArg(s,arrayRef(numvec,k := i),dollar,domain)
+ for s in rest sig for i in (index+1)..] =>
+ arrayRef(numvec,k + 1)
nil
nil
@@ -463,11 +466,11 @@ newCompareSig(sig, numvec, index, dollar, domain) ==
lazyMatchArg(s,a,dollar,domain) == lazyMatchArg2(s,a,dollar,domain,true)
lazyMatchArg2(s,a,dollar,domain,typeFlag) ==
- if s = '$ then
+ if s is '$ then
-- a = 0 => return true --needed only if extra call in newGoGet to basicLookup
s := devaluate dollar -- calls from HasCategory can have $s
integer? a =>
- not typeFlag => s = domain.a
+ not typeFlag => s = vectorRef(domain,a)
a = 6 and $isDefaultingPackage => s = devaluate dollar
vector? (d := domainVal(dollar,domain,a)) =>
s = d.0 => true
@@ -476,16 +479,16 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) ==
lazyMatchArgDollarCheck(replaceSharpCalls s,d.0,dollar.0,domainArg)
--vector? first d => lazyMatch(s,CDDR d,dollar,domain) --old style (erase)
lazyMatch(replaceSharpCalls s,d,dollar,domain) --new style
- a = '$ => s = devaluate dollar
- a = "$$" => s = devaluate domain
+ a is '$ => s = devaluate dollar
+ a is "$$" => s = devaluate domain
string? a =>
string? s => a = s
s is ['QUOTE,y] and PNAME y = a
IDENTP s and symbolName s = a
atom a => a = s
op := opOf a
- op = 'NRTEVAL => s = nrtEval(second a,domain)
- op = 'QUOTE => s = second a
+ op is 'NRTEVAL => s = nrtEval(second a,domain)
+ op is 'QUOTE => s = second a
lazyMatch(s,a,dollar,domain)
--above line is temporarily necessary until system is compiled 8/15/90
--s = a
@@ -533,7 +536,7 @@ lazyMatchArgDollarCheck(s,d,dollarName,domainName) ==
fn() ==
x = arg => true
x is ['elt,someDomain,opname] => lookupInDomainByName(opname,evalDomain someDomain,arg)
- x = '$ and (arg = dollarName or arg = domainName) => true
+ x is '$ and (arg = dollarName or arg = domainName) => true
x = dollarName and arg = domainName => true
atom x or atom arg => false
xt and first x = first arg =>
@@ -544,7 +547,7 @@ lookupInDomainByName(op,domain,arg) ==
atom arg => nil
opvec := domain . 1 . 2
numvec := getDomainByteVector domain
- predvec := domain.3
+ predvec := vectorRef(domain,3)
max := maxIndex opvec
k := getOpCode(op,opvec,max) or return nil
idxmax := maxIndex numvec
@@ -556,12 +559,12 @@ lookupInDomainByName(op,domain,arg) ==
success := false
while finish > start repeat
i := start
- numberOfArgs :=numvec.i
- predIndex := numvec.(i := i + 1)
+ numberOfArgs := arrayRef(numvec,i)
+ predIndex := arrayRef(numvec,i := i + 1)
predIndex ~= 0 and not testBitVector(predvec,predIndex) => nil
- slotIndex := numvec.(i + 2 + numberOfArgs)
+ slotIndex := arrayRef(numvec,i + 2 + numberOfArgs)
newStart := QSPLUS(start,QSPLUS(numberOfArgs,4))
- slot := domain.slotIndex
+ slot := vectorRef(domain,slotIndex)
cons? slot and sameObject?(first slot,first arg) and sameObject?(rest slot,rest arg) => return (success := true)
start := QSPLUS(start,QSPLUS(numberOfArgs,4))
success
@@ -590,20 +593,20 @@ newExpandLocalTypeForm([functorName,:argl],dollar,domain) ==
for [.,tag,dom] in argl]]
functorName in '(Union Mapping _[_|_|_] Enumeration) =>
[functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]]
- functorName = "QUOTE" => [functorName,:argl]
+ functorName is "QUOTE" => [functorName,:argl]
coSig := getDualSignatureFromDB functorName
null coSig => error ["bad functorName", functorName]
[functorName,:[newExpandLocalTypeArgs(a,dollar,domain,flag)
for a in argl for flag in rest coSig]]
newExpandLocalTypeArgs(u,dollar,domain,typeFlag) ==
- u = '$ => u
+ u is '$ => u
integer? u =>
typeFlag => newExpandTypeSlot(u, dollar,domain)
- domain.u
+ vectorRef(domain,u)
u is ['NRTEVAL,y] => nrtEval(y,domain)
u is ['QUOTE,y] => y
- u = "$$" => domain.0
+ u is "$$" => vectorRef(domain,0)
atom u => u --can be first, rest, etc.
newExpandLocalTypeForm(u,dollar,domain)
@@ -615,14 +618,14 @@ domainVal(dollar,domain,index) ==
--returns a domain or a lazy slot
index = 0 => dollar
index = 2 => domain
- domain.index
+ vectorRef(domain,index)
-- ??? This function should be merged into the preceding one.
sigDomainVal(dollar,domain,index) ==
--returns a domain or a lazy slot
index = 0 => "$"
index = 2 => domain
- domain.index
+ vectorRef(domain,index)
--=======================================================
-- Convert Lazy Domain to Domain Form
@@ -711,7 +714,7 @@ newHasTest(domform,catOrAtt) ==
lazyMatchAssocV(x,auxvec,catvec,domain) == --new style slot4
n := maxIndex catvec
xop := first x
- or/[auxvec.i for i in 0..n |
+ or/[vectorRef(auxvec,i) for i in 0..n |
xop = first (lazyt := vectorRef(catvec,i)) and lazyMatch(x,lazyt,domain,domain)]
lazyMatchAssocV1(x,vec,domain) == --old style slot4
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-02 23:12:46 +0000