{- |
    Module      :  $Header$
    Description :  Conditional compiling transformation
    Copyright   :  (c) 2017        Kai-Oliver Prott
                       2017        Finn Teegen
    License     :  BSD-3-clause

    Maintainer  :  fte@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    TODO
-}
module Curry.CondCompile.Transform (condTransform) where

import           Control.Monad.State
import           Control.Monad.Extra        (concatMapM)
import qualified Data.Map            as Map
import           Data.Maybe                 (fromMaybe)
import           Text.Parsec                             hiding (State)
import           Text.Parsec.Error          ()

import Curry.Base.Message
import Curry.Base.Position
import Curry.Base.Pretty

import Curry.CondCompile.Parser
import Curry.CondCompile.Type

type CCState = Map.Map String Int

type CCM = State CCState

condTransform :: CCState -> FilePath -> String -> Either Message String
condTransform :: CCState -> FilePath -> FilePath -> Either Message FilePath
condTransform s :: CCState
s fn :: FilePath
fn p :: FilePath
p = (ParseError -> Either Message FilePath)
-> (Program -> Either Message FilePath)
-> Either ParseError Program
-> Either Message FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Message -> Either Message FilePath
forall a b. a -> Either a b
Left (Message -> Either Message FilePath)
-> (ParseError -> Message) -> ParseError -> Either Message FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Message
convertError)
                              (FilePath -> Either Message FilePath
forall a b. b -> Either a b
Right (FilePath -> Either Message FilePath)
-> (Program -> FilePath) -> Program -> Either Message FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CCState -> Program -> FilePath
transformWith CCState
s)
                              (Parsec FilePath () Program
-> FilePath -> FilePath -> Either ParseError Program
forall s t a.
Stream s Identity t =>
Parsec s () a -> FilePath -> s -> Either ParseError a
parse Parsec FilePath () Program
program FilePath
fn FilePath
p)

transformWith :: CCState -> Program -> String
transformWith :: CCState -> Program -> FilePath
transformWith s :: CCState
s p :: Program
p = Doc -> FilePath
forall a. Show a => a -> FilePath
show (Doc -> FilePath) -> Doc -> FilePath
forall a b. (a -> b) -> a -> b
$ Program -> Doc
forall a. Pretty a => a -> Doc
pPrint (Program -> Doc) -> Program -> Doc
forall a b. (a -> b) -> a -> b
$ State CCState Program -> CCState -> Program
forall s a. State s a -> s -> a
evalState (Program -> State CCState Program
forall a. CCTransform a => a -> State CCState Program
transform Program
p) CCState
s

