-- Copy language L = { ww | w € {a,b}^* }
module ADP.Tests.CopyExample where

import ADP.Multi.All
import ADP.Multi.Rewriting.All

import MCFG.MCFG
                                 
type Copy_Algebra alphabet answerDim1 answerDim2 = (
  (EPS,EPS)  -> answerDim2,                         -- nil
  answerDim2 -> answerDim1,                         -- copy
  alphabet -> alphabet -> answerDim2 -> answerDim2  -- copy'
  )

data Start = Nil
           | Copy Start
           | Copy' Char Char Start
           deriving (Eq, Show)

-- without consistency checks
enum :: Copy_Algebra Char Start Start
enum = (nil,copy,copy') where
   nil _ = Nil
   copy  = Copy
   copy' = Copy'

-- MCFG grammar in Waldmann's data types, used for consistency checking 
mcfg :: MCFG
mcfg = MCFG 
  { start = N 1 "S"
  , rules = [ Rule { lhs = N 1 "S"
                   , function = [[Left (0,0), Left (0,1) ]]
                   , rhs = [ N 2 "X" ]
                   }
            , Rule { lhs = N 2 "X"
                   , function = 
                     [[ Right $ T 'a', Left (0,0) ]
                     ,[ Right $ T 'a', Left (0,1) ]
                     ]
                   , rhs = [N 2 "X"]
                   }
            , Rule { lhs = N 2 "X"
                   , function = 
                     [[ Right $ T 'b', Left (0,0) ]
                     ,[ Right $ T 'b', Left (0,1) ]
                     ]
                   , rhs = [N 2 "X"]
                   }
            , Rule { lhs = N 2 "X"
                   , function = [ [], [] ]
                   , rhs = []
                   }
            ]
    }

-- create derivation trees compatible to those generated by Waldmann's MCFG parser
-- this works here as the grammar is unambiguous and there is only exactly one child derivation tree
derivation :: Copy_Algebra Char Derivation Derivation
derivation = (nil,copy,copy') where
   nil _ = Derivation undefined r3 []
   copy d = Derivation undefined r0 [d]
   copy' 'a' 'a' d = Derivation undefined r1 [d]
   copy' 'b' 'b' d = Derivation undefined r2 [d]
   copy' _ _ _ = error "grammar mismatch"
   
   [ r0, r1, r2, r3 ] = rules mcfg
   
prettyprint :: Copy_Algebra Char String (String,String)
prettyprint = (nil,copy,copy') where
   copy (l,r) = l ++ r
   nil _ = ("","")   
   copy' c1 c2 (l,r) = (c1:l,c2:r)

-- (count of a's, count of b's)
countABs :: Copy_Algebra Char (Int,Int) (Int,Int)
countABs = (nil,copy,copy') where
   nil _                 = (0,0)
   copy (c1,c2)          = (c1*2,c2*2)
   copy' 'a' 'a' (c1,c2) = (c1+1,c2)
   copy' 'b' 'b' (c1,c2) = (c1,c2+1)
  
   
copyGr :: Copy_Algebra Char answerDim1 answerDim2 -> String -> [answerDim1]
copyGr algebra inp =
  let  
  (nil,copy,copy') = algebra
     
  s = tabulated1 $
      copy <<< c >>> id1 
  
  rewriteCopy :: Dim2
  rewriteCopy [a',a'',c1,c2] = ([a',c1],[a'',c2])
  
  c = tabulated2 $
      yieldSize2 (0,Nothing) (0,Nothing) $
      copy' <<< 'a' ~~~ 'a' ~~~ c >>> rewriteCopy |||
      copy' <<< 'b' ~~~ 'b' ~~~ c >>> rewriteCopy |||
      nil   <<< (EPS,EPS)         >>> id2
      
  z = mk inp
  tabulated1 = table1 z
  tabulated2 = table2 z
  
  in axiom z s