module HaScalaM.Types.Ref where
import HaScalaM.Classes.Base
import HaScalaM.Classes.Ref
import HaScalaM.Classes.Term
import HaScalaM.Classes.Type
data SmRefT n t where
SmApplyUnaryRT :: ( Name n
, Term t
) => { forall n t. SmRefT n t -> n
opAURT :: n
, forall n t. SmRefT n t -> t
argAURT :: t } -> SmRefT n t
SmSuperRT :: Name n => { forall n t. SmRefT n t -> n
thispSRT :: n
, forall n t. SmRefT n t -> n
superpSRT :: n } -> SmRefT n t
SmThisRT :: Name n => { forall n t. SmRefT n t -> n
nameThRT :: n } -> SmRefT n t
data SmAnonymousRT where
SmAnonymousRT :: SmAnonymousRT
data SmSelectRT tn t where
SmSelectRT :: ( Name tn
, Term t
) => { forall tn t. SmSelectRT tn t -> t
qualSRT :: t
, forall tn t. SmSelectRT tn t -> tn
nameSRT :: tn } -> SmSelectRT tn t
data SmRefT' t'n t' r where
SmProjectRT' :: ( NameT' t'n
, Type' t'
) => { forall t'n t' r. SmRefT' t'n t' r -> t'
qualPRT' :: t'
, forall t'n t' r. SmRefT' t'n t' r -> t'n
namePRT' :: t'n } -> SmRefT' t'n t' r
SmSelectRT' :: ( NameT' t'n
, RefT r
) => { forall t'n r t'. SmRefT' t'n t' r -> r
qualSRT' :: r
, forall t'n r t'. SmRefT' t'n t' r -> t'n
nameSRT' :: t'n } -> SmRefT' t'n t' r
SmSingletonRT' :: RefT r => { forall r t'n t'. SmRefT' t'n t' r -> r
refSRT' :: r } -> SmRefT' t'n t' r