2014-01-03 07:39:34 +00:00
|
|
|
{-# OPTIONS_GHC -Wall #-}
|
|
|
|
module Transform.Definition where
|
|
|
|
|
|
|
|
import Control.Applicative ((<$>))
|
|
|
|
import qualified SourceSyntax.Pattern as P
|
|
|
|
import SourceSyntax.Expression
|
|
|
|
import qualified Transform.Expression as Expr
|
|
|
|
|
|
|
|
combineAnnotations :: [ParseDef] -> Either String [Def]
|
|
|
|
combineAnnotations = go
|
|
|
|
where
|
|
|
|
msg x = "Syntax Error: The type annotation for '" ++ x ++
|
|
|
|
"' must be directly above its definition."
|
|
|
|
|
2014-01-05 09:15:37 +00:00
|
|
|
exprCombineAnnotations = Expr.crawlLet combineAnnotations
|
|
|
|
|
2014-01-03 07:39:34 +00:00
|
|
|
go defs =
|
|
|
|
case defs of
|
|
|
|
TypeAnnotation name tipe : Def pat@(P.PVar name') expr : rest | name == name' ->
|
2014-01-05 09:15:37 +00:00
|
|
|
do expr' <- exprCombineAnnotations expr
|
2014-01-03 07:39:34 +00:00
|
|
|
let def = Definition pat expr' (Just tipe)
|
|
|
|
(:) def <$> go rest
|
|
|
|
|
|
|
|
TypeAnnotation name _ : _ -> Left (msg name)
|
|
|
|
|
|
|
|
Def pat expr : rest ->
|
2014-01-05 09:15:37 +00:00
|
|
|
do expr' <- exprCombineAnnotations expr
|
2014-01-03 07:39:34 +00:00
|
|
|
let def = Definition pat expr' Nothing
|
|
|
|
(:) def <$> go rest
|
|
|
|
|
|
|
|
[] -> return []
|