{-# LANGUAGE RecordWildCards #-}

module Data.SVD.Util
  ( addReservedFields
  , procFields
  , continuityCheck
  , checkDeviceRegisterContinuity
  , mapPeriphs
  , mapRegs
  , mapFields
  , mapDevFields
  , getPeriphByGroup
  , getPeriph
  , getPeriphMay
  , getPeriphRegMay
  , getPeriphFollow
  , getPeriphRegs
  , getPeriphReg
  , getPeriphRegAddr
  , getPeriphRegFields
  , getRegFields
  , getFieldVal
  , getFieldValues
  , anyReservedSet
  , getDevMemMap
  , registerNames
  , fieldNames
  -- * Sorting
  , sortDeviceByAddresses
  , sortDeviceByNames
  -- * Interrupts
  , fillMissingInterrupts
  ) where

import Control.Lens ((^.), over, set, view)
import Control.Monad (liftM2)
import Data.Bits (Bits, shiftR, (.&.))
import Data.SVD.Lens
import Data.SVD.Types

import qualified Data.Char
import qualified Data.Bits.Pretty
import qualified Data.Either
import qualified Data.List
import qualified Data.Maybe
import qualified Data.Set
import qualified Safe

-- | Find holes in registers and create corresponding reserved fields for these
--
-- First finds missing bits and then merges them to single reserved field
procFields :: Register -> [Field]
procFields :: Register -> [Field]
procFields Register{Int
String
[Field]
Maybe Int
Maybe Dimension
AccessType
regFields :: Register -> [Field]
regResetValue :: Register -> Maybe Int
regAccess :: Register -> AccessType
regSize :: Register -> Int
regAddressOffset :: Register -> Int
regDescription :: Register -> String
regDimension :: Register -> Maybe Dimension
regDisplayName :: Register -> String
regName :: Register -> String
regFields :: [Field]
regResetValue :: Maybe Int
regAccess :: AccessType
regSize :: Int
regAddressOffset :: Int
regDescription :: String
regDimension :: Maybe Dimension
regDisplayName :: String
regName :: String
..} =
    [Field] -> [Field]
dataIfSingleReserved
  forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse
  forall a b. (a -> b) -> a -> b
$ [Field] -> [Field]
sortByOffset ([Field]
regFields forall a. [a] -> [a] -> [a]
++ [Field]
missingAsReserved)
  where
    missingAsReserved :: [Field]
missingAsReserved =
      [(Int, Int)] -> [Field]
mkReserved
      forall a b. (a -> b) -> a -> b
$ forall {a}. (Eq a, Num a) => [a] -> [(a, Int)]
conts
      forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Data.Set.toList Set Int
missing

    mkReserved :: [(Int, Int)] -> [Field]
mkReserved =
      forall a b. (a -> b) -> [a] -> [b]
map
        forall a b. (a -> b) -> a -> b
$ \(Int
offset', Int
width') ->
          Field
            { fieldName :: String
fieldName = String
"_"
            , fieldDescription :: String
fieldDescription = String
"(Reserved)"
            , fieldDimension :: Maybe Dimension
fieldDimension = forall a. Maybe a
Nothing
            , fieldBitOffset :: Int
fieldBitOffset = Int
offset'
            , fieldBitWidth :: Int
fieldBitWidth = Int
width'
            , fieldReserved :: Bool
fieldReserved = Bool
True
            , fieldRegType :: Maybe String
fieldRegType = forall a. Maybe a
Nothing
            }

    conts :: [a] -> [(a, Int)]
conts [a]
x = case forall a. (Eq a, Num a) => [a] -> [a]
cont [a]
x of
      [] -> []
      [a]
s -> (forall a. [a] -> a
head [a]
s, forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
s) forall a. a -> [a] -> [a]
: [a] -> [(a, Int)]
conts (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
s) [a]
x)

    -- find longest increasing sequence
    cont :: (Eq a, Num a) => [a] -> [a]
    cont :: forall a. (Eq a, Num a) => [a] -> [a]
cont (a
x:a
y:[a]
xs) | a
x forall a. Num a => a -> a -> a
+ a
1 forall a. Eq a => a -> a -> Bool
== a
y = a
x forall a. a -> [a] -> [a]
: forall a. (Eq a, Num a) => [a] -> [a]
cont (a
yforall a. a -> [a] -> [a]
:[a]
xs)
    cont (a
x:[a]
_)  = [a
x]
    cont [] = []

    missing :: Set Int
missing = Set Int
allRegs forall a. Ord a => Set a -> Set a -> Set a
`Data.Set.difference` Set Int
existing

    allRegs :: Set Int
allRegs = forall a. Ord a => [a] -> Set a
Data.Set.fromList [Int
0..(Int
regSize forall a. Num a => a -> a -> a
- Int
1)]

    existing :: Set Int
existing =
      forall a. Ord a => [a] -> Set a
Data.Set.fromList
      forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Field] -> [Field]
