clash-ffi: Fixup files for formatting compatibility

Author: rowanG077

clash-ffi/src/Clash/FFI/VPI/Callback.hs

@@ -13,18 +13,27 @@ Maintainer:   QBayLogic B.V. <devops@qbaylogic.com>
 {-# OPTIONS_GHC -fplugin=Foreign.Storable.Generic.Plugin #-}
 {-# OPTIONS_GHC -fplugin-opt=Foreign.Storable.Generic.Plugin:-v0 #-}
 
+#ifndef IVERILOG
 module Clash.FFI.VPI.Callback
   ( CCallbackInfo(..)
   , CallbackInfo(..)
   , Callback(..)
   , registerCallback
   , removeCallback
-#ifndef IVERILOG
   , getCallbackInfo
   , withCallbackInfo
   , unsafeReceiveCallbackInfo
   , receiveCallbackInfo
+  , module Clash.FFI.VPI.Callback.Reason
+  ) where
 #endif
+
+module Clash.FFI.VPI.Callback
+  ( CCallbackInfo(..)
+  , CallbackInfo(..)
+  , Callback(..)
+  , registerCallback
+  , removeCallback
   , module Clash.FFI.VPI.Callback.Reason
   ) where
 

clash-ffi/src/Clash/FFI/VPI/Callback/Reason.hs

@@ -66,6 +66,7 @@ obviously unchecked / unsafe, so must be performed carefully.
 --   for a compliant VPI implementation but a feature is optional and may not
 --   be implemented in all tools.
 --
+{- FOURMOLU_DISABLE -}
 data CallbackReason
   = forall a. Coercible a Object => AfterValueChange a TimeType ValueFormat
   -- ^ Triggered after the value of the object @a@ changes.
@@ -148,6 +149,7 @@ data CallbackReason
   -- ^ Triggered after non-blocking events in a time step are executed, but
   -- before read-only events are processed.
 #endif
+{- FOURMOLU_ENABLE -}
 
 type instance CRepr CallbackReason = (CInt, Object, Ptr CTime, Ptr CValue)
 
@@ -494,6 +496,7 @@ instance Show UnknownCallbackReason where
       , prettyCallStack c
       ]
 
+{- FOURMOLU_DISABLE -}
 instance UnsafeReceive CallbackReason where
   unsafeReceive (creason, object, ctime, cvalue) =
     let mObject = if isNullObject object then Nothing else Just object in
@@ -737,3 +740,4 @@ instance Receive CallbackReason where
 #endif
 
       n  -> throwIO $ UnknownCallbackReason n callStack
+{- FOURMOLU_ENABLE -}

clash-ffi/src/Clash/FFI/VPI/Control.hs

@@ -7,8 +7,8 @@ Maintainer:   QBayLogic B.V. <devops@qbaylogic.com>
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Clash.FFI.VPI.Control
 #if defined(VERILOG_2001)
+module Clash.FFI.VPI.Control
   ( Control(..)
   , StopValue(..)
   , DiagnosticLevel(..)
@@ -115,5 +115,5 @@ controlSimulator control = do
     throwIO $ CouldNotControl control callStack
 
 #else
-  () where
+  module Clash.FFI.VPI.Control () where
 #endif

clash-ffi/src/Clash/FFI/VPI/Object.hs

@@ -86,9 +86,13 @@ newtype Object
 #if defined(VERILOG)
 foreign import ccall "vpi_user.h vpi_free_object"
   c_vpi_free_object :: Object -> IO CInt
+c_vpi_release :: Object -> IO CInt
+c_vpi_release = c_vpi_free_object
 #elif defined(SYSTEMVERILOG)
 foreign import ccall "vpi_user.h vpi_release_handle"
   c_vpi_release_handle :: Object -> IO CInt
+c_vpi_release :: Object -> IO CInt
+c_vpi_release = c_vpi_release_handle
 #else
 #error "Neither VERILOG or SYSTEMVERILOG is defined in VPI implementation"
 #endif
@@ -135,13 +139,7 @@ instance IsObject Object where
   freeObject obj =
     Monad.unless (isNullObject obj)
       . Monad.void
-#if defined(VERILOG)
-      $ c_vpi_free_object obj
-#elif defined(SYSTEMVERILOG)
-      $ c_vpi_release_handle obj
-#else
-#error "Neither VERILOG or SYSTEMVERILOG is defined in VPI implementation"
-#endif
+      $ c_vpi_release obj
 
   compareObjects =
     c_vpi_compare_objects

clash-ffi/src/Clash/FFI/VPI/Object/Type.hs

@@ -22,19 +22,28 @@ import           Clash.FFI.View
 -- queried using the @vpiType@ property, and the value used to identify when
 -- it is safe to coerce into a type in the higher-level VPI API.
 --
+#if defined(VERILOG_2001)
 data ObjectType
   = ObjModule
   | ObjNet
   | ObjParameter
   | ObjPort
   | ObjReg
-#if defined(VERILOG_2001)
   | ObjCallback
-#endif
   deriving stock (Eq, Show)
+#else
+data ObjectType
+  = ObjModule
+  | ObjNet
+  | ObjParameter
+  | ObjPort
+  | ObjReg
+  deriving stock (Eq, Show)
+#endif
 
 type instance CRepr ObjectType = CInt
 
+#if defined(VERILOG_2001)
 instance Send ObjectType where
   send =
     pure . \case
@@ -43,8 +52,16 @@ instance Send ObjectType where
       ObjParameter -> 41
       ObjPort -> 44
       ObjReg -> 48
-#if defined(VERILOG_2001)
       ObjCallback -> 107
+#else
+instance Send ObjectType where
+  send =
+    pure . \case
+      ObjModule -> 32
+      ObjNet -> 36
+      ObjParameter -> 41
+      ObjPort -> 44
+      ObjReg -> 48
 #endif
 
 -- | An exception thrown when decoding an object type if an invalid value is
@@ -65,14 +82,23 @@ instance Show UnknownObjectType where
       , prettyCallStack c
       ]
 
+#if defined(VERILOG_2001)
 instance Receive ObjectType where
   receive = \case
     32 -> pure ObjModule
     36 -> pure ObjNet
     41 -> pure ObjParameter
     44 -> pure ObjPort
     48 -> pure ObjReg
-#if defined(VERILOG_2001)
     107 -> pure ObjCallback
-#endif
     ty -> throwIO $ UnknownObjectType ty callStack
+#else
+instance Receive ObjectType where
+  receive = \case
+    32 -> pure ObjModule
+    36 -> pure ObjNet
+    41 -> pure ObjParameter
+    44 -> pure ObjPort
+    48 -> pure ObjReg
+    ty -> throwIO $ UnknownObjectType ty callStack
+#endif

clash-ffi/src/Clash/FFI/VPI/Object/Value.hs

@@ -1,3 +1,4 @@
+{- FOURMOLU_DISABLE -}
 {-|
 Copyright:    (C) 2022 Google Inc.
 License:      BSD2 (see the file LICENSE)

clash-ffi/src/Clash/FFI/VPI/Object/Value/Format.hs

@@ -1,3 +1,4 @@
+{- FOURMOLU_DISABLE -}
 {-|
 Copyright:    (C) 2022 Google Inc.
 License:      BSD2 (see the file LICENSE)

clash-ffi/tests/Clash/FFI/Test/Instances.hs

@@ -267,6 +267,8 @@ instance TShow CallbackReason where
          <> pShow t
 #endif
 
+{- FOURMOLU_DISABLE -}
+
 instance Monad m => Serial m CallbackReason where
   series =
        (AfterValueChange <$> obj <~> series <~> series)
@@ -311,6 +313,8 @@ instance Monad m => Serial m CallbackReason where
       mObj :: Series m (Maybe Object)
       mObj = series
 
+{- FOURMOLU_ENABLE -}
+
 -- Additional Clash.FFI.VPI.Control.Control Instances
 
 instance TShow Control
@@ -398,6 +402,7 @@ instance Monad m => Serial m (Property CInt) where
 instance Monad m => Serial m (Property CString) where
   series = foldl (\/) (pure Name) $ map pure [FullName, File]
 
+{- FOURMOLU_DISABLE -}
 instance Monad m => Serial m (Property Bool) where
   series =
     foldl (\/) (pure IsScalar) $ map pure
@@ -407,6 +412,7 @@ instance Monad m => Serial m (Property Bool) where
       , IsLocalParam
 #endif
       ]
+{- FOURMOLU_ENABLE -}
 
 -- Additional Clash.FFI.VPI.Object.Time.TimeType Instances
 

clash-ghc/src-ghc/Clash/GHC/ClashFlags.hs

@@ -43,14 +43,18 @@ parseClashFlags :: IORef ClashOpts -> [Located String]
                 -> IO ([Located String],[Warn])
 parseClashFlags r = parseClashFlagsFull (flagsClash r)
 
-parseClashFlagsFull :: [Flag IO] -> [Located String]
-                    -> IO ([Located String],[Warn])
-parseClashFlagsFull flagsAvialable args = do
-  (leftovers,errs,warns) <- processArgs flagsAvialable args
+processGhcArgs :: [Flag IO] -> [Located String] -> IO ([Located String], [Err], [Warn])
 #if MIN_VERSION_ghc(9,4,0)
-                              parseResponseFile
+processGhcArgs flagsAvailable args = processArgs flagsAvailable args parseResponseFile
+#else
+processGhcArgs flagsAvailable args = processArgs flagsAvailable args
 #endif
 
+parseClashFlagsFull :: [Flag IO] -> [Located String]
+                    -> IO ([Located String],[Warn])
+parseClashFlagsFull flagsAvailable args = do
+  (leftovers,errs,warns) <- processGhcArgs flagsAvailable args
+
   unless (null errs) $ throwGhcExceptionIO $
     errorsToGhcException . map (("on the commandline", ) .  unLoc . errMsg)
                          $ errs

clash-ghc/src-ghc/Clash/GHC/Evaluator.hs

@@ -367,6 +367,23 @@ instantiate tcm pVal@(PrimVal (PrimInfo{primType}) tys es) ty m
 
 instantiate _ p _ _ = error $ "Evaluator.instantiate: Not a tylambda: " ++ show p
 
+getByteArrayIP :: Integer -> BA.ByteArray#
+#if MIN_VERSION_base(4,15,0)
+getByteArrayIP !(IP ba0) = ba0
+#else
+getByteArrayIP !(Jp# !(BN# ba0)) = ba0
+#endif
+getByteArrayIP _ = error "getByteArrayIP: not IP"
+
+getByteArrayIN :: Integer -> BA.ByteArray#
+#if MIN_VERSION_base(4,15,0)
+getByteArrayIN !(IN ba0) = ba0
+#else
+getByteArrayIN !(Jn# !(BN# ba0)) = ba0
+#endif
+getByteArrayIN _ = error "getByteArrayIN: not IN"
+
+
 -- | Evaluate a case-expression
 scrutinise :: Value -> Type -> [Alt] -> Machine -> Machine
 scrutinise v _altTy [] m = setTerm (valToTerm v) m
@@ -390,19 +407,11 @@ scrutinise (Lit l) _altTy alts m = case alts of
        1 | l1 >= ((-2)^(63::Int)) &&  l1 < 2^(63::Int) ->
           Just (IntLiteral l1)
        2 | l1 >= (2^(63::Int)) ->
-#if MIN_VERSION_base(4,15,0)
-          let !(IP ba0) = l1
-#else
-          let !(Jp# !(BN# ba0)) = l1
-#endif
+          let ba0 = getByteArrayIP l1
               ba1 = BA.ByteArray ba0
           in  Just (ByteArrayLiteral ba1)
        3 | l1 < ((-2)^(63::Int)) ->
-#if MIN_VERSION_base(4,15,0)
-          let !(IN ba0) = l1
-#else
-          let !(Jn# !(BN# ba0)) = l1
-#endif
+          let ba0 = getByteArrayIN l1
               ba1 = BA.ByteArray ba0
           in  Just (ByteArrayLiteral ba1)
        _ -> Nothing
@@ -415,11 +424,7 @@ scrutinise (Lit l) _altTy alts m = case alts of
        1 | l1 >= 0 &&  l1 < 2^(64::Int) ->
           Just (WordLiteral l1)
        2 | l1 >= (2^(64::Int)) ->
-#if MIN_VERSION_base(4,15,0)
-          let !(IP ba0) = l1
-#else
-          let !(Jp# !(BN# ba0)) = l1
-#endif
+          let ba0 = getByteArrayIP l1
               ba1 = BA.ByteArray ba0
           in  Just (ByteArrayLiteral ba1)
        _ -> Nothing