Commit bab00d3b authored by Mart Lubbers's avatar 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!
Please register or to comment