sortByOffset [Field]
regFields)
      forall a b. (a -> b) -> a -> b
$ \Field{Bool
Int
String
Maybe String
Maybe Dimension
fieldRegType :: Maybe String
fieldReserved :: Bool
fieldBitWidth :: Int
fieldBitOffset :: Int
fieldDimension :: Maybe Dimension
fieldDescription :: String
fieldName :: String
fieldRegType :: Field -> Maybe String
fieldReserved :: Field -> Bool
fieldBitWidth :: Field -> Int
fieldBitOffset :: Field -> Int
fieldDimension :: Field -> Maybe Dimension
fieldDescription :: Field -> String
fieldName :: Field -> String
..} -> [Int
fieldBitOffset .. (Int
fieldBitOffset forall a. Num a => a -> a -> a
+ Int
fieldBitWidth forall a. Num a => a -> a -> a
- Int
1)]

    sortByOffset :: [Field] -> [Field]
sortByOffset = forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn Field -> Int
fieldBitOffset

    -- this handles a case when there are no fields and code above
    -- creates a single full-sized reserved field
    -- which we turn into non-reserved "data" field
    dataIfSingleReserved :: [Field] -> [Field]
dataIfSingleReserved [Field
f] | Field -> Bool
fieldReserved Field
f =
      [ Field
f {
            fieldName :: String
fieldName = String
"DATA"
          , fieldReserved :: Bool
fieldReserved = Bool
False
          }
      ]
    dataIfSingleReserved [Field]
fs = [Field]
fs

-- | Fill in reserved fields for whole @Device@
addReservedFields :: Device -> Device
addReservedFields :: Device -> Device
addReservedFields =
  forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
    (forall s a. HasPeripherals s a => Lens' s a
peripherals forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRegisters s a => Lens' s a
registers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
    Register -> Register
procRegister
  where
    procRegister :: Register -> Register
procRegister Register
r = forall s t a b. ASetter s t a b -> b -> s -> t
set forall s a. HasFields s a => Lens' s a
fields (Register -> [Field]
procFields Register
r) Register
r

-- | Walk processed register fields top to bottom
-- checking that the register is exactly n bits long
continuityCheck :: Register -> Bool
continuityCheck :: Register -> Bool
continuityCheck Register{Int
String
[Field]
Maybe Int
Maybe Dimension
AccessType
regFields :: [Field]
regResetValue :: Maybe Int
regAccess :: AccessType
regSize :: Int
regAddressOffset :: Int
regDescription :: String
regDimension :: Maybe Dimension
regDisplayName :: String
regName :: String
regFields :: Register -> [Field]
regResetValue :: Register -> Maybe Int
regAccess :: Register -> AccessType
regSize :: Register -> Int
regAddressOffset :: Register -> Int
regDescription :: Register -> String
regDimension :: Register -> Maybe Dimension
regDisplayName :: Register -> String
regName :: Register -> String
..} = [Field] -> Int -> Bool
go [Field]
regFields Int
regSize
  where
  go :: [Field] -> Int -> Bool
go [] Int
0 = Bool
True
  go (Field
x:[Field]
xs) Int
remainingBits
    | Field -> Int
fieldBitOffset Field
x forall a. Num a => a -> a -> a
+ Field -> Int
fieldBitWidth Field
x forall a. Eq a => a -> a -> Bool
== Int
remainingBits
    = [Field] -> Int -> Bool
go [Field]
xs (Int
remainingBits forall a. Num a => a -> a -> a
- Field -> Int
fieldBitWidth Field
x)
  go [Field]
_ Int
_ = Bool
False

-- | Walk processed register fields top to bottom
-- checking that the register is exactly n bits long
continuityCheckReg
  :: Device
  -> Peripheral
  -> Register
  -> Either String Register

-- Some ignores
-- TIM5.CNT is 32 bit but has an aliased UIFCPY field
continuityCheckReg :: Device -> Peripheral -> Register -> Either String Register
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"STM32F730", String
"STM32F745", String
"STM32F750", String
"STM32F765"
                     , String
"STM32F7x2", String
"STM32F7x3", String
"STM32F7x6", String
"STM32F7x7", String
"STM32F7x9" ]
  Bool -> Bool -> Bool
