<commit_before>{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ViewPatterns #-}

module Unison.Type where

import Unison.Prelude

import qualified Control.Monad.Writer.Strict as Writer
import Data.Functor.Identity (runIdentity)
import Data.Monoid (Any(..))
import           Data.List.Extra (nubOrd)
import qualified Data.Map as Map
import qualified Data.Set as Set
import           Prelude.Extras (Eq1(..),Show1(..),Ord1(..))
import qualified Unison.ABT as ABT
import           Unison.Hashable (Hashable1)
import qualified Unison.Hashable as Hashable
import qualified Unison.Kind as K
import           Unison.Reference (Reference)
import qualified Unison.Reference as Reference
import qualified Unison.Reference.Util as ReferenceUtil
import           Unison.Var (Var)
import qualified Unison.Var as Var
import qualified Unison.Settings as Settings
import qualified Unison.Util.Relation as R
import qualified Unison.Names3 as Names
import qualified Unison.Name as Name
import qualified Unison.Util.List as List

-- | Base functor for types in the Unison language
data F a
  = Ref Reference
  | Arrow a a
  | Ann a K.Kind
  | App a a
  | Effect a a
  | Effects [a]
  | Forall a
  | IntroOuter a -- binder like ∀, used to introduce variables that are
                 -- bound by outer type signatures, to support scoped type
                 -- variables
  deriving (Foldable,Functor,Generic,Generic1,Eq,Ord,Traversable)

instance Eq1 F where (==#) = (==)
instance Ord1 F where compare1 = compare
instance Show1 F where showsPrec1 = showsPrec

-- | Types are represented as ABTs over the base functor F, with variables in `v`
type Type v a = ABT.Term F v a

wrapV :: Ord v => Type v a -> Type (ABT.V v) a
wrapV = ABT.vmap ABT.Bound

freeVars :: Type v a -> Set v
freeVars = ABT.freeVars

bindExternal
  :: ABT.Var v => [(v, Reference)] -> Type v a -> Type v a
bindExternal bs = ABT.substsInheritAnnotation [ (v, ref () r) | (v, r) <- bs ]

bindNames
  :: Var v
  => Set v
  -> Names.Names0
  -> Type v a
  -> Names.ResolutionResult v a (Type v a)
bindNames keepFree ns t = let
  fvs = ABT.freeVarOccurrences keepFree t
  rs = [(v, a, R.lookupDom (Name.fromVar v) (Names.types0 ns)) | (v,a) <- fvs ]
  ok (v, a, rs) = if Set.size rs == 1 then pure (v, Set.findMin rs)
                  else Left (pure (Names.TypeResolutionFailure v a rs))
  in List.validate ok rs <&> \es -> bindExternal es t

newtype Monotype v a = Monotype { getPolytype :: Type v a } deriving Eq

instance (Show v) => Show (Monotype v a) where
  show = show . getPolytype

-- Smart constructor which checks if a `Type` has no `Forall` quantifiers.
monotype :: ABT.Var v => Type v a -> Maybe (Monotype v a)<commit_msg>similar fix to type symbol resolution<commit_after>{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ViewPatterns #-}

module Unison.Type where

import Unison.Prelude

import qualified Control.Monad.Writer.Strict as Writer
import Data.Functor.Identity (runIdentity)
import Data.Monoid (Any(..))
import           Data.List.Extra (nubOrd)
import qualified Data.Map as Map
import qualified Data.Set as Set
import           Prelude.Extras (Eq1(..),Show1(..),Ord1(..))
import qualified Unison.ABT as ABT
import           Unison.Hashable (Hashable1)
import qualified Unison.Hashable as Hashable
import qualified Unison.Kind as K
import           Unison.Reference (Reference)
import qualified Unison.Reference as Reference
import qualified Unison.Reference.Util as ReferenceUtil
import           Unison.Var (Var)
import qualified Unison.Var as Var
import qualified Unison.Settings as Settings
import qualified Unison.Names3 as Names
import qualified Unison.Name as Name
import qualified Unison.Util.List as List

-- | Base functor for types in the Unison language
data F a
  = Ref Reference
  | Arrow a a
  | Ann a K.Kind
  | App a a
  | Effect a a
  | Effects [a]
  | Forall a
  | IntroOuter a -- binder like ∀, used to introduce variables that are
                 -- bound by outer type signatures, to support scoped type
                 -- variables
  deriving (Foldable,Functor,Generic,Generic1,Eq,Ord,Traversable)

instance Eq1 F where (==#) = (==)
instance Ord1 F where compare1 = compare
instance Show1 F where showsPrec1 = showsPrec

-- | Types are represented as ABTs over the base functor F, with variables in `v`
type Type v a = ABT.Term F v a

wrapV :: Ord v => Type v a -> Type (ABT.V v) a
wrapV = ABT.vmap ABT.Bound

freeVars :: Type v a -> Set v
freeVars = ABT.freeVars

bindExternal
  :: ABT.Var v => [(v, Reference)] -> Type v a -> Type v a
bindExternal bs = ABT.substsInheritAnnotation [ (v, ref () r) | (v, r) <- bs ]

bindNames
  :: Var v
  => Set v
  -> Names.Names0
  -> Type v a
  -> Names.ResolutionResult v a (Type v a)
bindNames keepFree ns0 t = let
  ns = Names.Names ns0 mempty
  fvs = ABT.freeVarOccurrences keepFree t
  rs = [(v, a, Names.lookupHQType (Name.convert $ Name.fromVar v) ns) | (v,a) <- fvs ]
  ok (v, a, rs) = if Set.size rs == 1 then pure (v, Set.findMin rs)
                  else Left (pure (Names.TypeResolutionFailure v a rs))
  in List.validate ok rs <&> \es -> bindExternal es t

newtype Monotype v a = Monotype { getPolytype :: Type v a } deriving Eq

instance (Show v) => Show (Monotype v a) where
  show = show . getPolytype

-- Smart constructor which checks if a `Type` has no `Forall` quantifiers.
monotype :: ABT.Var v => Type v a -> Maybe (Monotype v a)
{'fraction_non_alphanumeric': 0.10225057593478647, 'fraction_numerical': 0.005493531809321283, 'mean_word_length': 3.1931649331352157, 'pattern_counts': {'":': 0, '<': 9, '<?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': '5300702', 'n_tokens_mistral': 1866, 'n_tokens_neox': 1825, 'n_words': 693}