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