&& Peripheral
p forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"TIM5" Bool -> Bool -> Bool
&& Register
r forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"CNT" = forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
-- G4 TIM2.CCR5, might be a bug in stm32-rs
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"STM32G431xx", String
"STM32G441xx", String
"STM32G471xx", String
"STM32G473xx"
                     , String
"STM32G474xx", String
"STM32G483xx", String
"STM32G484xx", String
"STM32G491xx", String
"STM32G4A1xx" ]
  Bool -> Bool -> Bool
&& Peripheral
p forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"TIM2" Bool -> Bool -> Bool
&& Register
r forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"CCR5" = forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"STM32H73x"
  Bool -> Bool -> Bool
&& Peripheral
p forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"CRYP" Bool -> Bool -> Bool
&& Register
r forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"K2LR" = forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r
  | (Device
d forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"STM32L0x2" Bool -> Bool -> Bool
|| Device
d forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"STM32L0x3")
  Bool -> Bool -> Bool
&& Peripheral
p forall s a. s -> Getting a s a -> a
^.forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"PWR" Bool -> Bool -> Bool
&& Register
r forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"CR" = forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"STM32L4P5"
  Bool -> Bool -> Bool
&& Peripheral
p forall s a. s -> Getting a s a -> a
^.forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"TIM15" Bool -> Bool -> Bool
&& Register
r forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"SR" = forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"STM32L4P5"
  Bool -> Bool -> Bool
&& Peripheral
p forall s a. s -> Getting a s a -> a
^.forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"SAI1" Bool -> Bool -> Bool
&& Register
r forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"CR1" = forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"STM32L4P5"
  Bool -> Bool -> Bool
&& Peripheral
p forall s a. s -> Getting a s a -> a
^.forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"FLASH" Bool -> Bool -> Bool
&& Register
r forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"ECCR" = forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"STM32WB55"
  Bool -> Bool -> Bool
&& Peripheral
p forall s a. s -> Getting a s a -> a
^.forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"TIM2" Bool -> Bool -> Bool
&& Register
r forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name forall a. Eq a => a -> a -> Bool
== String
"CNT" = forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r =
  forall {a} {s}.
(Eq a, Num a, HasBitOffset s a, HasBitWidth s a, Show a) =>
[s] -> a -> Either String Register
go
    ( forall a. [a] -> [a]
reverse
    forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn
        (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasBitOffset s a => Lens' s a
bitOffset)
        (Register
r forall s a. s -> Getting a s a -> a
^. forall s a. HasFields s a => Lens' s a
fields)
    )
    (Register
r forall s a. s -> Getting a s a -> a
^. forall s a. HasSize s a => Lens' s a
size)
  where
  go :: [s] -> a -> Either String Register
go [] a
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r

  go (s
x:[s]
xs) a
remainingBits
    | s
