<commit_before>module Obj where

import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List (intercalate, foldl')
import Data.Maybe (mapMaybe, fromMaybe)
import Control.Monad.State
import Data.Char
import Types
import Util
import Debug.Trace

-- | The canonical Lisp object.
data Obj = Sym SymPath
         | MultiSym String [SymPath]
         | Num Ty Double
         | Str String
         | Chr Char
         | Bol Bool
         | Lst [XObj]
         | Arr [XObj]
         | Defn
         | Def
         | Do
         | Let
         | While
         | If
         | Mod Env
         | Typ
         | External
         | ExternalType
         | Deftemplate TemplateCreator
         | Instantiate Template
         | Defalias Ty
         | Address
         | SetBang
         | Macro
         | Dynamic
         | The
         | Ref
         | Interface Ty [SymPath]
         deriving (Show, Eq)

newtype TemplateCreator = TemplateCreator { getTemplateCreator :: TypeEnv -> Env -> Template }

instance Show TemplateCreator where
  show _ = "TemplateCreator"

-- | Note: This is to make comparisons of Environments possible, otherwise
-- | they are always different when they contain TemplateCreators.
instance Eq TemplateCreator where
  _ == _ = True

-- | Information about where the Obj originated from.
data Info = Info { infoLine :: Int
                 , infoColumn :: Int
                 , infoFile :: String
                 , infoDelete :: Set.Set Deleter
                 , infoIdentifier :: Int
                 } deriving (Show, Eq)

dummyInfo :: Info
dummyInfo = Info 0 0 "dummy-file" Set.empty (-1)

data Deleter = ProperDeleter { deleterPath :: SymPath
                             , deleterVariable :: String
                             }
             | FakeDeleter { deleterVariable :: String -- used for external types with no delete function
                           }
             deriving (Show, Eq, Ord)

prettyInfo :: Info -> String
prettyInfo i = "line " ++ show (infoLine i) ++ ", column " ++ show (infoColumn i) ++ " in '" ++ infoFile i ++ "'"

prettyInfoFromXObj :: XObj -> String
prettyInfoFromXObj xobj = case info xobj of
                            Just i -> prettyInfo i
                            Nothing -> "no info"

-- TODO: change name of this function
freshVar :: Info -> String
freshVar i = "_" ++ show (infoIdentifier i)

-- | Obj with eXtra information.
data XObj = XObj { obj :: Obj
                 , info :: Maybe Info
                 , ty :: Maybe Ty
                 } deriving (Show, Eq)

getBinderDescription :: XObj -> String
getBinderDescription (XObj (Lst (XObj Defn _ _ : XObj (Sym _) _ _ : _)) _ _) = "defn"
getBinderDescription (XObj (Lst (XObj Def _ _ : XObj (Sym _) _ _ : _)) _ _) = "def"
getBinderDescription (XObj (Lst (XObj Macro _ _ : XObj (Sym _) _ _ : _)) _ _) = "macro"
getBinderDescription (XObj (Lst (XObj (Deftemplate _) _ _ : XObj (Sym _) _ _ : _)) _ _) = "template"
getBinderDescription (XObj (Lst (XObj (Instantiate _) _ _ : XObj (Sym _) _ _ : _)) _ _) = "instantiate"
getBinderDescription (XObj (Lst (XObj (Defalias _) _ _ : XObj (Sym _) _ _ : _)) _ _) = "alias"
getBinderDescription (XObj (Lst (XObj External _ _ : XObj (Sym _) _ _ : _)) _ _) = "external"
getBinderDescription (XObj (Lst (XObj ExternalType _ _ : XObj (Sym _) _ _ : _)) _ _) = "external-type"
getBinderDescription (XObj (Lst (XObj Typ _ _ : XObj (Sym _) _ _ : _)) _ _) = "deftype"
getBinderDescription (XObj (Lst (XObj (Interface _ _) _ _ : XObj (Sym _) _ _ : _)) _ _) = "interface"
getBinderDescription _ = "?"

getName :: XObj -> String
getName xobj = show (getPath xobj)

-- | Extracts the second form (where the name of definitions are stored) from a list of XObj:s.
getPath :: XObj -> SymPath
getPath (XObj (Lst (XObj Defn _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj Def _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj Macro _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Deftemplate _) _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Instantiate _) _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Defalias _) _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj External _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj ExternalType _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Mod _) _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Interface _ _) _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Sym path) _ _) = path
getPath x = SymPath [] (pretty x)

