symantic-lib/Language/Symantic/Lib/If.hs

   1 {-# LANGUAGE UndecidableInstances #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 -- | Symantic for @If@.
   4 module Language.Symantic.Lib.If where
   5
   6 import qualified Data.Text as Text
   7
   8 import Language.Symantic
   9 import Language.Symantic.Lib.Bool (tyBool)
  10 import Language.Symantic.Lib.Function (a0)
  11
  12 -- * Type 'If'
  13 data If
  14
  15 -- * Class 'Sym_If'
  16 type instance Sym (Proxy If) = Sym_If
  17 class Sym_If term where
  18         if_ :: term Bool -> term a -> term a -> term a
  19         default if_ :: Sym_If (UnT term) => Trans term => term Bool -> term a -> term a -> term a
  20         if_ = trans3 if_
  21
  22 -- Interpreting
  23 instance Sym_If Eval where
  24         if_ (Eval b) ok ko = if b then ok else ko
  25 instance Sym_If View where
  26         if_ (View cond) (View ok) (View ko) =
  27                 View $ \po v ->
  28                         parenInfix po op $
  29                         Text.concat
  30                          [ "if ", cond (op, SideL) v
  31                          , " then ", ok (op, SideL) v
  32                          , " else ", ko (op, SideL) v ]
  33                 where op = infixN 2
  34 instance (Sym_If r1, Sym_If r2) => Sym_If (Dup r1 r2) where
  35         if_  = dup3 @Sym_If if_
  36
  37 -- Transforming
  38 instance (Sym_If term, Sym_Lambda term) => Sym_If (BetaT term)
  39
  40 -- Typing
  41 instance ClassInstancesFor If
  42 instance TypeInstancesFor If
  43
  44 -- Compiling
  45 instance Gram_Term_AtomsFor src ss g If
  46  -- TODO: some support for if-then-else or ternary (?:) operator
  47 instance ModuleFor src ss If
  48
  49 -- ** 'Type's
  50
  51 -- ** 'Term's
  52 teIf_if :: TermDef If '[Proxy a] (() #> (Bool -> a -> a -> a))
  53 teIf_if = Term noConstraint (tyBool ~> a0 ~> a0 ~> a0) $ teSym @If $ lam3 if_