x forall s a. s -> Getting a s a -> a
^. forall s a. HasBitOffset s a => Lens' s a
bitOffset forall a. Num a => a -> a -> a
+ s
x forall s a. s -> Getting a s a -> a
^. forall s a. HasBitWidth s a => Lens' s a
bitWidth forall a. Eq a => a -> a -> Bool
== a
remainingBits
    = [s] -> a -> Either String Register
go [s]
xs (a
remainingBits forall a. Num a => a -> a -> a
- (s
x forall s a. s -> Getting a s a -> a
^. forall s a. HasBitWidth s a => Lens' s a
bitWidth))

  go [s]
_xs a
remainingBits =
    forall a b. a -> Either a b
Left
    forall a b. (a -> b) -> a -> b
$ String
"Continuity check failed with remaining bits: "
    forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
remainingBits
    forall a. Semigroup a => a -> a -> a
<> String
" for device "
    forall a. Semigroup a => a -> a -> a
<> Device
d forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name
    forall a. Semigroup a => a -> a -> a
<> String
" for "
    forall a. Semigroup a => a -> a -> a
<> Peripheral
p forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name
    forall a. Semigroup a => a -> a -> a
<> String
"."
    forall a. Semigroup a => a -> a -> a
<> Register
r forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name

-- | Check all devices registers for continuity
checkDeviceRegisterContinuity
  :: Device
  -> Either String Device
checkDeviceRegisterContinuity :: Device -> Either String Device
checkDeviceRegisterContinuity Device
d =
  let
    res :: [Either String Register]
res =
      forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
        (\Peripheral
p ->
          forall a b. (a -> b) -> [a] -> [b]
map
            (Device -> Peripheral -> Register -> Either String Register
continuityCheckReg Device
d Peripheral
p)
            (Peripheral
p forall s a. s -> Getting a s a -> a
^. forall s a. HasRegisters s a => Lens' s a
registers)
        )
      (Device -> [Peripheral]
devicePeripherals Device
d)
  in
    case [Either String Register]
res of
      [Either String Register]
_ | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a b. Either a b -> Bool
Data.Either.isRight [Either String Register]
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Device
d
      [Either String Register]
_ | Bool
otherwise -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [a]
Data.Either.lefts [Either String Register]
res

mapPeriphs :: (Peripheral -> b) -> Device -> [b]
mapPeriphs :: forall b. (Peripheral -> b) -> Device -> [b]
mapPeriphs Peripheral -> b
f Device{Int
String
[Peripheral]
deviceResetMask :: Device -> Int
deviceResetValue :: Device -> Int
deviceSize :: Device -> Int
deviceWidth :: Device -> Int
deviceAddressUnitBits :: Device -> Int
deviceDescription :: Device -> String
deviceVersion :: Device -> String
deviceName :: Device -> String
devicePeripherals :: [Peripheral]
deviceResetMask :: Int
deviceResetValue :: Int
deviceSize :: Int
deviceWidth :: Int
deviceAddressUnitBits :: Int
deviceDescription :: String
deviceVersion :: String
deviceName :: String
devicePeripherals :: Device -> [Peripheral]
..} = forall a b. (a -> b) -> [a] -> [b]
map Peripheral -> b
f [Peripheral]
devicePeripherals

mapRegs :: (Register -> b) -> Peripheral -> [b]
mapRegs :: forall b. (Register -> b) -> Peripheral -> [b]
mapRegs Register -> b
f Peripheral{Int
String
[Register]
[Cluster]
[Interrupt]
Maybe String
Maybe AddressBlock
periphClusters :: Peripheral -> [Cluster]
periphRegisters :: Peripheral -> [Register]
periphInterrupts :: Peripheral -> [Interrupt]
periphAddressBlock :: Peripheral -> Maybe AddressBlock
periphBaseAddress :: Peripheral -> Int
periphGroupName :: Peripheral -> String
periphDerivedFrom :: Peripheral -> Maybe String
periphDescription :: Peripheral -> String
periphName :: Peripheral -> String
periphClusters :: [Cluster]
periphRegisters :: [Register]
periphInterrupts :: [Interrupt]
periphAddressBlock :: Maybe AddressBlock
periphBaseAddress :: Int
periphGroupName :: String
periphDerivedFrom :: Maybe String
periphDescription :: String
periphName :: String
..} = forall a b. (a -> b) -> [a] -> [b]
map Register -> b
f [Register]
periphRegisters

