diff --git a/language-lua.cabal b/language-lua.cabal --- a/language-lua.cabal +++ b/language-lua.cabal @@ -2,6 +2,14 @@ Description: Lua 5.2 lexer, parser and pretty-printer. Documentation: () . Changelog: + \0.4.1: + . + - Some tweaks in pretty-printer. + . + \0.4.0: + . + - `Table` and `FunDef` nodes are removed from simplified syntax. + . \0.3.1: . - Fixed incorrectly exported name `exp` in `Language.Lua.Parser` module. @@ -21,7 +29,7 @@ \0.2.0: . - Syntax tree is annotated. All parsers(`parseText`, `parseFile`) annotate resulting tree with source positions. -Version: 0.3.1 +Version: 0.4.1 Synopsis: Lua parser and pretty-printer Homepage: http://github.com/osa1/language-lua Bug-reports: http://github.com/osa1/language-lua/issues diff --git a/src/Language/Lua/Annotated/Simplify.hs b/src/Language/Lua/Annotated/Simplify.hs --- a/src/Language/Lua/Annotated/Simplify.hs +++ b/src/Language/Lua/Annotated/Simplify.hs @@ -59,16 +59,16 @@ sFunBody (A.FunBody _ ns vararg b) = FunBody (map sName ns) (maybe False (const True) vararg) (sBlock b) -sFunDef :: A.FunDef a -> FunDef -sFunDef (A.FunDef _ fb) = FunDef (sFunBody fb) +sFunDef :: A.FunDef a -> FunBody +sFunDef (A.FunDef _ fb) = sFunBody fb sPrefixExp :: A.PrefixExp a -> PrefixExp sPrefixExp (A.PEVar _ v) = PEVar (sVar v) sPrefixExp (A.PEFunCall _ fc) = PEFunCall (sFunCall fc) sPrefixExp (A.Paren _ e) = Paren (sExp e) -sTable :: A.Table a -> Table -sTable (A.Table _ fs) = Table (map sTableField fs) +sTable :: A.Table a -> [TableField] +sTable (A.Table _ fs) = map sTableField fs sBinop :: A.Binop a -> Binop sBinop A.Add{} = Add diff --git a/src/Language/Lua/PrettyPrinter.hs b/src/Language/Lua/PrettyPrinter.hs --- a/src/Language/Lua/PrettyPrinter.hs +++ b/src/Language/Lua/PrettyPrinter.hs @@ -29,7 +29,7 @@ pprint :: a -> Doc instance LPretty [Char] where - pprint s = text s + pprint = text instance LPretty Bool where pprint True = text "true" @@ -44,17 +44,13 @@ pprint (EFunDef f) = pprint f pprint (PrefixExp pe) = pprint pe pprint (TableConst t) = pprint t - - pprint (Binop op@And e1 e2) = group (nest 4 (pprint e1 <+> pprint op <$> pprint e2)) - pprint (Binop op@Or e1 e2) = group (nest 4 (pprint e1 <+> pprint op <$> pprint e2)) - pprint (Binop op e1 e2) = pprint e1 <+> pprint op <+> pprint e2 - - pprint (Unop op e) = pprint op <> pprint e + pprint (Binop op e1 e2) = group (pprint e1 <+> pprint op <$> pprint e2) + pprint (Unop op e) = pprint op <> pprint e instance LPretty Var where pprint (VarName n) = pprint n - pprint (Select pe e) = pprint pe <> brackets (pprint e) - pprint (SelectName pe name) = group (nest 4 (pprint pe (char '.' <> pprint name))) + pprint (Select pe e) = pprint pe <> align (brackets (pprint e)) + pprint (SelectName pe name) = pprint pe (char '.' <> pprint name) instance LPretty Binop where pprint Add = char '+' @@ -83,8 +79,8 @@ pprint (PEFunCall funcall) = pprint funcall pprint (Paren e) = parens (pprint e) -instance LPretty Table where - pprint (Table fields) = braces (nest 4 (cat (punctuate comma (map pprint fields)))) +instance LPretty [TableField] where + pprint fields = braces (align (fillSep (punctuate (comma <> space) (map pprint fields)))) instance LPretty TableField where pprint (ExpField e1 e2) = brackets (pprint e1) <+> equals <+> pprint e2 @@ -98,7 +94,8 @@ _ -> vsep (map pprint stats) <$> ret' where ret' = case ret of Nothing -> empty - Just e -> nest 2 (text "return" (intercalate comma (map pprint e))) + Just [fun@EFunDef{}] -> text "return" <+> pprint fun + Just e -> nest 4 (text "return" intercalate comma (map (align . pprint) e)) instance LPretty FunName where pprint (FunName name s methods) = cat (punctuate dot (map pprint $ name:s)) <> method' @@ -106,11 +103,8 @@ Nothing -> empty Just m' -> char ':' <> pprint m' -instance LPretty FunDef where - pprint (FunDef body) = pprint body - instance LPretty FunBody where - pprint funbody = pprintFunction Nothing funbody + pprint = pprintFunction Nothing pprintFunction :: Maybe Doc -> FunBody -> Doc pprintFunction funname (FunBody args vararg block) = @@ -119,44 +113,38 @@ header = case funname of Nothing -> text "function" <+> args' Just n -> text "function" <+> n <> args' - vararg' = if vararg then ["..."] else [] - - args' = parens $ case args ++ vararg' of - [] -> empty - l -> nest 2 (foldr1 () (punctuate comma (map pprint l))) - + args' = parens (align (cat (punctuate (comma <> space) (map pprint (args ++ vararg'))))) body = pprint block - end = text "end" instance LPretty FunCall where - pprint (NormalFunCall pe arg) = nest 4 (group (pprint pe <> pprint arg)) - pprint (MethodCall pe method arg) = nest 4 (group (pprint pe colon <> pprint method <> pprint arg)) + pprint (NormalFunCall pe arg) = pprint pe <> pprint arg + pprint (MethodCall pe method arg) = pprint pe colon <> pprint method <> pprint arg instance LPretty FunArg where - pprint (Args exps) = case map pprint exps of - [] -> parens empty - l -> parens (foldr1 () (punctuate comma l)) + pprint (Args [fun@EFunDef{}]) = parens (pprint fun) + pprint (Args exps) = parens (align (fillSep (punctuate comma (map (align . pprint) exps)))) pprint (TableArg t) = pprint t pprint (StringArg s) = dquotes (text s) instance LPretty Stat where pprint (Assign names vals) - = (intercalate comma (map pprint names)) + = intercalate comma (map pprint names) <+> equals - <+> (intercalate comma (map pprint vals)) + <+> intercalate comma (map pprint vals) pprint (FunCall funcall) = pprint funcall pprint (Label name) = text "::" <> pprint name <> text "::" pprint Break = text "break" pprint (Goto name) = text "goto" <+> pprint name pprint (Do block) = group (nest 4 (text "do" <$> pprint block) <$> text "end") pprint (While guard e) - = (nest 4 (text "while" <+> pprint guard <+> text "do" - indent 4 (pprint e))) - text "end" + = text "while" <+> pprint guard <+> text "do" + <$> indent 4 (pprint e) + <$> text "end" pprint (Repeat block guard) - = nest 4 (text "repeat" pprint block) (nest 4 (text "until" pprint guard)) + = (text "repeat" <$> indent 4 (pprint block)) + nest 4 (text "until" pprint guard) pprint (If cases elsePart) = group (printIf cases elsePart) where @@ -177,16 +165,16 @@ Just e -> comma <> pprint e pprint (ForIn names exps block) - = text "for" <+> (intercalate comma (map pprint names)) - <+> text "in" <+> (intercalate comma (map pprint exps)) <+> text "do" + = text "for" <+> intercalate comma (map pprint names) + <+> text "in" <+> intercalate comma (map pprint exps) <+> text "do" <$> indent 4 (pprint block) <$> text "end" pprint (FunAssign name body) = pprintFunction (Just (pprint name)) body pprint (LocalFunAssign name body) = text "local" <+> pprintFunction (Just (pprint name)) body pprint (LocalAssign names exps) - = text "local" <+> (intercalate comma (map pprint names)) <+> equals exps' + = text "local" <+> intercalate comma (map pprint names) <+> exps' where exps' = case exps of Nothing -> empty - Just es -> intercalate comma (map pprint es) + Just es -> equals intercalate comma (map pprint es) pprint EmptyStat = empty diff --git a/src/Language/Lua/Syntax.hs b/src/Language/Lua/Syntax.hs --- a/src/Language/Lua/Syntax.hs +++ b/src/Language/Lua/Syntax.hs @@ -31,9 +31,9 @@ | Number String | String String | Vararg -- ^/.../ - | EFunDef FunDef -- ^/function (..) .. end/ + | EFunDef FunBody -- ^/function (..) .. end/ | PrefixExp PrefixExp - | TableConst Table -- ^table constructor + | TableConst [TableField] -- ^table constructor | Binop Binop Exp Exp -- ^binary operators, /+ - * ^ % .. < <= > >= == ~= and or/ | Unop Unop Exp -- ^unary operators, /- not #/ deriving (Show, Eq) @@ -57,9 +57,6 @@ | Paren Exp deriving (Show, Eq) -data Table = Table [TableField] -- ^list of table fields - deriving (Show, Eq) - data TableField = ExpField Exp Exp -- ^/[exp] = exp/ | NamedField Name Exp -- ^/name = exp/ @@ -73,9 +70,6 @@ data FunName = FunName Name [Name] (Maybe Name) deriving (Show, Eq) -data FunDef = FunDef FunBody - deriving (Show, Eq) - data FunBody = FunBody [Name] Bool Block -- ^(args, vararg, block) deriving (Show, Eq) @@ -86,6 +80,6 @@ data FunArg = Args [Exp] -- ^list of args - | TableArg Table -- ^table constructor + | TableArg [TableField] -- ^table constructor | StringArg String -- ^string deriving (Show, Eq)