-- | Changes the second form (where the name of definitions are stored) in a list of XObj:s.
setPath :: XObj -> SymPath -> XObj
setPath (XObj (Lst (defn@(XObj Defn _ _) : XObj (Sym _) si st : rest)) i t) newPath =
  XObj (Lst (defn : XObj (Sym newPath) si st : rest)) i t
setPath (XObj (Lst [extr@(XObj External _ _), XObj (Sym _) si st]) i t) newPath =
  XObj (Lst [extr, XObj (Sym newPath) si st]) i t
setPath x _ =
  compilerError ("Can't set path on " ++ show x)

-- | Convert an XObj to a pretty string representation.
pretty :: XObj -> String
pretty = visit 0
  where visit :: Int -> XObj -> String
        visit indent xobj =
          case obj xobj of
            Lst lst -> "(" ++ joinWithSpace (map (visit indent) lst) ++ ")"
            Arr arr -> "[" ++ joinWithSpace (map (visit indent) arr) ++ "]"
            Num IntTy num -> show (round num :: Int)
            Num LongTy num -> show num ++ "l"
            Num FloatTy num -> show num ++ "f"
            Num DoubleTy num -> show num
            Num _ _ -> compilerError "Invalid number type."
            Str str -> show str
            Chr c -> '\\' : c : ""
            Sym path -> show path
            MultiSym originalName paths -> originalName ++ "{" ++ joinWithComma (map show paths) ++ "}"
            Bol b -> if b then "true" else "false"
            Defn -> "defn"
            Def -> "def"
            If -> "if"
            While -> "while"
            Do -> "do"
            Let -> "let"
            Mod env -> fromMaybe "module" (envModuleName env)
            Typ -> "deftype"
            Deftemplate _ -> "deftemplate"
            Instantiate _ -> "instantiate"
            External -> "external"
            ExternalType -> "external-type"
            Defalias _ -> "defalias"
            Address -> "address"
            SetBang -> "set!"
            Macro -> "macro"
            Dynamic -> "dynamic"
            The -> "the"
            Ref -> "ref"
            Interface _ _ -> "interface"

-- | Get the type of an XObj as a string.
typeStr :: XObj -> String
typeStr xobj = case ty xobj of
                 Nothing -> " : _"
                 Just t -> " : " ++ show t

-- | Convert XObj to pretty string representation with type annotations.
prettyTyped :: XObj -> String
prettyTyped = visit 0
  where visit :: Int -> XObj -> String
        visit indent xobj =
          let suffix = typeStr xobj ++ ", id = " ++ show (fmap infoIdentifier (info xobj)) ++ "\n"
          in case obj xobj of
               Lst lst -> "(" ++ joinWithSpace (map (visit indent) lst) ++ ")" ++ suffix
               Arr arr -> "[" ++ joinWithSpace (map (visit indent) arr) ++ "]" ++ suffix
               _ -> pretty xobj ++ suffix

-- | Wraps and holds an XObj in an environment.
newtype Binder = Binder { binderXObj :: XObj } deriving Eq

instance Show Binder where
  show binder = showBinderIndented 0 (getName (binderXObj binder), binder)

showBinderIndented :: Int -> (String, Binder) -> String
showBinderIndented indent (name, Binder (XObj (Mod env) _ _)) =
  replicate indent ' ' ++ name ++ " : Module = {\n" ++
  prettyEnvironmentIndented (indent + 4) env ++
  "\n" ++ replicate indent ' ' ++ "}"
showBinderIndented indent (name, Binder (XObj (Lst [XObj (Interface _ paths) _ _, _]) _ _)) =
  replicate indent ' ' ++ name ++ " : Interface = {\n    " ++
  joinWith "\n    " (map show paths) ++
  "\n" ++ replicate indent ' ' ++ "}"
showBinderIndented indent (name, Binder xobj) =
  replicate indent ' ' ++ name ++ -- " (" ++ show (getPath xobj) ++ ")" ++
  " : " ++ showMaybeTy (ty xobj) -- ++ " " ++ getBinderDescription xobj

-- | The score is used for sorting the bindings before emitting them.
-- | A lower score means appearing earlier in the emitted file.<commit_msg>Interfaces will print their abstract type.<commit_after>module Obj where