mapFields :: (Field -> b) -> Register -> [b]
mapFields :: forall b. (Field -> b) -> Register -> [b]
mapFields Field -> b
f Register{Int
String
[Field]
Maybe Int
Maybe Dimension
AccessType
regFields :: [Field]
regResetValue :: Maybe Int
regAccess :: AccessType
regSize :: Int
regAddressOffset :: Int
regDescription :: String
regDimension :: Maybe Dimension
regDisplayName :: String
regName :: String
regFields :: Register -> [Field]
regResetValue :: Register -> Maybe Int
regAccess :: Register -> AccessType
regSize :: Register -> Int
regAddressOffset :: Register -> Int
regDescription :: Register -> String
regDimension :: Register -> Maybe Dimension
regDisplayName :: Register -> String
regName :: Register -> String
..} = forall a b. (a -> b) -> [a] -> [b]
map Field -> b
f [Field]
regFields

mapDevFields :: (Field -> b) -> Device -> [b]
mapDevFields :: forall b. (Field -> b) -> Device -> [b]
mapDevFields Field -> b
f Device
d =
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b. (Peripheral -> b) -> Device -> [b]
mapPeriphs Device
d
  forall a b. (a -> b) -> a -> b
$ forall b. (Register -> b) -> Peripheral -> [b]
mapRegs
  forall a b. (a -> b) -> a -> b
$ forall b. (Field -> b) -> Register -> [b]
mapFields Field -> b
f

-- | Get peripheral by groupName
getPeriphByGroup :: String -> Device -> Peripheral
getPeriphByGroup :: String -> Device -> Peripheral
getPeriphByGroup String
name' Device
dev =
  case forall a. String -> (a -> String) -> [a] -> [a]
filterLowerBy String
name' Peripheral -> String
periphGroupName (Device -> [Peripheral]
devicePeripherals Device
dev) of
    [] -> forall a. Partial => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"getPeriphByGroup, peripheral " forall a. [a] -> [a] -> [a]
++ String
name' forall a. [a] -> [a] -> [a]
++ String
" not found"
    [Peripheral
p] -> Peripheral
p
    [Peripheral]
ps -> case forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
Data.Maybe.isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peripheral -> Maybe String
periphDerivedFrom) [Peripheral]
ps of
      [] -> forall a. Partial => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"getPeriphByGroup: No non-derived peripheral found for " forall a. [a] -> [a] -> [a]
++ String
name'
      [Peripheral
p] -> Peripheral
p
      (Peripheral
p:[Peripheral]
_xs) -> Peripheral
p
       -- TODO: warn?
       -- error $ "getPeriphByGroup: Multiple non-derived peripheral found for " ++ name

-- | Get peripheral by name
getPeriph :: String -> Device -> Peripheral
getPeriph :: String -> Device -> Peripheral
getPeriph String
name' Device
dev =
  forall a. Partial => String -> [a] -> a
