git.iko.soy/elk
on edd4fbb help sign in
elk/compiler/Transform/Declaration.hs
67 lines 2.6 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Transform.Declaration where
4import Control.Applicative ((<$>))
5import qualified SourceSyntax.Pattern as P
6import SourceSyntax.Expression as E
7import SourceSyntax.Declaration as D
9import qualified Transform.Expression as Expr
10import qualified Transform.Definition as Def
13combineAnnotations :: [ParseDeclaration] -> Either String [Declaration]
14combineAnnotations = go
15 where
16 msg x = "Syntax Error: The type annotation for '" ++ x ++
17 "' must be directly above its definition."
19 exprCombineAnnotations = Expr.crawlLet Def.combineAnnotations
21 go decls =
22 case decls of
23 -- simple cases, pass them through with no changes
24 [] -> return []
26 Datatype name tvars ctors ds : rest ->
27 (:) (Datatype name tvars ctors ds) <$> go rest
29 TypeAlias name tvars alias ds : rest ->
30 (:) (TypeAlias name tvars alias ds) <$> go rest
32 Fixity assoc prec op : rest ->
33 (:) (Fixity assoc prec op) <$> go rest
35 -- combine definitions
36 D.Definition def : defRest ->
37 case def of
38 Def pat expr ->
39 do expr' <- exprCombineAnnotations expr
40 let def' = E.Definition pat expr' Nothing
41 (:) (D.Definition def') <$> go defRest
43 TypeAnnotation name tipe ->
44 case defRest of
45 D.Definition (Def pat@(P.PVar name') expr) : rest | name == name' ->
46 do expr' <- exprCombineAnnotations expr
47 let def' = E.Definition pat expr' (Just tipe)
48 (:) (D.Definition def') <$> go rest
50 _ -> Left (msg name)
52 -- combine ports
53 Port port : portRest ->
54 case port of
55 SendDefinition name _ -> Left (msg name)
56 RecvDefinition name _ -> Left (msg name)
57 PortAnnotation name tipe ->
58 case portRest of
59 Port (SendDefinition name' expr) : rest | name == name' ->
60 do expr' <- exprCombineAnnotations expr
61 (:) (Port (Send name expr' tipe)) <$> go rest
63 Port (RecvDefinition name' expr) : rest | name == name' ->
64 do expr' <- exprCombineAnnotations expr
65 (:) (Port (Recv name expr' tipe)) <$> go rest
67 _ -> Left (msg name)