49fc0b6378
Used to combine type annotations with definitions and find ordering problems with Definitions and Ports
65 lines
2.6 KiB
Haskell
65 lines
2.6 KiB
Haskell
{-# OPTIONS_GHC -Wall #-}
|
|
module Transform.Declaration where
|
|
|
|
import Control.Applicative ((<$>))
|
|
import qualified SourceSyntax.Pattern as P
|
|
import SourceSyntax.Expression as E
|
|
import SourceSyntax.Declaration as D
|
|
|
|
import qualified Transform.Expression as Expr
|
|
import qualified Transform.Definition as Def
|
|
|
|
|
|
combineAnnotations :: [ParseDeclaration] -> Either String [Declaration]
|
|
combineAnnotations = go
|
|
where
|
|
msg x = "Syntax Error: The type annotation for '" ++ x ++
|
|
"' must be directly above its definition."
|
|
|
|
go decls =
|
|
case decls of
|
|
-- simple cases, pass them through with no changes
|
|
[] -> return []
|
|
|
|
Datatype name tvars ctors ds : rest ->
|
|
(:) (Datatype name tvars ctors ds) <$> go rest
|
|
|
|
TypeAlias name tvars alias ds : rest ->
|
|
(:) (TypeAlias name tvars alias ds) <$> go rest
|
|
|
|
Fixity assoc prec op : rest ->
|
|
(:) (Fixity assoc prec op) <$> go rest
|
|
|
|
-- combine definitions
|
|
D.Definition def : defRest ->
|
|
case def of
|
|
Def pat expr ->
|
|
do expr' <- Expr.crawl Def.combineAnnotations expr
|
|
let def' = E.Definition pat expr' Nothing
|
|
(:) (D.Definition def') <$> go defRest
|
|
|
|
TypeAnnotation name tipe ->
|
|
case defRest of
|
|
D.Definition (Def pat@(P.PVar name') expr) : rest | name == name' ->
|
|
do expr' <- Expr.crawl Def.combineAnnotations expr
|
|
let def' = E.Definition pat expr' (Just tipe)
|
|
(:) (D.Definition def') <$> go rest
|
|
|
|
_ -> Left (msg name)
|
|
|
|
-- combine ports
|
|
Port port : portRest ->
|
|
case port of
|
|
SendDefinition name _ -> Left (msg name)
|
|
RecvDefinition name _ -> Left (msg name)
|
|
PortAnnotation name tipe ->
|
|
case portRest of
|
|
Port (SendDefinition name' expr) : rest | name == name' ->
|
|
do expr' <- Expr.crawl Def.combineAnnotations expr
|
|
(:) (Port (Send name expr' tipe)) <$> go rest
|
|
|
|
Port (RecvDefinition name' expr) : rest | name == name' ->
|
|
do expr' <- Expr.crawl Def.combineAnnotations expr
|
|
(:) (Port (Send name expr' tipe)) <$> go rest
|
|
|
|
_ -> Left (msg name)
|