]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Repr/Host.hs
fix (->) by removing inline/val/lazy
[haskell/symantic.git] / Language / Symantic / Repr / Host.hs
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE MultiParamTypeClasses #-}
4 {-# LANGUAGE ScopedTypeVariables #-}
5 {-# LANGUAGE Rank2Types #-}
6 {-# LANGUAGE TypeFamilies #-}
7 {-# LANGUAGE UndecidableInstances #-}
8 -- | Interpreter to compute a host-term.
9 module Language.Symantic.Repr.Host where
10
11 import Control.Applicative as Applicative
12 import Control.Monad as Monad
13 import Data.Foldable as Foldable
14 import Data.Functor as Functor
15 import Data.Monoid as Monoid
16 import Data.Traversable as Traversable
17 import qualified Data.Bool as Bool
18 import qualified Data.List as List
19 import qualified Data.Map.Strict as Map
20 import qualified Data.Maybe as Maybe
21 import qualified System.IO as IO
22
23 -- import Language.Symantic.Type
24 import Language.Symantic.Expr hiding (Sym_Monad(..))
25 import qualified Language.Symantic.Expr as Expr
26
27 -- * Type 'Repr_Host'
28
29 -- | Interpreter's data.
30 newtype Repr_Host h = Repr_Host { unRepr_Host :: h }
31 instance Functor Repr_Host where
32 fmap f (Repr_Host a) = Repr_Host (f a)
33 instance Applicative Repr_Host where
34 pure = Repr_Host
35 (Repr_Host f) <*> (Repr_Host a) = Repr_Host (f a)
36 instance Monad Repr_Host where
37 return = Repr_Host
38 (Repr_Host a) >>= f = f a
39
40 -- | Interpreter.
41 host_from_expr :: Repr_Host h -> h
42 host_from_expr = unRepr_Host
43
44 instance Sym_Lambda Repr_Host where
45 ($$) = (Applicative.<*>)
46 lam f = Repr_Host (unRepr_Host . f . Repr_Host)
47 instance Sym_Bool Repr_Host where
48 bool = Repr_Host
49 not = liftM Bool.not
50 (&&) = liftM2 (Prelude.&&)
51 (||) = liftM2 (Prelude.||)
52 instance Sym_Int Repr_Host where
53 int = Repr_Host
54 abs = liftM Prelude.abs
55 negate = liftM Prelude.negate
56 (+) = liftM2 (Prelude.+)
57 (-) = liftM2 (Prelude.-)
58 (*) = liftM2 (Prelude.*)
59 mod = liftM2 Prelude.mod
60 instance Sym_Text Repr_Host where
61 text = Repr_Host
62 instance Sym_Maybe Repr_Host where
63 nothing = Repr_Host Nothing
64 just = liftM Just
65 maybe = liftM3 Maybe.maybe
66 instance Sym_IO Repr_Host where
67 io_hClose = liftM IO.hClose
68 io_openFile = liftM2 IO.openFile
69 instance Sym_If Repr_Host where
70 if_ (Repr_Host b) ok ko = if b then ok else ko
71 instance Sym_When Repr_Host where
72 when (Repr_Host b) = Monad.when b
73 instance Sym_Eq Repr_Host where
74 (==) = liftM2 (Prelude.==)
75 instance Sym_Ord Repr_Host where
76 compare = liftM2 Prelude.compare
77 instance Sym_List Repr_Host where
78 list_empty = return []
79 list_cons = liftM2 (:)
80 list = sequence
81 list_filter = liftM2 List.filter
82 instance Sym_Tuple2 Repr_Host where
83 tuple2 = liftM2 (,)
84 instance Sym_Map Repr_Host where
85 map_from_list = liftM Map.fromList
86 mapWithKey = liftM2 Map.mapWithKey
87 instance Sym_Functor Repr_Host where
88 fmap = liftM2 (Functor.<$>)
89 instance Expr.Sym_Monad Repr_Host where
90 return = liftM Monad.return
91 (>>=) = Monad.liftM2 (Monad.>>=)
92 instance Sym_Either Repr_Host where
93 right = liftM Right
94 left = liftM Left
95 instance Sym_Monoid Repr_Host where
96 mempty = Repr_Host Monoid.mempty
97 mappend = liftM2 Monoid.mappend
98 instance Sym_Foldable Repr_Host where
99 foldMap = liftM2 Foldable.foldMap
100 null = liftM Foldable.null
101 length = liftM Foldable.length
102 minimum = liftM Foldable.minimum
103 maximum = liftM Foldable.maximum
104 elem = liftM2 Foldable.elem
105 instance Sym_Applicative Repr_Host where
106 pure = liftM Applicative.pure
107 (<*>) = liftM2 (Applicative.<*>)
108 instance Sym_Traversable Repr_Host where
109 traverse = liftM2 Traversable.traverse