diff --git a/src/Bang/Syntax/AST.hs b/src/Bang/Syntax/AST.hs index dfc2c9b..fac426e 100644 --- a/src/Bang/Syntax/AST.hs +++ b/src/Bang/Syntax/AST.hs @@ -1,8 +1,9 @@ module Bang.Syntax.AST where -import Data.Text.Lazy(Text) +import Data.Text.Lazy(Text, unpack) import Bang.Syntax.Location +import Text.PrettyPrint.Annotated data NameEnvironment = ModuleEnv | TypeEnv | VarEnv deriving (Eq, Ord, Show) @@ -10,26 +11,67 @@ data NameEnvironment = ModuleEnv | TypeEnv | VarEnv data Name = Name Location NameEnvironment Word Text deriving (Show) +ppName :: Name -> Doc a +ppName (Name _ _ _ t) = text' t + data Module = Module Name [Declaration] deriving (Show) -data Declaration = TypeDeclaration !Name !Type - | ValueDeclaration !Name !Expression - | PrimTypeDecl !PrimitiveType +ppModule :: Module -> Doc a +ppModule (Module name decls) = + vcat ([text "module" <> space <> ppName name, text ""] ++ + map ppDeclaration decls) + +data Declaration = TypeDeclaration Name Type + | ValueDeclaration Name Expression + | PrimTypeDeclaration Name Text deriving (Show) -data PrimitiveType = PrimType Name Text - deriving (Show) +ppDeclaration :: Declaration -> Doc a +ppDeclaration d = + case d of + TypeDeclaration n t -> + ppName n <> space <> text "::" <> space <> ppType t + ValueDeclaration n e -> + ppName n <> space <> text "=" <> space <> ppExpression e + PrimTypeDeclaration n t -> + text "primitive" <> space <> text "type" <> space <> + ppName n <> space <> text "=" <> space <> text' t -data Expression = ConstantExp Location ConstantVal +data Expression = ConstantExp Location ConstantValue | ReferenceExp Location Name deriving (Show) -data ConstantVal = ConstantInt Word Text - | ConstantChar Text - | ConstantString Text - | ConstantFloat Text +ppExpression :: Expression -> Doc a +ppExpression e = + case e of + ConstantExp _ v -> ppConstantValue v + ReferenceExp _ n -> ppName n + +data ConstantValue = ConstantInt Word Text + | ConstantChar Text + | ConstantString Text + | ConstantFloat Text deriving (Show) +ppConstantValue :: ConstantValue -> Doc a +ppConstantValue cv = + case cv of + ConstantInt 2 t -> text "0b" <> text' t + ConstantInt 8 t -> text "0o" <> text' t + ConstantInt 10 t -> text' t + ConstantInt 16 t -> text "0x" <> text' t + ConstantChar c -> text' c + ConstantString s -> text' s + ConstantFloat f -> text' f + data Type = TypeRef Location Name deriving (Show) + +ppType :: Type -> Doc a +ppType t = + case t of + TypeRef _ n -> ppName n + +text' :: Text -> Doc a +text' = text . unpack diff --git a/src/Bang/Syntax/Parser.y b/src/Bang/Syntax/Parser.y index 6759b89..401aed6 100644 --- a/src/Bang/Syntax/Parser.y +++ b/src/Bang/Syntax/Parser.y @@ -143,7 +143,7 @@ declaration :: { Maybe Declaration } do let Located src (TypeIdent rawName) = $3 Located _ (StringTok rawText) = $5 name <- registerName False src TypeEnv rawName - return (Just (PrimTypeDecl (PrimType name rawText))) } + return (Just (PrimTypeDeclaration name rawText)) } Type :: { Type } : TypeIdent {% diff --git a/src/Main.hs b/src/Main.hs index 70d0bb8..376efb6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,5 @@ import Bang.CommandLine +import Bang.Syntax.AST(ppModule) import Bang.Syntax.Lexer import Bang.Syntax.Location import Bang.Syntax.Parser @@ -8,6 +9,7 @@ import qualified Data.Text.Lazy.IO as T import Data.Version(showVersion) import Paths_bang(version) import System.IO.Error(isDoesNotExistError) +import Text.PrettyPrint.Annotated(render) main :: IO () main = getCommand >>= \ cmd -> @@ -34,5 +36,9 @@ runParser _cmd opts = case mtxt of Left _ -> fail ("Unable to open file: " ++ path) Right txt -> - do let mod = parseModule (File path) txt - putStrLn (show mod) + do let res = parseModule (File path) txt + case res of + Left err -> + putStrLn (show err) + Right mod -> + putStrLn (render (ppModule mod))