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 macro :: HashDefine
macro parameters :: [String]
parameters layout :: 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 (Arg,s :: String
s) = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ("") 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 (Str,s :: String
s) = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ShowS
str "") ShowS
str (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s [(String, String)]
env)
replace (Text,s :: 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
/='\n') String
s
str :: ShowS
str s :: String
s = '"'Char -> ShowS
forall a. a -> [a] -> [a]
:String
sString -> ShowS
forall a. [a] -> [a] -> [a]
++"\""
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
== 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
<= 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 ("macro "String -> ShowS
forall a. [a] -> [a] -> [a]
++HashDefine -> String
name HashDefine
macroString -> ShowS
forall a. [a] -> [a] -> [a]
++" 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]
++
" 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 ansi :: Bool
ansi def :: [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@(x :: t Char
x:xs :: [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 ("line":xs :: [String]
xs) = HashDefine -> Maybe HashDefine
forall a. a -> Maybe a
Just (String -> HashDefine
LineDrop ("#line"String -> ShowS
forall a. [a] -> [a] -> [a]
++[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
xs))
command ("pragma":xs :: [String]
xs) = HashDefine -> Maybe HashDefine
forall a. a -> Maybe a
Just (String -> HashDefine
Pragma ("#pragma"String -> ShowS
forall a. [a] -> [a] -> [a]
++[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
xs))
command ("define":xs :: [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 ("undef":xs :: [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 _ = Maybe HashDefine
forall a. Maybe a
Nothing
undef :: [String] -> HashDefine
undef (sym :: String
sym:_) = AntiDefined :: String -> Int -> HashDefine
AntiDefined { name :: String
name=String
sym, linebreaks :: Int
linebreaks=0 }
define :: [String] -> HashDefine
define (sym :: String
sym:xs :: [String]
xs) = case [String]
xs of
("(":ys :: [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
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 sym :: String
sym args :: [String]
args (",":xs :: [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 sym :: String
sym args :: [String]
args (")":xs :: [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 sym :: String
sym args :: [String]
args (var :: String
var:xs :: [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 sym :: String
sym args :: [String]
args [] = String -> HashDefine
forall a. HasCallStack => String -> a
error ("incomplete macro definition:\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++" #define "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
symString -> ShowS
forall a. [a] -> [a] -> [a]
++"("
String -> ShowS
forall a. [a] -> [a] -> [a]
++String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "," [String]
args)
classifyRhs :: t String -> [String] -> [(ArgOrText, String)]
classifyRhs args :: t String
args ("#":x :: String
x:xs :: [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 args :: t String
args ("##":xs :: [String]
xs)
| Bool
ansi = t String -> [String] -> [(ArgOrText, String)]
classifyRhs t String
args [String]
xs
classifyRhs args :: t String
args (s :: String
s:"##":s' :: String
s':xs :: [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 args :: t String
args (word :: String
word:xs :: [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 _ [] = []
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
=='\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 -> ShowS
forall a. [a] -> [a] -> [a]
++String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "," (HashDefine -> [String]
arguments HashDefine
hd)
String -> ShowS
forall a. [a] -> [a] -> [a]
++")"
,((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))]