convertError :: ParseError -> Message
convertError :: ParseError -> Message
convertError err :: ParseError
err = Position -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage Position
pos (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$
  (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($+$) Doc
empty ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (FilePath -> Doc) -> [FilePath] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Doc
text ([FilePath] -> [Doc]) -> [FilePath] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. [a] -> [a]
tail ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
err
  where pos :: Position
pos = FilePath -> Int -> Int -> Position
Position (SourcePos -> FilePath
sourceName SourcePos
src) (SourcePos -> Int
sourceLine SourcePos
src) (SourcePos -> Int
sourceColumn SourcePos
src)
        src :: SourcePos
src = ParseError -> SourcePos
errorPos ParseError
err

class CCTransform a where
  transform :: a -> CCM [Stmt]

instance CCTransform Stmt where
  transform :: Stmt -> State CCState Program
transform (Line              s :: FilePath
s) = Program -> State CCState Program
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath -> Stmt
Line FilePath
s]
  transform (If     c :: Cond
c stmts :: Program
stmts is :: [Elif]
is e :: Else
e) = do
    CCState
s <- StateT CCState Identity CCState
forall s (m :: * -> *). MonadState s m => m s
get
    if Cond -> CCState -> Bool
checkCond Cond
c CCState
s
      then do Program
stmts' <- Program -> State CCState Program
forall a. CCTransform a => a -> State CCState Program
transform Program
stmts
              Program -> State CCState Program
forall (m :: * -> *) a. Monad m => a -> m a
return (Stmt
blank Stmt -> Program -> Program
forall a. a -> [a] -> [a]
: Program
stmts' Program -> Program -> Program
forall a. [a] -> [a] -> [a]
++ [Elif] -> Program
forall a. FillLength a => a -> Program
fill [Elif]
is Program -> Program -> Program
forall a. [a] -> [a] -> [a]
++ Else -> Program
forall a. FillLength a => a -> Program
fill Else
e Program -> Program -> Program
forall a. [a] -> [a] -> [a]
++ [Stmt
blank])
      else case [Elif]
is of
             []                        -> do
               Program
stmts' <- Else -> State CCState Program
forall a. CCTransform a => a -> State CCState Program
transform Else
e
               Program -> State CCState Program
forall (m :: * -> *) a. Monad m => a -> m a
return (Stmt
blank Stmt -> Program -> Program
forall a. a -> [a] -> [a]
: Program -> Program
forall a. FillLength a => a -> Program
fill Program
stmts Program -> Program -> Program
forall a. [a] -> [a] -> [a]
++ Program
stmts' Program -> Program -> Program
forall a. [a] -> [a] -> [a]
++ [Stmt
blank])
             (Elif (c' :: Cond
c', stmts' :: Program
stmts') : is' :: [Elif]
is') -> do
               Program
stmts'' <- Stmt -> State CCState Program
forall a. CCTransform a => a -> State CCState Program
transform (Cond -> Program -> [Elif] -> Else -> Stmt
If Cond
c' Program
stmts' [Elif]
is' Else
e)
               Program -> State CCState Program
forall (m :: * -> *) a. Monad m => a -> m a
return (Stmt
blank Stmt -> Program -> Program
forall a. a -> [a] -> [a]
: Program -> Program
forall a. FillLength a => a -> Program
fill Program
stmts Program -> Program -> Program
forall a. [a] -> [a] -> [a]
++ Program
stmts'')
  transform (IfDef  v :: FilePath
v stmts :: Program
stmts is :: [Elif]
is e :: Else
e) = Stmt -> State CCState Program
forall a. CCTransform a => a -> State CCState Program
transform (Cond -> Program -> [Elif] -> Else -> Stmt
If (FilePath -> Cond
Defined  FilePath
v) Program
stmts [Elif]
is Else
e)
  transform (IfNDef v :: FilePath
v stmts :: Program
stmts is :: [Elif]
is e :: Else
e) = Stmt -> State CCState Program
forall a. CCTransform a => a -> State CCState Program
transform (Cond -> Program -> [Elif] -> Else -> Stmt
If (FilePath -> Cond
NDefined FilePath
v) Program
stmts [Elif]
is Else
e)
  transform (Define          v :: FilePath
v i :: Int
i) = (CCState -> CCState) -> StateT CCState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (FilePath -> Int -> CCState -> CCState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FilePath
v Int
i) StateT CCState Identity ()
-> State CCState Program -> State CCState Program
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Program -> State CCState Program
forall (m :: * -> *) a. Monad m => a -> m a
return [Stmt
blank]
  transform (Undef           v :: FilePath
v  ) = (CCState -> CCState) -> StateT CCState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (FilePath -> CCState -> CCState
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete FilePath
v) StateT CCState Identity ()
-> State CCState Program -> State CCState Program
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Program -> State CCState Program
forall (m :: * -> *) a. Monad m => a -> m a
return [Stmt
blank]

instance CCTransform a => CCTransform [a] where
  transform :: [a] -> State CCState Program
transform = (a -> State CCState Program) -> [a] -> State CCState Program
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM a -> State CCState Program
forall a. CCTransform a => a -> State CCState Program
transform

instance CCTransform Else where
  transform :: Else -> State CCState Program
transform (Else (Just p :: Program
p)) = (Stmt
blank Stmt -> Program -> Program
forall a. a -> [a] -> [a]
:) (Program -> Program)
-> State CCState Program -> State CCState Program
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Program -> State CCState Program
forall a. CCTransform a => a -> State CCState Program
transform Program
p
  transform (Else Nothing ) = Program -> State CCState Program
forall (m :: * -> *) a. Monad m => a -> m a
return []

checkCond :: Cond -> CCState -> Bool
checkCond :: Cond -> CCState -> Bool
checkCond (Comp v :: FilePath
v op :: Op
op i :: Int
i) = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Op -> Int -> Int -> Bool
forall a. Ord a => Op -> a -> a -> Bool
compareOp Op
op) Int
i (Int -> Bool) -> (CCState -> Int) -> CCState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> (CCState -> Maybe Int) -> CCState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> CCState -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
v
checkCond (Defined   v :: FilePath
v) = FilePath -> CCState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member FilePath
v
checkCond (NDefined  v :: FilePath
v) = FilePath -> CCState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember FilePath
v

compareOp :: Ord a => Op -> a -> a -> Bool
compareOp :: Op -> a -> a -> Bool
compareOp Eq  = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
compareOp Neq = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
compareOp Lt  = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)
compareOp Leq = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
compareOp Gt  = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)
compareOp Geq = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)

