on 63243ca help sign in
elk/compiler/Transform/Declaration.hs
63 lines 2.4 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 PPDef name _ -> Left (msg name)
56 PPAnnotation name tipe ->
57 case portRest of
58 Port (PPDef name' expr) : rest | name == name' ->
59 do expr' <- exprCombineAnnotations expr
60 (:) (Port (Out name expr' tipe)) <$> go rest
62 _ -> (:) (Port (In name tipe)) <$> go portRest