From b9d0012f6b957446fdf82509469e2fbbe260285a Mon Sep 17 00:00:00 2001
From: Inari Listenmaa <inari.listenmaa@gmail.com>
Date: Fri, 6 Apr 2018 16:32:58 +0200
Subject: Add a tool to generate test cases for GF grammars

---
 src/tools/gftest/EqRel.hs | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)
 create mode 100644 src/tools/gftest/EqRel.hs

(limited to 'src/tools/gftest/EqRel.hs')

diff --git a/src/tools/gftest/EqRel.hs b/src/tools/gftest/EqRel.hs
new file mode 100644
index 000000000..823900ae0
--- /dev/null
+++ b/src/tools/gftest/EqRel.hs
@@ -0,0 +1,32 @@
+module EqRel where
+
+import qualified Data.Map as M
+import Data.List ( sort )
+
+data EqRel a = Top | Classes [[a]] deriving (Eq,Ord,Show)
+
+(/\) :: (Ord a) => EqRel a -> EqRel a -> EqRel a
+Top /\ r = r
+r /\ Top = r
+Classes xss /\ Classes yss = Classes $ sort $ map sort $ concat -- maybe throw away singleton lists?
+  [ M.elems tabXs 
+  | xs <- xss 
+  , let tabXs = M.fromListWith (++) 
+                   [ (tabYs M.! x, [x])
+                   | x <- xs ] 
+  ]
+
+ where
+  tabYs = M.fromList [ (y,representative)
+                     | ys <- yss
+                     , let representative = head ys 
+                     , y <- ys ]
+
+basic :: (Ord a) => [a] -> EqRel Int
+basic xs = Classes $ sort $ map sort $ M.elems $ M.fromListWith (++) 
+  [ (x,[i]) | (x,i) <- zip xs [0..] ]
+
+rep :: EqRel Int -> Int -> Int
+rep Top j           = 0
+rep (Classes xss) j = head [ head xs | xs <- xss, j `elem` xs ]
+
-- 
cgit v1.2.3