Language/Symantic/Expr/Alt.hs

   1 {-# LANGUAGE ConstraintKinds #-}
   2 {-# LANGUAGE DataKinds #-}
   3 {-# LANGUAGE FlexibleContexts #-}
   4 {-# LANGUAGE FlexibleInstances #-}
   5 {-# LANGUAGE GADTs #-}
   6 {-# LANGUAGE KindSignatures #-}
   7 {-# LANGUAGE MultiParamTypeClasses #-}
   8 {-# LANGUAGE Rank2Types #-}
   9 {-# LANGUAGE ScopedTypeVariables #-}
  10 {-# LANGUAGE TypeFamilies #-}
  11 {-# LANGUAGE TypeOperators #-}
  12 {-# LANGUAGE UndecidableInstances #-}
  13 module Language.Symantic.Expr.Alt where
  14
  15 import Language.Symantic.Type
  16 import Language.Symantic.Expr.Root
  17
  18 -- * Type 'Expr_Alt'
  19 -- | Expression making an alternative between two expressions.
  20 data Expr_Alt curr next (root:: *)
  21  =   Expr_Alt_Curr (curr root)
  22  |   Expr_Alt_Next (next root)
  23
  24 -- | Convenient alias. Requires @TypeOperators@.
  25 --
  26 -- TODO: see if using a type-level list is better.
  27 type (.|.) = Expr_Alt
  28 infixr 5 .|.
  29 type instance Root_of_Expr (Expr_Alt curr next root) = root
  30 type instance Type_of_Expr (Expr_Alt curr next root)
  31  = Type_of_Expr_Alt (Type_of_Expr (curr root))
  32                     (Type_of_Expr (next root))
  33
  34 -- ** Type family 'Type_of_Expr_Alt'
  35 -- | Remove 'No_Type' type when building 'Type_of_Expr'.
  36 type family Type_of_Expr_Alt
  37  (type_curr:: (* -> *) -> * -> *)
  38  (type_next:: (* -> *) -> * -> *)
  39  where
  40         Type_of_Expr_Alt No_Type next    = next
  41         Type_of_Expr_Alt curr    No_Type = curr
  42         Type_of_Expr_Alt curr    next    = Type_Alt curr next
  43
  44 -- ** Type family 'Is_Last_Expr'
  45 -- | Return whether a given expression is the last one in a given expression stack.
  46 --
  47 -- NOTE: each expression parser uses this type family
  48 -- when it encounters unsupported syntax:
  49 -- to know if it is the last expression parser component that will be tried
  50 -- (and thus return 'Error_Expr_Unsupported')
  51 -- or if some other expression parser component shall be tried
  52 -- (and thus return 'Error_Expr_Unsupported_here',
  53 -- which is then handled accordingly by the 'Expr_From' instance of 'Expr_Alt').
  54 type family Is_Last_Expr (ex:: *) (exs:: *) :: Bool where
  55         Is_Last_Expr ex        ex                        = 'True
  56         Is_Last_Expr ex        (Expr_Root exs)           = Is_Last_Expr ex (exs (Expr_Root exs))
  57         Is_Last_Expr (ex root) (Expr_Alt ex   next root) = 'False
  58         Is_Last_Expr other     (Expr_Alt curr next root) = Is_Last_Expr other (next root)