import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List (intercalate, foldl')
import Data.Maybe (mapMaybe, fromMaybe)
import Control.Monad.State
import Data.Char
import Types
import Util
import Debug.Trace

-- | The canonical Lisp object.
data Obj = Sym SymPath
         | MultiSym String [SymPath]
         | Num Ty Double
         | Str String
         | Chr Char
         | Bol Bool
         | Lst [XObj]
         | Arr [XObj]
         | Defn
         | Def
         | Do
         | Let
         | While
         | If
         | Mod Env
         | Typ
         | External
         | ExternalType
         | Deftemplate TemplateCreator
         | Instantiate Template
         | Defalias Ty
         | Address
         | SetBang
         | Macro
         | Dynamic
         | The
         | Ref
         | Interface Ty [SymPath]
         deriving (Show, Eq)

newtype TemplateCreator = TemplateCreator { getTemplateCreator :: TypeEnv -> Env -> Template }

instance Show TemplateCreator where
  show _ = "TemplateCreator"

-- | Note: This is to make comparisons of Environments possible, otherwise
-- | they are always different when they contain TemplateCreators.
instance Eq TemplateCreator where
  _ == _ = True

-- | Information about where the Obj originated from.
data Info = Info { infoLine :: Int
                 , infoColumn :: Int
                 , infoFile :: String
                 , infoDelete :: Set.Set Deleter
                 , infoIdentifier :: Int
                 } deriving (Show, Eq)

dummyInfo :: Info
dummyInfo = Info 0 0 "dummy-file" Set.empty (-1)

data Deleter = ProperDeleter { deleterPath :: SymPath
                             , deleterVariable :: String
                             }
             | FakeDeleter { deleterVariable :: String -- used for external types with no delete function
                           }
             deriving (Show, Eq, Ord)

prettyInfo :: Info -> String
prettyInfo i = "line " ++ show (infoLine i) ++ ", column " ++ show (infoColumn i) ++ " in '" ++ infoFile i ++ "'"

prettyInfoFromXObj :: XObj -> String
prettyInfoFromXObj xobj = case info xobj of
                            Just i -> prettyInfo i
                            Nothing -> "no info"

-- TODO: change name of this function
freshVar :: Info -> String
freshVar i = "_" ++ show (infoIdentifier i)

-- | Obj with eXtra information.
data XObj = XObj { obj :: Obj
                 , info :: Maybe Info
                 , ty :: Maybe Ty
                 } deriving (Show, Eq)

getBinderDescription :: XObj -> String
getBinderDescription (XObj (Lst (XObj Defn _ _ : XObj (Sym _) _ _ : _)) _ _) = "defn"
getBinderDescription (XObj (Lst (XObj Def _ _ : XObj (Sym _) _ _ : _)) _ _) = "def"
getBinderDescription (XObj (Lst (XObj Macro _ _ : XObj (Sym _) _ _ : _)) _ _) = "macro"
getBinderDescription (XObj (Lst (XObj (Deftemplate _) _ _ : XObj (Sym _) _ _ : _)) _ _) = "template"
getBinderDescription (XObj (Lst (XObj (Instantiate _) _ _ : XObj (Sym _) _ _ : _)) _ _) = "instantiate"
getBinderDescription (XObj (Lst (XObj (Defalias _) _ _ : XObj (Sym _) _ _ : _)) _ _) = "alias"
getBinderDescription (XObj (Lst (XObj External _ _ : XObj (Sym _) _ _ : _)) _ _) = "external"
getBinderDescription (XObj (Lst (XObj ExternalType _ _ : XObj (Sym _) _ _ : _)) _ _) = "external-type"
getBinderDescription (XObj (Lst (XObj Typ _ _ : XObj (Sym _) _ _ : _)) _ _) = "deftype"
getBinderDescription (XObj (Lst (XObj (Interface _ _) _ _ : XObj (Sym _) _ _ : _)) _ _) = "interface"
getBinderDescription _ = "?"

getName :: XObj -> String
getName xobj = show (getPath xobj)

-- | Extracts the second form (where the name of definitions are stored) from a list of XObj:s.
getPath :: XObj -> SymPath
getPath (XObj (Lst (XObj Defn _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj Def _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj Macro _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Deftemplate _) _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Instantiate _) _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Defalias _) _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj External _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj ExternalType _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Mod _) _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Interface _ _) _ _ : XObj (Sym path) _ _ : _)) _ _) = path
getPath (XObj (Sym path) _ _) = path
getPath x = SymPath [] (pretty x)

