concChoiceSuffix

Author: adamburkegh

src/main/haskell/Toothpaste.hs

@@ -350,19 +350,31 @@ concFromChoiceList ptl
 concFromSeqList :: (Ord a) => [PPTree a] -> [PPTree a]
 concFromSeqList ptl 
     | length rs /= length hds 
-        = map (uncurry convertConcMapEntryToNode) (Map.toList rs)
+        = map (uncurry convertConcMapEntryToNodePrefix) (Map.toList rs)
     | otherwise               = ptl
     where (hds,tls) = unzip $ map (splitAt 2 . children) ptl
           rs        = concMapFromSeqChildren hds tls
 
-convertConcMapEntryToNode :: (Ord a) => [PPTree a] -> [[PPTree a]] -> PPTree a
-convertConcMapEntryToNode ptl tptl 
+
+
+convertConcMapEntryToNode :: (Ord a) => 
+    ([PPTree a] -> [PPTree a]) -> [PPTree a] -> [[PPTree a]] 
+        -> PPTree a
+convertConcMapEntryToNode frc ptl tptl 
     | onlySilent cr = concP ptl w
-    | otherwise     = seqP [concP ptl w, cr] w
+    | otherwise     = seqP (frc [concP ptl w, cr]) w
     where w    = sum $ map weight ptl
           cc   = mapMaybe convertConcTailEntry tptl 
           cr   = singleNodeOp $ choiceSim $ choiceP cc w 
 
+convertConcMapEntryToNodePrefix :: (Ord a) => 
+    [PPTree a] -> [[PPTree a]] -> PPTree a
+convertConcMapEntryToNodePrefix = convertConcMapEntryToNode id
+
+convertConcMapEntryToNodeSuffix :: (Ord a) => 
+    [PPTree a] -> [[PPTree a]] -> PPTree a
+convertConcMapEntryToNodeSuffix = convertConcMapEntryToNode reverse
+
 onlySilent :: PPTree a -> Bool
 onlySilent (Silent w) = True
 onlySilent pt         = False
@@ -452,7 +464,7 @@ mergeConcPairT (ptx1,pty1) (ptx2,pty2)
 
 
 concFromChoiceSuff :: (Eq a, Ord a) => PRule a
-concFromChoiceSuff = choiceChildMR concFromChoiceList 
+concFromChoiceSuff = choiceChildMR concFromChoiceListSuff 
 
 concFromChoiceListSuff :: (Eq a, Ord a) => LRule a
 concFromChoiceListSuff ptl
@@ -462,18 +474,19 @@ concFromChoiceListSuff ptl
           fl = filter (not . isNontrivSeq) ptl
           rs = concFromSeqListSuff sq
 
-tail2 :: [a] -> [a]
-tail2 (x:y:xs)  | null xs    = [x,y]
-                | otherwise  = tail2 (y:xs)
-tail2 [x] = []
-tail2 [] = []
+tail2 :: [a] -> ([a],[a])
+tail2 (x:y:xs)  | null xs    = ([],[x,y])
+                | otherwise  = (x:nh,nt) 
+    where (nh,nt) = tail2 (y:xs)
+tail2 [x]   = ([],[])
+tail2 []    = ([],[])
 
 concFromSeqListSuff :: (Ord a) => [PPTree a] -> [PPTree a]
 concFromSeqListSuff ptl 
     | length rs /= length hds 
-        = map (uncurry convertConcMapEntryToNode) (Map.toList rs)
+        = map (uncurry convertConcMapEntryToNodeSuffix) (Map.toList rs)
     | otherwise               = ptl
-    where (hds,tls) = unzip $ map (splitAt 2 . children) ptl
+    where (hds,tls) = unzip $ map (tail2 . children) ptl
           rs        = concMapFromSeqChildren tls hds
 
 

src/test/haskell/ToothpasteTest.hs

@@ -31,7 +31,10 @@ sba2 = NodeN Seq [lb2,la2] 2
 sbc2 = seqP [lb2,lc2] 2
 sbad2  = NodeN Seq [lb2,la2,ld2] 2
 sca = seqP [lc,la] 1
-sdb2 = seqP [ld2,lb2] 1
+scab = seqP [lc,la,lb] 1
+scb2 = seqP [lc2,lb2] 2
+sdba2 = seqP [ld2,lb2,la2] 2
+sdb2  = seqP [ld2,lb2] 2
 
 ccab1 = NodeN Conc [la,lb] 2
 
@@ -414,15 +417,14 @@ concFromChoicePrefTests = [
                             ~=? concFromChoice( NodeN Choice [sabc,sbad2] 3) 
                             ]
 
--- TODO many more len > 2 cases at different levels
+-- more len > 2 cases at different levels wouldn't hurt
 
-emptyPPTL :: [PPTree Int] 
-emptyPPTL = []
 
-tail2Tests = [ "empty" ~: emptyPPTL ~=? tail2 [],
-               "l1" ~: [] ~=? tail2 [1],
-               "l2" ~: [1,2] ~=? tail2 [1,2],
-               "l3" ~: [2,3] ~=? tail2 [1,2,3]
+tail2Tests = [ "empty" ~: ([]::[Int],[]::[Int]) ~=? tail2 ([]::[Int] ),
+               "l1" ~: ([],[]) ~=? tail2 [1],
+               "l2" ~: ([],[1,2]) ~=? tail2 [1,2],
+               "l3" ~: ([1],[2,3]) ~=? tail2 [1,2,3],
+               "l4" ~: ([4,5],[7,8]) ~=? tail2 [4,5,7,8] 
                ]
 
 concFromChoiceSuffTests = [ 
@@ -431,14 +433,12 @@ concFromChoiceSuffTests = [
     "cfcs1" ~: concP [la,lb] 2 
                         ~=? concFromChoiceSuff( NodeN Choice [sab,sba] 2),
     "cfcs2" ~: concP [la,lb2] 3 
-                        ~=? concFromChoiceSuff( NodeN Choice [sab,sba2] 3) 
-    -- fail due to suff bug TODO
-    -- "cfcs5" ~: seqP [ choiceP [la, Silent 2] 3, 
-    --                   concP [lb,lc2] 3] 3 
-    --                     ~=? concFromChoiceSuff( NodeN Choice [sabc,sbc2] 3),
-    -- fail due to suff bug TODO
-    -- "cfcs6" ~: seqP [ choiceP [lc,ld2] 3,  concP [la,lb2 ] 3 ] 3
-    --                     ~=? concFromChoiceSuff( NodeN Choice [sca,sdb2] 3) 
+                        ~=? concFromChoiceSuff( NodeN Choice [sab,sba2] 3),
+    "cfcs3" ~: seqP [ choiceP [la, Silent 2] 3, 
+                      concP [lb,lc2] 3] 3 
+                        ~=? concFromChoiceSuff( NodeN Choice [sabc,scb2] 3),
+    "cfcs4" ~: seqP [ choiceP [lc,ld2] 3,  concP [la,lb2 ] 3 ] 3
+                        ~=? concFromChoiceSuff( NodeN Choice [scab,sdba2] 3) 
     ]
 
 concFromChoiceTests = concFromChoicePrefTests