Commit f03c3210 authored by Vincent Zweije's avatar Vincent Zweije
Browse files

This commit was generated by cvs2svn to compensate for changes in r748,

which included commits to RCS files with non-trunk default branches.
parent 0f10d175
......@@ -127,7 +127,7 @@ exports (CliAlias m) = m.exportedsymbols
// Determine the arity of a core clean symbol
arity :: Cli SuclSymbol -> Int
arity (CliAlias m) sym
= extendfn m.arities (length o arguments o (extendfn m.typerules coretyperule)) sym
= extendfn m.arities (length o arguments o (extendfn m.typerules (coretyperule--->"coreclean.coretyperule begins from cli.arity"))) sym
/*
> typerule (tdefs,(es,as,ts,rs)) = maxtyperule ts
......@@ -177,7 +177,7 @@ typearity ti = length (arguments ti)
//maxtypeinfo defs sym = extendfn defs coretypeinfo sym
maxtyperule :: [(SuclSymbol,Rule SuclTypeSymbol SuclTypeVariable)] SuclSymbol -> Rule SuclTypeSymbol SuclTypeVariable
maxtyperule defs sym = extendfn defs coretyperule sym
maxtyperule defs sym = extendfn defs (coretyperule--->"cli.coretyperule begins from cli.maxtyperule") sym
maxstricts :: [(SuclSymbol,[Bool])] SuclSymbol -> [Bool]
maxstricts defs sym = extendfn defs corestricts sym
......
......@@ -314,11 +314,12 @@ tryinstantiate onode rpattern anode sargs
where act continue history failinfo instdone stricts sroot subject heap
| anode==sroot // Check if strategy applied at root
&& goodorder strictargs sargs subject subject` // Check if order of arguments of rule ok
= Instantiate success fail
= Instantiate ipattern success fail
= Stop
where success = continue history failinfo True stricts` sroot subject` heap`
fail = continue history failinfo` True stricts` sroot subject heap
failinfo` = adjust onode [rpattern:failinfo onode] failinfo
ipattern = mkrgraph onode subject`
(heap`,subject`) = rewrinstantiate pgraph proot onode (heap,subject)
proot = rgraphroot rpattern; pgraph = rgraphgraph rpattern
......
......@@ -202,11 +202,11 @@ foldtips foldarea foldcont
-> (foldoptional exres (pair True o addstrict stricts o mapfst rule2body) (actualfold deltanodes rnfnodes foldarea (==) foldcont (snd hist) rule) <--- "newfold.foldtips.ft ends (Stop)") ---> "newfold.foldtips.ft case = Stop"
where deltanodes = foldoptional [] getdeltanodes answer
rnfnodes = foldoptional [ruleroot rule] (const []) answer
Instantiate yestrace notrace
Instantiate ipattern yestrace notrace
-> ft` ((ft--->"newfold.foldtips.ft begins from newfold.foldtips.ft.Instantiate.match") hist yestrace) ((ft--->"newfold.foldtips.ft begins from newfold.foldtips.ft.Instantiate.fail") hist notrace)
where ft` (False,yessra) (False,nosra) = (exres <--- "newfold.foldtips.ft ends (Instantiate/no)") ---> "newfold.foldtips.ft case Instantiate/no"
ft` (yesfound,(yesstricts,yesbody,yesareas)) (nofound,(nostricts,nobody,noareas))
= ((True,(stricts,matchpattern answer yesbody nobody,yesareas++noareas)) <--- "newfold.foldtips.ft ends (Instantiate/yes)") ---> "newfold.foldtips.ft case Instantiate/yes"
= ((True,(stricts,MatchPattern ipattern yesbody nobody,yesareas++noareas)) <--- "newfold.foldtips.ft ends (Instantiate/yes)") ---> "newfold.foldtips.ft case Instantiate/yes"
Reduce reductroot trace
-> ft` ((ft--->"newfold.foldtips.ft begins from newfold.foldtips.ft.Reduce") (fst hist,fst hist) trace)
where ft` (False,sra) = (exres <--- "newfold.foldtips.ft ends (Reduce/no)") ---> "newfold.foldtips.ft case Reduce/no"
......@@ -218,14 +218,6 @@ foldtips foldarea foldcont
where (Trace stricts rule answer _ transf) = trace
exres = (False,newextract noetrc foldarea trace)
matchpattern ::
(Answer sym var pvar)
(FuncBody sym var)
(FuncBody sym var)
-> FuncBody sym var
matchpattern _ _ _ = error "newfold: matchpattern: not yet implemented"
rule2body rule = buildgraph (arguments rule) (ruleroot rule) (rulegraph rule)
addstrict stricts (body,areas) = (stricts,body,areas)
......@@ -277,8 +269,8 @@ newextract trc newname (Trace stricts rule answer history transf)
-> newextract trc newname trace <--- "newfold.newextract ends (at Reduce transformation)"
Annotate trace
-> newextract trc newname trace <--- "newfold.newextract ends (at Annotate transformation)"
Instantiate yestrace notrace
-> (stricts,matchpattern answer yesbody nobody,yesareas++noareas) <--- "newfold.newextract ends (at Instantiate transformation)"
Instantiate ipattern yestrace notrace
-> (stricts,MatchPattern ipattern yesbody nobody,yesareas++noareas) <--- "newfold.newextract ends (at Instantiate transformation)"
where (_,yesbody,yesareas) = newextract trc newname yestrace
(_,nobody,noareas) = newextract trc newname notrace
Stop
......@@ -373,7 +365,7 @@ findpattern pattern thespinenodes residuroot (Reduce reductroot trace)
fp residuroot trace = findpattern` pattern residuroot trace
redirect = adjust (last thespinenodes) reductroot id
findpattern pattern thespinenodes residuroot (Instantiate yestrace notrace)
findpattern pattern thespinenodes residuroot (Instantiate ipattern yestrace notrace)
= findpattern` pattern residuroot yestrace || findpattern` pattern residuroot notrace
findpattern pattern thespinenodes residuroot (Annotate trace)
......@@ -407,9 +399,9 @@ getdeltanodes spine
partial _ _ _ nodes = (False,nodes)
redex _ _ = none
instance <<< FuncBody sym var | toString sym & ==,toString var
instance <<< (FuncBody sym var) | toString sym & ==,toString var
where (<<<) file (MatchPattern pat yesbody nobody)
= file <<< "?Match: " <<< pat <<< nl
= file <<< "?Match: " /* <<< toString (rgraphroot pat) <<< " =?= " */ <<< pat <<< nl
<<< "Match succes:" <<< nl
<<< yesbody
<<< "Match failure:" <<< nl
......
......@@ -163,7 +163,8 @@ Implementation
= Reduce var (Trace sym var pvar)
| Annotate (Trace sym var pvar)
| Stop
| Instantiate (Trace sym var pvar)
| Instantiate (Rgraph sym var)
(Trace sym var pvar)
(Trace sym var pvar)
/* Disable the new abstraction node for now...
......@@ -259,7 +260,7 @@ been applied; this has to be done afterwards.
> tips :: trace * ** *** -> [rule * **]
> tips
> = foldtrace reduce annotate stop instantiate
> = oldtrace reduce annotate stop instantiate
> where reduce stricts rule answer history reductroot = id
> annotate stricts rule answer history = id
> stop stricts rule answer history = [rule]
......@@ -283,7 +284,7 @@ foldtrace
:: ([Bool] (Rule sym var) (Answer sym var pvar) (History sym var) var .result -> .result)
([Bool] (Rule sym var) (Answer sym var pvar) (History sym var) .result -> .result)
([Bool] (Rule sym var) (Answer sym var pvar) (History sym var) -> .result)
([Bool] (Rule sym var) (Answer sym var pvar) (History sym var) .result .result -> .result)
([Bool] (Rule sym var) (Answer sym var pvar) (History sym var) (Rgraph sym var) .result .result -> .result)
!.(Trace sym var pvar)
-> .result
......@@ -292,7 +293,7 @@ foldtransformation
(var .result -> .subresult)
(.result -> .subresult)
.subresult
(.result .result -> .subresult)
((Rgraph sym var) .result .result -> .subresult)
([.absresult] -> .subresult)
((Rule sym var) -> .absresult)
(.result -> .absresult)
......
......@@ -129,7 +129,8 @@ Implementation
= Reduce var (Trace sym var pvar)
| Annotate (Trace sym var pvar)
| Stop
| Instantiate (Trace sym var pvar)
| Instantiate (Rgraph sym var)
(Trace sym var pvar)
(Trace sym var pvar)
/* Disable the abstraction node for now...
......@@ -227,7 +228,7 @@ foldtrace
:: ([Bool] (Rule sym var) (Answer sym var pvar) (History sym var) var .result -> .result)
([Bool] (Rule sym var) (Answer sym var pvar) (History sym var) .result -> .result)
([Bool] (Rule sym var) (Answer sym var pvar) (History sym var) -> .result)
([Bool] (Rule sym var) (Answer sym var pvar) (History sym var) .result .result -> .result)
([Bool] (Rule sym var) (Answer sym var pvar) (History sym var) (Rgraph sym var) .result .result -> .result)
!.(Trace sym var pvar)
-> .result
......@@ -238,7 +239,7 @@ foldtrace reduce annotate stop instantiate trace
ftf stricts rule answer history (Reduce reductroot trace) = reduce stricts rule answer history reductroot (ftr trace)
ftf stricts rule answer history (Annotate trace) = annotate stricts rule answer history (ftr trace)
ftf stricts rule answer history Stop = stop stricts rule answer history
ftf stricts rule answer history (Instantiate yestrace notrace) = instantiate stricts rule answer history (ftr yestrace) (ftr notrace)
ftf stricts rule answer history (Instantiate ipattern yestrace notrace) = instantiate stricts rule answer history ipattern (ftr yestrace) (ftr notrace)
// ftf _ _ _ _ (Abstract _) = error "foldtrace not implemented for abstraction nodes"
foldtransformation
......@@ -246,7 +247,7 @@ foldtransformation
(var .result -> .subresult)
(.result -> .subresult)
.subresult
(.result .result -> .subresult)
((Rgraph sym var) .result .result -> .subresult)
([.absresult] -> .subresult)
((Rule sym var) -> .absresult)
(.result -> .absresult)
......@@ -258,7 +259,7 @@ foldtransformation ftr reduce annotate stop instantiate abstract knownabstractio
where ftf (Reduce reductroot trace) = reduce reductroot (ftr trace)
ftf (Annotate trace) = annotate (ftr trace)
ftf Stop = stop
ftf (Instantiate yestrace notrace) = instantiate (ftr yestrace) (ftr notrace)
ftf (Instantiate ipattern yestrace notrace) = instantiate ipattern (ftr yestrace) (ftr notrace)
// ftf (Abstract as) = abstract (map fab as)
// fab (NewAbstraction t) = newabstraction (ftr t)
// fab (KnownAbstraction r) = knownabstraction r
......@@ -286,12 +287,13 @@ where // (<<<) file trace = error "trace.<<<(Trace): blocked for debugging"
<<< "Transformation:" <<< nl writeTransformation transf
where (Trace stricts rule answer history transf) = trace
instance <<< Transformation sym var pvar | toString sym & ==,toString,<<< var // & ==,toString,<<< pvar
instance <<< (Transformation sym var pvar) | toString sym & ==,toString,<<< var // & ==,toString,<<< pvar
where (<<<) file (Reduce reductroot subtrace) = file <<< "Reduce; root of reduct: " <<< reductroot <<< nl <<< subtrace
(<<<) file (Annotate subtrace) = file <<< "Annotate" <<< nl <<< subtrace
(<<<) file Stop = file <<< "Stop" <<< nl
(<<<) file (Instantiate yestrace notrace)
(<<<) file (Instantiate ipattern yestrace notrace)
= file <<< "Instantiate" <<< nl
// <<< "Pattern: " <<< ipattern <<< nl
<<< "Successful match..." <<< nl
<<< yestrace
<<< "End of successful match." <<< nl
......@@ -299,20 +301,28 @@ where (<<<) file (Reduce reductroot subtrace) = file <<< "Reduce; root of reduct
<<< notrace
<<< "End of failing match." <<< nl
(writeTransformation) infixl :: *File .(Transformation sym var pvar) -> .File | toString sym & ==,toString,<<< var // & ==,toString,<<< pvar
(writeTransformation) infixl ::
*File
.(Transformation sym var pvar)
-> .File
| toString sym
& ==,toString,<<< var
// & ==,toString,<<< pvar
(writeTransformation) file (Reduce reductroot subtrace)
= file <<< "Reduce; root of reduct: " <<< reductroot <<< nl
writeTrace subtrace
= file <<< "Reduce; root of reduct: " <<< reductroot <<< nl
writeTrace subtrace
(writeTransformation) file (Annotate subtrace)
= file <<< "Annotate" <<< nl
writeTrace subtrace
= file <<< "Annotate" <<< nl
writeTrace subtrace
(writeTransformation) file Stop
= file <<< "Stop" <<< nl
(writeTransformation) file (Instantiate yestrace notrace)
= file <<< "Instantiate" <<< nl
<<< "Successful match..." <<< nl
// writeTrace yestrace
<<< "End of successful match." <<< nl
<<< "Failing match..." <<< nl
// writeTrace notrace
<<< "End of failing match." <<< nl
= file <<< "Stop" <<< nl
(writeTransformation) file (Instantiate ipattern yestrace notrace)
= file <<< "Instantiate" <<< nl
// <<< "Pattern: " <<< ipattern <<< nl
<<< "Successful match..." <<< nl
// writeTrace yestrace
<<< "End of successful match." <<< nl
<<< "Failing match..." <<< nl
// writeTrace notrace
<<< "End of failing match." <<< nl
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment