{-# LANGUAGE FlexibleInstances #-}

module ADP.Multi.Rewriting.Explicit (
        constructSubwords1,
        constructSubwords2
) where

import Control.Exception
import qualified Data.Map as Map
import Data.Maybe

import ADP.Debug
import ADP.Multi.Parser
import ADP.Multi.Rewriting
import ADP.Multi.Rewriting.Model
import ADP.Multi.Rewriting.YieldSize
import ADP.Multi.Rewriting.RangesHelper

constructSubwords1 :: SubwordConstructionAlgorithm Dim1
constructSubwords1 _ _ b | trace ("constructSubwords1 " ++ show b) False = undefined
constructSubwords1 f infos [i,j] =
        assert (i <= j) $
        let yieldSizeMap = buildYieldSizeMap infos
            symbolIDs = Map.keys yieldSizeMap
            rewritten = f symbolIDs
            parserCount = length infos
            remainingParsers = [parserCount,parserCount-1..1] `zip` infos
            rangeDesc = [(i,j,rewritten)]
        in trace ("f " ++ show symbolIDs ++ " = " ++ show rewritten) $
           assert (length rewritten == Map.size yieldSizeMap && all (`elem` rewritten) symbolIDs) $
           constructSubwordsRec yieldSizeMap remainingParsers rangeDesc

constructSubwords2 :: SubwordConstructionAlgorithm Dim2
constructSubwords2 _ _ b | trace ("constructSubwords2 " ++ show b) False = undefined
constructSubwords2 f infos [i,j,k,l] =
        assert (i <= j && j <= k && k <= l) $
        let yieldSizeMap = buildYieldSizeMap infos
            symbolIDs = Map.keys yieldSizeMap
            (left,right) = f symbolIDs
            parserCount = length infos
            remainingParsers = [parserCount,parserCount-1..1] `zip` infos
            rangeDescs = [(i,j,left),(k,l,right)]
        in trace ("f " ++ show symbolIDs ++ " = (" ++ show left ++ "," ++ show right ++ ")") $
           assert (length left + length right == Map.size yieldSizeMap && 
                   all (`elem` (left ++ right)) symbolIDs &&
                   not (null left) && not (null right)) $
           constructSubwordsRec yieldSizeMap remainingParsers rangeDescs



constructSubwordsRec :: YieldSizeMap -> [(Int,ParserInfo)] -> [RangeDesc] -> [SubwordTree]
constructSubwordsRec a b c | trace ("constructSubwordsRec " ++ show a ++ " " ++ show b ++ " " ++ show c) False = undefined
constructSubwordsRec _ [] _ = []
constructSubwordsRec yieldSizeMap ((current,ParserInfo1 {}):rest) rangeDescs =
        let symbolPos = findSymbol1 current rangeDescs
            subwords = calcSubwords1 yieldSizeMap symbolPos
        in trace ("calc subwords for dim1") $
           trace ("subwords: " ++ show subwords) $
           [ SubwordTree [i,j] restTrees |
             (i,j) <- subwords,
             let newDescs = constructNewRangeDescs1 rangeDescs symbolPos (i,j),
             let restTrees = constructSubwordsRec yieldSizeMap rest newDescs
           ]
constructSubwordsRec yieldSizeMap ((current,ParserInfo2 {}):rest) rangeDescs =
        let symbolPositions = findSymbol2 current rangeDescs
            subwords = calcSubwords2 yieldSizeMap symbolPositions
        in trace ("calc subwords for dim2") $
           trace ("subwords: " ++ show subwords) $
           [ SubwordTree [i,j,k,l] restTrees |
             (i,j,k,l) <- subwords,
             let newDescs = constructNewRangeDescs2 rangeDescs symbolPositions (i,j,k,l),
             let restTrees = constructSubwordsRec yieldSizeMap rest newDescs
           ]



-- The maximum yield sizes are only used in some cases at the moment.
-- They are not used in: 
--  1. last case of 'calcSubwords1'
--  2. 'calcSubwords2Dependent'
-- Considering maximum yield sizes in all cases will further decrease
-- the number of generated subwords and thus increase performance.
calcSubwords2 :: YieldSizeMap -> (SymbolPos,SymbolPos) -> [Subword2]
calcSubwords2 a b | trace ("calcSubwords2 " ++ show a ++ " " ++ show b) False = undefined
calcSubwords2 yieldSizeMap (left@((i,j,r),sym1Idx),right@((m,n,r'),sym2Idx))
  | r == r' = calcSubwords2Dependent yieldSizeMap (i,j,r) sym1Idx sym2Idx
  | length r == 1 && length r' == 1 = [(i,j,m,n)]
  | length r == 1  = [ (i,j,k',l') |
                       (k',l') <- calcSubwords1 yieldSizeMap right
                     ]
  | length r' == 1 = [ (i',j',m,n) |
                       (i',j') <- calcSubwords1 yieldSizeMap left
                     ]
  | otherwise = [ (i',j',k',l') |
                  (i',j') <- calcSubwords1 yieldSizeMap left
                , (k',l') <- calcSubwords1 yieldSizeMap right
                ]

calcSubwords1 :: YieldSizeMap -> SymbolPos -> [Subword1]
calcSubwords1 _ b | trace ("calcSubwords1 " ++ show b) False = undefined
calcSubwords1 yieldSizeMap pos@((i,j,r),symIdx)
  | symIdx == 0 =
         [ (i,l) |
           Just (minY',minYRight') <- [adjustMinYield (i,j) (minY,maxY) (minYRight,maxYRight)]
         , l <- [i+minY'..j-minYRight']
         ]
  | symIdx == length r - 1 =
         [ (k,j) |
           Just (minYLeft',minY') <- [adjustMinYield (i,j) (minYLeft,maxYLeft) (minY,maxY)]
         , k <- [i+minYLeft'..j-minY']
         ]
  | otherwise =
        [ (k,l) |
          k <- [i+minYLeft..j-minY-minYRight]
        , l <- [k+minY..j-minYRight]
        ]
  where (minY,maxY) = yieldSizeOf yieldSizeMap pos
        (minYLeft,maxYLeft) = combinedYieldSizeLeftOf yieldSizeMap pos
        (minYRight,maxYRight) = combinedYieldSizeRightOf yieldSizeMap pos

adjustMinYield :: Subword1 -> YieldSize -> YieldSize -> Maybe (Int,Int)
adjustMinYield (i,j) (minl,maxl) (minr,maxr) =
        let len = j-i
            adjust oldMinY maxY = let x = maybe oldMinY (\m -> len - m) maxY
                                  in max x oldMinY
            minrAdj = adjust minr maxl
            minlAdj = adjust minl maxr
        in do
           minlRes <- maybe (Just minlAdj) (\m -> if minlAdj > m then Nothing else Just minlAdj) maxl
           minrRes <- maybe (Just minrAdj) (\m -> if minrAdj > m then Nothing else Just minrAdj) maxr
           Just (minlRes,minrRes)

-- assumes that other nonterminal component is in the same part
calcSubwords2Dependent :: YieldSizeMap -> RangeDesc -> Int -> Int -> [Subword2]
calcSubwords2Dependent _ b c d | trace ("calcSubwords2Dependent " ++ show b ++ " " ++ show c ++ " " ++ show d) False = undefined
calcSubwords2Dependent yieldSizeMap (i,j,r) sym1Idx sym2Idx =
        let sym1Idx' = if sym1Idx < sym2Idx then sym1Idx else sym2Idx
            sym2Idx' = if sym1Idx < sym2Idx then sym2Idx else sym1Idx
            subs = doCalcSubwords2Dependent yieldSizeMap (i,j,r) sym1Idx' sym2Idx'
        in if sym1Idx < sym2Idx then subs
           else [ (k,l,m,n) | (m,n,k,l) <- subs ]

doCalcSubwords2Dependent :: YieldSizeMap -> RangeDesc -> Int -> Int -> [Subword2]
doCalcSubwords2Dependent yieldSizeMap desc@(i,j,r) sym1Idx sym2Idx =
   assert (sym1Idx < sym2Idx) $
   trace ("min yields: " ++ show minY1 ++ " " ++ show minY2 ++ " " ++ show minYLeft1 ++ " " ++
          show minYLeft2 ++ " " ++ show minYRight1 ++ " " ++ show minYRight2 ++ " " ++ show minYBetween) $
   trace ("max yields: " ++ show maxY1 ++ " " ++ show maxY2 ++ " " ++ show maxYLeft1 ++ " " ++
          show maxYLeft2 ++ " " ++ show maxYRight1 ++ " " ++ show maxYRight2 ++ " " ++ show maxYBetween) $
   result where

   (minY1,maxY1) = yieldSizeOf yieldSizeMap (desc,sym1Idx)
   (minY2,maxY2) = yieldSizeOf yieldSizeMap (desc,sym2Idx)
   (minYLeft1,maxYLeft1) = combinedYieldSizeLeftOf yieldSizeMap (desc,sym1Idx)
   (minYLeft2,maxYLeft2) = combinedYieldSizeLeftOf yieldSizeMap (desc,sym2Idx)
   (minYRight1,maxYRight1) = combinedYieldSizeRightOf yieldSizeMap (desc,sym1Idx)
   (minYRight2,maxYRight2) = combinedYieldSizeRightOf yieldSizeMap (desc,sym2Idx)
   minYBetween = minYRight1 - minYRight2 - minY2
   maxYBetween = if isNothing maxYRight1
                 then Nothing
                 else Just $ fromJust maxYRight1 - fromJust maxYRight2 - fromJust maxY2

   neighbors = sym1Idx + 1 == sym2Idx

   result | sym1Idx == 0 && sym2Idx == length r - 1 && neighbors =
                [ (i,l,l,j) |
                  l <- [i+minY1..j-minY2]
                ]

          | sym1Idx == 0 && sym2Idx == length r - 1 =
                [ (i,l,m,j) |
                  l <- [i+minY1..j-minYRight1]
                , m <- [l+minYBetween..j-minY2]
                ]

          | sym1Idx == 0 && neighbors =
                [ (i,l,l,n) |
                  l <- [i+minY1..j-minYRight1]
                , n <- [l+minY2..j-minYRight2]
                ]

          | sym1Idx == 0 =
                [ (i,l,m,n) |
                  l <- [i+minY1..j-minYRight1]
                , m <- [l+minYBetween..j-minY2-minYRight2]
                , n <- [m+minY2..j-minYRight2]
                ]

          | sym2Idx == length r - 1 && neighbors =
                [ (k,m,m,j) |
                  m <- [i+minYLeft2..j-minY2]
                , k <- [i+minYLeft1..m-minY1]
                ]

          | sym2Idx == length r - 1 =
                [ (k,l,m,j) |
                  m <- [i+minYLeft2..j-minY2]
                , l <- [i+minY1+minYLeft1..m-minYBetween]
                , k <- [i+minYLeft1..l-minY1]
                ]

          | sym1Idx > 0 && sym2Idx < length r - 1 && neighbors =
                [ (k,l,l,n) |
                  k <- [i+minYLeft1..j-minY1-minYRight1]
                , l <- [k+minY1..j-minYRight1]
                , n <- [l+minY2..j-minYRight2]
                ]

          | sym1Idx > 0 && sym2Idx < length r - 1 =
                [ (k,l,m,n) |
                  k <- [i+minYLeft1..j-minY1-minYRight1]
                , l <- [k+minY1..j-minYRight1]
                , m <- [l+minYBetween..j-minY2-minYRight2]
                , n <- [m+minY2..j-minYRight2]
                ]

          | otherwise = error "invalid conditions, e.g. sym1Idx == sym2Idx == 0"