<commit_before>{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}

--
-- Quote.hs --- Bit data quasiquoter.
--
-- Copyright (C) 2014, Galois, Inc.
-- All Rights Reserved.
--

module Ivory.Language.Syntax.Concrete.QQ.BitDataQQ (fromBitData) where

import Control.Monad (MonadPlus, msum, when, unless, mzero, join)
import Data.Foldable (find, foldl')
import Data.List (sort)
import Data.Maybe (mapMaybe, catMaybes, isJust)
import Data.Traversable (mapAccumL)
import MonadLib (ChoiceT, findOne, lift)

import           Language.Haskell.TH hiding (Exp, Type)
import qualified Language.Haskell.TH as TH

import qualified Ivory.Language.Bits  as I
import qualified Ivory.Language.Type  as I
import qualified Ivory.Language.Cast  as I
import qualified Ivory.Language.IBool as I
import qualified Ivory.Language.Init  as I
import qualified Ivory.Language.Ref   as I
import Ivory.Language.Syntax.Concrete.ParseAST

import qualified Ivory.Language.BitData.Bits    as B
import qualified Ivory.Language.BitData.BitData as B
import qualified Ivory.Language.BitData.Array   as B
import           Ivory.Language.Syntax.Concrete.QQ.TypeQQ

----------------------------------------------------------------------

-- | Combine a list of items using a "MonadPlus" Monad.  This is used
-- to lift a list of items into a "ChoiceT m a".
anyOf :: MonadPlus m => [a] -> m a
anyOf = msum . map return

----------------------------------------------------------------------
-- AST Annotation

-- | Convert a parser type to a Template Haskell type.
convertType :: BitTy -> Q TH.Type
convertType Bit = getType "Bit"
convertType (Bits n) =
  let b = getType "Bits" in
  appT b (return $ szTy n)
convertType (BitArray n t) = do
  appT (appT (getType "BitArray") (return $ szTy n)) (convertType t)
convertType (BitTySynonym s) = getType s

getType :: String -> Q TH.Type
getType s = do
  m <- lookupTypeName s
  case m of
    Just ty -> return $ ConT ty
    Nothing -> fail $ "undefined type: " ++ s

-- | Look up a type and return its size in bits.
getTyBits :: TH.Type -> ChoiceT Q Integer
getTyBits ty =
  case ty of
    ConT name
      | name == ''B.Bit -> return 1
      | otherwise       -> tyInsts ''B.BitType ty >>= decBits
    AppT (AppT (ConT name) (LitT (NumTyLit n))) ty2
      | name == ''B.BitArray -> do
         m <- lift $ tyBits ty2
         return (fromIntegral n * m)
    AppT (ConT name) (LitT (NumTyLit n))
      | name == ''B.Bits -> return $ fromIntegral n
      | otherwise        -> mzero
    _ -> mzero
  where
    tyInsts name t = lift (reifyInstances name [t]) >>= anyOf
#if __GLASGOW_HASKELL__ >= 781
    decBits (TySynInstD _ (TySynEqn _ t)) = getTyBits t
#else
    decBits (TySynInstD _ (TySynEqn t) = getTyBits t
#endif
    decBits _ = mzero

-- | Return the size in bits of a type that can appear in a bitdata
-- definition.  The allowed forms are "Bit", "Bits n", "BitArray n t"
-- where "t" is a valid bit data type, or a name defined by "bitdata".
tyBits :: TH.Type -> Q Integer
tyBits ty = do
  r <- findOne (getTyBits ty)
  case r of
    Just x  -> return x
    Nothing -> fail $ "invalid bit value base type: " ++ show ty

-- | A field definition annotated with its TH name, type, and bit
-- size.
data THField = THField
  { thFieldName :: Maybe Name
  , thFieldType :: TH.Type
  , thFieldLen  :: Integer
  } deriving Show
<commit_msg>fix parse error.<commit_after>{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}

--
-- Quote.hs --- Bit data quasiquoter.
--
-- Copyright (C) 2014, Galois, Inc.
-- All Rights Reserved.
--

module Ivory.Language.Syntax.Concrete.QQ.BitDataQQ (fromBitData) where

import Control.Monad (MonadPlus, msum, when, unless, mzero, join)
import Data.Foldable (find, foldl')
import Data.List (sort)
import Data.Maybe (mapMaybe, catMaybes, isJust)
import Data.Traversable (mapAccumL)
import MonadLib (ChoiceT, findOne, lift)

import           Language.Haskell.TH hiding (Exp, Type)
import qualified Language.Haskell.TH as TH

import qualified Ivory.Language.Bits  as I
import qualified Ivory.Language.Type  as I
import qualified Ivory.Language.Cast  as I
import qualified Ivory.Language.IBool as I
import qualified Ivory.Language.Init  as I
import qualified Ivory.Language.Ref   as I
import Ivory.Language.Syntax.Concrete.ParseAST

import qualified Ivory.Language.BitData.Bits    as B
import qualified Ivory.Language.BitData.BitData as B
import qualified Ivory.Language.BitData.Array   as B
import           Ivory.Language.Syntax.Concrete.QQ.TypeQQ

----------------------------------------------------------------------

-- | Combine a list of items using a "MonadPlus" Monad.  This is used
-- to lift a list of items into a "ChoiceT m a".
anyOf :: MonadPlus m => [a] -> m a
anyOf = msum . map return

----------------------------------------------------------------------
-- AST Annotation

-- | Convert a parser type to a Template Haskell type.
convertType :: BitTy -> Q TH.Type
convertType Bit = getType "Bit"
convertType (Bits n) =
  let b = getType "Bits" in
  appT b (return $ szTy n)
convertType (BitArray n t) = do
  appT (appT (getType "BitArray") (return $ szTy n)) (convertType t)
convertType (BitTySynonym s) = getType s

getType :: String -> Q TH.Type
getType s = do
  m <- lookupTypeName s
  case m of
    Just ty -> return $ ConT ty
    Nothing -> fail $ "undefined type: " ++ s

-- | Look up a type and return its size in bits.
getTyBits :: TH.Type -> ChoiceT Q Integer
getTyBits ty =
  case ty of
    ConT name
      | name == ''B.Bit -> return 1
      | otherwise       -> tyInsts ''B.BitType ty >>= decBits
    AppT (AppT (ConT name) (LitT (NumTyLit n))) ty2
      | name == ''B.BitArray -> do
         m <- lift $ tyBits ty2
         return (fromIntegral n * m)
    AppT (ConT name) (LitT (NumTyLit n))
      | name == ''B.Bits -> return $ fromIntegral n
      | otherwise        -> mzero
    _ -> mzero
  where
    tyInsts name t = lift (reifyInstances name [t]) >>= anyOf
#if __GLASGOW_HASKELL__ >= 781
    decBits (TySynInstD _ (TySynEqn _ t)) = getTyBits t
#else
    decBits (TySynInstD _ t) = getTyBits t
#endif
    decBits _ = mzero

-- | Return the size in bits of a type that can appear in a bitdata
-- definition.  The allowed forms are "Bit", "Bits n", "BitArray n t"
-- where "t" is a valid bit data type, or a name defined by "bitdata".
tyBits :: TH.Type -> Q Integer
tyBits ty = do
  r <- findOne (getTyBits ty)
  case r of
    Just x  -> return x
    Nothing -> fail $ "invalid bit value base type: " ++ show ty

-- | A field definition annotated with its TH name, type, and bit
-- size.
data THField = THField
  { thFieldName :: Maybe Name
  , thFieldType :: TH.Type
  , thFieldLen  :: Integer
  } deriving Show

{'fraction_non_alphanumeric': 0.1451353328456474, 'fraction_numerical': 0.002926115581565472, 'mean_word_length': 2.5697127937336814, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 45, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4150308', 'n_tokens_mistral': 2249, 'n_tokens_neox': 2187, 'n_words': 803}