<commit_before>{-# LANGUAGE LambdaCase, TupleSections, RecordWildCards, OverloadedStrings, TemplateHaskell #-}

module Reducer.LLVM.InferType where

import Text.Printf

import Data.Map (Map)
import qualified Data.Map as Map
import Data.Vector (Vector)
import qualified Data.Vector as V

import Control.Monad.State
import Lens.Micro.Platform

import Reducer.LLVM.Base
import Grin
import TypeEnv
import Pretty

-- allows simple type singletons or locations
validateNodeItem :: Type -> CG ()
validateNodeItem ts@T_NodeSet{} = error $ printf "illegal node item type %s" (show $ pretty ts)
validateNodeItem _ = pure ()

nodeType :: Tag -> [Type] -> CG Type
nodeType tag items = do
  mapM_ validateNodeItem items
  pure $ T_NodeSet $ Map.singleton tag $ V.fromList $ map _simpleType items

typeOfVal :: Val -> CG Type
typeOfVal val = do
  case val of
    ConstTagNode tag args -> mapM typeOfVal args >>= nodeType tag
    {-
    VarTagNode    Name [SimpleVal] -- complete node (variable tag)
    ValTag        Tag
    -}
    Unit      -> pure $ T_SimpleType T_Unit
    Lit lit   -> pure $ typeOfLit lit
    Var name  -> use (envTypeEnv.variable.at name) >>= \case
                  Nothing -> error $ printf "unknown variable %s" name
                  Just ty -> pure ty
    _ -> error $ printf "unsupported val" (show $ pretty val)<commit_msg>fix error message<commit_after>{-# LANGUAGE LambdaCase, TupleSections, RecordWildCards, OverloadedStrings, TemplateHaskell #-}

module Reducer.LLVM.InferType where

import Text.Printf

import Data.Map (Map)
import qualified Data.Map as Map
import Data.Vector (Vector)
import qualified Data.Vector as V

import Control.Monad.State
import Lens.Micro.Platform

import Reducer.LLVM.Base
import Grin
import TypeEnv
import Pretty

-- allows simple type singletons or locations
validateNodeItem :: Type -> CG ()
validateNodeItem ts@T_NodeSet{} = error $ printf "illegal node item type %s" (show $ pretty ts)
validateNodeItem _ = pure ()

nodeType :: Tag -> [Type] -> CG Type
nodeType tag items = do
  mapM_ validateNodeItem items
  pure $ T_NodeSet $ Map.singleton tag $ V.fromList $ map _simpleType items

typeOfVal :: Val -> CG Type
typeOfVal val = do
  case val of
    ConstTagNode tag args -> mapM typeOfVal args >>= nodeType tag
    {-
    VarTagNode    Name [SimpleVal] -- complete node (variable tag)
    ValTag        Tag
    -}
    Unit      -> pure $ T_SimpleType T_Unit
    Lit lit   -> pure $ typeOfLit lit
    Var name  -> use (envTypeEnv.variable.at name) >>= \case
                  Nothing -> error $ printf "unknown variable %s" name
                  Just ty -> pure ty
    _ -> error $ printf "unsupported val %s" (show $ pretty val)
{'fraction_non_alphanumeric': 0.08907938874394335, 'fraction_numerical': 0.0, 'mean_word_length': 3.129230769230769, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 33, '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': '7371735', 'n_tokens_mistral': 825, 'n_tokens_neox': 799, 'n_words': 288}