{-# LANGUAGE CPP, OverloadedStrings, ViewPatterns #-}
module Hpp.Macro (parseDefinition) where
import Data.Char (isSpace)
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup ((<>))
#endif
import Hpp.StringSig
import Hpp.Tokens (trimUnimportant, importants, Token(..), isImportant)
import Hpp.Types (Macro(..), String, TOKEN, Scan(..))
import Prelude hiding (String)
prepTOKENSplices :: [TOKEN] -> [TOKEN]
prepTOKENSplices = map (fmap copy) . dropSpaces [] . mergeTOKENs []
where
mergeTOKENs acc [] = acc
mergeTOKENs acc (Important "#" : Important "#" : ts) =
mergeTOKENs (Important "##" : acc) (dropWhile (not . isImportant) ts)
mergeTOKENs acc (t:ts) = mergeTOKENs (t : acc) ts
dropSpaces acc [] = acc
dropSpaces acc (t@(Important "##") : ts) =
dropSpaces (t : acc) (dropWhile (not . isImportant) ts)
dropSpaces acc (t:ts) = dropSpaces (t : acc) ts
parseDefinition :: [TOKEN] -> Maybe (String, Macro)
parseDefinition toks =
case dropWhile (not . isImportant) toks of
(Important name:Important "(":rst) ->
let params = takeWhile (/= ")") $ filter (/= ",") (importants rst)
body = trimUnimportant . tail $ dropWhile (/= Important ")") toks
macro = Function (length params) (functionMacro params body)
in Just (name, macro)
(Important name:_) ->
let rhs = case dropWhile (/= Important name) toks of
[] -> [Important ""]
str@(_:t)
| all (not . isImportant) str -> [Important ""]
| otherwise -> trimUnimportant t
in Just (copy name, Object (map (fmap copy) rhs))
_ -> Nothing
prepStringify :: [TOKEN] -> [TOKEN]
prepStringify [] = []
prepStringify (Important "#" : ts) =
case dropWhile (not . isImportant) ts of
(Important t : ts') -> Important (cons '#' t) : prepStringify ts'
_ -> Important "#" : ts
prepStringify (t:ts) = t : prepStringify ts
paste :: [Scan] -> [Scan]
paste [] = []
paste (Rescan (Important s) : Rescan (Important "##") : Rescan (Important t) : ts) =
paste (Rescan (Important (trimSpaces s <> sdropWhile isSpace t)) : ts)
paste (t:ts) = t : paste ts
functionMacro :: [String] -> [TOKEN] -> [([Scan],String)] -> [Scan]
functionMacro params body = paste
. subst body'
. zip params'
where params' = map copy params
subst toks gamma = go toks
where go [] = []
go (p@(Important "##"):t@(Important s):ts) =
case lookup s gamma of
Nothing -> Rescan p : Rescan t : go ts
Just (_,arg) ->
Rescan p : Rescan (Important arg) : go ts
go (t@(Important s):p@(Important "##"):ts) =
case lookup s gamma of
Nothing -> Rescan t : go (p:ts)
Just (_,arg) -> Rescan (Important arg) : go (p:ts)
go (t@(Important "##"):ts) = Rescan t : go ts
go (t@(Important (uncons -> Just ('#',s))) : ts) =
case lookup s gamma of
Nothing -> Rescan t : go ts
Just (_,arg) ->
Rescan (Important (stringify arg)) : go ts
go (t@(Important s) : ts) =
case lookup s gamma of
Nothing -> Rescan t : go ts
Just (arg,_) -> arg ++ go ts
go (t:ts) = Rescan t : go ts
body' = prepStringify . prepTOKENSplices $
dropWhile (not . isImportant) body