Safe.headNote (String
"getPeriph " forall a. [a] -> [a] -> [a]
++ String
name')
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> (a -> String) -> [a] -> [a]
filterLowerBy String
name' Peripheral -> String
periphName forall a b. (a -> b) -> a -> b
$ Device -> [Peripheral]
devicePeripherals Device
dev

-- | Get peripheral by name iff found, Nothing otherwise
getPeriphMay :: String -> Device -> Maybe Peripheral
getPeriphMay :: String -> Device -> Maybe Peripheral
getPeriphMay String
name' Device
dev =
  forall a. [a] -> Maybe a
Safe.headMay
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> (a -> String) -> [a] -> [a]
filterLowerBy String
name' Peripheral -> String
periphName forall a b. (a -> b) -> a -> b
$ Device -> [Peripheral]
devicePeripherals Device
dev

-- | Get register of the peripheral by their names iff found, Nothing otherwise
getPeriphRegMay :: String -> Peripheral -> Maybe Register
getPeriphRegMay :: String -> Peripheral -> Maybe Register
getPeriphRegMay String
rName =
  forall a. [a] -> Maybe a
Safe.headMay
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> (a -> String) -> [a] -> [a]
filterLowerBy String
rName Register -> String
regName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peripheral -> [Register]
periphRegisters

-- | Filter elements matching lowercased `eqTo` after applying `by`
filterLowerBy :: String -> (a -> String) -> [a] -> [a]
filterLowerBy :: forall a. String -> (a -> String) -> [a] -> [a]
filterLowerBy String
eqTo a -> String
by =
  forall a. (a -> Bool) -> [a] -> [a]
filter
  forall a b. (a -> b) -> a -> b
$ (forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Data.Char.toLower String
eqTo)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Data.Char.toLower
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
by

-- | Get peripheral by name or its parent peripheral if it's
-- a derived peripheral (for example USART2 is typically derived from USART1)
getPeriphFollow :: String -> Device -> Either String Peripheral
getPeriphFollow :: String -> Device -> Either String Peripheral
getPeriphFollow String
pName Device
dev = case String -> Device -> Maybe Peripheral
getPeriphMay String
pName Device
dev of
  Maybe Peripheral
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"No peripheral found: " forall a. [a] -> [a] -> [a]
++ String
pName
  Just Peripheral
p  -> case Peripheral -> Maybe String
periphDerivedFrom Peripheral
p of
    Maybe String
Nothing -> forall a b. b -> Either a b
Right Peripheral
p
    Just String
fromName -> case String -> Device -> Maybe Peripheral
getPeriphMay String
fromName Device
dev of
      Maybe Peripheral
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Parent peripheral not found: " forall a. [a] -> [a] -> [a]
++ String
fromName forall a. [a] -> [a] -> [a]
++ String
" for peripheral " forall a. [a] -> [a] -> [a]
++ String
pName
      Just Peripheral
parentPeriph -> forall a b. b -> Either a b
Right Peripheral
parentPeriph

-- | Get registers of the peripheral
getPeriphRegs :: String -> Device -> Either String [Register]
getPeriphRegs :: String -> Device -> Either String [Register]
getPeriphRegs String
pName Device
dev = Peripheral -> [Register]
periphRegisters forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Device -> Either String Peripheral
getPeriphFollow String
pName Device
dev

-- | Get specific register of the peripheral
-- Follows derived from.
getPeriphReg :: String -> String -> Device -> Either String Register
getPeriphReg :: String -> String -> Device -> Either String Register
getPeriphReg String
pName String
rName Device
dev =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    forall a b. a -> Either a b
Left
    (forall a b. a -> Maybe b -> Either a b
maybeToEither String
errMsg forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Peripheral -> Maybe Register
getPeriphRegMay String
rName)
    forall a b. (a -> b) -> a -> b
$ String -> Device -> Either String Peripheral
getPeriphFollow String
pName Device
dev
  where
    errMsg :: String
errMsg = String
"No register found: " forall a. [a] -> [a] -> [a]
++ String
rName forall a. [a] -> [a] -> [a]
++ String
" for peripheral " forall a. [a] -> [a] -> [a]
++ String
pName

maybeToEither :: a -> Maybe b -> Either a b
maybeToEither :: forall a b. a -> Maybe b -> Either a b
maybeToEither a
msg Maybe b
m = case Maybe b
m of
  Just b
x -> forall a b. b -> Either a b
Right b
x
  Maybe b
Nothing -> forall a b. a -> Either a b
Left a
msg

-- | Get address of the specific register of the peripheral with `pName`
getPeriphRegAddr :: String -> String -> Device -> Either String Int
getPeriphRegAddr :: String -> String -> Device -> Either String Int
getPeriphRegAddr String
pName String
rName Device
dev =
  (\Peripheral
p Register
r -> Peripheral -> Int
periphBaseAddress Peripheral
p forall a. Num a => a -> a -> a
+ Register -> Int
regAddressOffset Register
r)
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. a -> Maybe b -> Either a b
maybeToEither String
errMsg (String -> Device -> Maybe Peripheral
getPeriphMay String
pName Device
dev)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Device -> Either String Register
getPeriphReg String
pName String
rName Device
dev
  where
    errMsg :: String
errMsg = String
"No peripheral found " forall a. [a] -> [a] -> [a]
++ String
pName

-- | Get fields of the specific register of the peripheral with `pName`
getPeriphRegFields
  :: String -- ^ Peripheral name
  -> String -- ^ Register name
  -> Device
  -> Either String [Field]
getPeriphRegFields :: String -> String -> Device -> Either String [Field]
getPeriphRegFields String
pName String
rName Device
dev =
  Register -> [Field]
regFields forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Device -> Either String Register
getPeriphReg String
pName String
rName Device
dev

getReg
  :: String -- ^ Peripheral name
  -> String -- ^ Register name
  -> Device
  -> Register
getReg :: String -> String -> Device -> Register
getReg String
pName String
rName Device
dev =
  forall a. Partial => String -> [a] -> a
Safe.headNote String
"getReg"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter((forall a. Eq a => a -> a -> Bool
==String
rName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Register -> String
regName)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peripheral -> [Register]
periphRegisters
  forall a b. (a -> b) -> a -> b
$ String -> Device -> Peripheral
getPeriph String
pName Device
dev

getRegFields
  :: String -- ^ Peripheral name
  -> String -- ^ Register name
  -> Device
  -> [Field]
getRegFields :: String -> String -> Device -> [Field]
getRegFields String
pName String
rName Device
dev =
  Register -> [Field]
regFields
  forall a b. (a -> b) -> a -> b
$ String -> String -> Device -> Register
getReg String
pName String
rName Device
dev

-- | Get value of specific @Field@ according to input `x`
getFieldVal :: (Bits a, Num a) => a -> Field -> a
getFieldVal :: forall a. (Bits a, Num a) => a -> Field -> a
getFieldVal a
x Field
f = (a
x forall a. Bits a => a -> Int -> a
`shiftR` Field -> Int
fieldBitOffset Field
f) forall a. Bits a => a -> a -> a
.&. (a
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Field -> Int
fieldBitWidth Field
f forall a. Num a => a -> a -> a
- a
1)

-- | Decode integer `x` according to Fields `fs`
getFieldValues :: (Bits a, Num a) => a -> [Field] -> [(a, Field)]
getFieldValues :: forall a. (Bits a, Num a) => a -> [Field] -> [(a, Field)]
getFieldValues a
x [Field]
fs = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Bits a, Num a) => a -> Field -> a
getFieldVal a
x) [Field]
fs) [Field]
fs

