Commit 649c09ae authored by Vincent Zweije's avatar Vincent Zweije
Browse files

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

which included commits to RCS files with non-trunk default branches.
parent c78d2bb5
......@@ -37,7 +37,7 @@ $(SYS)/coreclean.abc: coreclean.icl coreclean.dcl strat.dcl spine.dcl rule.dcl g
$(SYS)/loop.abc: loop.icl loop.dcl strat.dcl trace.dcl spine.dcl history.dcl rewr.dcl rule.dcl graph.dcl pfun.dcl basic.dcl
$(SYS)/strat.abc: strat.icl strat.dcl spine.dcl history.dcl rule.dcl dnc.dcl graph.dcl pfun.dcl basic.dcl
$(SYS)/absmodule.abc: absmodule.icl absmodule.dcl rule.dcl
$(SYS)/trace.abc: trace.icl trace.dcl spine.dcl history.dcl rule.dcl basic.dcl
$(SYS)/trace.abc: trace.icl trace.dcl spine.dcl history.dcl rule.dcl graph.dcl basic.dcl
$(SYS)/spine.abc: spine.icl spine.dcl history.dcl rule.dcl graph.dcl pfun.dcl basic.dcl
$(SYS)/history.abc: history.icl history.dcl rule.dcl graph.dcl pfun.dcl basic.dcl
$(SYS)/complete.abc: complete.icl complete.dcl graph.dcl
......
......@@ -143,6 +143,7 @@ prefix :: .(Graph sym var) .[var] !.[var] -> .([var],[var]) | == var
// Determine a multiline representation of a graph with multiple roots
printgraph :: .(Graph sym var) .[var] -> .[String] | toString sym & toString var & == var
printgraphBy :: (sym->String) (var->String) .(Graph sym var) .[var] -> .[String] | == var
// Do reference counting in a graph for the outer bindings.
// References from case branches are counted once only.
......
......@@ -161,23 +161,26 @@ prefix graph without vars
*/
printgraph :: .(Graph sym var) .[var] -> .[String] | toString sym & toString var & == var
printgraph graph nodes
= prntgrph (refcount graph nodes) graph nodes
printgraph graph nodes = printgraphBy toString toString graph nodes
prntgrph count graph nodes
printgraphBy :: (sym->String) (var->String) .(Graph sym var) .[var] -> .[String] | == var
printgraphBy showsym showvar graph nodes
= prntgrph showsym showvar (refcount graph nodes) graph nodes
prntgrph showsym showvar count graph nodes
= snd (foldlr pg ([],[]) nodes)
where pg node (seen,reprs)
= (seen2,[repr3:reprs])
where repr3
= if (not (isMember node seen) && def && count node>1)
(toString node+++":"+++repr2)
(showvar node+++":"+++repr2)
repr2
(seen2,repr2)
= if (isMember node seen || not def)
(seen,toString node)
(seen,showvar node)
(if (args==[])
(seen1,toString func)
(seen1,"("+++toString func+++foldr (+++) ")" (map ((+++)" ") repr1)))
(seen1,showsym func)
(seen1,"("+++showsym func+++foldr (+++) ")" (map ((+++)" ") repr1)))
(seen1,repr1) = foldlr pg ([node:seen],[]) args
(def,(func,args)) = varcontents graph node
......
......@@ -49,3 +49,12 @@ historyToString ::
(writeHistory) infixl :: *File (History sym var) -> .File | toString sym & toString,== var
(writeHistoryAssociation) infixl :: *File (HistoryAssociation sym var) -> .File | toString sym & toString,== var
printhistory ::
(sym->String)
(var->String)
String
(History sym var)
*File
-> .File
| == var
......@@ -75,3 +75,31 @@ historyToString history
(writeHistoryAssociation) infixl :: *File (HistoryAssociation sym var) -> .File | toString sym & toString,== var
(writeHistoryAssociation) file ha = file <<< "<historyassociation>" // showpair toString (showlist toString) ha <<< nl
printhistory ::
(sym->String)
(var->String)
String
(History sym var)
*File
-> .File
| == var
printhistory showsym showvar indent history file
= foldl (flip (printhistoryassociation showsym showvar indent)) file history
printhistoryassociation showsym showvar indent vargraphs file
= printlist (myshowrgraph showsym showvar) (indent+++" ") rgraphs (file <<< indent <<< showvar var <<< " <=" <<< nl)
//= file <<< indent <<< showvar var <<< " <=" <<< showlist (showrgraph showsym showvar) rgraphs <<< nl
//= file <<< indent <<< showpair showvar (showlist toString) vargraphs <<< nl
//= file <<< "<history>" <<< nl
where (var,rgraphs) = vargraphs
myshowrgraph showsym showvar rgraph
= hd (printgraphBy showsym showvar (rgraphgraph rgraph) [rgraphroot rgraph])
printlist :: (elem->String) String [elem] *File -> .File
printlist showelem indent [] file
= file
printlist showelem indent [x:xs] file
= printlist showelem indent xs (file <<< indent <<< showelem x <<< nl)
......@@ -171,18 +171,29 @@ where toString srr
"\nAreas: "+++listToString srr.srr_areas+++"\n"
instance <<< (Symredresult sym var tsym tvar) | toString sym & <<<,==,toString var
where (<<<) file srr
= file <<< "==[BEGIN]==" <<< nl
<<< "Task expression: " <<< srr.srr_task_expression <<< nl
<<< "Assigned symbol: " <<< toString (srr.srr_assigned_symbol) <<< nl
<<< "Strictness: " <<< srr.srr_strictness <<< nl
//<<< "Type rule: ..." <<< nl
<<< srr.srr_trace <<< nl
//<<< "Function definition:" <<< nl
//<<< srr.srr_function_def
<<< "Areas:" <<< nl
writeareas srr.srr_areas
<<< "==[END]==" <<< nl
where (<<<) file0 srr
= file5
where file1
= file0 <<< "==[BEGIN]==" <<< nl
<<< "Task expression: " <<< srr.srr_task_expression <<< nl
<<< "Assigned symbol: " <<< toString (srr.srr_assigned_symbol) <<< nl
<<< "Strictness: " <<< srr.srr_strictness <<< nl
//<<< "Type rule: ..." <<< nl
file2 = printtrace srr.srr_assigned_symbol toString toString toString "" srr.srr_trace file1
file3
= file2 //<<< "Function definition:" <<< nl
//<<< srr.srr_function_def
<<< "Areas:" <<< nl
file4 = printareas toString toString " " srr.srr_areas file3
file5
= file4 <<< "==[END]==" <<< nl
printareas :: (sym->String) (var->String) String [Rgraph sym var] *File -> .File | == var
printareas showsym showvar indent areas file
= foldl (flip (printarea showsym showvar indent)) file areas
printarea showsym showvar indent area file
= file <<< indent <<< hd (printgraphBy showsym showvar (rgraphgraph area) [rgraphroot area]) <<< nl
(writeareas) infixl :: *File [Rgraph sym var] -> .File | toString sym & toString,== var
(writeareas) file xs = sfoldl (<<<) file xs
......
......@@ -4,6 +4,7 @@ definition module pfun
from StdString import toString
from StdOverloaded import ==
from cleanversion import String
// Partial function abstract type
:: Pfun dom ran
......@@ -42,6 +43,13 @@ apply :: !(Pfun dom .ran) dom -> (.Bool,.ran) | == dom
instance toString (Pfun dom ran) | toString dom & toString ran & == dom
(writepfun) infixl :: *File .(Pfun dom ran) -> .File | ==,toString dom & toString ran
showpfun ::
(dom->String)
(ran->String)
(Pfun dom ran)
-> String
| == dom
/* `Idpfun dom pfun' checks whether partial function `pfun' is the identity
on the nodes in `dom' for which it is defined.
*/
......
......@@ -71,9 +71,17 @@ apply pfun arg
baddomain = abort "apply: partial function applied outside domain"
instance toString Pfun dom ran | toString dom & toString ran & == dom
where toString pfun
= toString ['{':drop 1 (flatten (map ((cons ',') o printlink) (pfunlist pfun)))++['}']]
where printlink (arg,res) = fromString (toString arg)++['|->']++fromString (toString res)
where toString pfun = showpfun toString toString pfun
showpfun ::
(dom->String)
(ran->String)
(Pfun dom ran)
-> String
| == dom
showpfun showdom showran pfun
= toString ['{':drop 1 (flatten (map ((cons ',') o printlink) (pfunlist pfun)))++['}']]
where printlink (arg,res) = fromString (showdom arg)++['|->']++fromString (showran res)
pfunlist :: (Pfun dom res) -> [(dom,res)] | == dom
pfunlist EmptyPfun = []
......
......@@ -30,6 +30,22 @@ rulegraph :: !.(Rule sym var) -> Graph sym var
instance toString (Rule sym var) | toString sym & toString var & == var
ruleToString :: (sym->.String) .(Rule sym var) -> String | Eq,toString var
showrule ::
(sym->String)
(var->String)
(Rule sym var)
-> String
| == var
showruleanch ::
(sym->String)
(var->String)
[Bool]
(Rule sym var)
[var]
-> String
| == var
// --- Functions on rooted graphs
// The empty rooted graph with a given root
......@@ -52,6 +68,14 @@ mkrgraph :: var (Graph sym var) -> .Rgraph sym var
instance == (Rgraph sym var) | == sym & == var
instance toString (Rgraph sym var) | toString sym & toString var & Eq var
showrgraph ::
(sym->String)
(var->String)
(Rgraph sym var)
-> String
| == var
instance <<< (Rgraph sym var) | toString sym & toString var & == var
instance <<< (Rule sym var) | toString sym & toString,== var
......
......@@ -133,32 +133,26 @@ maprgraph :: (.(var1,Graph sym1 var1) -> .(var2,Graph sym2 var2)) !.(Rgraph sym1
maprgraph f (RgraphAlias root1 graph1) = RgraphAlias root2 graph2
where (root2,graph2) = f (root1,graph1)
/*
> showrgraph showfunc shownode (root,graph)
> = '(':snd (showsubgraph root ([],"emptyrgraph) "))++shownode root
> where showsubgraph node (seen,repr)
> = (seen,repr), if ~def \/ member seen node
> = (seen'',repr''), otherwise
> where (def,(f,args)) = nodecontents graph node
> (seen'',repr') = foldlr showsubgraph (seen',repr) args
> seen' = node:seen
> repr''
> = "updatergraph "++shownode node++" ("++
> showfunc f++',':showlist shownode args++")."++
> repr'
*/
instance toString (Rgraph sym var) | toString sym & toString var & Eq var
where toString (RgraphAlias root graph)
= "("+++snd (showsubgraph root ([],"emptyrgraph) "))+++toString root
where showsubgraph node (seen,repr)
| not def || isMember node seen
= (seen,repr)
= (seen``,repr``)
where (def,(f,args)) = varcontents graph node
(seen``,repr`) = foldlr showsubgraph (seen`,repr) args
seen` = [node:seen]
repr`` = "updatergraph "+++toString node+++" ("+++toString f+++","+++listToString args+++") o "+++repr`
where toString rgraph = showrgraph toString toString rgraph
showrgraph ::
(sym->String)
(var->String)
(Rgraph sym var)
-> String
| == var
showrgraph showsym showvar (RgraphAlias root graph)
= "("+++snd (showsubgraph root ([],"emptyrgraph) "))+++showvar root
where showsubgraph node (seen,repr)
| not def || isMember node seen
= (seen,repr)
= (seen``,repr``)
where (def,(f,args)) = varcontents graph node
(seen``,repr`) = foldlr showsubgraph (seen`,repr) args
seen` = [node:seen]
repr`` = "updatergraph "+++showvar node+++" ("+++showsym f+++","+++showlist showvar args+++") o "+++repr`
/*
> printrgraph showfunc shownode (root,graph)
......@@ -191,20 +185,6 @@ rulegraph :: !.(Rule sym var) -> Graph sym var
rulegraph (RuleAlias _ _ graph) = graph
/*
> showrule showfunc shownode (lroots,rroot,graph)
> = "((mkrule "++showlist shownode lroots++' ':shownode rroot++repr'++") emptygraph)"
> where (seen,repr') = showsubgraph rroot ([],repr)
> (seen',repr) = foldlr showsubgraph (seen,"") lroots
> showsubgraph node (seen,repr)
> = (seen,repr), if ~def \/ member seen node
> = (seen'',repr''), otherwise
> where (def,(f,args)) = nodecontents graph node
> (seen'',repr') = foldlr showsubgraph (seen',repr) args
> seen' = node:seen
> repr''
> = ".updategraph "++shownode node++" ("++
> showfunc f++',':showlist shownode args++')':repr'
> printrule showfunc shownode (lroots,rroot,graph)
> = (concat.map (++" ").init) reprs++"-> "++last reprs
> where reprs = printgraph showfunc shownode graph (lroots++[rroot])
......@@ -219,19 +199,27 @@ where (==) (RgraphAlias root1 graph1) (RgraphAlias root2 graph2)
= root1==root2 && graph1==graph2
instance toString (Rule sym var) | toString sym & toString var & == var
where //toString rule = "<rule>"
toString (RuleAlias lroots rroot graph)
= "((mkrule "+++listToString lroots+++" "+++toString rroot+++repr`+++") emptygraph)"
where (seen,repr`) = foldlr showsubgraph ([],repr) lroots
(seen`,repr) = showsubgraph rroot (seen,"")
showsubgraph node (seen,repr)
| not def || isMember node seen
= (seen,repr)
= (seen``,repr``)
where (def,(f,args)) = varcontents graph node
(seen``,repr`) = foldlr showsubgraph (seen`,repr) args
seen` = [node:seen]
repr`` = " o updategraph "+++toString node+++" ("+++toString f+++","+++listToString args+++")"+++repr`
where toString rule = showrule toString toString rule
showrule ::
(sym->String)
(var->String)
(Rule sym var)
-> String
| == var
showrule showsym showvar (RuleAlias lroots rroot graph)
= "((mkrule "+++showlist showvar lroots+++" "+++showvar rroot+++repr`+++") emptygraph)"
where (seen,repr`) = foldlr showsubgraph ([],repr) lroots
(seen`,repr) = showsubgraph rroot (seen,"")
showsubgraph node (seen,repr)
| not def || isMember node seen
= (seen,repr)
= (seen``,repr``)
where (def,(f,args)) = varcontents graph node
(seen``,repr`) = foldlr showsubgraph (seen`,repr) args
seen` = [node:seen]
repr`` = " o updategraph "+++showvar node+++" ("+++showsym f+++","+++showlist showvar args+++")"+++repr`
ruleToString :: (sym->.String) .(Rule sym var) -> String | Eq,toString var
ruleToString symToString (RuleAlias lroots rroot graph)
......@@ -259,3 +247,19 @@ where (<<<) file rule = file <<< toString rule
(writerule) infixl :: *File .(Rule sym var) -> .File | toString sym & ==,toString var
(writerule) file rule = file <<< rule
showruleanch ::
(sym->String)
(var->String)
[Bool]
(Rule sym var)
[var]
-> String
| == var
showruleanch showsym showvar stricts rule anchors
= foldr (+++) "" (map2 annot stricts argreprs)+++"-> "+++rootrepr
where graph = rulegraph rule; args = arguments rule; root = ruleroot rule
(argreprs,[rootrepr:anchorreprs]) = claim args reprs
reprs = printgraphBy showsym showvar graph (args++[root:anchors])
annot strict repr = (if strict ((+++) "!") id) (repr+++" ")
......@@ -10,6 +10,7 @@ from general import Optional
from StdOverloaded import ==
from StdFile import <<<
from StdString import toString
from cleanversion import String
/*
......@@ -92,6 +93,18 @@ that the node was in root normal form.
:: Answer sym var pvar
:== Optional (Spine sym var pvar)
// Write a strategy answer to a file
printanswer ::
(sym->String)
(var->String)
(pvar->String)
String
-> (Answer sym var pvar)
*File
-> .File
| == var
& == pvar
/*
Spine describes the spine returned by a strategy. It contains the node
......
......@@ -8,7 +8,7 @@ import dnc
import graph
import pfun
import basic
from general import No,Yes,--->
from general import No,Yes
import StdEnv
/*
......@@ -92,6 +92,22 @@ that the node was in root normal form.
:: Answer sym var pvar
:== Optional (Spine sym var pvar)
printanswer ::
(sym->String)
(var->String)
(pvar->String)
String
-> (Answer sym var pvar)
*File
-> .File
| == var
& == pvar
printanswer showsym showvar showpvar indent
= foldoptional (printrnf indent) (printspine showsym showvar showpvar indent)
printrnf indent file = file <<< indent <<< "RNF" <<< nl
/*
Spine describes the spine returned by a strategy. It contains the node
......@@ -119,6 +135,30 @@ at which the strategy was applied, and the result for that node.
:: Spine sym var pvar
:== (var,Subspine sym var pvar)
printspine ::
(sym->String)
(var->String)
(pvar->String)
String
-> (Spine sym var pvar)
*File
-> .File
| == var
& == pvar
printspine showsym showvar showpvar indent
= foldspine pair cycle delta force missingcase open partial unsafe redex strict
where pair node (line,printrest) file = printrest (file <<< indent <<< showvar node <<< ": " <<< line <<< nl)
cycle = ("Cycle",id)
delta = ("Delta",id)
force argno printrest = ("Force argument "+++toString argno,printrest)
missingcase = ("MissingCase",id)
open rgraph = ("Open "+++hd (printgraphBy showsym showpvar (rgraphgraph rgraph) [rgraphroot rgraph]),id)
partial rule matching pvar printrest = ("Partial <fn> "+++showruleanch showsym showpvar (repeat False) rule [pvar]+++" <"+++showpvar pvar+++"> "+++showpfun showpvar showvar matching,printrest)
unsafe rgraph = ("Unsafe "+++hd (printgraphBy showsym showvar (rgraphgraph rgraph) [rgraphroot rgraph]),id)
redex rule matching = ("Redex <fn> "+++showruleanch showsym showpvar (repeat False) rule []+++" "+++showpfun showpvar showvar matching,id)
strict = ("Strict",id)
/*
Subspine describes what was the result of the strategy applied to a node
......@@ -239,7 +279,7 @@ spinetip spine = spine
spinenodes :: .(Spine sym var pvar) -> [var]
spinenodes spine
= ((nodes<---"spine.spinenodes ends") ---> ("spine.spinenodes number of spine nodes is "+++toString (length nodes))) ---> "spine.spinenodes begins"
= nodes
where partial _ _ _ = id
redex _ _ = []
nodes = foldspine cons [] [] (const id) [] (const []) partial (const []) redex [] spine
......
......@@ -8,6 +8,7 @@ from rule import Rule
from StdFile import <<<
from StdOverloaded import ==
from StdString import toString
from cleanversion import String
// Transitive necessities
......@@ -249,8 +250,22 @@ Implementation
> (args',root':anchors') = claim args reprs
> reprs = printgraph printa printb graph (args++root:anchors)
> annot strict repr = cond strict ('!':) id (repr++" ")
*/
printtrace ::
sym // LHS function symbol
(sym->String) // Symbol representation
(var->String) // Variable representation for transformed program
(pvar->String) // Variable representation for consulted program
String // Indent
(Trace sym var pvar) // Trace
*File // File before writing
-> .File // File after writing
| == var
& == pvar
/*
Tips traverses a finite trace and produces the list of rewrite rules
that are found at the leaves of the tree. This list of rewrite rules
precisely constitutes the result of symbolic reduction of the original
......
......@@ -5,6 +5,7 @@ implementation module trace
import spine
import history
import rule
import graph
import basic
import syntax
import StdEnv
......@@ -193,8 +194,55 @@ Implementation
> (args',root':anchors') = claim args reprs
> reprs = printgraph printa printb graph (args++root:anchors)
> annot strict repr = cond strict ('!':) id (repr++" ")
*/
printtrace ::
sym // LHS function symbol
(sym->String) // Symbol representation
(var->String) // Variable representation for transformed program
(pvar->String) // Variable representation for consulted program
String // Indent
(Trace sym var pvar) // Trace
*File // File before writing
-> .File // File after writing
| == var
& == pvar
printtrace sym showsym showvar showpvar indent trace file0
= file4
where (Trace stricts rule answer history transf) = trace
file1 = file0 <<< indent <<< showsym sym <<< " " <<< showruleanch showsym showvar stricts rule (map fst history++answernodes answer) <<< nl
file2 = printanswer showsym showvar showpvar (indent+++" ") answer file1
file3 = printhistory showsym showvar (indent+++" ") history file2
file4 = printtransf sym showsym showvar showpvar indent transf file3
printtransf ::
sym // LHS function symbol
(sym->String) // Symbol representation
(var->String) // Variable representation for transformed program
(pvar->String) // Variable representation for consulted program
String // Indent
(Transformation sym var pvar) // Transformation to print
*File // File before writing
-> .File // File after writing
| == var
& == pvar
printtransf sym showsym showvar showpvar indent transf file0
= case transf
of Reduce reductroot trace
-> ptr indent trace (file0 <<< indent <<< "Reduce to " <<< showvar reductroot <<< nl)
Annotate trace
-> ptr indent trace (file0 <<< indent <<< "Annotate" <<< nl)
Stop
-> file0 <<< indent <<< "Stop" <<< nl
Instantiate rgraph yestrace notrace
-> ptr indent notrace (ptr (indent+++" ") yestrace (file0 <<< indent <<< "Instantiate " <<< showrgraph showsym showvar rgraph <<< nl))
where ptr = printtrace sym showsym showvar showpvar
answernodes = foldoptional [] spinenodes
/*
Tips traverses a finite trace and produces the list of rewrite rules
that are found at the leaves of the tree. This list of rewrite rules
precisely constitutes the result of symbolic reduction of the original
......
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