From 8bb81e3c6c677c6118e804d03d57607f5869b29d Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Tue, 19 Mar 2019 23:58:43 -0400
Subject: Support nested pointers.

---
 monkeypatch.hs | 27 +++++++++++++++++----------
 1 file changed, 17 insertions(+), 10 deletions(-)

diff --git a/monkeypatch.hs b/monkeypatch.hs
index d5889f9..b5f76d4 100644
--- a/monkeypatch.hs
+++ b/monkeypatch.hs
@@ -13,7 +13,7 @@ import Control.Arrow (left,first,second)
 import Data.Either
 import Data.Generics.Aliases
 import Data.Generics.Schemes
-import Debug.Trace
+-- import Debug.Trace
 import Control.Monad
 import qualified Data.ByteString.Char8 as B
 import Data.Char
@@ -49,7 +49,7 @@ import Text.Show.Pretty
 
 import Comments
 
--- trace _ = id
+trace _ = id
 
 -- | Pretty print the given tranlation unit, but replace declarations from header files with @#include@ directives.
 --
@@ -460,6 +460,7 @@ isFunctionDecl (CFDefExt (CFunDef _ _ _ (CCompound [] _ _) _)) = True
 isFunctionDecl _ = False
 
 
+cleanTree d = fmap (const LT) $ everywhere (mkT eraseNodeInfo) $ d
 
 transpile :: C2HaskellOptions -> FilePath -> IncludeStack -> CTranslationUnit NodeInfo -> IO ()
 transpile o fname incs (CTranslUnit edecls _) = do
@@ -487,7 +488,6 @@ transpile o fname incs (CTranslUnit edecls _) = do
                         -- putStrLn $ show (fmap (const LT) c)
                         putStrLn . HS.prettyPrint $ changeType makeFunctionUseIO hh
                         putStrLn $ unwords (hname:as) ++ " ="
-                cleanTree d = fmap (const LT) $ everywhere (mkT eraseNodeInfo) $ d
             forM_ mprintHeader $ \printHeader -> do
                 let bdy = concat $ take 1 $ dropWhile null $ map body $ symbolSource sym
                 if oPrettyTree o
@@ -641,9 +641,11 @@ hsTransField ctyps vars
         trace ("fident="++show mfident) $ return ()
         trace ("ptrdeclr="++show ptrdeclr) $ return ()
         let btyp = HS.TyCon () typname
+            grok :: Show a => [CDerivedDeclarator a] -> HS.Type () -> HS.Type ()
             grok bs b = case bs of
                 []                               -> b
-                (CPtrDeclr [] _:cs)              -> HS.TyApp () (HS.TyCon () (hsMkName "Ptr")) (grok cs b)
+                CArrDeclr [] (CNoArrSize _) _:cs -> HS.TyApp () (HS.TyCon () (hsMkName "Ptr")) (grok cs b)
+                CPtrDeclr [] _               :cs -> HS.TyApp () (HS.TyCon () (hsMkName "Ptr")) (grok cs b)
                 CFunDeclr (Right (args,flg)) attrs _:p ->
                     let (as,ts) = unzip $ concatMap (\(CDecl rs as _) -> map fst $ hsTransField rs $ concatMap fieldInfo as) args
                         b0 = case p of
@@ -706,11 +708,16 @@ primtypes t = [t]
 -- Haskell type name as string.
 tname :: HS.Type () -> String
 tname (HS.TyCon () (HS.UnQual () (HS.Ident () str))) = str
-tname _                                              = "_unkonwn"
+tname t                                              = "_unknown(" ++ show (cleanTree t)++")"
 
 getPtrType :: HS.Type l -> Maybe (HS.Type l)
-getPtrType (HS.TyApp _ (HS.TyCon _ (HS.UnQual _ (HS.Ident _ "Ptr"))) x) = Just x
-getPtrType _                                                            = Nothing
+getPtrType (HS.TyApp _ (HS.TyCon _ (HS.UnQual _ (HS.Ident _ "Ptr"))) x) | isPtrType x = getPtrType x
+                                                                        | otherwise   = Just x
+getPtrType _ = Nothing
+
+isPtrType :: HS.Type l -> Bool
+isPtrType (HS.TyApp _ (HS.TyCon _ (HS.UnQual _ (HS.Ident _ "Ptr"))) x) = True
+isPtrType _                                                            = False
 
 -- pointers :: [HS.Decl ()] -> [String]
 pointers :: [HS.Type l] -> [HS.Type l]
@@ -921,7 +928,7 @@ c2haskell opts cs cmodname missings incs (CTranslUnit edecls _) = do
           forM_ (uniq $ ts ++ sigs2) $ \(t,ct) -> do
             case ct >>= (`Map.lookup` syms db) of
                 Just si -> case take 1 (symbolSource si) >>= enumCases of
-                    [] -> hPutStrLn haskmod $ "data " ++ t
+                    [] -> hPutStrLn haskmod $ "data-1 " ++ t
                     (eni,es):_ -> do
                         let symfile :: Maybe FilePath
                             symfile = (listToMaybe (symbolSource si) >>= fileOfNode)
@@ -949,7 +956,7 @@ c2haskell opts cs cmodname missings incs (CTranslUnit edecls _) = do
                                   -> hPutStr haskmod $ commented $ "| " ++ strip s
                                 x -> hPutStr haskmod $ commented $ "x="++show x
                             hPutStrLn haskmod $ unwords ["pattern",identToString e,"=",t,show n]
-                Nothing -> hPutStrLn haskmod $ "data " ++ t
+                Nothing -> hPutStrLn haskmod $ "data-2 " ++ t ++ "-- (t,ct)="++show (t,ct)
           hPutStrLn haskmod ""
           forM_ sigs $ \(_,(k,hs,d)) -> do
             forM_ hs $ \hdecl -> do
@@ -1033,7 +1040,7 @@ c2haskell opts cs cmodname missings incs (CTranslUnit edecls _) = do
                 putStrLn $ show $ pretty $ makeFunctionPointer d
                 putStrLn $ show $ pretty $ makeSetter d
                 putStrLn $ show $ pretty $ makeStub d
-                putStrLn $ ppShow $ everywhere (mkT eraseNodeInfo) d -- <$> makeFunctionPointer d
+                putStrLn $ ppShow $ cleanTree d -- <$> makeFunctionPointer d
 
 -- TODO: make idempotent
 makeStatic :: [CDeclarationSpecifier NodeInfo] -> [CDeclarationSpecifier NodeInfo]
-- 
cgit v1.2.3