-- | Changes the second form (where the name of definitions are stored) in a list of XObj:s.
setPath :: XObj -> SymPath -> XObj
setPath (XObj (Lst (defn@(XObj Defn _ _) : XObj (Sym _) si st : rest)) i t) newPath =
  XObj (Lst (defn : XObj (Sym newPath) si st : rest)) i t
setPath (XObj (Lst [extr@(XObj External _ _), XObj (Sym _) si st]) i t) newPath =
  XObj (Lst [extr, XObj (Sym newPath) si st]) i t
setPath x _ =
  compilerError ("Can't set path on " ++ show x)

-- | Convert an XObj to a pretty string representation.
pretty :: XObj -> String
pretty = visit 0
  where visit :: Int -> XObj -> String
        visit indent xobj =
          case obj xobj of
            Lst lst -> "(" ++ joinWithSpace (map (visit indent) lst) ++ ")"
            Arr arr -> "[" ++ joinWithSpace (map (visit indent) arr) ++ "]"
            Num IntTy num -> show (round num :: Int)
            Num LongTy num -> show num ++ "l"
            Num FloatTy num -> show num ++ "f"
            Num DoubleTy num -> show num
            Num _ _ -> compilerError "Invalid number type."
            Str str -> show str
            Chr c -> '\\' : c : ""
            Sym path -> show path
            MultiSym originalName paths -> originalName ++ "{" ++ joinWithComma (map show paths) ++ "}"
            Bol b -> if b then "true" else "false"
            Defn -> "defn"
            Def -> "def"
            If -> "if"
            While -> "while"
            Do -> "do"
            Let -> "let"
            Mod env -> fromMaybe "module" (envModuleName env)
            Typ -> "deftype"
            Deftemplate _ -> "deftemplate"
            Instantiate _ -> "instantiate"
            External -> "external"
            ExternalType -> "external-type"
            Defalias _ -> "defalias"
            Address -> "address"
            SetBang -> "set!"
            Macro -> "macro"
            Dynamic -> "dynamic"
            The -> "the"
            Ref -> "ref"
            Interface _ _ -> "interface"

-- | Get the type of an XObj as a string.
typeStr :: XObj -> String
typeStr xobj = case ty xobj of
                 Nothing -> " : _"
                 Just t -> " : " ++ show t

-- | Convert XObj to pretty string representation with type annotations.
prettyTyped :: XObj -> String
prettyTyped = visit 0
  where visit :: Int -> XObj -> String
        visit indent xobj =
          let suffix = typeStr xobj ++ ", id = " ++ show (fmap infoIdentifier (info xobj)) ++ "\n"
          in case obj xobj of
               Lst lst -> "(" ++ joinWithSpace (map (visit indent) lst) ++ ")" ++ suffix
               Arr arr -> "[" ++ joinWithSpace (map (visit indent) arr) ++ "]" ++ suffix
               _ -> pretty xobj ++ suffix

-- | Wraps and holds an XObj in an environment.
newtype Binder = Binder { binderXObj :: XObj } deriving Eq

instance Show Binder where
  show binder = showBinderIndented 0 (getName (binderXObj binder), binder)

showBinderIndented :: Int -> (String, Binder) -> String
showBinderIndented indent (name, Binder (XObj (Mod env) _ _)) =
  replicate indent ' ' ++ name ++ " : Module = {\n" ++
  prettyEnvironmentIndented (indent + 4) env ++
  "\n" ++ replicate indent ' ' ++ "}"
showBinderIndented indent (name, Binder (XObj (Lst [XObj (Interface t paths) _ _, _]) _ _)) =
  replicate indent ' ' ++ name ++ " : " ++ show t ++ " = {\n    " ++
  joinWith "\n    " (map show paths) ++
  "\n" ++ replicate indent ' ' ++ "}"
showBinderIndented indent (name, Binder xobj) =
  replicate indent ' ' ++ name ++ -- " (" ++ show (getPath xobj) ++ ")" ++
  " : " ++ showMaybeTy (ty xobj) -- ++ " " ++ getBinderDescription xobj

-- | The score is used for sorting the bindings before emitting them.
-- | A lower score means appearing earlier in the emitted file.
{'fraction_non_alphanumeric': 0.1216940671908506, 'fraction_numerical': 0.0008339289969025494, 'mean_word_length': 2.144007490636704, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 119, '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': '7093045', 'n_tokens_mistral': 5332, 'n_tokens_neox': 5224, 'n_words': 1718}