diff --git a/language-ats.cabal b/language-ats.cabal --- a/language-ats.cabal +++ b/language-ats.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: language-ats -version: 1.2.0.3 +version: 1.2.0.4 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale @@ -31,7 +31,7 @@ library exposed-modules: Language.ATS - build-tools: happy >=1.17.1, alex -any + build-tools: happy >=1.17.1, alex -any, cpphs -any hs-source-dirs: src other-modules: Language.ATS.Lexer diff --git a/src/Language/ATS/Lexer.x b/src/Language/ATS/Lexer.x --- a/src/Language/ATS/Lexer.x +++ b/src/Language/ATS/Lexer.x @@ -19,6 +19,7 @@ , get_staload ) where +import Data.Char (chr) import Data.Bool (bool) import Control.DeepSeq (NFData) import GHC.Generics (Generic) @@ -276,6 +277,34 @@ { +nested_comment :: AlexInput -> Int -> Alex Token +nested_comment _ _ = do + + input <- alexGetInput + go 1 input + + where go :: Int -> AlexInput -> Alex Token + go 0 input = alexSetInput input >> alexMonadScan + go n input = do + case alexGetByte input of + Nothing -> err input + Just (c, input) -> do + case chr (fromIntegral c) of + '*' -> do + case alexGetByte input of + Nothing -> err input + Just (41,input) -> go (n-1) input + Just (_,input) -> go n input + '(' -> do + case alexGetByte input of + Nothing -> err input + Just (c,input) -> go (bool id (+1) (c==42) $ n) input + _ -> go n input + + err (pos,_,_,_) = + let (AlexPn _ line col) = pos + in alexError ("Error in nested comment at line " ++ show line ++ ", column " ++ show col) + alex :: a -> Alex a alex = pure @@ -572,7 +601,7 @@ -- | This function turns a string into a stream of tokens for the parser. lexATS :: String -> Either String [Token] -lexATS str = runAlex str $ loop +lexATS str = runAlex str loop loop :: Alex [Token] loop = do diff --git a/src/Language/ATS/Parser.y b/src/Language/ATS/Parser.y --- a/src/Language/ATS/Parser.y +++ b/src/Language/ATS/Parser.y @@ -689,8 +689,11 @@ | sortdef IdentifierOr eq Universal { SortDef $1 $2 (Right $4) } StaticDef : eq Type { Right $2 } - | eq StaticExpression { Left $2 } + | eq StaticExpression MaybeAnnot { Left ($2, $3) } +MaybeAnnot : colon Sort { Just $2 } + | { Nothing } + AndStadef : stadef IdentifierOr SortArgs StaticDef { Stadef $2 $3 $4 } | stadef Operator SortArgs StaticDef { Stadef $2 $3 $4 } | AndStadef and IdentifierOr SortArgs StaticDef { AndD $1 (Stadef $3 $4 $5) } @@ -756,7 +759,7 @@ | dataview IdentifierOr SortArgs eq lineComment Leaves { DataView $1 $2 $3 $6 } -- | Parse a declaration defining a type -TypeDecl : typedef IdentifierOr SortArgs eq Type { TypeDef $1 $2 $3 $5 } +TypeDecl : typedef IdentifierOr SortArgs eq Type MaybeAnnot { TypeDef $1 $2 $3 $5 $6 } | vtypedef IdentifierOr SortArgs eq Type { ViewTypeDef $1 $2 $3 $5 } | extern vtypedef string SortArgs eq Type { Extern $1 $ ViewTypeDef $2 $3 $4 $6 } | abst0p IdentifierOr SortArgs MaybeType { AbsT0p $1 $2 $3 $4 } diff --git a/src/Language/ATS/PrettyPrint.hs b/src/Language/ATS/PrettyPrint.hs --- a/src/Language/ATS/PrettyPrint.hs +++ b/src/Language/ATS/PrettyPrint.hs @@ -526,6 +526,10 @@ prettySortArgs Nothing = mempty prettySortArgs (Just as) = prettyArgs' ", " "(" ")" as +maybeT :: Pretty a => Maybe a -> Doc +maybeT (Just x) = ":" <+> pretty x +maybeT Nothing = mempty + instance Eq a => Pretty (Declaration a) where pretty (Exception s t) = "exception" <+> text s <+> "of" <+> pretty t pretty (AbsType _ s as t) = "abstype" <+> text s <> prettySortArgs as <> prettyMaybeType t @@ -571,7 +575,7 @@ pretty (Extern _ d) = "extern" <$> pretty d pretty (DataProp _ s as ls) = "dataprop" <+> text s <> prettySortArgs as <+> "=" <$> prettyDL ls pretty (ViewTypeDef _ s as t) = "vtypedef" <+> text s <> prettySortArgs as <+> "=" <#> pretty t - pretty (TypeDef _ s as t) = "typedef" <+> text s <> prettySortArgs as <+> "=" <+> pretty t + pretty (TypeDef _ s as t ms) = "typedef" <+> text s <> prettySortArgs as <+> "=" <+> pretty t <> maybeT ms pretty (AbsProp _ n as) = "absprop" <+> text n <+> prettyArgs as pretty (Assume n NoA e) = "assume" pretty n <+> "=" pretty e pretty (Assume n as e) = "assume" pretty n <> prettyArgs as <+> "=" pretty e @@ -584,9 +588,9 @@ pretty (FixityDecl f ss) = pretty f <+> hsep (fmap text ss) pretty (StaVal us i t) = "val" mconcat (fmap pretty us) <+> text i <+> ":" <+> pretty t pretty (Stadef i as (Right t)) = "stadef" <+> text i <+> prettySortArgs as <+> "=" <+> pretty t - pretty (Stadef i as (Left se)) = "stadef" <+> text i <+> prettySortArgs as <+> "=" <+> pretty se + pretty (Stadef i as (Left (se, mt))) = "stadef" <+> text i <+> prettySortArgs as <+> "=" <+> pretty se <> maybeT mt pretty (AndD d (Stadef i as (Right t))) = pretty d <+> "and" <+> text i <+> prettySortArgs as <+> "=" <+> pretty t - pretty (AndD d (Stadef i as (Left se))) = pretty d <+> "and" <+> text i <+> prettySortArgs as <+> "=" <+> pretty se + pretty (AndD d (Stadef i as (Left (se, mt)))) = pretty d <+> "and" <+> text i <+> prettySortArgs as <+> "=" <+> pretty se <> maybeT mt pretty (AbsView _ i as t) = "absview" <+> text i <> prettySortArgs as <> prettyMaybeType t pretty (AbsVT0p _ i as t) = "absvt@ype" <+> text i <> prettySortArgs as <> prettyMaybeType t pretty (AbsT0p _ i Nothing t) = "abst@ype" <+> text i <+> "=" <+> pretty t diff --git a/src/Language/ATS/Types.hs b/src/Language/ATS/Types.hs --- a/src/Language/ATS/Types.hs +++ b/src/Language/ATS/Types.hs @@ -105,9 +105,9 @@ | AndDecl { andT :: Maybe (Type a), andPat :: Pattern a, _andExpr :: Expression a } | Include String | Load { static :: Bool, withOctothorpe :: Bool, qualName :: Maybe String, fileName :: String } - | Stadef String (SortArgs a) (Either (StaticExpression a) (Type a)) -- TODO (StaticExpression a, Maybe (Type a)) + | Stadef String (SortArgs a) (Either (StaticExpression a, Maybe (Sort a)) (Type a)) | CBlock String - | TypeDef a String (SortArgs a) (Type a) + | TypeDef a String (SortArgs a) (Type a) (Maybe (Sort a)) | ViewTypeDef a String (SortArgs a) (Type a) | SumType { typeName :: String, typeArgs :: SortArgs a, _leaves :: [Leaf a] } | SumViewType { typeName :: String, typeArgs :: SortArgs a, _leaves :: [Leaf a] }