2014-01-03 11:33:56 +00:00
|
|
|
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
|
2013-07-07 16:13:40 +00:00
|
|
|
module Parse.Declaration where
|
|
|
|
|
2014-01-03 11:33:56 +00:00
|
|
|
import Control.Applicative ((<$>))
|
2013-07-07 16:13:40 +00:00
|
|
|
import Text.Parsec hiding (newline,spaces)
|
|
|
|
|
|
|
|
import Parse.Helpers
|
|
|
|
import qualified Parse.Expression as Expr
|
|
|
|
import qualified Parse.Type as Type
|
2013-12-23 22:42:43 +00:00
|
|
|
import qualified SourceSyntax.Declaration as D
|
2013-07-07 16:13:40 +00:00
|
|
|
|
|
|
|
|
2014-01-03 07:20:25 +00:00
|
|
|
declaration :: IParser D.ParseDeclaration
|
2013-12-24 07:53:54 +00:00
|
|
|
declaration = alias <|> datatype <|> infixDecl <|> port <|> definition
|
2013-07-07 16:13:40 +00:00
|
|
|
|
2014-01-03 07:20:25 +00:00
|
|
|
definition :: IParser D.ParseDeclaration
|
2013-12-23 22:42:43 +00:00
|
|
|
definition = D.Definition <$> Expr.def
|
2013-07-07 16:13:40 +00:00
|
|
|
|
2014-01-03 07:20:25 +00:00
|
|
|
alias :: IParser D.ParseDeclaration
|
2013-07-07 16:13:40 +00:00
|
|
|
alias = do
|
|
|
|
reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"
|
|
|
|
forcedWS
|
2014-01-03 11:33:56 +00:00
|
|
|
name <- capVar
|
|
|
|
args <- spacePrefix lowVar
|
2013-11-02 18:21:26 +00:00
|
|
|
padded equals
|
2013-07-07 16:13:40 +00:00
|
|
|
tipe <- Type.expr
|
2014-01-20 00:09:50 +00:00
|
|
|
return (D.TypeAlias name args tipe)
|
2013-07-07 20:06:56 +00:00
|
|
|
|
2014-01-03 07:20:25 +00:00
|
|
|
datatype :: IParser D.ParseDeclaration
|
2013-07-07 20:06:56 +00:00
|
|
|
datatype = do
|
|
|
|
reserved "data" <?> "datatype definition (data T = A | B | ...)"
|
|
|
|
forcedWS
|
|
|
|
name <- capVar <?> "name of data-type"
|
|
|
|
args <- spacePrefix lowVar
|
2013-11-02 18:21:26 +00:00
|
|
|
padded equals
|
2013-07-07 20:06:56 +00:00
|
|
|
tcs <- pipeSep1 Type.constructor
|
2014-01-20 00:09:50 +00:00
|
|
|
return $ D.Datatype name args tcs
|
2013-07-07 20:06:56 +00:00
|
|
|
|
|
|
|
|
2014-01-03 07:20:25 +00:00
|
|
|
infixDecl :: IParser D.ParseDeclaration
|
2013-07-16 12:39:58 +00:00
|
|
|
infixDecl = do
|
2013-12-23 22:42:43 +00:00
|
|
|
assoc <- choice [ reserved "infixl" >> return D.L
|
|
|
|
, reserved "infix" >> return D.N
|
|
|
|
, reserved "infixr" >> return D.R ]
|
2013-11-02 18:21:26 +00:00
|
|
|
forcedWS
|
2013-07-16 12:39:58 +00:00
|
|
|
n <- digit
|
2013-07-16 12:50:35 +00:00
|
|
|
forcedWS
|
2013-12-23 22:42:43 +00:00
|
|
|
D.Fixity assoc (read [n]) <$> anyOp
|
2013-07-16 12:39:58 +00:00
|
|
|
|
|
|
|
|
2014-01-03 07:20:25 +00:00
|
|
|
port :: IParser D.ParseDeclaration
|
2013-12-24 07:53:54 +00:00
|
|
|
port =
|
|
|
|
do try (reserved "port")
|
|
|
|
whitespace
|
|
|
|
name <- lowVar
|
2014-01-03 07:20:25 +00:00
|
|
|
whitespace
|
|
|
|
let port' op ctor expr = do { try op ; whitespace ; ctor name <$> expr }
|
2014-01-13 18:24:17 +00:00
|
|
|
D.Port <$> choice [ port' hasType D.PPAnnotation Type.expr
|
2014-01-20 00:09:50 +00:00
|
|
|
, port' equals D.PPDef Expr.expr ]
|