Permalink
Browse files

initial

  • Loading branch information...
1 parent 417ab3e commit c9fcc34aa230800319608c453488e44e3e7383c2 @atzedijkstra atzedijkstra committed Nov 27, 2012
View
@@ -0,0 +1,41 @@
+The Utrecht Haskell Compiler (UHC) License
+==========================================
+
+UHC follows the advertisement free BSD license, of which the basic
+template can be found here:
+
+ http://www.opensource.org/licenses/bsd-license.php
+
+UHC uses the following libraries with their own license:
+- Library code from the GHC distribution, see comment in the modules in ehclib
+
+License text
+============
+
+Copyright (c) 2009-2010, Utrecht University, Department of Information
+and Computing Sciences, Software Technology group
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
View
@@ -1,4 +1,14 @@
uhc-utils
=========
-Utilities required by UHC (Utrecht Haskell Compiler)
+Utilities required by UHC (Utrecht Haskell Compiler)
+
+
+status/disclamer
+================
+
+Currently the source code is just factored out of UHC, minimally
+commented, all modules in UHC.Util, not yet properly spread using naming
+conventions. Also, some of the modules have become obsolete over time,
+so will someday be removed, to be replaced by other libraries. In other
+words, the library is intended for UHC only.
View
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
View
Binary file not shown.
@@ -0,0 +1,61 @@
+-------------------------------------------------------------------------
+-- Interface to inductive graph library, by Gerrit vd Geest
+-------------------------------------------------------------------------
+
+module UHC.Util.AGraph
+ ( AGraph(agraphGraph)
+ , insertEdge
+ , insertEdges
+ , deleteEdge
+ , deleteNode
+ , successors
+ , predecessors
+ , emptyAGraph
+ )
+ where
+
+import Data.Graph.Inductive.Graph (empty, insNodes, gelem, lab, lpre, lsuc, delEdge, delNode)
+import Data.Graph.Inductive.NodeMap (NodeMap, new, mkNodes, mkNode_, insMapEdge)
+import Data.Graph.Inductive.Tree (Gr)
+import Data.Graph.Inductive.Graphviz (graphviz')
+
+import Data.Maybe (fromJust)
+import Data.List(nub)
+
+data AGraph a b = AGr { agraphNodeMap :: NodeMap a, agraphGraph :: Gr a b}
+
+instance (Show a, Show b) => Show (AGraph a b) where
+ show (AGr _ gr) = graphviz' gr
+
+insertEdges :: Ord a => [(a, a, b)] -> AGraph a b -> AGraph a b
+insertEdges = flip (foldr insertEdge)
+
+insertEdge :: Ord a => (a, a, b) -> AGraph a b -> AGraph a b
+insertEdge e@(p, q, _) gr = let (AGr nm' gr') = insMapNodes (p:[q]) gr
+ in AGr nm' (insMapEdge nm' e gr')
+
+deleteEdge :: Ord a => (a, a) -> AGraph a b -> AGraph a b
+deleteEdge (p, q) (AGr nm gr) = AGr nm (delEdge (getId p, getId q) gr)
+ where getId nd = fst $ mkNode_ nm nd
+
+deleteNode :: Ord a => a -> AGraph a b -> AGraph a b
+deleteNode p (AGr nm gr) = AGr nm (delNode (getId p) gr)
+ where getId nd = fst $ mkNode_ nm nd
+
+insMapNodes :: Ord a => [a] -> AGraph a b -> AGraph a b
+insMapNodes as (AGr m g) =
+ let (ns, m') = mkNodes m (nub as)
+ ns' = filter (\(i, _) -> not $ gelem i g) ns
+ in AGr m' (insNodes ns' g)
+
+successors, predecessors :: Ord a => AGraph a b -> a -> [(b, a)]
+successors = neighbours lsuc
+predecessors = neighbours lpre
+
+emptyAGraph :: Ord a => AGraph a b
+emptyAGraph = AGr new empty
+
+neighbours dir (AGr nm gr) node
+ | nd `gelem` gr = map (\(n, info) -> (info, fromJust $ lab gr n)) (dir gr nd)
+ | otherwise = []
+ where nd = fst $ mkNode_ nm node
@@ -0,0 +1,75 @@
+-------------------------------------------------------------------------
+-- Wrapper module around Data.Binary, providing additional functionality
+-------------------------------------------------------------------------
+
+module UHC.Util.Binary
+ ( module Data.Binary
+ , module Data.Binary.Get
+ , module Data.Binary.Put
+
+ , hGetBinary
+ , getBinaryFile
+ , getBinaryFPath
+
+ , hPutBinary
+ , putBinaryFile
+ , putBinaryFPath
+ )
+ where
+
+import qualified Data.ByteString.Lazy as L
+import Data.Binary
+import Data.Binary.Put(runPut,putWord16be)
+import Data.Binary.Get(runGet,getWord16be)
+import System.IO
+import Control.Monad
+
+import UHC.Util.FPath
+
+-------------------------------------------------------------------------
+-- Decoding from ...
+-------------------------------------------------------------------------
+
+-- | Decode from Handle
+hGetBinary :: Binary a => Handle -> IO a
+hGetBinary h
+ = liftM decode (L.hGetContents h)
+
+-- | Decode from FilePath
+getBinaryFile :: Binary a => FilePath -> IO a
+getBinaryFile fn
+ = do { h <- openBinaryFile fn ReadMode
+ ; b <- hGetBinary h
+ -- ; hClose h
+ ; return b ;
+ }
+
+-- | Decode from FilePath
+getBinaryFPath :: Binary a => FPath -> IO a
+getBinaryFPath fp
+ = getBinaryFile (fpathToStr fp)
+
+-------------------------------------------------------------------------
+-- Encoding to ...
+-------------------------------------------------------------------------
+
+-- | Encode to Handle
+hPutBinary :: Binary a => Handle -> a -> IO ()
+hPutBinary h pt
+ = L.hPut h (encode pt)
+
+-- | Encode to FilePath
+putBinaryFile :: Binary a => FilePath -> a -> IO ()
+putBinaryFile fn pt
+ = do { h <- openBinaryFile fn WriteMode
+ ; hPutBinary h pt
+ ; hClose h
+ }
+
+-- | Encode to FPath, ensuring existence of path
+putBinaryFPath :: Binary a => FPath -> a -> IO ()
+putBinaryFPath fp pt
+ = do { fpathEnsureExists fp
+ ; putBinaryFile (fpathToStr fp) pt
+ }
+
Oops, something went wrong.

0 comments on commit c9fcc34

Please sign in to comment.