repl.it
@anonymous/

WarmQuintessentialKeygen

Haskell

No description

fork
loading
Files
  • main.hs
main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

-- Base types

data ExprF var t e
  = Literal Int
  | Binary e var e
  | Typed t e
  deriving (Functor)

mapT :: (a -> b) -> ExprF var a e -> ExprF var b e
mapT f e =
  case e of
    Literal i -> Literal i
    Binary l op r -> Binary l op r
    Typed t e -> Typed (f t) e
  

data TypeF t
  = TypeConstructor String [t]
  | FunctionType t t
  deriving (Functor)

-- AST types

newtype Expr ann var = FixExpr { unFixExpr :: ann (ExprF var (Type ann) (Expr ann var)) }
newtype Type ann = FixType { unFixType :: ann (TypeF (Type ann)) }
newtype Decl ann doc var = Decl (ann (Maybe doc, Maybe (Type ann), Expr ann var))
newtype Module ann = Module [Decl ann String String]

-- Recursion schemes

cataExpr :: Functor ann => (ann (ExprF var (Type ann) a) -> a) -> Expr ann var -> a
cataExpr f = f . fmap (fmap $ cataExpr f) . unFixExpr

cataType :: Functor ann => (ann (TypeF a) -> a) -> Type ann -> a
cataType f = f . fmap (fmap $ cataType f) . unFixType

-- Converting annotations

class Convert ann1 ann2 v1 v2 where
  convert :: (forall x. ann1 x -> ann2 x) -> v1 -> v2

instance Functor ann1 => Convert ann1 ann2 (Expr ann1 var) (Expr ann2 var) where
  convert f = cataExpr (FixExpr . f . fmap (mapT (convert f)))

instance Functor ann1 => Convert ann1 ann2 (Type ann1) (Type ann2) where
  convert f = cataType (FixType . f)

instance Functor ann1 => Convert ann1 ann2 (Decl ann1 doc var) (Decl ann2 doc var) where
  convert f (Decl d) =
    Decl (f $ fmap convertD d)
    where
      convertD (doc, t, e) = (doc, fmap (convert f) t, convert f e)

instance Functor ann1 => Convert ann1 ann2 (Module ann1) (Module ann2) where
  convert f (Module m) = Module $ fmap (convert f) m

--

main = putStrLn "main"
GHCi, version 8.6.5