never executed always true always false

    1 {-# LANGUAGE OverloadedStrings #-}
    2 
    3 {- |
    4 Module      : NITTA.Utils
    5 Description :
    6 Copyright   : (c) Aleksandr Penskoi, 2019
    7 License     : BSD3
    8 Maintainer  : aleksandr.penskoi@gmail.com
    9 Stability   : experimental
   10 -}
   11 module NITTA.Utils (
   12     doc2text,
   13     Verilog,
   14     shiftI,
   15 
   16     -- * HDL generation
   17     bool2verilog,
   18     values2dump,
   19     hdlValDump,
   20     toModuleName,
   21 
   22     -- * Process inspection
   23     endpointAt,
   24     getEndpoint,
   25     getInstruction,
   26     getEndpoints,
   27     transferred,
   28     inputsPushedAt,
   29     stepsInterval,
   30     relatedEndpoints,
   31     isIntermediate,
   32     getIntermediate,
   33     getIntermediates,
   34     isInstruction,
   35     module NITTA.Utils.Base,
   36 
   37     -- * Toml
   38     getToml,
   39     getFromToml,
   40     getFromTomlSection,
   41 ) where
   42 
   43 import Data.Aeson
   44 import Data.Bits (setBit, testBit)
   45 import Data.HashMap.Strict qualified as HM
   46 import Data.List (sortOn)
   47 import Data.Maybe
   48 import Data.String.Utils qualified as S
   49 import Data.Text qualified as T
   50 import NITTA.Intermediate.Types
   51 import NITTA.Model.ProcessorUnits.Types
   52 import NITTA.Utils.Base
   53 import NITTA.Utils.ProcessDescription
   54 import Numeric (readInt, showHex)
   55 import Numeric.Interval.NonEmpty (inf, sup, (...))
   56 import Numeric.Interval.NonEmpty qualified as I
   57 import Prettyprinter
   58 import Prettyprinter.Render.Text
   59 import Text.Toml (parseTomlDoc)
   60 
   61 type Verilog = Doc ()
   62 doc2text :: Verilog -> T.Text
   63 doc2text = renderStrict . layoutPretty defaultLayoutOptions
   64 
   65 shiftI offset i = i + I.singleton offset
   66 
   67 bool2verilog True = "1'b1" :: T.Text
   68 bool2verilog False = "1'b0"
   69 
   70 values2dump vs =
   71     let vs' = concatMap show vs
   72         x = length vs' `mod` 4
   73         vs'' = if x == 0 then vs' else replicate (4 - x) '0' ++ vs'
   74      in concatMap (\e -> showHex (readBin e) "") $ groupBy4 vs''
   75     where
   76         groupBy4 [] = []
   77         groupBy4 xs = take 4 xs : groupBy4 (drop 4 xs)
   78         readBin :: String -> Int
   79         readBin = fst . head . readInt 2 (`elem` ("x01" :: String)) (\case '1' -> 1; _ -> 0)
   80 
   81 hdlValDump x =
   82     let bins =
   83             map (testBit $ rawAttr x) (reverse [0 .. attrWidth x - 1])
   84                 ++ map (testBit $ rawData x) (reverse [0 .. dataWidth x - 1])
   85 
   86         lMod = length bins `mod` 4
   87         bins' =
   88             groupBy4 $
   89                 if lMod == 0
   90                     then bins
   91                     else replicate (4 - lMod) (head bins) ++ bins
   92         hs = map (foldr (\(i, a) acc -> if a then setBit acc i else acc) (0 :: Int) . zip [3, 2, 1, 0]) bins'
   93      in T.concat $ map (T.pack . (`showHex` "")) hs
   94     where
   95         groupBy4 [] = []
   96         groupBy4 xs = take 4 xs : groupBy4 (drop 4 xs)
   97 
   98 toModuleName name = S.replace " " "_" $ S.replace ":" "" name
   99 
  100 endpointAt t p =
  101     case mapMaybe getEndpoint $ whatsHappen t p of
  102         [ep] -> Just ep
  103         [] -> Nothing
  104         eps -> error $ "endpoints collision at: " ++ show t ++ " " ++ show eps
  105 
  106 isIntermediate s = isJust $ getIntermediate s
  107 
  108 getIntermediate Step{pDesc} | IntermediateStep f <- descent pDesc = Just f
  109 getIntermediate _ = Nothing
  110 
  111 getIntermediates p = mapMaybe getIntermediate $ sortOn stepStart $ steps p
  112 
  113 getEndpoint Step{pDesc} | EndpointRoleStep role <- descent pDesc = Just role
  114 getEndpoint _ = Nothing
  115 
  116 isInstruction instr = isJust $ getInstruction instr
  117 
  118 getInstruction Step{pDesc} | instr@(InstructionStep _) <- descent pDesc = Just instr
  119 getInstruction _ = Nothing
  120 
  121 getEndpoints p = mapMaybe getEndpoint $ sortOn stepStart $ steps p
  122 transferred pu = unionsMap variables $ getEndpoints $ process pu
  123 
  124 inputsPushedAt process_ f = sup $ stepsInterval $ relatedEndpoints process_ $ inputs f
  125 
  126 stepsInterval ss =
  127     let a = minimum $ map (inf . pInterval) ss
  128         b = maximum $ map (sup . pInterval) ss
  129      in a ... b
  130 
  131 stepStart Step{pInterval} = I.inf pInterval
  132 
  133 getToml text = either (error . show) id $ parseTomlDoc "parse error: " text
  134 
  135 getFromToml toml = getFromTomlSection T.empty toml
  136 
  137 getFromTomlSection section toml
  138     | section == T.empty = unwrap $ fromJSON $ toJSON toml
  139     | otherwise = case HM.lookup section toml of
  140         Just s -> unwrap $ fromJSON $ toJSON s
  141         Nothing -> error $ "section not found - " <> T.unpack section
  142     where
  143         unwrap (Success conf) = conf
  144         unwrap (Error msg) = error msg