Parser for tuples in macros

This is a first step towards #262.
well-typed · Nov 16, 2024 · 74987ed · 74987ed
1 parent 447145c
commit 74987ed
Show file tree

Hide file tree

Showing 4 changed files with 19 additions and 2 deletions.
diff --git a/hs-bindgen/examples/macros.h b/hs-bindgen/examples/macros.h
@@ -14,6 +14,10 @@
 #define LONG_INT_TOKEN3 1844'6744'0737'0955'0592uLL
 #define LONG_INT_TOKEN4 184467'440737'0'95505'92LLU
 
+#define TUPLE1 ( 1 , 2 )
+#define TUPLE2 3 , 4
+#define TUPLE3 5, 6
+
 // ---
 // https://en.cppreference.com/w/cpp/language/floating_literal
 // (1)

diff --git a/hs-bindgen/src/HsBindgen/C/AST/Macro.hs b/hs-bindgen/src/HsBindgen/C/AST/Macro.hs
@@ -21,6 +21,7 @@ import Data.String
 import Data.Text qualified as Text
 import Data.Type.Equality
   ( type (:~:)(..) )
+import Data.Type.Nat (SNatI)
 import GHC.Generics (Generic)
 import System.FilePath (takeBaseName)
 import Text.Show.Pretty (PrettyVal(..))
@@ -117,6 +118,8 @@ data MFun arity where
   MLogicalAnd :: MFun ( S ( S Z ) )
   -- | @||@
   MLogicalOr  :: MFun ( S ( S Z ) )
+  -- | Tuples
+  MTuple      :: SNatI n => MFun ( S ( S n ) )
 
 deriving stock instance Show ( MFun arity )
 deriving stock instance Eq   ( MFun arity )

diff --git a/hs-bindgen/src/HsBindgen/C/Reparse/Macro.hs b/hs-bindgen/src/HsBindgen/C/Reparse/Macro.hs
@@ -4,6 +4,7 @@ module HsBindgen.C.Reparse.Macro (
     reparseMacro
   ) where
 
+import Data.Type.Nat
 import Data.Vec.Lazy
 import Text.Parsec
 import Text.Parsec.Expr
@@ -18,7 +19,6 @@ import HsBindgen.C.Reparse.Type
 import HsBindgen.Clang.HighLevel.Types
 import HsBindgen.Clang.LowLevel.Core
 
-
 {-------------------------------------------------------------------------------
   Top-level
 
@@ -113,7 +113,7 @@ actualArgs = parens $ mExpr `sepBy` comma
 
 mExpr :: Reparse MExpr
 mExpr =
-    buildExpressionParser ops term <?> "expression"
+    (tup <$> buildExpressionParser ops term `sepBy1` comma) <?> "expression"
   where
     term :: Reparse MExpr
     term = choice [
@@ -169,5 +169,14 @@ mExpr =
       , [ Infix (ap2 MLogicalOr  <$ punctuation "||") AssocLeft ]
       ]
 
+    ap1 :: MFun (S Z) -> MExpr -> MExpr
     ap1 op arg = MApp op ( arg ::: VNil )
+
+    ap2 :: MFun (S (S Z)) -> MExpr -> MExpr -> MExpr
     ap2 op arg1 arg2 = MApp op ( arg1 ::: arg2 ::: VNil )
+
+    tup :: [MExpr] -> MExpr
+    tup []  = error "apSN: empty list" -- sepBy1 should give us @NonEmpty@
+    tup [e] = e
+    tup (e1 : e2 : es) = reifyList es $ \es' -> MApp MTuple (e1 ::: e2 ::: es')
+
diff --git a/hs-bindgen/src/HsBindgen/C/Tc/Macro.hs b/hs-bindgen/src/HsBindgen/C/Tc/Macro.hs
@@ -969,6 +969,7 @@ inferMFun = \case
   MBitwiseOr  -> q1 $ \ a   -> QuantTyBody [Bits a]             ( funTy [a,a]        a )
   MLogicalAnd -> q0 $          QuantTyBody []                   ( funTy [Bool, Bool] Bool )
   MLogicalOr  -> q0 $          QuantTyBody []                   ( funTy [Bool, Bool] Bool )
+  _otherwise  -> QuantTy @Z $ \VNil -> QuantTyBody [] Empty -- TODO
   where
     q0 body = QuantTy @Z             $ \ VNil -> body
     q1 body = QuantTy @( S Z )       $ \ (a ::: VNil) -> body a