-- | Check if any reserved field has value other than 0
anyReservedSet :: (Eq a, Num a) => [(a, Field)] -> Bool
anyReservedSet :: forall a. (Eq a, Num a) => [(a, Field)] -> Bool
anyReservedSet = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(a
val, Field
f) -> a
val forall a. Eq a => a -> a -> Bool
/= a
0 Bool -> Bool -> Bool
&& Field -> Bool
fieldReserved Field
f)

-- | Get memory map of the device according to its perhiperal addresses
getDevMemMap :: Device -> [(String, String)]
getDevMemMap :: Device -> [(String, String)]
getDevMemMap Device{Int
String
[Peripheral]
devicePeripherals :: [Peripheral]
deviceResetMask :: Int
deviceResetValue :: Int
deviceSize :: Int
deviceWidth :: Int
deviceAddressUnitBits :: Int
deviceDescription :: String
deviceVersion :: String
deviceName :: String
deviceResetMask :: Device -> Int
deviceResetValue :: Device -> Int
deviceSize :: Device -> Int
deviceWidth :: Device -> Int
deviceAddressUnitBits :: Device -> Int
deviceDescription :: Device -> String
deviceVersion :: Device -> String
deviceName :: Device -> String
devicePeripherals :: Device -> [Peripheral]
..} =
  forall a b. (a -> b) -> [a] -> [b]
