Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Fredrik Wieczerkowski
curry-libs
Commits
b3a5be87
Commit
b3a5be87
authored
Nov 23, 2018
by
Michael Hanus
Browse files
Adds Distribution.curryCompilerRevisionVersion, removes Array and SCC
parent
deafaa9e
Changes
5
Hide whitespace changes
Inline
Side-by-side
Array.curry
deleted
100644 → 0
View file @
deafaa9e
--- Implementation of Arrays with Braun Trees. Conceptually, Braun trees
--- are always infinite. Consequently, there is no test on emptiness.
---
--- @authors {bbr, fhu}@informatik.uni-kiel.de
--- @category algorithm
module Array
(Array,
emptyErrorArray, emptyDefaultArray,
listToDefaultArray,listToErrorArray,
(//), update, applyAt,
(!),
combine, combineSimilar)
where
import Integer
infixl 9 !, //
data Array b = Array (Int -> b) (Entry b)
data Entry b = Entry b (Entry b) (Entry b) | Empty
--- Creates an empty array which generates errors for non-initialized
--- indexes.
emptyErrorArray :: Array b
emptyErrorArray = emptyDefaultArray errorArray
errorArray :: Int -> _
errorArray idx = error ("Array index "++show idx++" not initialized")
--- Creates an empty array, call given function for non-initialized
--- indexes.
--- @param default - function to call for each non-initialized index
emptyDefaultArray :: (Int -> b) -> Array b
emptyDefaultArray dflt = Array dflt Empty
--- Inserts a list of entries into an array.
--- @param array - array to modify
--- @param modifications - list of new (indexes,entries)
--- If an index in the list was already initialized, the old value
--- will be overwritten. Likewise the last entry with a given index
--- will be contained in the result array.
(//) :: Array b -> [(Int,b)] -> Array b
(//) (Array dflt array) modifications =
Array dflt
(foldr (\ (n,v) a -> at (dflt n) a n (const v)) array modifications)
--- Inserts a new entry into an array.
--- @param array - array to modify
--- @param idx - index of update
--- @param val - value to update at index idx
--- Entries already initialized will be overwritten.
update :: Array b -> Int -> b -> Array b
update (Array dflt a) i v =
Array dflt (at (dflt i) a i (const v))
--- Applies a function to an element.
--- @param array - array to modify
--- @param idx - index of update
--- @param fun - function to apply on element at index idx
applyAt :: Array b -> Int -> (b->b) -> Array b
applyAt (Array dflt a) n f = Array dflt (at (dflt n) a n f)
at :: b -> Entry b -> Int -> (b -> b) -> Entry b
at dflt Empty n f
| n==0 = Entry (f dflt) Empty Empty
| odd n = Entry dflt (at dflt Empty (n `div` 2) f) Empty
| otherwise = Entry dflt Empty (at dflt Empty (n `div` 2 - 1) f)
at dflt (Entry v al ar) n f
| n==0 = Entry (f v) al ar
| odd n = Entry v (at dflt al (n `div` 2) f) ar
| otherwise = Entry v al (at dflt ar (n `div` 2 - 1) f)
--- Yields the value at a given position.
--- @param a - array to look up in
--- @param n - index, where to look
(!) :: Array b -> Int -> b
(Array dflt array) ! i = from (dflt i) array i
from :: a -> Entry a -> Int -> a
from dflt Empty _ = dflt
from dflt (Entry v al ar) n
| n==0 = v
| odd n = from dflt al (n `div` 2)
| otherwise = from dflt ar (n `div` 2 - 1)
split :: [a] -> ([a],[a])
split [] = ([],[])
split [x] = ([x],[])
split (x:y:xys) = let (xs,ys) = split xys in
(x:xs,y:ys)
--- Creates a default array from a list of entries.
--- @param def - default funtion for non-initialized indexes
--- @param xs - list of entries
listToDefaultArray :: (Int -> b) -> [b] -> Array b
listToDefaultArray def = Array def . listToArray
--- Creates an error array from a list of entries.
--- @param xs - list of entries
listToErrorArray :: [b] -> Array b
listToErrorArray = listToDefaultArray errorArray
listToArray :: [b] -> Entry b
listToArray [] = Empty
listToArray (x:xs) = let (ys,zs) = split xs in
Entry x (listToArray ys)
(listToArray zs)
--- combine two arbitrary arrays
combine :: (a -> b -> c) -> Array a -> Array b -> Array c
combine f (Array def1 a1) (Array def2 a2) =
Array (\i -> f (def1 i) (def2 i)) (comb f def1 def2 a1 a2 0 1)
comb :: (a -> b -> c) -> (Int -> a) -> (Int -> b)
-> Entry a -> Entry b -> Int -> Int -> Entry c
comb _ _ _ Empty Empty _ _ = Empty
comb f def1 def2 (Entry x xl xr) Empty b o =
Entry (f x (def2 (b+o-1)))
(comb f def1 def2 xl Empty (2*b) o)
(comb f def1 def2 xr Empty (2*b) (o+b))
comb f def1 def2 Empty (Entry y yl yr) b o =
Entry (f (def1 (b+o-1)) y)
(comb f def1 def2 Empty yl (2*b) o)
(comb f def1 def2 Empty yr (2*b) (o+b))
comb f def1 def2 (Entry x xl xr) (Entry y yl yr) b o =
Entry (f x y)
(comb f def1 def2 xl yl (2*b) o)
(comb f def1 def2 xr yr (2*b) (o+b))
--- the combination of two arrays with identical default function
--- and a combinator which is neutral in the default
--- can be implemented much more efficient
combineSimilar :: (a -> a -> a) -> Array a -> Array a -> Array a
combineSimilar f (Array def a1) (Array _ a2) = Array def (combSim f a1 a2)
combSim :: (a -> a -> a) -> Entry a -> Entry a -> Entry a
combSim _ Empty a2 = a2
combSim _ (Entry x y z) Empty = Entry x y z
combSim f (Entry x xl xr) (Entry y yl yr) =
Entry (f x y) (combSim f xl yl) (combSim f xr yr)
Distribution.curry
View file @
b3a5be87
...
...
@@ -4,12 +4,13 @@
--- compiler version, load paths, front end.
---
--- @author Bernd Brassel, Michael Hanus, Bjoern Peemoeller, Finn Teegen
--- @version
July
201
7
--- @version
November
201
8
--- @category general
--------------------------------------------------------------------------------
module Distribution (
curryCompiler, curryCompilerMajorVersion, curryCompilerMinorVersion,
curryCompilerRevisionVersion,
curryRuntime, curryRuntimeMajorVersion, curryRuntimeMinorVersion,
baseVersion, installDir, stripCurrySuffix, modNameToPath,
currySubdir, inCurrySubdir, addCurrySubdir,
...
...
@@ -67,6 +68,10 @@ curryCompilerMajorVersion external
curryCompilerMinorVersion :: Int
curryCompilerMinorVersion external
--- The revision version number of the Curry compiler.
curryCompilerRevisionVersion :: Int
curryCompilerRevisionVersion external
--- The name of the run-time environment (e.g., "sicstus", "swi", or "ghc")
curryRuntime :: String
curryRuntime external
...
...
Distribution.kics2
View file @
b3a5be87
...
...
@@ -9,6 +9,9 @@ external_d_C_curryCompilerMajorVersion _ _ = toCurry I.majorVersion
external_d_C_curryCompilerMinorVersion :: Cover -> ConstStore -> Curry_Prelude.C_Int
external_d_C_curryCompilerMinorVersion _ _ = toCurry I.minorVersion
external_d_C_curryCompilerRevisionVersion :: Cover -> ConstStore -> Curry_Prelude.C_Int
external_d_C_curryCompilerRevisionVersion _ _ = toCurry I.revisionVersion
external_d_C_curryRuntime :: Cover -> ConstStore -> Curry_Prelude.C_String
external_d_C_curryRuntime _ _ = toCurry I.runtime
...
...
Distribution.pakcs
View file @
b3a5be87
...
...
@@ -13,6 +13,10 @@
<library>
prim_distribution
</library>
<entry>
prim_curryCompilerMinorVersion
</entry>
</primitive>
<primitive
name=
"curryCompilerRevisionVersion"
arity=
"0"
>
<library>
prim_distribution
</library>
<entry>
prim_curryCompilerRevisionVersion
</entry>
</primitive>
<primitive
name=
"curryRuntime"
arity=
"0"
>
<library>
prim_distribution
</library>
<entry>
prim_curryRuntime
</entry>
...
...
SCC.curry
deleted
100644 → 0
View file @
deafaa9e
--- ----------------------------------------------------------------------------
--- Computing strongly connected components
---
--- Copyright (c) 2000 - 2003, Wolfgang Lux
--- See LICENSE for the full license.
---
--- The function `scc` computes the strongly connected components of a list
--- of entities in two steps. First, the list is topologically sorted
--- "downwards" using the *defines* relation.
--- Then the resulting list is sorted "upwards" using the *uses* relation
--- and partitioned into the connected components. Both relations
--- are computed within this module using the bound and free names of each
--- declaration.
---
--- In order to avoid useless recomputations, the code in the module first
--- decorates the declarations with their bound and free names and a
--- unique number. The latter is only used to provide a trivial ordering
--- so that the declarations can be used as set elements.
---
--- @author Wolfgang Lux
--- @category algorithm
--- ----------------------------------------------------------------------------
module SCC (scc) where
import SetRBT (emptySetRBT, elemRBT, insertRBT)
data Node a b = Node Int [b] [b] a
deriving Eq
cmpNode :: Node a b -> Node a b -> Bool
cmpNode n1 n2 = key n1 < key n2
key :: Node a b -> Int
key (Node k _ _ _) = k
bvs :: Node a b -> [b]
bvs (Node _ bs _ _) = bs
fvs :: Node a b -> [b]
fvs (Node _ _ fs _) = fs
node :: Node a b -> a
node (Node _ _ _ n) = n
--- Computes the strongly connected components of a list
--- of entities. To be flexible, we distinguish the nodes and
--- the entities defined in this node.
---
--- @param defines - maps each node to the entities defined in this node
--- @param uses - maps each node to the entities used in this node
--- @param nodes - the list of nodes which should be sorted into
--- strongly connected components
--- @return the strongly connected components of the list of nodes
scc :: (Eq a, Eq b) =>
(a -> [b]) -- ^ entities defined by node
-> (a -> [b]) -- ^ entities used by node
-> [a] -- ^ list of nodes
-> [[a]] -- ^ strongly connected components
scc bvs' fvs' = map (map node) . tsort' . tsort . zipWith wrap [0 ..]
where wrap i n = Node i (bvs' n) (fvs' n) n
tsort :: (Eq a, Eq b) => [Node a b] -> [Node a b]
tsort xs = snd (dfs xs (emptySetRBT cmpNode) [])
where
dfs [] marks stack = (marks, stack)
dfs (x : xs') marks stack
| x `elemRBT` marks = dfs xs' marks stack
| otherwise = dfs xs' marks' (x : stack')
where
(marks', stack') = dfs (defs x) (x `insertRBT` marks) stack
defs x1 = filter (any (`elem` fvs x1) . bvs) xs
tsort' :: (Eq a, Eq b) => [Node a b] -> [[Node a b]]
tsort' xs = snd (dfs xs (emptySetRBT cmpNode) [])
where
dfs [] marks stack = (marks, stack)
dfs (x : xs') marks stack
| x `elemRBT` marks = dfs xs' marks stack
| otherwise = dfs xs' marks' ((x : concat stack') : stack)
where
(marks', stack') = dfs (uses x) (x `insertRBT` marks) []
uses x1 = filter (any (`elem` bvs x1) . fvs) xs
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment