From 8ff316cc00adfb02c30626ccd3a2d59aa801b0d0 Mon Sep 17 00:00:00 2001
From: Valentin Robert <val@galois.com>
Date: Mon, 8 Apr 2024 11:02:41 -0700
Subject: [PATCH] add support for function pointer types from DWARF
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Before:
__libc_start_main ↦ i32 (main : void*, argc : i32, argv : void*, init : void*, fini : void*, rtld_fini : void*, stack_end : void*)

After:
__libc_start_main ↦ i32 (main : i32 (i32,i8**,i8**), argc : i32, argv : i8**, init : i32 (i32,i8**,i8**), fini : void (), rtld_fini : void (), stack_end : void*)
---
 deps/macaw                            |  2 +-
 src/Reopt/TypeInference/DebugTypes.hs | 32 ++++++++++++++++++++++++---
 2 files changed, 30 insertions(+), 4 deletions(-)

diff --git a/deps/macaw b/deps/macaw
index 7e1694b0..77a6c623 160000
--- a/deps/macaw
+++ b/deps/macaw
@@ -1 +1 @@
-Subproject commit 7e1694b0ef87e4e431b73d1df14e55d47670e4b1
+Subproject commit 77a6c62352fd68ca5bc59796fb683726b08984fc
diff --git a/src/Reopt/TypeInference/DebugTypes.hs b/src/Reopt/TypeInference/DebugTypes.hs
index cea9e6b1..f5a3537d 100644
--- a/src/Reopt/TypeInference/DebugTypes.hs
+++ b/src/Reopt/TypeInference/DebugTypes.hs
@@ -14,6 +14,7 @@ import Control.Monad.Except (
   MonadError (throwError),
   runExceptT,
  )
+import Control.Monad.Extra (forM)
 import Control.Monad.Trans (
   MonadTrans (lift),
  )
@@ -68,6 +69,7 @@ import Reopt.TypeInference.HeaderTypes (
   AnnType (
     DoubleAnnType,
     FloatAnnType,
+    FunPtrAnnType,
     IAnnType,
     PtrAnnType,
     VoidAnnType
@@ -118,7 +120,16 @@ resolveDwarfType ::
   ExceptT ArgResolverError (IncCompM (ReoptLogEvent w) r) AnnType
 resolveDwarfType typeMap ref = do
   tp <- resolveDwarfTypeRef typeMap ref
-  case tp of
+  resolveDwarfTypeApp typeMap ref tp
+
+resolveDwarfTypeApp ::
+  Map Dwarf.TypeRef Dwarf.AbsType ->
+  -- | Still needed for reporting errors
+  Dwarf.TypeRef ->
+  Dwarf.TypeApp ->
+  ExceptT ArgResolverError (IncCompM (ReoptLogEvent w) r) AnnType
+resolveDwarfTypeApp typeMap ref tApp =
+  case tApp of
     Dwarf.BoolType -> do
       pure $! IAnnType 1
     Dwarf.UnsignedIntType byteCount -> do
@@ -137,9 +148,24 @@ resolveDwarfType typeMap ref = do
       pure $! IAnnType 8
     Dwarf.ArrayType _ _ -> do
       throwDwarfTypeError ref "Array arguments are not supported."
-    Dwarf.PointerType _ _ -> do
-      -- We just use void pointers for now.
+    Dwarf.PointerType _ Nothing -> do
       pure $ PtrAnnType VoidAnnType
+    Dwarf.PointerType _ (Just tr) -> do
+      dty <- resolveDwarfTypeRef typeMap tr
+      -- Here we distinguish function pointers from other "regular" pointers
+      case dty of
+        Dwarf.SubroutineTypeF std -> do
+          args <- forM (Dwarf.fntypeFormals std) $ \ var -> do
+            case Dwarf.varType var of
+              Nothing -> throwDwarfTypeError ref "void in argument position is not supported."
+              Just tr' -> resolveDwarfType typeMap tr'
+          ret <- case Dwarf.fntypeType std of
+                  Nothing -> pure VoidAnnType
+                  Just retTypeRef -> resolveDwarfType typeMap retTypeRef
+          pure $ FunPtrAnnType ret args
+        _ -> do
+          ty <- resolveDwarfTypeApp typeMap tr dty
+          pure $ PtrAnnType ty
     Dwarf.StructType _ -> do
       throwDwarfTypeError ref "Struct arguments are not supported."
     Dwarf.UnionType _ -> do