map
    (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (forall t. PrintfArg t => t -> String
Data.Bits.Pretty.formatHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peripheral -> Int
periphBaseAddress) Peripheral -> String
periphName)
    [Peripheral]
devicePeripherals

registerNames :: String -> Device -> [String]
registerNames :: String -> Device -> [String]
registerNames String
pName Device
dev =
  forall a b. (a -> b) -> [a] -> [b]
map
    Register -> String
regName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peripheral -> [Register]
periphRegisters
    forall a b. (a -> b) -> a -> b
$ String -> Device -> Peripheral
getPeriph String
pName Device
dev

fieldNames :: String -> String -> Device -> [String]
fieldNames :: String -> String -> Device -> [String]
fieldNames String
rName String
pName Device
dev =
  forall a b. (a -> b) -> [a] -> [b]
map
    Field -> String
fieldName
    forall a b. (a -> b) -> a -> b
$ String -> String -> Device -> [Field]
getRegFields String
pName String
rName Device
dev

-- * Sorting

-- | Sort everything by memory address
sortDeviceByAddresses :: Device -> Device
sortDeviceByAddresses :: Device -> Device
sortDeviceByAddresses =
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      forall s a. HasPeripherals s a => Lens' s a
peripherals
      (forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasBaseAddress s a => Lens' s a
baseAddress))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      (forall s a. HasPeripherals s a => Lens' s a
peripherals forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRegisters s a => Lens' s a
registers)
      (forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasAddressOffset s a => Lens' s a
addressOffset))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      (forall s a. HasPeripherals s a => Lens' s a
peripherals forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRegisters s a => Lens' s a
registers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFields s a => Lens' s a
fields)
      (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasBitOffset s a => Lens' s a
bitOffset))

-- | Sort everything by name
sortDeviceByNames :: Device -> Device
sortDeviceByNames :: Device -> Device
sortDeviceByNames =
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      forall s a. HasPeripherals s a => Lens' s a
peripherals
      (forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasName s a => Lens' s a
name))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      (forall s a. HasPeripherals s a => Lens' s a
peripherals forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRegisters s a => Lens' s a
registers)
      (forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasName s a => Lens' s a
name))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      (forall s a. HasPeripherals s a => Lens' s a
peripherals forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRegisters s a => Lens' s a
registers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFields s a => Lens' s a
fields)
      (forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s a. HasName s a => Lens' s a
name))

-- * Interrupts

fillMissingInterrupts
  :: [Interrupt]
  -> [Interrupt]
fillMissingInterrupts :: [Interrupt] -> [Interrupt]
fillMissingInterrupts [Interrupt]
isrs =
  [Interrupt]
isrs
  forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map Int -> Interrupt
filler forall a b. (a -> b) -> a -> b
$ [Int]
missingInterrupts)
  where
    filler :: Int -> Interrupt
filler Int
x = Interrupt {
       interruptName :: String
interruptName = String
"Undefined" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
x
     , interruptValue :: Int
interruptValue = Int
x
     , interruptDescription :: String
interruptDescription = String
"Undefined interrupt (padding only)"
     }
    missingInterrupts :: [Int]
missingInterrupts =
      let
        vals :: [Int]
vals = forall a b. (a -> b) -> [a] -> [b]
map Interrupt -> Int
interruptValue [Interrupt]
isrs
      in
          forall a. Set a -> [a]
Data.Set.toList
        forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference
            (forall a. Ord a => [a] -> Set a
Data.Set.fromList [Int
0 .. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
vals])
            (forall a. Ord a => [a] -> Set a
Data.Set.fromList [Int]
vals)