class FillLength a where
  fillLength :: a -> Int

instance FillLength Stmt where
  fillLength :: Stmt -> Int
fillLength (Line   _           ) = 1
  fillLength (Define _ _         ) = 1
  fillLength (Undef  _           ) = 1
  fillLength (If     _ stmts :: Program
stmts is :: [Elif]
is e :: Else
e) =
    3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Program -> Int
forall a. FillLength a => a -> Int
fillLength Program
stmts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Else -> Int
forall a. FillLength a => a -> Int
fillLength Else
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Elif] -> Int
forall a. FillLength a => a -> Int
fillLength [Elif]
is
  fillLength (IfDef  v :: FilePath
v stmts :: Program
stmts is :: [Elif]
is e :: Else
e) = Stmt -> Int
forall a. FillLength a => a -> Int
fillLength (Cond -> Program -> [Elif] -> Else -> Stmt
If (FilePath -> Cond
Defined  FilePath
v) Program
stmts [Elif]
is Else
e)
  fillLength (IfNDef v :: FilePath
v stmts :: Program
stmts is :: [Elif]
is e :: Else
e) = Stmt -> Int
forall a. FillLength a => a -> Int
fillLength (Cond -> Program -> [Elif] -> Else -> Stmt
If (FilePath -> Cond
NDefined FilePath
v) Program
stmts [Elif]
is Else
e)

instance FillLength a => FillLength [a] where
  fillLength :: [a] -> Int
fillLength = (a -> Int -> Int) -> Int -> [a] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> (a -> Int) -> a -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. FillLength a => a -> Int
fillLength) 0

instance FillLength Else where
  fillLength :: Else -> Int
fillLength (Else (Just stmts :: Program
stmts)) = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Program -> Int
forall a. FillLength a => a -> Int
fillLength Program
stmts
  fillLength (Else Nothing     ) = 0

instance FillLength Elif where
  fillLength :: Elif -> Int
fillLength (Elif (_, stmts :: Program
stmts)) = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Program -> Int
forall a. FillLength a => a -> Int
fillLength Program
stmts

fill :: FillLength a => a -> [Stmt]
fill :: a -> Program
fill p :: a
p = Int -> Stmt -> Program
forall a. Int -> a -> [a]
replicate (a -> Int
forall a. FillLength a => a -> Int
fillLength a
p) Stmt
blank

blank :: Stmt
blank :: Stmt
blank = FilePath -> Stmt
Line ""