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
(HashDefine -> HashDefine -> Bool)
-> (HashDefine -> HashDefine -> Bool) -> Eq HashDefine
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
(Int -> HashDefine -> ShowS)
-> (HashDefine -> String)
-> ([HashDefine] -> ShowS)
-> Show HashDefine
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 :: String -> String -> Int -> HashDefine
SymbolReplacement
{ name :: String
name=String
forall a. HasCallStack => a
undefined, replacement :: String
replacement=String
forall a. HasCallStack => a
undefined, linebreaks :: Int
linebreaks=Int
forall a. HasCallStack => a
undefined }
data ArgOrText = Arg | Text | Str deriving (ArgOrText -> ArgOrText -> Bool
(ArgOrText -> ArgOrText -> Bool)
-> (ArgOrText -> ArgOrText -> Bool) -> Eq ArgOrText
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
(Int -> ArgOrText -> ShowS)
-> (ArgOrText -> String)
-> ([ArgOrText] -> ShowS)
-> Show ArgOrText
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 = [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (HashDefine -> [String]
arguments HashDefine
macro) [String]
parameters
replace :: (ArgOrText, String) -> String
replace (ArgOrText
Arg,String
s) = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
"") ShowS
forall a. a -> a
id (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s [(String, String)]
env)
replace (ArgOrText
Str,String
s) = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ShowS
str String
"") ShowS
str (String -> [(String, String)] -> Maybe String
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 (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n') String
s
str :: ShowS
str String
s = Char
'"'Char -> ShowS
forall a. a -> [a] -> [a]
:String
sString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\""
checkArity :: a -> a
checkArity | [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (HashDefine -> [String]
arguments HashDefine
macro) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parameters Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
Bool -> Bool -> Bool
|| [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (HashDefine -> [String]
arguments HashDefine
macro) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parameters = a -> a
forall a. a -> a
id
| Bool
otherwise = String -> a -> a
forall a. HasCallStack => String -> a
error (String
"macro "String -> ShowS
forall a. [a] -> [a] -> [a]
++HashDefine -> String
name HashDefine
macroString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" expected "String -> ShowS
forall a. [a] -> [a] -> [a]
++
Int -> String
forall a. Show a => a -> String
show ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (HashDefine -> [String]
arguments HashDefine
macro))String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" arguments, but was given "String -> ShowS
forall a. [a] -> [a] -> [a]
++
Int -> String
forall a. Show a => a -> String
show ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parameters))
in
ShowS
forall a. a -> a
checkArity ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ((ArgOrText, String) -> String) -> [(ArgOrText, String)] -> String
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 ([String] -> Maybe HashDefine)
-> ([String] -> [String]) -> [String] -> Maybe HashDefine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
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) | (Char -> Bool) -> t Char -> Bool
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) = HashDefine -> Maybe HashDefine
forall a. a -> Maybe a
Just (String -> HashDefine
LineDrop (String
"#line"String -> ShowS
forall a. [a] -> [a] -> [a]
++[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
xs))
command (String
"pragma":[String]
xs) = HashDefine -> Maybe HashDefine
forall a. a -> Maybe a
Just (String -> HashDefine
Pragma (String
"#pragma"String -> ShowS
forall a. [a] -> [a] -> [a]
++[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
xs))
command (String
"define":[String]
xs) = HashDefine -> Maybe HashDefine
forall a. a -> Maybe a
Just ((([String] -> HashDefine
define ([String] -> HashDefine)
-> ([String] -> [String]) -> [String] -> HashDefine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall (t :: * -> *). Foldable t => [t Char] -> [t Char]
skip) [String]
xs) { linebreaks :: Int
linebreaks=[String] -> Int
count [String]
def })
command (String
"undef":[String]
xs) = HashDefine -> Maybe HashDefine
forall a. a -> Maybe a
Just ((([String] -> HashDefine
undef ([String] -> HashDefine)
-> ([String] -> [String]) -> [String] -> HashDefine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall (t :: * -> *). Foldable t => [t Char] -> [t Char]
skip) [String]
xs))
command [String]
_ = Maybe HashDefine
forall a. Maybe a
Nothing
undef :: [String] -> HashDefine
undef (String
sym:[String]
_) = AntiDefined :: String -> Int -> HashDefine
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 [] ([String] -> HashDefine)
-> ([String] -> [String]) -> [String] -> HashDefine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall (t :: * -> *). Foldable t => [t Char] -> [t Char]
skip) [String]
ys
[String]
ys -> HashDefine
symbolReplacement
{ name :: String
name=String
sym
, replacement :: String
replacement = ((ArgOrText, String) -> String) -> [(ArgOrText, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ArgOrText, String) -> String
forall a b. (a, b) -> b
snd
([String] -> [String] -> [(ArgOrText, String)]
forall (t :: * -> *).
Foldable t =>
t String -> [String] -> [(ArgOrText, String)]
classifyRhs [] ([String] -> [String]
chop ([String] -> [String]
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 ([String] -> HashDefine)
-> ([String] -> [String]) -> [String] -> HashDefine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall (t :: * -> *). Foldable t => [t Char] -> [t Char]
skip) [String]
xs
macroHead String
sym [String]
args (String
")":[String]
xs) = MacroExpansion :: String -> [String] -> [(ArgOrText, String)] -> Int -> HashDefine
MacroExpansion
{ name :: String
name =String
sym , arguments :: [String]
arguments = [String] -> [String]
forall a. [a] -> [a]
reverse [String]
args
, expansion :: [(ArgOrText, String)]
expansion = [String] -> [String] -> [(ArgOrText, String)]
forall (t :: * -> *).
Foldable t =>
t String -> [String] -> [(ArgOrText, String)]
classifyRhs [String]
args ([String] -> [String]
forall (t :: * -> *). Foldable t => [t Char] -> [t Char]
skip [String]
xs)
, linebreaks :: Int
linebreaks = Int
forall a. HasCallStack => a
undefined }
macroHead String
sym [String]
args (String
var:[String]
xs) = (String -> [String] -> [String] -> HashDefine
macroHead String
sym (String
varString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
args) ([String] -> HashDefine)
-> ([String] -> [String]) -> [String] -> HashDefine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall (t :: * -> *). Foldable t => [t Char] -> [t Char]
skip) [String]
xs
macroHead String
sym [String]
args [] = String -> HashDefine
forall a. HasCallStack => String -> a
error (String
"incomplete macro definition:\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" #define "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
symString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"("
String -> ShowS
forall a. [a] -> [a] -> [a]
++String -> [String] -> String
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 String -> t String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t String
args = (ArgOrText
Str,String
x)(ArgOrText, String)
-> [(ArgOrText, String)] -> [(ArgOrText, String)]
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
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> 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 String -> t String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t String
args = (ArgOrText
Arg,String
word)(ArgOrText, String)
-> [(ArgOrText, String)] -> [(ArgOrText, String)]
forall a. a -> [a] -> [a]
: t String -> [String] -> [(ArgOrText, String)]
classifyRhs t String
args [String]
xs
| Bool
otherwise = (ArgOrText
Text,String
word)(ArgOrText, String)
-> [(ArgOrText, String)] -> [(ArgOrText, String)]
forall a. a -> [a] -> [a]
: t String -> [String] -> [(ArgOrText, String)]
classifyRhs t String
args [String]
xs
classifyRhs t String
_ [] = []
count :: [String] -> Int
count = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ([String] -> String) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
chop :: [String] -> [String]
chop = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse
simplifyHashDefines :: [HashDefine] -> [(String,String)]
simplifyHashDefines :: [HashDefine] -> [(String, String)]
simplifyHashDefines = (HashDefine -> [(String, String)])
-> [HashDefine] -> [(String, String)]
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
hdString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"("String -> ShowS
forall a. [a] -> [a] -> [a]
++String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," (HashDefine -> [String]
arguments HashDefine
hd)
String -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"
,((ArgOrText, String) -> String) -> [(ArgOrText, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ArgOrText, String) -> String
forall a b. (a, b) -> b
snd (HashDefine -> [(ArgOrText, String)]
expansion HashDefine
hd))]