module HaScalaM.Types.Ref where

import HaScalaM.Classes.Base
import HaScalaM.Classes.Ref
import HaScalaM.Classes.Term
import HaScalaM.Classes.Type


-------------------------------------------------------------------------- RT --

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

------------------------------------------------------------------------- RT' --

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