delete sucl, the same files can be found in the branch sucl

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1940 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

1 files changed, 0 insertions, 227 deletions

diff --git a/sucl/canon.icl b/sucl/canon.icl
deleted file mode 100644
index 515404f..0000000
--- a/sucl/canon.icl
+++ /dev/null
@@ -1,227 +0,0 @@
-implementation module canon
-
-// $Id$
-
-import rule
-import graph
-import basic
-import general
-import StdEnv
-
-/*
-
-canon.lit - Area canonicalization
-=================================
-
-Description
------------
-
-This script defines functions for folding areas and generating canonical
-forms from them for renewed symbolic reduction.
-
-------------------------------------------------------------------------
-
-Interface
----------
-
-Exported identifiers:
-
->   %export
->       canonise  ||  Transform an area into canonical form
->       foldarea  ||  Fold an area to an application of its assigned symbol
->       labelarea ||  Use a list of symbols to label a list of areas
-
-------------------------------------------------------------------------
-
-Includes
---------
-
->   %include "basic.lit" -uncurry -split
->   %include "graph.lit" -extgraph
->   %include "rule.lit"
-
-------------------------------------------------------------------------
-
-`Canonise heap' canonises an area to a  standard  form,  so  that  equal
-areas  are  detected by the `=' operator.  Canonisation is done in three
-steps:
-
-(1) Splitting arguments to prevent too much sharing and  allowing  delta
-    functions to be recognised.
-
-(2) Adding extra arguments to the full complement according to the  type
-    rule for the top symbol.
-
-(3) Relabeling the nodes in a standard way.
-
->   canonise :: (*->rule **** *****) -> [***] -> rgraph * ** -> rgraph * ***
->   canonise typerule heap = relabel heap.etaexpand typerule.splitrg.relabel localheap
-
-*/
-
-canonise :: (sym -> Int) [var2] (Rgraph sym var1) -> Rgraph sym var2 | == var1
-canonise arity heap rg
- = (relabel heap o etaexpand arity o splitrg o relabel localheap) rg
-
-/*
-
->   split :: rgraph * num -> rgraph * num
->   split rgraph
->   =   foldsingleton single rgraph rgraph
->       where single root sym args = mkrgraph root (updategraph root (sym,fst (claim args (localheap--[root]))) emptygraph)
-
-*/
-
-splitrg :: (Rgraph sym Int) -> Rgraph sym Int
-splitrg rgraph
- = foldsingleton single rgraph rgraph
-   where single root sym args = mkrgraph root (updategraph root (sym,fst (claim args (localheap--[root]))) emptygraph)
-
-/*
->   uncurry :: (*->rule **** *****) -> rgraph * num -> rgraph * num
->   uncurry typerule rgraph
->   =   f (nc root)
->       where f (True,(sym,args))
->             =   mkrgraph root (updategraph root (sym,fst (claim targs (args++localheap--nodelist graph [root]))) graph)
->                 where targs = lhs (typerule sym)
->             f cont = rgraph
->             nc = nodecontents graph
->             root = rgraphroot rgraph; graph = rgraphgraph rgraph
-*/
-
-etaexpand :: (sym->Int) (Rgraph sym Int) -> Rgraph sym Int
-etaexpand arity rgraph
- = f (nc root)
-   where f (True,(sym,args))
-          = mkrgraph root (updategraph root (sym,take (arity sym) (args++(localheap--(varlist graph [root])))) graph)
-         f cont = rgraph
-         nc = varcontents graph
-         root = rgraphroot rgraph; graph = rgraphgraph rgraph
-
-localheap :: [Int]
-localheap =: [0..]
-
-/*
-------------------------------------------------------------------------
-
->   foldarea :: (rgraph * **->*) -> rgraph * ** -> (*,[**])
->   foldarea label rgraph
->   =   (label rgraph,foldsingleton single nosingle rgraph)
->       where single root sym args = args
->             nosingle = snd (varset (rgraphgraph rgraph) [rgraphroot rgraph])
-*/
-
-foldarea :: ((Rgraph sym var) -> sym) (Rgraph sym var) -> Node sym var | == var
-foldarea label rgraph
- = (labelrgraph,foldsingleton single nosingle rgraph)
-   where single root sym = id
-         nosingle = snd (graphvars (rgraphgraph rgraph) [rgraphroot rgraph])
-         labelrgraph = label rgraph
-
-/*
-------------------------------------------------------------------------
-
->   labelarea :: [rgraph * **] -> [*] -> rgraph * ** -> *
->   labelarea areas labels
->   =   foldmap id nolabel (maketable areas labels)
->       where nolabel = error "labelarea: no label assigned to area"
-
->   maketable :: [rgraph * **] -> [*] -> [(rgraph * **,*)]
->   maketable [] = const []
->   maketable (area:areas) labels
->   =   (area,label):maketable areas labels'
->       where (label,labels') = getlabel (nc aroot) labels
->             getlabel (True,(asym,aargs)) labels = (asym,labels), if ~or (map (fst.nc) aargs)
->             getlabel acont (label:labels) = (label,labels)
->             getlabel = error "maketable: out of labels"
->             nc = varcontents agraph
->             aroot = rgraphroot area; agraph = rgraphgraph area
-*/
-
-labelarea :: (sym->Bool) [Rgraph sym var] [sym] (Rgraph sym var) -> sym | == sym & == var
-labelarea reusable areas labels rg
- = foldmap id nolabel (maketable reusable areas labels) rg
-   where nolabel = abort "canon: labelarea: no label assigned to area"
-
-maketable :: (sym->Bool) [Rgraph sym var] [sym] -> [(Rgraph sym var,sym)] | == var
-maketable _ [] _ = []
-maketable reusable [area:areas] labels
- = [(area,label):maketable reusable areas labels`]
-   where (label,labels`) = getlabel (nc aroot) labels
-         getlabel (True,(asym,aargs)) labels
-          | reusable asym && not (or (map (fst o nc) aargs))
-            = (asym,labels)
-         getlabel acont [label:labels]
-          = (label,labels)
-         getlabel _ _
-          = abort "canon: maketable: out of labels"
-         nc = varcontents agraph
-         aroot = rgraphroot area; agraph = rgraphgraph area
-
-/*
-------------------------------------------------------------------------
-
->   relabel :: [***] -> rgraph * ** -> rgraph * ***
-
->   relabel heap rgraph
->   =   mkrgraph (move root) graph'
->       where root = rgraphroot rgraph; graph = rgraphgraph rgraph
->             nodes = nodelist graph [root]
->             table = zip2 nodes heap
->             move = foldmap id nonew table
->             nonew = error "relabel: no new node assigned to node"
->             graph' = foldr addnode emptygraph table
->             addnode (node,node')
->             =   updategraph node' (sym,map move args), if def
->             =   id, otherwise
->                 where (def,(sym,args)) = nc node
->             nc = nodecontents graph
-*/
-
-relabel :: [var2] (Rgraph sym var1) -> Rgraph sym var2 | == var1
-relabel heap rgraph
- = mkrgraph (move root) graph`
-   where root = rgraphroot rgraph; graph = rgraphgraph rgraph
-         nodes = varlist graph [root]
-         table = zip2 nodes heap
-         move = foldmap id nonew table
-         nonew = abort "relabel: no new node assigned to node"
-         graph` = foldr addnode emptygraph table
-         addnode (node,node`)
-          | def
-            = updategraph node` (sym,map move args)
-          = id
-            where (def,(sym,args)) = nc node
-         nc = varcontents graph
-
-/*
->   foldsingleton
->   ::  (**->*->[**]->***) ->
->       *** ->
->       rgraph * ** ->
->       ***
-
->   foldsingleton single nosingle rgraph
->   =   f (nc root)
->       where f (True,(sym,args)) = single root sym args, if ~or (map (fst.nc) args)
->             f cont = nosingle
->             nc = nodecontents graph
->             root = rgraphroot rgraph; graph = rgraphgraph rgraph
-*/
-
-foldsingleton ::
-    (var sym [var] -> pvar)
-    pvar
-    (Rgraph sym var)
- -> pvar
- |  == var
-
-foldsingleton single nosingle rgraph
- = case nc root
-   of (True,(sym,args))
-       | not (or (map (fst o nc) args))
-         -> single root sym args
-      _
-       -> nosingle
-   where nc = varcontents graph
-         root = rgraphroot rgraph; graph = rgraphgraph rgraph