<commit_before>{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}

--
-- Ivory types QuasiQuoter.
--
-- Copyright (C) 2014, Galois, Inc.
-- All rights reserved.
--

module Ivory.Language.Syntax.Concrete.QQ.TypeQQ where

import           Prelude hiding (exp, init)

import Data.List (nub)
import Control.Monad

import Ivory.Language.Syntax.Concrete.QQ.Common

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

import qualified Ivory.Language.Float     as I
import qualified Ivory.Language.IBool     as I
import qualified Ivory.Language.IChar     as I
import qualified Ivory.Language.Sint      as I
import qualified Ivory.Language.Uint      as I
import qualified Ivory.Language.Scope     as I
import qualified Ivory.Language.Area      as I
import qualified Ivory.Language.Ref       as I
import qualified Ivory.Language.Proc      as I
import qualified Ivory.Language.Proxy     as I
import qualified Ivory.Language.Array     as I

import Ivory.Language.Syntax.Concrete.ParseAST

--------------------------------------------------------------------------------
-- Haskell type synonyms

fromTypeDef :: TypeDef -> Q Dec
fromTypeDef (TypeDef syn ty) = do
  n      <- newName syn
  (t, _) <- runToQ (fromType ty)
  return (TySynD n [] t)

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

-- Data type to keep track of class constraints
data Class = Int -- SingI type constraint
  deriving (Show, Read, Eq, Ord)

data TyVar = TyVar
  { tyVar       :: Name
  , constraints :: [Class]
  } deriving (Show, Eq, Ord)

-- We use a state monad over the Q monad to keep track of type variables that we
-- need to quantify later.
type TTyVar a = QStM TyVar a

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

fromIntSz :: IntSize -> Name
fromIntSz sz = case sz of
  Int8  -> ''I.Sint8
  Int16 -> ''I.Sint16
  Int32 -> ''I.Sint32
  Int64 -> ''I.Sint64

fromWordSz :: WordSize -> Name
fromWordSz sz = case sz of
  Word8  -> ''I.Uint8
  Word16 -> ''I.Uint16
  Word32 -> ''I.Uint32
  Word64 -> ''I.Uint64

fromScope :: Scope -> TTyVar T.Type
fromScope ma = case ma of
  Global     -> liftPromote 'I.Global
  Stack mv   -> do s <- liftPromote 'I.Stack
                   n <- case mv of
                      Nothing -> newTyVar "s" []
                      Just v  -> mkTyVar v []
                   return (AppT s n)
  PolyMem mv -> case mv of
                  Nothing -> newTyVar "c" []
                  Just v  -> mkTyVar  v   []

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

constrTyVar :: Name -> [Class] -> TTyVar T.Type
constrTyVar n classes = do
  insert (TyVar n classes)
  return (VarT n)

newTyVar :: String -> [Class] -> TTyVar T.Type
newTyVar v classes = do
  n <- liftQ (newName v)
  constrTyVar n classes

mkTyVar :: String -> [Class] -> TTyVar T.Type
mkTyVar v classes = do
  n <- return (mkName v)
  constrTyVar n classes

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

-- Syntactic check for base types
-- isBaseType :: T.Type -> Bool
-- isBaseType ty
--   | ty == PromotedT '()            = True

--   | ty == PromotedT 'I.Sint8       = True
--   | ty == PromotedT 'I.Sint16      = True
--   | ty == PromotedT 'I.Sint32      = True
--   | ty == PromotedT 'I.Sint64      = True

--   | ty == PromotedT 'I.Uint8       = True
--   | ty == PromotedT 'I.Uint16      = True
--   | ty == PromotedT 'I.Uint32      = True
--   | ty == PromotedT 'I.Uint64      = True

--   | ty == PromotedT 'I.IBool       = True
--   | ty == PromotedT 'I.IChar       = True
--   | ty == PromotedT 'I.IFloat      = True
--   | ty == PromotedT 'I.IDouble     = True
--   | otherwise                      =
--     let ix = PromotedT 'I.Ix in
--     case ty of
--       AppT i _ -> i == ix
--       _        -> False

