diff options
Diffstat (limited to 'src/interp/c-util.boot')
| -rw-r--r-- | src/interp/c-util.boot | 120 |
1 files changed, 11 insertions, 109 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 7904dc77..134bb196 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -301,13 +301,15 @@ warnLiteral x == intersectionEnvironment(e,e') == ce:= makeCommonEnvironment(e,e') - ic:= intersectionContour(deltaContour(e,ce),deltaContour(e',ce)) - e'':= (ic => addContour(ic,ce); ce) + ic := intersectionContour(deltaContour(e,ce),deltaContour(e',ce)) => + addContour(ic,ce) + ce deltaContour([[c,:cl],:el],[[c',:cl'],:el']) == not EQ(el,el') => systemError '"deltaContour" --a cop out for now eliminateDuplicatePropertyLists contourDifference(c,c') where - contourDifference(c,c') == [first x for x in tails c while (x~=c')] + contourDifference(c,c') == + [first x for x in tails c while not EQ(x,c')] eliminateDuplicatePropertyLists contour == contour is [[x,:.],:contour'] => LASSOC(x,contour') => @@ -317,7 +319,7 @@ deltaContour([[c,:cl],:el],[[c',:cl'],:el']) == nil intersectionContour(c,c') == - $var: local + $var: local := nil computeIntersection(c,c') where computeIntersection(c,c') == varlist:= removeDuplicates ASSOCLEFT c @@ -381,8 +383,6 @@ addContour(c,E is [cur,:tail]) == for pv in p repeat fn3(x,pv,ee) where fn3(x,pv,e) == [p,:v]:=pv - if member(x,$getPutTrace) then - pp([x,"has",pv]) if p="conditionalmode" then pv.first := "mode" --check for conflicts with earlier mode @@ -391,7 +391,11 @@ addContour(c,E is [cur,:tail]) == stackWarning('"The conditional modes %1p and %2p conflict", [v,vv]) [c] - + +++ Return the common root of the environments e and e'. +++ Note: we use cell pointer comparison instead of general object +++ equality comparison because both are expected to build from +++ a commont cell node. makeCommonEnvironment(e,e') == interE makeSameLength(e,e') where interE [e,e'] == @@ -924,16 +928,6 @@ sublisV(p,e) == --% DEBUGGING PRINT ROUTINES used in breaks -_?MODEMAPS x == _?modemaps x -_?modemaps x == - env:= - $insideCapsuleFunctionIfTrue=true => $CapsuleModemapFrame - $f - x="all" => displayModemaps env - -- displayOpModemaps(x,old2NewModemaps get(x,"modemap",env)) - displayOpModemaps(x,get(x,"modemap",env)) - - old2NewModemaps x == -- [[dcSig,pred] for [dcSig,[pred,:.],:.] in x] x is [dcSig,[pred,:.],:.] => [dcSig,pred] @@ -946,11 +940,6 @@ traceUp() == sayBrightly [y,'" ==> mode",'%b,u.mode,'%d] sayBrightly [y,'" does not compile"] -_?M x == _?m x -_?m x == - u:= comp(x,$EmptyMode,$f) => u.mode - nil - traceDown() == mmList:= getFormModemaps($x,$f) => for mm in mmList repeat if u:= qModemap mm then return u @@ -969,26 +958,6 @@ qArg(a,m) == sayBrightly [a," --> ",m,'%b,yesOrNo,'%d] yesOrNo="yes" -_?COMP x == _?comp x -_?comp x == - msg:= - u:= comp(x,$EmptyMode,$f) => - [MAKESTRING "compiles to mode",'%b,u.mode,'%d] - nil - sayBrightly msg - -_?domains() == pp getDomainsInScope $f -_?DOMAINS() == ?domains() - -_?mode x == displayProplist(x,[["mode",:getmode(x,$f)]]) -_?MODE x == _?mode x - -_?properties x == displayProplist(x,getProplist(x,$f)) -_?PROPERTIES x == _?properties x - -_?value x == displayProplist(x,[["value",:get(x,"value",$f)]]) -_?VALUE x == _?value x - displayProplist(x,alist) == sayBrightly ["properties of",'%b,x,'%d,":"] fn alist where @@ -1450,73 +1419,6 @@ noteSpecialVariable x == $SpecialVars := insert(x,$SpecialVars) --% ---% Middle Env to Back End Transformations. ---% - ---% e ::= ---% (%ilConst <c> <type>) -- constant ---% (%ilInert <e> <type>) -- inert form ---% (%ilCtx <d> <type>) -- context ---% (%ilVar <n> <type>) -- variable ---% (%ilLisp <e> <type>) -- Lisp form ---% (%ilFun <e> <type>) -- function object ---% (%ilMm <e> <type>) -- modemap ---% (%ilLocal <n> <type>) -- local function ---% (%ilCtor <n> <type>) -- constructor ---% (%ilTag <e> <type>) -- tag of union object ---% (%ilVal <e> <type>) -- value of union object ---% (%ilCall <e...e> <type>) -- a call ---% (%ilXLAM <e> <type>) -- XLAM form ---% (%ilLAM <e> <type>) -- LAMBDA form - -structure ILInsn == - %ilConst(c,t) -- constant - %ilInert(e,t) -- inert form - %ilContext(e,t) -- context - %ilVar(n,t) -- variable - %ilCtor(n,t) -- constructor - %ilLocal(op,t) -- local function - %ilLisp(e,t) -- Lisp form - %ilModemap(e,t) -- exported function modemap - %ilUnionTag e -- union object tag - %ilUnionValue(e,t) -- union object value - %ilDeref(e,t) -- deref function pointer - %ilCall(e,t) -- call - %ilType(d,t) -- type instantiation request - %ilReturn(n,T,t) -- `return' expression - %ilExit(n,T,t) -- `exit' expression - -++ Convert middle end IL forms to old back end forms. -il2OldForm x == - atom x => x -- ideally should not happen - x is ["QUOTE",:.] => x -- idem. - case x of - %ilConst(c,.) => c - %ilInert(e,.) => e - %ilVar(n,.) => n - %ilCtor(n,.) => n - %ilContext(e,.) => e - %ilLisp(e,.) => e - %ilModemap(e,.) => e - %ilUnionTag(e,.) => ["CAR",il2OldForm e] - %ilUnionValue(e,.) => ["CAR",il2OldForm e] - %ilDeref(e,.) => ["applyFun",il2OldForm e] - %ilCall(e,.) => - e is [["%ilLocal",op,:.],:.] => - e.first := op - ilTransformInsns rest e - e - ['%call,:ilTransformInsns e] - otherwise => ilTransformInsns x - -++ Subroutines of il2OldForm to walk sequence of IL instructions. -ilTransformInsns form == - for insns in tails form repeat - insns.first := il2OldForm first insns - form - - ---% ++ Replace every middle end sub-forms in `x' with Lisp code. massageBackendCode: %Code -> %Void |