Commit 75123a91 authored by Vincent Zweije's avatar Vincent Zweije

Initial import of partially converted Miranda scripts

parent f5985296
COCL = cocl
#COCLFLAGS = -lat
SYS = Clean\ System\ Files
MODULES = basic pretty pfun graph dnc rule trd rewr complete history spine trace absmodule spine strat loop law
ABC = $(patsubst %,$(SYS)/%.abc,$(MODULES))
#default: $(SYS)/history.abc $(SYS)/spine.abc $(SYS)/absmodule.abc $(SYS)/trace.abc $(SYS)/complete.abc $(SYS)/rewr.abc $(SYS)/trd.abc $(SYS)/rule.abc $(SYS)/dnc.abc $(SYS)/graph.abc $(SYS)/pfun.abc $(SYS)/pretty.abc $(SYS)/basic.abc
default: $(ABC)
clean:
rm -Rf errors.err $(SYS)
%: $(SYS)/%.abc
@:
$(SYS)/%.abc: %.icl
$(COCL) $(COCLFLAGS) $*
$(SYS)/law.abc: law.icl law.dcl
$(SYS)/loop.abc: loop.icl loop.dcl trace.dcl strat.dcl history.dcl rule.dcl graph.dcl basic.dcl
$(SYS)/strat.abc: strat.icl strat.dcl history.dcl spine.dcl dnc.dcl rule.dcl graph.dcl pfun.dcl basic.dcl
$(SYS)/history.abc: history.icl history.dcl spine.dcl rule.dcl graph.dcl basic.dcl
$(SYS)/spine.abc: spine.icl spine.dcl rule.dcl pfun.dcl basic.dcl
$(SYS)/absmodule.abc: absmodule.icl absmodule.dcl rule.dcl
$(SYS)/trace.abc: trace.icl trace.dcl rule.dcl
$(SYS)/complete.abc: complete.icl complete.dcl graph.dcl
$(SYS)/rewr.abc: rewr.icl rewr.dcl graph.dcl pfun.dcl basic.dcl
$(SYS)/trd.abc: trd.icl trd.dcl rule.dcl graph.dcl basic.dcl
$(SYS)/rule.abc: rule.icl rule.dcl graph.dcl basic.dcl
$(SYS)/dnc.abc: dnc.icl dnc.dcl graph.dcl
$(SYS)/graph.abc: graph.icl graph.dcl pfun.dcl basic.dcl
$(SYS)/pfun.abc: pfun.icl pfun.dcl basic.dcl
$(SYS)/pretty.abc: pretty.icl pretty.dcl
$(SYS)/basic.abc: basic.icl basic.dcl
definition module absmodule
from rule import Rule
:: Module sym pvar tsym tvar
= { exportedtypesymbols :: [tsym] // Exported type symbols (from DCL)
, typealias :: [(tsym,Rule tsym tvar)] // Alias types
, typeconstructors :: [(tsym,[sym])] // All constructor symbols of each declared algebraic type
, exportedsymbols :: [sym] // Exported function/constructor symbols
, aliases :: [(sym,Rule sym pvar)] // Macros
, typerules :: [(sym,Rule tsym tvar,[Bool])] // Info from type rules (actual type and argument strictnesses)
, rules :: [(sym,[Rule sym pvar])] // Rewrite rules of each symbol, absent if imported
}
implementation module absmodule
import rule
/*
------------------------------------------------------------------------
Exports.
> %export
> module
> addtalias
> addtsymdef
> addalias
> addsymdef
> newmodule
------------------------------------------------------------------------
Includes.
> %include "basic.lit"
> %include "graph.lit" -extgraph
> %include "rule.lit"
------------------------------------------------------------------------
Module implementation.
> module * *** **** *****
> == ( ( [****], || Exported types
> [(****,rule **** *****)], || Type alias rules
> [(****,[*])] || Constructor symbols for algebraic type symbol
> ),
> ( [*], || Exported symbols
> [(*,rule * ***)], || Alias rules
> [(*,(rule **** *****,[bool]))], || Typerule for symbol
> [(*,[rule * ***])] || Rewrite rules for symbol, absent if imported
> )
> )
*/
:: Module sym pvar tsym tvar
= { exportedtypesymbols :: [tsym] // Exported type symbols (from DCL)
, typealias :: [(tsym,Rule tsym tvar)] // Alias types
, typeconstructors :: [(tsym,[sym])] // All constructor symbols of each declared algebraic type
, exportedsymbols :: [sym] // Exported function/constructor symbols
, aliases :: [(sym,Rule sym pvar)] // Macros
, typerules :: [(sym,Rule tsym tvar,[Bool])] // Info from type rules (actual type and argument strictnesses)
, rules :: [(sym,[Rule sym pvar])] // Rewrite rules of each symbol, absent if imported
}
/*
> newmodule :: module * *** **** *****
> newmodule = (([],[],[]),([],[],[],[]))
> addtalias :: **** -> bool -> rule **** ***** -> module * *** **** ***** -> module * *** **** *****
> addtalias ts exp tr ((tes,tas,tcs),defs)
> = ((cond exp (ts:tes) tes,(ts,tr):tas,tcs),defs)
> addtsymdef :: **** -> bool -> [*] -> module * *** **** ***** -> module * *** **** *****
> addtsymdef ts exp ss ((tes,tas,tcs),defs)
> = ((cond exp (ts:tes) tes,tas,(ts,ss):tcs),defs)
> addalias :: * -> bool -> rule * *** -> module * *** **** ***** -> module * *** **** *****
> addalias s exp r (tdefs,(es,as,ts,rs))
> = (tdefs,(cond exp (s:es) es,(s,r):as,ts,rs))
> addsymdef :: * -> bool -> rule **** ***** -> bool -> [rule * ***] -> module * *** **** ***** -> module * *** **** *****
> addsymdef s exp t imp rr (tdefs,(es,as,ts,rs))
> = (tdefs,(cond exp (s:es) es,as,(s,(t,[])):ts,cond imp rs ((s,rr):rs)))
*/
definition module basic
/*
Basic definitions
=================
Description
-----------
Basic types and functions.
*/
import StdOverloaded
import StdString
/*
Implementation
--------------
*/
// The optional type of type t is a type like t
// where the actual t value may be present or absent.
:: Optional t = Absent | Present t
// Adjust a function for a single argument
adjust :: !arg res (arg->res) !arg -> res | == arg
// Claim a list of nodes from a heap
claim :: ![.param] u:[.cell] -> ([.cell],v:[.cell]), [u<=v]
// Cons prepends an element to a list
cons :: .elem u:[.elem] -> v:[.elem], [u <= v]
// Depthfirst does depth first enumeration of a search process
/* Depthfirst collects results of a function (called process), applied to a
given list of inputs and other inputs which are generated from the
results recursively, and so on. Duplicates are removed.
*/
depthfirst :: (res->.[elem]) (elem->res) !.[elem] -> .[res] | == elem
// `Disjoint xs ys' checks whether xs and ys are disjoint.
disjoint :: .[elem] !.[elem] -> Bool | == elem
// `Eqlen xs ys' determines whether `xs' and `ys' are equally long.
eqlen :: ![.elem1] ![.elem2] -> .Bool
// `Foldlm' is a combination of foldl and map.
foldlm :: ((.collect,.elem) -> (.collect,.elem`)) !(.collect,![.elem]) -> (.collect,[.elem`])
// Foldlr combines foldl and foldr:
// Information flows both forward and backward through the list.
foldlr :: (.elem -> .((.lrinfo,.rlinfo) -> (.lrinfo,.rlinfo))) !(.lrinfo,.rlinfo) ![.elem] -> (.lrinfo,.rlinfo)
// Foldmap is the fold function for a map type (from arg to res) given by a list,
// deriving a total function from it giving res`.
foldmap :: (x:res -> w:res`) w:res` -> u:(![(arg,x:res)] -> v:(arg -> w:res`)) | == arg, [v u <= w, v <= x]
// Foldoptional is the standard fold for the optional type.
foldoptional :: .res .(.t -> .res) !(Optional .t) -> .res
// Forget drops a mapped value from a map given by a list.
forget :: val -> .(![.(val,res)] -> .[(val,res)]) | == val
// Indent a list of strings with spaces,
// except the first which is indented with a specific string.
indent :: .String -> .([.String] -> .[String])
// `Identifiers' is the list of all identifiers
identifiers :: [String]
// `Intersect xs ys' is the intersection of list `ys' with list `xs'.
intersect :: ![elem] [elem] -> .[elem] | == elem
// `Join x xss' is the join of the list of lists `xss', separated by `x'.
join :: a ![.[a]] -> .[a]
/* `Kleene xs' determines the kleene closure of the list `xs' of symbols,
i.e. all strings over that list in standard order. The implementation
is designed for maximum sharing.
*/
kleene :: !.[symbol] -> .[[symbol]]
// Lookup finds a value mapped in a list mapping.
lookup :: u:([(arg,w:res)] -> v:(arg -> w:res)) | == arg, [v u <= w]
// Map a function onto the zip of two lists.
map2 :: (.a -> .(.b -> .c)) ![.a] [.b] -> [.c]
// Map a function on the first element of a 2-tuple.
mapfst :: v:(.a -> .b) -> u:((.a,.c) -> (.b,.c)), [u <= v]
// Map a function on the first element of a triple.
mapfst3 :: v:(.a -> .b) -> u:((.a,.c,.d) -> (.b,.c,.d)), [u <= v]
// Map a function onto the head of a list.
maphd :: .(.a -> .a) !u:[.a] -> v:[.a], [u <= v]
// Map a function onto an optional value.
mapoptional :: .(.a -> .b) !(Optional .a) -> Optional .b
// Map two functions onto a pair.
mappair :: .(.a -> .b) .(.c -> .d) !(.a,.c) -> (.b,.d)
// Map a function onto the second element of a 2-tuple.
mapsnd :: v:(.a -> .b) -> u:((.c,.a) -> (.c,.b)), [u <= v]
// Map a function onto the tail of a list.
maptl :: .(x:[.a] -> u:[.a]) !w:[.a] -> v:[.a], [u <= v, w <= x]
// Map three functions onto a triple.
maptriple :: x:(.a -> .b) w:(.c -> .d) v:(.e -> .f) -> u:((.a,.c,.e) -> (.b,.d,.f)), [u <= v, u <= w, u <= x]
// Pairwith pairs a value with its result under a given function
pairwith :: .(arg -> .res) arg -> (arg,.res)
// Partition a list.
// The first argument is a representer function that defines partition blocks.
// The second argument is a selector function that is applied to each element of each block.
partition :: (a -> b) (a -> .c) -> .(!.[a] -> [(b,[.c])]) | == b
// Plookup is a printable lookup with a more readable error message for the not found case.
plookup :: .(arg -> String) ![(arg,.res)] arg -> .res | == arg
// Power applies a function a number of times to a value.
power :: !Int (.t -> .t) -> .(.t -> .t)
// Printoptional produces a printable representation of an optional type.
printoptional :: .(.t -> String) !(Optional .t) -> String
// Proc is an argument-permuted variant of foldr
proc :: .((w:elem -> .(.res -> .res)) -> v:(![w:elem] -> u:(.res -> .res))), [u <= v, u <= w]
// `Relimg rel x' is the relational image of `x' in relation `rel' (represented by a table).
relimg :: ![(a,.b)] a -> [.b] | == a
// `Remap x y mapping' alters the mapping by associating y with x, removing the old values.
remap :: a b [.(a,b)] -> .[(a,b)] | == a
// `Shorter xs' determines whether a list is shorter than list `xs'.
shorter :: ![.a] [.b] -> .Bool
// `Showbool b' is the string representation of boolean `b'.
showbool :: .(!.Bool -> a) | fromBool a
// `Showoptional showa opt' is the string representation of optional value `opt',
// where `showa' determines the string representation of the inner value.
showoptional :: .(.a -> .String) !(Optional .a) -> String
// `Showpair showa showb pair' is the string representation of a pair,
// where showa and showb represent the internal types.
showpair :: !.(.a -> .String) !.(.b -> .String) !(.a,.b) -> String
// `Showstring s' represents a string as a string.
showstring :: .(!.String -> a) | fromString a
// `Showtriple' determines the string representation of a triple.
showtriple :: !.(.a -> .String) !.(.b -> .String) !.(.c -> .String) !(.a,.b,.c) -> String
// `Split sep' splits a list into a list of sublists which are separated by `sep'.
split :: a -> .(.[a] -> [.[a]]) | == a
// `Superset xs ys' determines whether ys is a superset (actually, super-multi-set or super-list) of xs.
superset :: .[a] -> .(.[a] -> Bool) | == a
implementation module basic
/*
Basic definitions
=================
Description
-----------
Basic types and functions.
*/
import StdEnv
/*
Implementation
--------------
*/
:: Optional t = Absent | Present t
// Adjust a function for a single argument
adjust :: !arg res (arg->res) !arg -> res | == arg
adjust a r f x
| x==a = r
= f x
// Claim a list of nodes from a heap
claim :: ![.param] u:[.cell] -> ([.cell],v:[.cell]), [u<=v]
claim [] heap = ([],heap)
claim [pnode:pnodes] [snode:heap]
= ([snode:snodes],heap`)
where (snodes,heap`) = claim pnodes heap
claim pnodes emptyheap = abort "claim: out of heap" // Just in case. Should be used with an infinite heap.
/* Depthfirst collects results of a function (called process), applied to a
given list of inputs and other inputs which are generated from the
results recursively, and so on. Duplicates are removed. */
depthfirst :: (res->.[elem]) (elem->res) !.[elem] -> .[res] | == elem
depthfirst generate process xs
= snd (collect xs ([],[]))
where collect [] seenrest = seenrest
collect [x:xs] (seen,rest)
| isMember x seen
= collect xs (seen,rest)
= (seen``,[y:rest``])
where (seen`,rest``) = collect (generate y) ([x:seen],rest`)
(seen``,rest`) = collect xs ( seen`,rest)
y = process x
// `Disjoint xs ys' checks whether xs and ys are disjoint.
disjoint :: .[elem] !.[elem] -> Bool | == elem
disjoint xs ys = not (or (map (flip isMember xs) ys))
eqlen :: ![.elem1] ![.elem2] -> .Bool
eqlen [x:xs] [y:ys] = eqlen xs ys
eqlen [] [] = True
eqlen xs ys = False
// `Foldlm' is a combination of foldl and map.
foldlm :: ((.collect,.elem) -> (.collect,.elem`)) !(.collect,![.elem]) -> (.collect,[.elem`])
foldlm f (l,[]) = (l,[])
foldlm f (l,[m:ms])
= (l``,[m`:ms`])
where (l`,m`) = f (l,m)
(l``,ms`) = foldlm f (l`,ms)
foldlr :: (.elem -> .((.lrinfo,.rlinfo) -> (.lrinfo,.rlinfo))) !(.lrinfo,.rlinfo) ![.elem] -> (.lrinfo,.rlinfo)
foldlr f (l,r) []
= (l,r)
foldlr f (l,r) [x:xs]
= (l``,r``)
where (l``,r`) = foldlr f (l`,r) xs
(l`,r``) = f x (l,r`)
foldmap :: (x:res -> w:res`) w:res` -> u:(![(arg,x:res)] -> v:(arg -> w:res`)) | == arg, [v u <= w, v <= x]
foldmap f d
= foldr foldmap` (const d)
where foldmap` (x,y) g v = if (x==v) (f y) (g v)
foldoptional :: .res .(.t -> .res) !(Optional .t) -> .res
foldoptional absent present Absent = absent
foldoptional absent present (Present x) = present x
forget :: val -> .(![.(val,res)] -> .[(val,res)]) | == val
forget x = filter (neq x o fst)
neq x y = x <> y
indent :: .String -> .([.String] -> .[String])
indent first = map2 (+++) [first:repeat (createArray (size first) ' ')]
map2 :: (.a -> .(.b -> .c)) ![.a] [.b] -> [.c]
map2 f [x:xs] [y:ys] = [f x y:map2 f xs ys]
map2 f _ _ = []
// `Identifiers' is the list of all identifiers
identifiers :: [String]
identifiers =: map toString (tl (kleene ['abcdefghijklmnopqrstuvwxyz']))
// `Intersect xs ys' is the intersection of list `ys' with list `xs'.
intersect :: ![elem] [elem] -> .[elem] | == elem
intersect [] _ = []
intersect [y:ys] xs = elim (cons y o intersect ys) (intersect ys xs) y xs
// Elim removes a given element from a list.
// There are two continuations, one for failure and one for success.
elim :: .(v:[elem] -> .res) .res elem u:[elem] -> .res | == elem, [u <= v]
elim found notfound y []
= notfound
elim found notfound y [x:xs]
| x==y
= found xs
= elim (found o cons x) notfound y xs
// Cons prepends an element to a list
cons :: .elem u:[.elem] -> v:[.elem], [u <= v]
cons x xs = [x:xs]
// `Join x xss' is the join of the list of lists `xss', separated by `x'.
join :: a ![.[a]] -> .[a]
join sep [] = []
join sep [x:xs] = x++flatten (map (cons sep) xs)
/* `Kleene xs' determines the kleene closure of the list `xs' of symbols,
i.e. all strings over that list in standard order. The implementation
is designed for maximum sharing.
*/
kleene :: !.[symbol] -> .[[symbol]]
kleene [] = [[]]
kleene symbols
= flatten (iterate prefix [[]])
where prefix strings
= flatten (map appendstrings symbols)
where appendstrings symbol = map (cons symbol) strings
lookup :: u:([(arg,w:res)] -> v:(arg -> w:res)) | == arg, [v u <= w]
lookup = foldmap id (abort "lookup: not found")
pairwith :: .(arg -> .res) arg -> (arg,.res)
pairwith f x = (x,f x)
plookup :: .(arg -> String) ![(arg,.res)] arg -> .res | == arg
plookup showa tbl a = foldmap id (abort (showa a+++": not found")) tbl a
power :: !Int (.t -> .t) -> .(.t -> .t)
power n f
| n <= 0
= id
= f o power (n-1) f
printoptional :: .(.t -> String) !(Optional .t) -> String
printoptional printa Absent = ""
printoptional printa (Present a) = printa a
proc :: .((w:elem -> .(.res -> .res)) -> v:(![w:elem] -> u:(.res -> .res))), [u <= v, u <= w]
proc = flip o foldr
mapfst :: v:(.a -> .b) -> u:((.a,.c) -> (.b,.c)), [u <= v]
mapfst f = app2 (f,id)
mapfst3 :: v:(.a -> .b) -> u:((.a,.c,.d) -> (.b,.c,.d)), [u <= v]
mapfst3 f = app3 (f,id,id)
maphd :: .(.a -> .a) !u:[.a] -> v:[.a], [u <= v]
maphd f [] = []
maphd f [x:xs] = [f x:xs]
mapoptional :: .(.a -> .b) !(Optional .a) -> Optional .b
mapoptional f Absent = Absent
mapoptional f (Present x) = Present (f x)
mappair :: .(.a -> .b) .(.c -> .d) !(.a,.c) -> (.b,.d)
mappair f g (x,y) = (f x,g y)
mapsnd :: v:(.a -> .b) -> u:((.c,.a) -> (.c,.b)), [u <= v]
mapsnd f = app2 (id,f)
maptl :: .(x:[.a] -> u:[.a]) !w:[.a] -> v:[.a], [u <= v, w <= x]
maptl f [] = []
maptl f [x:xs] = [x:f xs]
maptriple :: x:(.a -> .b) w:(.c -> .d) v:(.e -> .f) -> u:((.a,.c,.e) -> (.b,.d,.f)), [u <= v, u <= w, u <= x]
maptriple f g h = app3 (f,g,h)
partition :: (a -> b) (a -> .c) -> .(!.[a] -> [(b,[.c])]) | == b
partition f g
= h
where h [] = []
h [x:xs]
= [((r,[g x:ins])):h outs]
where ins = [g x\\x<-xs|f x==r]
outs = [x\\x<-xs|f x<>r]
r = f x
relimg :: ![(a,.b)] a -> [.b] | == a
relimg rel x` = [y\\(x,y)<-rel|x==x`]
remap :: a b [.(a,b)] -> .[(a,b)] | == a
remap x y xys = [(x,y):forget x xys]
shorter :: ![.a] [.b] -> .Bool
shorter [] yys = False
shorter [x:xs] [] = True
shorter [x:xs] [y:ys] = shorter xs ys
showbool :: .(!.Bool -> a) | fromBool a
showbool = fromBool
showoptional :: .(.a -> .String) !(Optional .a) -> String
showoptional showa Absent = "Absent"
showoptional showa (Present a) = "(Present "+++showa a+++")"
showpair :: !.(.a -> .String) !.(.b -> .String) !(.a,.b) -> String
showpair showa showb (a,b) = "("+++showa a+++","+++showb b+++")"
showstring :: .(!.String -> a) | fromString a
showstring = fromString
showtriple :: !.(.a -> .String) !.(.b -> .String) !.(.c -> .String) !(.a,.b,.c) -> String
showtriple showa showb showc (a,b,c) = "("+++showa a+++","+++showb b+++","+++showc c+++")"
split :: a -> .(.[a] -> [.[a]]) | == a
split sep
= uncurry cons o spl
where spl [] = ([],[])
spl [x:xs]
| x==sep
= ([],[ys:yss])
= ([x:ys],yss)
where (ys,yss) = spl xs
superset :: .[a] -> .(.[a] -> Bool) | == a
superset set = isEmpty o (removeMembers set)
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.uncurry typerule.split.relabel localheap
> 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)
> 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
> localheap = [0..]
------------------------------------------------------------------------
> foldarea :: (rgraph * **->*) -> rgraph * ** -> (*,[**])
> foldarea label rgraph
> = (label rgraph,foldsingleton single nosingle rgraph)
> where single root sym args = args
> nosingle = snd (nodeset (rgraphgraph rgraph) [rgraphroot 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 = nodecontents 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
> 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
This diff is collapsed.
cli.lit - Clean implementation modules
======================================
Description
-----------
This script implements Clean modules (type module) and partial Clean
programs (type cli), which are essentially sets of Clean modules.
------------------------------------------------------------