module Language.Preprocessor.Cpphs.HashDefine
( HashDefine(..)
, ArgOrText(..)
, expandMacro
, parseHashDefine
, simplifyHashDefines
) where
import Data.Char (isSpace)
import Data.List (intercalate)
data HashDefine
= LineDrop
{ HashDefine -> String
name :: String }
| Pragma
{ name :: String }
| AntiDefined
{ name :: String
, HashDefine -> Int
linebreaks :: Int
}
| SymbolReplacement
{ name :: String
, HashDefine -> String
replacement :: String
, linebreaks :: Int
}
| MacroExpansion
{ name :: String
, HashDefine -> [String]
arguments :: [String]
, HashDefine -> [(ArgOrText, String)]
expansion :: [(ArgOrText,String)]
, linebreaks :: Int
}
deriving (HashDefine -> HashDefine -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashDefine -> HashDefine -> Bool
$c/= :: HashDefine -> HashDefine -> Bool
== :: HashDefine -> HashDefine -> Bool
$c== :: HashDefine -> HashDefine -> Bool
Eq,Int -> HashDefine -> ShowS
[HashDefine] -> ShowS
HashDefine -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashDefine] -> ShowS
$cshowList :: [HashDefine] -> ShowS
show :: HashDefine -> String
$cshow :: HashDefine -> String
showsPrec :: Int -> HashDefine -> ShowS
$cshowsPrec :: Int -> HashDefine -> ShowS
Show)
symbolReplacement :: HashDefine
symbolReplacement :: HashDefine
symbolReplacement =
SymbolReplacement
{ name :: String
name=forall a. HasCallStack => a
undefined, replacement :: String
replacement=forall a. HasCallStack => a
undefined, linebreaks :: Int
linebreaks=forall a. HasCallStack => a
undefined }
data ArgOrText = Arg | Text | Str deriving (ArgOrText -> ArgOrText -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgOrText -> ArgOrText -> Bool
$c/= :: ArgOrText -> ArgOrText -> Bool
== :: ArgOrText -> ArgOrText -> Bool
$c== :: ArgOrText -> ArgOrText -> Bool
Eq,Int -> ArgOrText -> ShowS
[ArgOrText] -> ShowS
ArgOrText -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgOrText] -> ShowS
$cshowList :: [ArgOrText] -> ShowS
show :: ArgOrText -> String
$cshow :: ArgOrText -> String
showsPrec :: Int -> ArgOrText -> ShowS
$cshowsPrec :: Int -> ArgOrText -> ShowS
Show)
expandMacro :: HashDefine -> [String] -> Bool -> String
expandMacro :: HashDefine -> [String] -> Bool -> String
expandMacro HashDefine
macro [String]
parameters Bool
layout =
let env :: [(String, String)]
env = forall a b. [a] -> [b] -> [(a, b)]
zip (HashDefine -> [String]
arguments HashDefine
macro) [String]
parameters
replace :: (ArgOrText, String) -> String
replace (ArgOrText
Arg,String
s) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
"") forall a. a -> a
id (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s [(String, String)]
env)
replace (ArgOrText
Str,String
s) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ShowS
str String
"") ShowS
str (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s [(String, String)]
env)
replace (ArgOrText
Text,String
s) = if Bool
layout then String
s else forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Char
'\n') String
s
str :: ShowS
str String
s = Char
'"'forall a. a -> [a] -> [a]
:String
sforall a. [a] -> [a] -> [a]
++String
"\""
checkArity :: a -> a
checkArity | forall (t :: * -> *) a. Foldable t => t a -> Int
length (HashDefine -> [String]
arguments HashDefine
macro) forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parameters forall a. Ord a => a -> a -> Bool
<= Int
1
Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Int
length (HashDefine -> [String]
arguments HashDefine
macro) forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parameters = forall a. a -> a
id
| Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"macro "forall a. [a] -> [a] -> [a]
++HashDefine -> String
name HashDefine
macroforall a. [a] -> [a] -> [a]
++String
" expected "forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length (HashDefine -> [String]
arguments HashDefine
macro))forall a. [a] -> [a] -> [a]
++
String
" arguments, but was given "forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parameters))
in
forall a. a -> a
checkArity forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ArgOrText, String) -> String
replace (HashDefine -> [(ArgOrText, String)]
expansion HashDefine
macro)
parseHashDefine :: Bool -> [String] -> Maybe HashDefine
parseHashDefine :: Bool -> [String] -> Maybe HashDefine
parseHashDefine Bool
ansi [String]
def = ([String] -> Maybe HashDefine
command forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
skip) [String]
def
where
skip :: [t Char] -> [t Char]
skip xss :: [t Char]
xss@(t Char
x:[t Char]
xs) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace t Char
x = [t Char] -> [t Char]
skip [t Char]
xs
| Bool
otherwise = [t Char]
xss
skip [] = []
command :: [String] -> Maybe HashDefine
command (String
"line":[String]
xs) = forall a. a -> Maybe a
Just (String -> HashDefine
LineDrop (String
"#line"forall a. [a] -> [a] -> [a]
++forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
xs))
command (String
"pragma":[String]
xs) = forall a. a -> Maybe a
Just (String -> HashDefine
Pragma (String
"#pragma"forall a. [a] -> [a] -> [a]
++forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
xs))
command (String
"define":[String]
xs) = forall a. a -> Maybe a
Just ((([String] -> HashDefine
define forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
skip) [String]
xs) { linebreaks :: Int
linebreaks=[String] -> Int
count [String]
def })
command (String
"undef":[String]
xs) = forall a. a -> Maybe a
Just ((([String] -> HashDefine
undef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
skip) [String]
xs))
command [String]
_ = forall a. Maybe a
Nothing
undef :: [String] -> HashDefine
undef (String
sym:[String]
_) = AntiDefined { name :: String
name=String
sym, linebreaks :: Int
linebreaks=Int
0 }
define :: [String] -> HashDefine
define (String
sym:[String]
xs) = case [String]
xs of
(String
"(":[String]
ys) -> (String -> [String] -> [String] -> HashDefine
macroHead String
sym [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
skip) [String]
ys
[String]
ys -> HashDefine
symbolReplacement
{ name :: String
name=String
sym
, replacement :: String
replacement = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd
(forall {t :: * -> *}.
Foldable t =>
t String -> [String] -> [(ArgOrText, String)]
classifyRhs [] ([String] -> [String]
chop (forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
skip [String]
ys))) }
macroHead :: String -> [String] -> [String] -> HashDefine
macroHead String
sym [String]
args (String
",":[String]
xs) = (String -> [String] -> [String] -> HashDefine
macroHead String
sym [String]
args forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
skip) [String]
xs
macroHead String
sym [String]
args (String
")":[String]
xs) = MacroExpansion
{ name :: String
name =String
sym , arguments :: [String]
arguments = forall a. [a] -> [a]
reverse [String]
args
, expansion :: [(ArgOrText, String)]
expansion = forall {t :: * -> *}.
Foldable t =>
t String -> [String] -> [(ArgOrText, String)]
classifyRhs [String]
args (forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
skip [String]
xs)
, linebreaks :: Int
linebreaks = forall a. HasCallStack => a
undefined }
macroHead String
sym [String]
args (String
var:[String]
xs) = (String -> [String] -> [String] -> HashDefine
macroHead String
sym (String
varforall a. a -> [a] -> [a]
:[String]
args) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
skip) [String]
xs
macroHead String
sym [String]
args [] = forall a. HasCallStack => String -> a
error (String
"incomplete macro definition:\n"
forall a. [a] -> [a] -> [a]
++String
" #define "forall a. [a] -> [a] -> [a]
++String
symforall a. [a] -> [a] -> [a]
++String
"("
forall a. [a] -> [a] -> [a]
++forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
args)
classifyRhs :: t String -> [String] -> [(ArgOrText, String)]
classifyRhs t String
args (String
"#":String
x:[String]
xs)
| Bool
ansi Bool -> Bool -> Bool
&&
String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t String
args = (ArgOrText
Str,String
x)forall a. a -> [a] -> [a]
: t String -> [String] -> [(ArgOrText, String)]
classifyRhs t String
args [String]
xs
classifyRhs t String
args (String
"##":[String]
xs)
| Bool
ansi = t String -> [String] -> [(ArgOrText, String)]
classifyRhs t String
args [String]
xs
classifyRhs t String
args (String
s:String
"##":String
s':[String]
xs)
| Bool
ansi Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s'
= t String -> [String] -> [(ArgOrText, String)]
classifyRhs t String
args [String]
xs
classifyRhs t String
args (String
word:[String]
xs)
| String
word forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t String
args = (ArgOrText
Arg,String
word)forall a. a -> [a] -> [a]
: t String -> [String] -> [(ArgOrText, String)]
classifyRhs t String
args [String]
xs
| Bool
otherwise = (ArgOrText
Text,String
word)forall a. a -> [a] -> [a]
: t String -> [String] -> [(ArgOrText, String)]
classifyRhs t String
args [String]
xs
classifyRhs t String
_ [] = []
count :: [String] -> Int
count = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
==Char
'\n') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
chop :: [String] -> [String]
chop = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
simplifyHashDefines :: [HashDefine] -> [(String,String)]
simplifyHashDefines :: [HashDefine] -> [(String, String)]
simplifyHashDefines = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HashDefine -> [(String, String)]
simp
where
simp :: HashDefine -> [(String, String)]
simp hd :: HashDefine
hd@LineDrop{} = []
simp hd :: HashDefine
hd@Pragma{} = []
simp hd :: HashDefine
hd@AntiDefined{} = []
simp hd :: HashDefine
hd@SymbolReplacement{} = [(HashDefine -> String
name HashDefine
hd, HashDefine -> String
replacement HashDefine
hd)]
simp hd :: HashDefine
hd@MacroExpansion{} = [(HashDefine -> String
name HashDefine
hdforall a. [a] -> [a] -> [a]
++String
"("forall a. [a] -> [a] -> [a]
++forall a. [a] -> [[a]] -> [a]
intercalate String
"," (HashDefine -> [String]
arguments HashDefine
hd)
forall a. [a] -> [a] -> [a]
++String
")"
,forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd (HashDefine -> [(ArgOrText, String)]
expansion HashDefine
hd))]