aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/compiler.boot13
-rw-r--r--src/interp/define.boot88
-rw-r--r--src/interp/functor.boot25
-rw-r--r--src/interp/nruncomp.boot12
-rw-r--r--src/interp/nrunfast.boot13
-rw-r--r--src/interp/nrungo.boot4
-rw-r--r--src/interp/nrunopt.boot3
7 files changed, 59 insertions, 99 deletions
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 5022d5dc..28a4cbf3 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -620,8 +620,8 @@ compFormWithModemap(form,m,e,modemap) ==
(c:=get(z,'condition,e)) and
c is [["case",=z,c1]] and
(c1 is [":",=(second argl),=m] or EQ(c1,second argl) ) =>
--- first is a full tag, as placed by getInverseEnvironment
--- second is what getSuccessEnvironment will place there
+ -- first is a full tag, as placed by getInverseEnvironment
+ -- second is what getSuccessEnvironment will place there
["CDR",z]
["call",:form']
e':=
@@ -843,7 +843,6 @@ setqSingle(id,val,m,E) ==
e':= augModemapsFromDomain1(id,val,e')
--all we do now is to allocate a slot number for lhs
--e.g. the %LET form below will be changed by putInLocalDomainReferences
---+
if k := NRTassocIndex(id) then
form := ["setShellEntry","$",k,x]
else form:=
@@ -862,18 +861,18 @@ setqMultiple(nameList,val,m,e) ==
val is ["CONS",:.] and m=$NoValueMode =>
setqMultipleExplicit(nameList,uncons val,m,e)
val is ["%Comma",:l] and m=$NoValueMode => setqMultipleExplicit(nameList,l,m,e)
- 1 --create a gensym, %add to local environment, compile and assign rhs
+ -- 1. create a gensym, %add to local environment, compile and assign rhs
g:= genVariable()
e:= addBinding(g,nil,e)
T:= [.,m1,.]:= compSetq1(g,val,$EmptyMode,e) or return nil
e:= put(g,"mode",m1,e)
[x,m',e]:= convert(T,m) or return nil
- 1.1 --exit if result is a list
+ -- 1.1. exit if result is a list
m1 is ["List",D] =>
for y in nameList repeat
e:= put(y,"value",[genSomeVariable(),D,$noEnv],e)
convert([["PROGN",x,["%LET",nameList,g],g],m',e],m)
- 2 --verify that the #nameList = number of parts of right-hand-side
+ -- 2. verify that the #nameList = number of parts of right-hand-side
selectorModePairs:=
--list of modes
decompose(m1,#nameList,e) or return nil where
@@ -884,7 +883,7 @@ setqMultiple(nameList,val,m,e) ==
stackMessage('"no multiple assigns to mode: %1p",[t])
#nameList~=#selectorModePairs =>
stackMessage('"%1b must decompose into %2 components",[val,#nameList])
- 3 --generate code; return
+ -- 3. generate code; return
assignList:=
[([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr
for x in nameList for [y,:z] in selectorModePairs]
diff --git a/src/interp/define.boot b/src/interp/define.boot
index ce5bf8d7..debdd992 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -364,17 +364,11 @@ macroExpandList(l,e) ==
[macroExpand(x,e) for x in l]
--% constructor evaluation
--- The following functions are used by the compiler but are modified
--- here for use with new LISPLIB scheme
mkEvalableCategoryForm c ==
c is [op,:argl] =>
op="Join" => ["Join",:[mkEvalableCategoryForm x for x in argl]]
- op is "DomainSubstitutionMacro" =>
- --$extraParms :local
- --catobj := EVAL c -- DomainSubstitutionFunction makes $extraParms
- --mkEvalableCategoryForm sublisV($extraParms, catobj)
- mkEvalableCategoryForm second argl
+ op is "DomainSubstitutionMacro" => mkEvalableCategoryForm second argl
op is "mkCategory" => c
MEMQ(op,$CategoryNames) =>
([x,m,$e]:= compOrCroak(c,$EmptyMode,$e); m=$Category => x)
@@ -464,25 +458,25 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
-- Remember the body for checking the current instantiation.
$currentCategoryBody : local := body
--Set in DomainSubstitutionFunction, used further down
--- 1.1 augment e to add declaration $: <form>
+ -- 1.1 augment e to add declaration $: <form>
[$op,:argl] := $definition
e:= addBinding("$",[['mode,:$definition]],e)
--- 2. obtain signature
+ -- 2. obtain signature
signature':=
[first signature,
:[getArgumentModeOrMoan(a,$definition,e) for a in argl]]
e:= giveFormalParametersValues(argl,e)
--- 3. replace arguments by $1,..., substitute into body,
--- and introduce declarations into environment
+ -- 3. replace arguments by $1,..., substitute into body,
+ -- and introduce declarations into environment
sargl:= TAKE(# argl, $TriangleVariableList)
$functorForm:= $form:= [$op,:sargl]
$formalArgList:= [:sargl,:$formalArgList]
aList := pairList(argl,sargl)
formalBody:= SUBLIS(aList,body)
signature' := SUBLIS(aList,signature')
---Begin lines for category default definitions
+ --Begin lines for category default definitions
$functionStats: local:= [0,0]
$functorStats: local:= [0,0]
$getDomainCode: local := nil
@@ -490,7 +484,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
for x in sargl for t in rest signature' repeat
[.,.,e]:= compMakeDeclaration(x,t,e)
--- 4. compile body in environment of %type declarations for arguments
+ -- 4. compile body in environment of %type declarations for arguments
op':= $op
-- following line causes cats with no with or Join to be fresh copies
if opOf(formalBody)~='Join and opOf(formalBody)~='mkCategory then
@@ -510,13 +504,13 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
["setShellEntry",g,0,mkConstructor $form]]
fun:= compile [op',["LAM",sargl,body]]
--- 5. give operator a 'modemap property
+ -- 5. give operator a 'modemap property
pairlis := pairList(argl,$FormalMapVariableList)
parSignature:= SUBLIS(pairlis,signature')
parForm:= SUBLIS(pairlis,form)
-- If we are only interested in the defaults, there is no point
-- in writing out compiler info and load-time stuff for
- --the category which is assumed to have already been translated.
+ -- the category which is assumed to have already been translated.
if not $compileDefaultsOnly then
lisplibWrite('"compilerInfo",
removeZeroOne ['SETQ,'$CategoryFrame,
@@ -528,7 +522,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
evalAndRwriteLispForm('NILADIC,
['MAKEPROP,['QUOTE,op'],'(QUOTE NILADIC),true])
--- 6. put modemaps into InteractiveModemapFrame
+ -- 6. put modemaps into InteractiveModemapFrame
$domainShell := eval [op',:MAPCAR('MKQ,sargl)]
$lisplibCategory:= formalBody
if $LISPLIB then
@@ -609,7 +603,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
originale:= $e
[$op,:argl]:= form
$formalArgList:= [:argl,:$formalArgList]
- $pairlis := pairList(argl,$FormalMapVariableList)
+ $pairlis: local := pairList(argl,$FormalMapVariableList)
$mutableDomain: local :=
-- all defaulting packages should have caching turned off
isCategoryPackageName $op or MEMQ($op,$mutableDomains)
@@ -627,7 +621,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
[ds,.,$e]:= compMakeCategoryObject(target,$e) or return
stackAndThrow('" cannot produce category object: %1pb",[target])
$compileExportsOnly => compDefineExports(form, ds.1, signature',$e)
- $domainShell:= COPY_-SEQ ds
+ $domainShell: local := COPY_-SEQ ds
attributeList := ds.2 --see below under "loadTimeAlist"
$condAlist: local := nil
$uncondAlist: local := nil
@@ -866,26 +860,25 @@ mkOpVec(dom,siglist) ==
u:= ASSQ(op,oplist)
assoc(sig,u) is [.,n,.,'ELT] => ops.i := dom.n
noplist:= SUBLIS(substargs,u)
- -- following variation on assoc needed for GENSYMS in Mutable domains
+ -- 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]
ops
+
+++ form is lhs (f a1 ... an) of definition; body is rhs;
+++ signature is (t0 t1 ... tn) where t0= target type, ti=type of ai, i > 0;
+++ specialCases is (NIL l1 ... ln) where li is list of special cases
+++ which can be given for each ti
+++ removes declarative and assignment information from form and
+++ signature, placing it in list L, replacing form by ("where",form',:L),
+++ signature by a list of NILs (signifying declarations are in e)
compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) ==
--- form is lhs (f a1 ... an) of definition; body is rhs;
--- signature is (t0 t1 ... tn) where t0= target type, ti=type of ai, i > 0;
--- specialCases is (NIL l1 ... ln) where li is list of special cases
--- which can be given for each ti
-
--- removes declarative and assignment information from form and
--- signature, placing it in list L, replacing form by ("where",form',:L),
--- signature by a list of NILs (signifying declarations are in e)
$sigAlist: local := nil
$predAlist: local := nil
-
--- 1. create sigList= list of all signatures which have embedded
--- declarations moved into global variable $sigAlist
+ -- 1. create sigList= list of all signatures which have embedded
+ -- declarations moved into global variable $sigAlist
sigList:=
[transformType fetchType(a,x,e,form) for a in rest form for x in rest signature]
where
@@ -900,16 +893,16 @@ compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) ==
x is ['Record,:.] => x --RDJ 8/83
[first x,:[transformType y for y in rest x]]
--- 2. replace each argument of the form (|| x p) by x, recording
--- the given predicate in global variable $predAlist
+ -- 2. replace each argument of the form (|| x p) by x, recording
+ -- the given predicate in global variable $predAlist
argList:=
[removeSuchthat a for a in rest form] where
removeSuchthat x ==
x is ["|",y,p] => ($predAlist:= [[y,:p],:$predAlist]; y)
x
--- 3. obtain a list of parameter identifiers (x1 .. xn) ordered so that
--- the type of xi is independent of xj if i < j
+ -- 3. obtain a list of parameter identifiers (x1 .. xn) ordered so that
+ -- the type of xi is independent of xj if i < j
varList:=
orderByDependency(ASSOCLEFT argDepAlist,ASSOCRIGHT argDepAlist) where
argDepAlist:=
@@ -919,13 +912,13 @@ compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) ==
delete(x,listOfIdentifiersIn LASSOC(x,$predAlist)))
argSigAlist:= [:$sigAlist,:pairList(argList,sigList)]
--- 4. construct a WhereList which declares and/or defines the xi's in
--- the order constructed in step 3
+ -- 4. construct a WhereList which declares and/or defines the xi's in
+ -- the order constructed in step 3
(whereList:= [addSuchthat(x,[":",x,LASSOC(x,argSigAlist)]) for x in varList])
where addSuchthat(x,y) == (p:= LASSOC(x,$predAlist) => ["|",y,p]; y)
--- 5. compile new ('DEF,("where",form',:WhereList),:.) where
--- all argument parameters of form' are bound/declared in WhereList
+ -- 5. compile new ('DEF,("where",form',:WhereList),:.) where
+ -- all argument parameters of form' are bound/declared in WhereList
comp(form',m,e) where
form':=
["where",defform,:whereList] where
@@ -1031,8 +1024,8 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
if $newCompCompare=true then
SAY '"The old compiler generates:"
prTriple T
--- A THROW to the above CATCH occurs if too many semantic errors occur
--- see stackSemanticError
+ -- A THROW to the above CATCH occurs if too many semantic errors occur
+ -- see stackSemanticError
catchTag:= MKQ GENSYM()
fun:=
body':= replaceExitEtc(T.expr,catchTag,"TAGGEDreturn",$returnMode)
@@ -1041,7 +1034,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
compile [$op,["LAM",[:argl,'_$],finalBody]]
$functorStats:= addStats($functorStats,$functionStats)
--- 7. give operator a 'value property
+ --7. give operator a 'value property
val:= [fun,signature',e]
[fun,['Mapping,:signature'],$e]
@@ -1202,7 +1195,7 @@ compile u ==
-- Deduce old sequence number and use it (items have been skipped).
if $LISPLIB and $compileOnlyCertainItems then
parts := splitEncodedFunctionName(u.0, ";")
--- Next line JHD/SMWATT 7/17/86 to deal with inner functions
+ -- Next line JHD/SMWATT 7/17/86 to deal with inner functions
parts='inner => $savableItems:=[u.0,:$savableItems]
unew := nil
for [s,t] in $splitUpItemsAlreadyThere repeat
@@ -1555,9 +1548,6 @@ doItIf(item is [.,p,x,y],$predl,$e) ==
$functorLocalParameters:=[:oldFLP,:nreverse nils]
nreverse ans
---compSingleCapsuleIf(x,predl,e,$functorLocalParameters) ==
--- compSingleCapsuleItem(x,predl,e)
-
--% CATEGORY AND DOMAIN FUNCTIONS
compContained: (%Form, %Mode, %Env) -> %Maybe %Triple
@@ -1649,7 +1639,7 @@ DomainSubstitutionFunction(parameters,body) ==
[Subst(parameters,u) for u in body]
not (body is ["Join",:.]) => body
atom $definition => body
- null rest $definition => body
+ null rest $definition => body
--should not bother if it will only be called once
name:= INTERN STRCONC(KAR $definition,";CAT")
SETANDFILE(name,nil)
@@ -1709,9 +1699,9 @@ compCategoryItem(x,predl,env) ==
for u in l repeat
compCategoryItem(u,predl,env)
--- 4. otherwise, x gives a signature for a
--- single operator name or a list of names; if a list of names,
--- recurse
+ -- 4. otherwise, x gives a signature for a
+ -- single operator name or a list of names; if a list of names,
+ -- recurse
x is ["SIGNATURE",:opsig] => compSignature(opsig,pred,env)
systemErrorHere ["compCategoryItem",x]
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 95b9ccd1..75ac00e4 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -44,7 +44,7 @@ keyItem a ==
--The item that domain checks on
--Global strategy here is to maintain a list of substitutions
--- ( %in Sublis), of vectors and the names that they have,
+-- ( in $Sublis), of vectors and the names that they have,
-- which may be either local names ('View1') or global names ('Where1')
-- The global names are remembered on $Sublis from one
-- invocation of DomainPrint1 to the next
@@ -803,9 +803,9 @@ InvestigateConditions catvecListMaker ==
list2
list:= [[sec,:ICformat u] for u in list for sec in secondaries]
pv:= getPossibleViews $principal
--- $HackSlot4 is used in SetVector4 to ensure that conditional
--- extensions of the principal view are handles correctly
--- here we build the code necessary to remove spurious extensions
+ -- $HackSlot4 is used in SetVector4 to ensure that conditional
+ -- extensions of the principal view are handles correctly
+ -- here we build the code necessary to remove spurious extensions
($HackSlot4:= [reshape u for u in $HackSlot4]) where
reshape u ==
['COND,[TryGDC ICformat rest u],
@@ -907,23 +907,6 @@ resolvePatternVars(p,args) ==
p := SUBLISLIS(args, $TriangleVariableList, p)
SUBLISLIS(args, $FormalMapVariableList, p)
---resolvePatternVars(p,args) ==
--- atom p =>
--- isSharpVarWithNum p => args.(position(p,$FormalMapVariableList))
--- p
--- [resolvePatternVars(first p,args),:resolvePatternVars(rest p,args)]
-
--- Mysterious JENKS definition follows:
---DescendCodeVarAdd(base,flag) ==
--- baseops := [(u:=LASSOC([base,:SUBST(base,'$,types)],
--- get(op,'modemap,$e))) and [sig,:u]
--- for (sig := [op,types]) in $CheckVectorList]
--- $CheckVectorList := [sig for sig in $CheckVectorList
--- for op in baseops | null op]
--- [SetFunctionSlots(sig,implem,flag,'adding)
--- for u in baseops | u is [sig,[pred,implem]]]
-
-
--% Code Processing Packages
isCategoryPackageName nam ==
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index f69f80b3..c0fdeda4 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -264,7 +264,6 @@ NRTgetLocalIndex item ==
-- ??? That we do is likely a bug.
flag => item
(compOrCroak(item,$EmptyMode,$e)).expr
--- item
RPLACA(saveNRTdeltaListComp,compEntry)
saveIndex
@@ -399,10 +398,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
changeDirectoryInSlot1() --this extends $NRTslot1PredicateList
- --pp '"=================="
- --for item in $NRTdeltaList repeat pp item
-
---LOCAL BOUND FLUID VARIABLES:
+ --LOCAL BOUND FLUID VARIABLES:
$GENNO: local:= 0 --bound in compDefineFunctor1, then as parameter here
$catvecList: local := nil --list of vectors v1..vn for each view
$hasCategoryAlist: local := nil --list of GENSYMs bound to (HasCategory ..) items
@@ -418,7 +414,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
$supplementaries: local := nil
--set in InvestigateConditions to represent any additional
--category membership tests that may be needed(see buildFunctor for details)
-------------------------
+
oldtime:= TEMPUS_-FUGIT()
[$catsig,:argsig]:= sig
catvecListMaker:=REMDUP
@@ -440,8 +436,8 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
$catNames:= ['$,:[GENVAR() for u in rest catvecListMaker]]
domname:='dv_$
---> Do this now to create predicate vector; then DescendCode can refer
---> to predicate vector if it can
+ -- Do this now to create predicate vector; then DescendCode can refer
+ -- to predicate vector if it can
[$uncondAlist,:$condAlist] := --bound in compDefineFunctor1
NRTsetVector4Part1($catNames,catvecListMaker,condCats)
[$NRTslot1PredicateList,predBitVectorCode1,:predBitVectorCode2] :=
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 96f7b3bc..813dab7d 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -356,7 +356,7 @@ newLookupInCategories1(op,sig,dom,dollar) ==
slot4 := dom.4
packageVec := first slot4
catVec := first QCDR slot4
---the next three lines can go away with new category world
+ --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 := [MKQ val for val in valueList]
@@ -434,7 +434,7 @@ lazyMatchArg(s,a,dollar,domain) == lazyMatchArg2(s,a,dollar,domain,true)
lazyMatchArg2(s,a,dollar,domain,typeFlag) ==
if s = '$ then
--- a = 0 => return true --needed only if extra call in newGoGet to basicLookup
+ -- a = 0 => return true --needed only if extra call in newGoGet to basicLookup
s := devaluate dollar -- calls from HasCategory can have $s
INTEGERP a =>
not typeFlag => s = domain.a
@@ -532,7 +532,7 @@ newExpandGoGetTypeSlot(slot,dollar,domain) ==
newExpandTypeSlot(slot,domain,domain)
newExpandTypeSlot(slot, dollar, domain) ==
---> returns domain form for dollar.slot
+-- returns domain form for dollar.slot
newExpandLocalType(sigDomainVal(dollar, domain, slot), dollar,domain)
@@ -679,13 +679,6 @@ lazyMatchAssocV1(x,vec,domain) == --old style slot4
or/[QCDR QVELT(vec,i) for i in 0..n |
xop = first (lazyt := first QVELT(vec,i)) and lazyMatch(x,lazyt,domain,domain)]
---newHasAttribute(domain,attrib) ==
--- predIndex := LASSOC(attrib,domain.2) =>
--- EQ(predIndex,0) => true
--- predvec := domain.3
--- testBitVector(predvec,predIndex)
--- false
-
--=======================================================
-- Utility Functions
--=======================================================
diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot
index 1fb22e93..a359fed7 100644
--- a/src/interp/nrungo.boot
+++ b/src/interp/nrungo.boot
@@ -340,8 +340,8 @@ NRTisRecurrenceRelation(op,body,minivectorName) ==
-- body should have a conditional expression which
-- gives k boundary values, one general term plus possibly an
-- "out of domain" condition
---pcl is [:.,[ ''T,:mess]] and not (CONTAINED('throwMessage,mess) or
--- CONTAINED('throwKeyedMsg,mess)) => NIL
+ --pcl is [:.,[ ''T,:mess]] and not (CONTAINED('throwMessage,mess) or
+ -- CONTAINED('throwKeyedMsg,mess)) => NIL
pcl := [x for x in pcl | not (x is [''T,:mess] and
(CONTAINED('throwMessage,mess) or
CONTAINED('throwKeyedMsg,mess)))]
diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot
index a4aea6b5..568929ee 100644
--- a/src/interp/nrunopt.boot
+++ b/src/interp/nrunopt.boot
@@ -384,7 +384,6 @@ NRTcatCompare [catform,:pred] == LASSOC(first catform,$levelAlist)
hasDefaultPackage catname ==
defname := INTERN STRCONC(catname,'"&")
constructor? defname => defname
---MEMQ(defname,allConstructors()) => defname
nil
@@ -911,6 +910,6 @@ expandTypeArgs(u,template,domform) ==
templateVal(template,domform,index) ==
--returns a domform or a lazy slot
- index = 0 => harhar() --template
+ index = 0 => BREAK() --template
template.index