isBaseType :: Type -> Bool
isBaseType ty = case ty of
  TyVoid            -> True
  TyInt sz          -> True
  TyWord sz         -> True
  TyBool            -> True
  TyChar            -> True
  TyFloat           -> True
  TyDouble          -> True
  TyIx ix           -> True
  TyStored area     -> False
  TyStruct nm       -> False
  TyArray a sz      -> False
  TyRef qma qt      -> False
  TyConstRef qma qt -> False
  TySynonym str     -> False

maybeAddStored :: Type -> Type
maybeAddStored ty =<commit_msg>concrete syntax: cleanups.<commit_after>{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}

--
-- Ivory types QuasiQuoter.
--
-- Copyright (C) 2014, Galois, Inc.
-- All rights reserved.
--

module Ivory.Language.Syntax.Concrete.QQ.TypeQQ where

import           Prelude hiding (exp, init)

import Data.List (nub)
import Control.Monad

import Ivory.Language.Syntax.Concrete.QQ.Common

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

import qualified Ivory.Language.Float     as I
import qualified Ivory.Language.IBool     as I
import qualified Ivory.Language.IChar     as I
import qualified Ivory.Language.Sint      as I
import qualified Ivory.Language.Uint      as I
import qualified Ivory.Language.Scope     as I
import qualified Ivory.Language.Area      as I
import qualified Ivory.Language.Ref       as I
import qualified Ivory.Language.Proc      as I
import qualified Ivory.Language.Proxy     as I
import qualified Ivory.Language.Array     as I

import Ivory.Language.Syntax.Concrete.ParseAST

--------------------------------------------------------------------------------
-- Haskell type synonyms

fromTypeDef :: TypeDef -> Q Dec
fromTypeDef (TypeDef syn ty) = do
  n      <- newName syn
  (t, _) <- runToQ (fromType ty)
  return (TySynD n [] t)

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

-- Data type to keep track of class constraints
data Class = Int -- SingI type constraint
  deriving (Show, Read, Eq, Ord)

data TyVar = TyVar
  { tyVar       :: Name
  , constraints :: [Class]
  } deriving (Show, Eq, Ord)

-- We use a state monad over the Q monad to keep track of type variables that we
-- need to quantify later.
type TTyVar a = QStM TyVar a

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

fromIntSz :: IntSize -> Name
fromIntSz sz = case sz of
  Int8  -> ''I.Sint8
  Int16 -> ''I.Sint16
  Int32 -> ''I.Sint32
  Int64 -> ''I.Sint64

fromWordSz :: WordSize -> Name
fromWordSz sz = case sz of
  Word8  -> ''I.Uint8
  Word16 -> ''I.Uint16
  Word32 -> ''I.Uint32
  Word64 -> ''I.Uint64

fromScope :: Scope -> TTyVar T.Type
fromScope ma = case ma of
  Global     -> liftPromote 'I.Global
  Stack mv   -> do s <- liftPromote 'I.Stack
                   n <- case mv of
                      Nothing -> newTyVar "s" []
                      Just v  -> mkTyVar v []
                   return (AppT s n)
  PolyMem mv -> case mv of
                  Nothing -> newTyVar "c" []
                  Just v  -> mkTyVar  v   []

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

constrTyVar :: Name -> [Class] -> TTyVar T.Type
constrTyVar n classes = do
  insert (TyVar n classes)
  return (VarT n)

newTyVar :: String -> [Class] -> TTyVar T.Type
newTyVar v classes = do
  n <- liftQ (newName v)
  constrTyVar n classes

mkTyVar :: String -> [Class] -> TTyVar T.Type
mkTyVar v classes = do
  n <- return (mkName v)
  constrTyVar n classes

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

-- Syntactic check for base types
isBaseType :: Type -> Bool
isBaseType ty = case ty of
  TyVoid       -> True
  TyInt{}      -> True
  TyWord{}     -> True
  TyBool       -> True
  TyChar       -> True
  TyFloat      -> True
  TyDouble     -> True
  TyIx{}       -> True
  TyStored{}   -> False
  TyStruct{}   -> False
  TyArray{}    -> False
  TyRef{}      -> False
  TyConstRef{} -> False
  TySynonym{}  -> False

maybeAddStored :: Type -> Type
maybeAddStored ty =
{'fraction_non_alphanumeric': 0.19730331519049976, 'fraction_numerical': 0.009648688767936665, 'mean_word_length': 1.5496688741721854, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 88, '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': '4247459', 'n_tokens_mistral': 2516, 'n_tokens_neox': 2411, 'n_words': 788}