Commit bab00d3b by Mart Lubbers

### Fix funcmayfail buggery

parent 36c17fcd
Pipeline #15385 passed with stage
in 1 minute and 36 seconds
 ... ... @@ -37,7 +37,7 @@ instance < (LPath a) | gLexOrd{|*|} a where // and the remaining 'Graph'. defMatchAny :: (gr a b) -> GDecomp gr a b | Graph gr defMatchAny g = case labNodes g of [] -> abort "Match Exception, Empty Graph" _ -> abort "Match Exception, Empty Graph" [(v,_):_] -> (c,g`) where (Just c,g`) = match v g ... ...
 ... ... @@ -22,7 +22,7 @@ findP v [LP (p=:[(w,_):_]):ps] | v==w = p | otherwise = findP v ps getPath :: Node RTree -> Path getPath v t = (reverse o first (\[w:_]->w==v)) t getPath v t = (reverse o first (\w->hd w==v)) t getLPath :: Node (LRTree a) -> LPath a getLPath v t = (LP o reverse o findP v) t ... ...
 ... ... @@ -37,7 +37,9 @@ defMatchAnyM :: (m (gr a b)) -> m (GDecomp gr a b) | GraphM m gr defMatchAnyM g = labNodesM g >>= \vs -> case vs of [] -> abort "Match Exception, Empty Graph" [(v,_):_] -> matchM v g >>= \(Just c,g`) -> pure (c,g`) [(v,_):_] -> matchM v g >>= \t->case t of (Just c,g`) -> pure (c,g`) _ -> abort "No Match" defNoNodesM :: (m (gr a b)) -> m Int | GraphM m gr defNoNodesM m = (labNodesM >>. length) m ... ...
 ... ... @@ -5,7 +5,6 @@ implementation module Data.Graph.Inductive.NodeMap //import Control.Monad.Trans.State // TODO Implement monadic interface import Control.Monad, Control.Applicative, Data.Functor import StdOverloaded, StdBool, StdClass, StdTuple, StdInt from StdFunc import o import Data.Maybe //import Data.Graph.Inductive.Graph from Data.Graph.Inductive.Graph import class Graph, class DynGraph, :: LNode, :: Node, :: LEdge, :: Edge ... ... @@ -13,6 +12,8 @@ import qualified Data.Graph.Inductive.Graph from Data.Map import :: Map, instance == (Map k v) import qualified Data.Map import qualified Data.List import Data.Func import StdEnv :: NodeMap a = { map :: Map a Node ... ... @@ -85,7 +86,7 @@ insMapNode_ m a g = insMapEdge :: (NodeMap a) (a, a, b) (g a b) -> g a b | Ord a & DynGraph g insMapEdge m e g = let (Just e`) = mkEdge m e let e` = maybe (abort "shouldn't happen") id \$ mkEdge m e in 'Data.Graph.Inductive.Graph'.insEdge e` g delMapNode :: (NodeMap a) a (g a b) -> g a b | Ord a & DynGraph g ... ... @@ -95,7 +96,7 @@ delMapNode m a g = delMapEdge :: (NodeMap a) (a, a) (g a b) -> g a b | Ord a & DynGraph g delMapEdge m (n1, n2) g = let (Just (n1`, n2`, _)) = mkEdge m (n1, n2, ()) let (n1`, n2`, _) = maybe (abort "shouldn't happen") id \$ mkEdge m (n1, n2, ()) in 'Data.Graph.Inductive.Graph'.delEdge (n1`, n2`) g insMapNodes :: (NodeMap a) [a] (g a b) -> (g a b, NodeMap a, [LNode a]) | Ord a & DynGraph g ... ... @@ -110,7 +111,7 @@ insMapNodes_ m as g = insMapEdges :: (NodeMap a) [(a, a, b)] (g a b) -> g a b | Ord a & DynGraph g insMapEdges m es g = let (Just es`) = mkEdges m es let es` = maybe (abort "Shouldn't happen") id \$ mkEdges m es in 'Data.Graph.Inductive.Graph'.insEdges es` g delMapNodes :: (NodeMap a) [a] (g a b) -> g a b | Ord a & DynGraph g ... ... @@ -120,14 +121,14 @@ delMapNodes m as g = delMapEdges :: (NodeMap a) [(a, a)] (g a b) -> g a b | Ord a & DynGraph g delMapEdges m ns g = let (Just ns`) = mkEdges m ('Data.List'.map (\(a, b) -> (a, b, ())) ns) let ns` = maybe (abort "shouldn't happen") id \$ mkEdges m ('Data.List'.map (\(a, b) -> (a, b, ())) ns) ns`` = 'Data.List'.map (\(a, b, _) -> (a, b)) ns` in 'Data.Graph.Inductive.Graph'.delEdges ns`` g mkMapGraph :: [a] [(a, a, b)] -> (g a b, NodeMap a) | Ord a & DynGraph g mkMapGraph ns es = let (ns`, m`) = mkNodes new ns (Just es`) = mkEdges m` es es` = maybe (abort "shouldn't happen") id \$ mkEdges m` es in ('Data.Graph.Inductive.Graph'.mkGraph ns` es`, m`) // | Graph construction monad; handles passing both the `NodeMap` and the ... ...
 ... ... @@ -3,7 +3,7 @@ implementation module Data.Graph.Inductive.Query.BFS import StdBool, StdFunc import StdMisc,StdBool, StdFunc import Data.List import Data.Maybe import Data.Graph.Inductive.Graph ... ... @@ -47,7 +47,7 @@ leveln _ g | isEmptyGraph g = [] leveln [(v,j):vs] g = case match v g of (Just c,g`) -> [(v,j):leveln (vs++suci c (j+1)) g`] (Nothing,g`) -> leveln vs g` leveln _ _ = abort "Shouldn't happen" // bfe (breadth first edges) // remembers predecessor information ... ... @@ -90,17 +90,17 @@ bft :: Node (gr a b) -> RTree | Graph gr bft v g = bf (queuePut [v] mkQueue) g bf :: (Queue Path) (gr a b) -> RTree | Graph gr bf q g | queueEmpty q || isEmptyGraph g = [] | otherwise = let (p=:[v:_],q`) = queueGet q in case match v g of (Just c, g`) -> [p:bf (queuePutList (map (\x -> [x:p]) (suc` c)) q`) g`] (Nothing, g`) -> bf q` g` bf q g | queueEmpty q || isEmptyGraph g = [] = case queueGet q of (p=:[v:_],q`) = case match v g of (Just c, g`) = [p:bf (queuePutList (map (\x -> [x:p]) (suc` c)) q`) g`] (Nothing, g`) = bf q` g` (_,_) = abort "shouldn't happen" esp :: Node Node (gr a b) -> Path | Graph gr esp s t g = (getPath t o bft s) g // lesp is a version of esp that returns labeled paths // Note that the label of the first node in a returned path is meaningless; // all other nodes are paired with the label of their incoming edge. ... ... @@ -112,13 +112,14 @@ lbft v g = case out g v of lbf :: (Queue (LPath b)) (gr a b) -> LRTree b | Graph gr lbf q g | queueEmpty q || isEmptyGraph g = [] | otherwise = let (LP (p=:[(v,_):_]),q`) = queueGet q in case match v g of (Just c, g`) -> [LP p:lbf (queuePutList (map (\v` -> LP [v`:p]) (lsuc` c)) q`) g`] (Nothing, g`) -> lbf q` g` lbf q g | queueEmpty q || isEmptyGraph g = [] = case queueGet q of (LP (p=:[(v,_):_]),q`) = case match v g of (Just c, g`) = [LP p:lbf (queuePutList (map (\v` -> LP [v`:p]) (lsuc` c)) q`) g`] (Nothing, g`) = lbf q` g` _ = abort "Shouldn't happen" lesp :: Node Node (gr a b) -> LPath b | Graph gr lesp s t g = (getLPath t o lbft s) g
 ... ... @@ -44,6 +44,7 @@ instance == (Heap a) where go f [x:xs] [y:ys] = f x y && f y x && go f xs ys go _ [] [] = True go _ _ _ = False (==) _ _ = False instance < (Heap a) where < Empty Empty = False ... ... @@ -60,6 +61,7 @@ instance < (Heap a) where go f [] [] = False go f [] [_:_] = True go f [_:_] [] = False < _ _ = False // /O(1)/. Is the heap empty? ... ...
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!