[Git][ghc/ghc][wip/az/ghc-cpp] Fixed point expansion

[Alan Zimmerman (@alanz)]

Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC


Commits:
2b48a246 by Alan Zimmerman at 2025-02-16T17:00:18+00:00
Fixed point expansion

- - - - -


2 changed files:

- utils/check-cpp/Macro.hs
- utils/check-cpp/Main.hs


Changes:

=====================================
utils/check-cpp/Macro.hs
=====================================
@@ -95,19 +95,31 @@ expand s str = expanded
     expanded = combineToks $ map t_str $ expandToks s toks
 
 expandToks :: MacroDefines -> [Token] -> [Token]
-expandToks _ [] = []
-expandToks s (TIdentifier n : ts) = expanded ++ expandToks s ts'
+expandToks s ts =
+    let
+        (expansionDone, r) = doExpandToks False s ts
+     in
+        if expansionDone
+            then expandToks s r
+            else r
+
+doExpandToks :: Bool -> MacroDefines -> [Token] -> (Bool, [Token])
+doExpandToks ed _ [] = (ed, [])
+doExpandToks ed s (TIdentifier n : ts) = (ed'', expanded ++ rest)
   where
-    (expanded, ts') = case Map.lookup n s of
-        Nothing -> ([TIdentifier n], ts)
-        Just defs -> (r, rest)
+    (ed', expanded, ts') = case Map.lookup n s of
+        Nothing -> (ed, [TIdentifier n], ts)
+        Just defs -> (ed0, r, rest0)
           where
-            (args, rest) = getExpandArgs ts
+            (args, rest0) = getExpandArgs ts
             (m_args, rhs) = fromMaybe (Nothing, [TIdentifier n]) (Map.lookup (arg_arity args) defs)
-            r = case m_args of
-                Nothing -> rhs
-                Just _ -> replace_args args m_args rhs
-expandToks s (t : ts) = t : expandToks s ts
+            (ed0, r) = case m_args of
+                Nothing -> (True, rhs)
+                Just _ -> (True, replace_args args m_args rhs)
+    (ed'', rest) = doExpandToks ed' s ts'
+doExpandToks ed s (t : ts) = (ed', t : r)
+  where
+    (ed', r) = doExpandToks ed s ts
 
 -- ---------------------------------------------------------------------
 


=====================================
utils/check-cpp/Main.hs
=====================================
@@ -459,3 +459,15 @@ t16 = do
         , "#endif"
         ]
 -- x = 1
+
+t17 :: IO ()
+t17 = do
+    doTest
+        [ "#define FOO(A,B) A + B"
+        , "#if FOO(1,FOO(3,4)) == 8"
+        , "x = 1"
+        , "#else"
+        , "x = 5"
+        , "#endif"
+        ]
+-- x = 1



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b48a24612ef38a982bebf027ff611e8007dbd61

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b48a24612ef38a982bebf027ff611e8007dbd61
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20250216/cfdb05e9/attachment-0001.html>