diff options
| -rw-r--r-- | src/ChangeLog | 9 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 9 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 43 | ||||
| -rw-r--r-- | src/interp/define.boot | 4 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 2 |
5 files changed, 37 insertions, 30 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 015e78ed..67a73452 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,14 @@ 2013-05-27 Gabriel Dos Reis <gdr@integrable-solutions.net> + * interp/compiler.boot(compNoStacking): Add DB parameter. + Adjust callers. + (comp2): Likewise. + (comp3): Likewise. + * interp/c-util.boot (currentDB): New. + (currentConstructor): Remove. Adjust callers. + +2013-05-27 Gabriel Dos Reis <gdr@integrable-solutions.net> + * interp/define.boot (compDefine): Take DB as first parameter. Adjust callers. diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 3ba88514..bc0c6726 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -48,7 +48,7 @@ module c_-util where getInverseEnvironment: (%Form,%Env) -> %Env giveVariableSomeValue: (%Symbol,%Mode,%Env) -> %Env registerConstructor: (%Symbol,%Env) -> %Env - currentConstructor: %Env -> %Maybe %Symbol + currentDB: %Env -> %Maybe %Database -- functor data manipulation dbInfovec: %Symbol -> %Maybe %FunctorData @@ -813,9 +813,10 @@ isLiteral(x,e) == registerConstructor(x,e) == put('%compilerData,'%ctor,x,e) -++ Retrieve the name of the constructor definition being processed. -currentConstructor e == - get('%compilerData,'%ctor,e) +++ Retrieve the DB of the constructor definition being processed. +currentDB e == + ctor := get('%compilerData,'%ctor,e) => constructorDB ctor + nil makeLiteral: (%Symbol,%Env) -> %Thing makeLiteral(x,e) == diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 1bb651c2..c8b9553c 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -48,12 +48,12 @@ module compiler where --% compUniquely: (%Form,%Mode,%Env) -> %Maybe %Triple -compNoStacking: (%Form,%Mode,%Env) -> %Maybe %Triple -compNoStacking1: (%Form,%Mode,%Env,%List %Thing) -> %Maybe %Triple +compNoStacking: (%Maybe %Database,%Form,%Mode,%Env) -> %Maybe %Triple +compNoStacking1: (%Maybe %Database,%Form,%Mode,%Env,%List %Thing) -> %Maybe %Triple compOrCroak1: (%Form,%Mode,%Env) -> %Maybe %Triple -comp2: (%Form,%Mode,%Env) -> %Maybe %Triple -comp3: (%Form,%Mode,%Env) -> %Maybe %Triple -compExpression: (%Form,%Mode,%Env) -> %Maybe %Triple +comp2: (%Maybe %Database,%Form,%Mode,%Env) -> %Maybe %Triple +comp3: (%Maybe %Database,%Form,%Mode,%Env) -> %Maybe %Triple +compExpression: (%Maybe %Database,%Form,%Mode,%Env) -> %Maybe %Triple compAtom: (%Form,%Mode,%Env) -> %Maybe %Triple compSymbol: (%Form,%Mode,%Env) -> %Maybe %Triple compForm: (%Form,%Mode,%Env) -> %Maybe %Triple @@ -136,12 +136,12 @@ compCompilerPredicate(x,e) == compOrCroak(parseTran x, $Boolean, e) comp(x,m,e) == - T:= compNoStacking(x,m,e) => ($compStack:= nil; T) + T:= compNoStacking(currentDB e,x,m,e) => ($compStack:= nil; T) $compStack:= [[x,m,e,$exitModeStack],:$compStack] nil -compNoStacking(x,m,e) == - T:= comp2(x,m,e) => +compNoStacking(db,x,m,e) == + T:= comp2(db,x,m,e) => $useRepresentationHack and m=$EmptyMode and T.mode=$Representation => [T.expr,"$",T.env] T @@ -150,15 +150,15 @@ compNoStacking(x,m,e) == --preferred to the underlying representation -- RDJ 9/12/83 --Now that `per' and `rep' are built in, we use the above --hack only when `Rep' is defined the old way. -- gdr 2008/01/26 - compNoStacking1(x,m,e,$compStack) + compNoStacking1(db,x,m,e,$compStack) -compNoStacking1(x,m,e,$compStack) == +compNoStacking1(db,x,m,e,$compStack) == u:= get(RepIfRepHack m,"value",e) => - (T:= comp2(x,u.expr,e) => [T.expr,m,T.env]; nil) + (T:= comp2(db,x,u.expr,e) => [T.expr,m,T.env]; nil) nil -comp2(x,m,e) == - [y,m',e] := T := comp3(x,m,e) or return nil +comp2(db,x,m,e) == + [y,m',e] := T := comp3(db,x,m,e) or return nil T.mode = $Category => T --if cons? y and isDomainForm(y,e) then e := addDomain(x,e) --line commented out to prevent adding derived domain forms @@ -166,11 +166,8 @@ comp2(x,m,e) == --isDomainForm test needed to prevent error while compiling Ring T -comp3(x,m,$e) == +comp3(db,x,m,$e) == --returns a Triple or %else nil to signalcan't do' - db := - ctor := currentConstructor $e => constructorDB ctor - nil $e:= addDomain(m,$e) e:= $e --for debugging purposes m is ["Mapping",:.] => compWithMappingMode(x,m,e) @@ -187,7 +184,7 @@ comp3(x,m,$e) == op is ":" => compColon(x,m,e) op is "::" => compCoerce(x,m,e) op is 'DEF => compDefine(db,x,m,e) - t:= compExpression(x,m,e) + t:= compExpression(db,x,m,e) t is [x',m',e'] and not listMember?(m',getDomainsInScope e') => [x',m',addDomain(m',e')] t @@ -352,7 +349,7 @@ extractCode(u,vars) == u is ['%call,['%closure,:.],: =vars] => first u.args ['%closure,['%function,['%lambda,[:vars,'$],u]],'$] -compExpression(x,m,e) == +compExpression(db,x,m,e) == $insideExpressionIfTrue: local:= true -- special forms have dedicated compilers. (op := x.op) and ident? op and (fn := property(op,'SPECIAL)) => @@ -435,7 +432,7 @@ compSymbol(s,m,e) == sameObject?(s,m) or isLiteral(s,e) => [quote s,s,e] v := get(s,"value",e) => symbolMember?(s,$functorLocalParameters) => - getLocalIndex(constructorDB currentConstructor e,s) + getLocalIndex(currentDB e,s) [s,v.mode,e] --s will be replaced by an ELT form in beforeCompile [s,v.mode,e] --s has been SETQd @@ -709,7 +706,7 @@ compApplication(op,argl,m,T) == comp(eltForm, m, e) compToApply(op,argl,m,e) == - T := compNoStacking(op,$EmptyMode,e) or return nil + T := compNoStacking(currentDB e,op,$EmptyMode,e) or return nil T.expr is ['QUOTE, =T.mode] => nil compApplication(op,argl,m,T) @@ -947,7 +944,7 @@ setqSingle(id,val,m,E) == --all we do now is to allocate a slot number for lhs --e.g. the %LET form below will be changed by putInLocalDomainReferences form := - db := constructorDB currentConstructor e' + db := currentDB e' k := assocIndex(db,id) => ['%store,['%tref,'$,k],x] ["%LET",id,x] [form,m',e'] @@ -2497,7 +2494,7 @@ numberize x == ++ If there is a local reference to mode `m', return it. localReferenceIfThere(m,e) == m is "$" => m - idx := assocIndex(constructorDB currentConstructor e,m) => ['%tref,'$,idx] + idx := assocIndex(currentDB e,m) => ['%tref,'$,idx] quote m compRepeatOrCollect(form,m,e) == diff --git a/src/interp/define.boot b/src/interp/define.boot index a8983cf4..9f579f44 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -2212,7 +2212,7 @@ compAdd(['add,$addForm,capsule],m,e) == ['%otherwise, ['systemError,['%list,'"%b",MKQ $functorForm.op,'"%d",'"from", _ '"%b",MKQ namestring $editFile,'"%d",'"needs to be compiled"]]]],m,e] $addFormLhs: local:= $addForm - db := constructorDB currentConstructor e + db := currentDB e if $addForm is ["SubDomain",domainForm,predicate] then $NRTaddForm := domainForm getLocalIndex(db,domainForm) @@ -2334,7 +2334,7 @@ doIt(item,$predl) == if $optimizeRep then registerInlinableDomain $Representation code is ["%LET",:.] => - db := constructorDB currentConstructor $e + db := currentDB $e item.op := '%store rhsCode := rhs' item.args := [['%tref,'$,getLocalIndex(db,lhs)],rhsCode] diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index c6c17ce0..d73344de 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -201,7 +201,7 @@ genDeltaEntry(op,mm,e) == kind is 'XLAM => cform if kind is 'Subsumed then kind := 'ELT $onlyAbstractSlot => [kind,'$,[op,[dc,:sig]]] - db := constructorDB currentConstructor e + db := currentDB e if dc isnt [.,:.] then dc = "$" => nsig := sig if integer? nsig then nsig := MSUBST("$",dc,substitute("$$","$",sig)) |