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 ""