language-lua 0.6.0 → 0.6.2

raw patch · 12 files changed

+220/−112 lines, 12 filesdep +criteriondep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: criterion

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• bench/Main.hs +21/−0
• dist/build/Language/Lua/Annotated/Lexer.hs +64/−10
• language-lua.cabal +26/−4
• src/Language/Lua.hs +5/−4
• src/Language/Lua/Annotated.hs +4/−3
• src/Language/Lua/Annotated/Parser.hs +8/−12
• src/Language/Lua/Annotated/Simplify.hs +5/−4
• src/Language/Lua/Annotated/Syntax.hs +36/−19
• src/Language/Lua/Parser.hs +7/−8
• src/Language/Lua/PrettyPrinter.hs +3/−6
• src/Language/Lua/Syntax.hs +30/−16
• tests/Main.hs +11/−26

@@ -0,0 +1,21 @@+module Main where++import           Control.Applicative+import           Criterion.Main+import           Data.Maybe          (catMaybes)+import           System.Directory    (getDirectoryContents)+import           System.FilePath++import           Language.Lua++main :: IO ()+main = defaultMain+  [ env (loadFiles "lua-5.2.2-tests") $ \files ->+      bench "Parsing Lua files from 5.2.2 test suite" $+        nf (catMaybes . map (either (const Nothing) Just) . map (parseText chunk)) files+  ]++loadFiles :: FilePath -> IO [String]+loadFiles root = do+  luaFiles <- map (root </>) . filter ((==) ".lua" . takeExtension) <$> getDirectoryContents root+  mapM readFile luaFiles

@@ -38,6 +38,7 @@ #endif {-# LINE 1 "templates/wrappers.hs" #-} {-# LINE 1 "templates/wrappers.hs" #-}+{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# LINE 9 "<command-line>" #-} # 1 "/usr/include/stdc-predef.h" 1 3 4@@ -66,6 +67,25 @@   +++++++++++++++++++ {-# LINE 9 "<command-line>" #-} {-# LINE 1 "templates/wrappers.hs" #-} -- -----------------------------------------------------------------------------@@ -74,8 +94,9 @@ -- This code is in the PUBLIC DOMAIN; you may copy it freely and use -- it for any purpose whatsoever. +import Control.Applicative (Applicative (..)) import Data.Word (Word8)-{-# LINE 22 "templates/wrappers.hs" #-}+{-# LINE 23 "templates/wrappers.hs" #-}  import qualified Data.Bits @@ -127,11 +148,11 @@                               in p' `seq`  Just (b, (p', c, bs, s))  -{-# LINE 92 "templates/wrappers.hs" #-}+{-# LINE 93 "templates/wrappers.hs" #-} -{-# LINE 106 "templates/wrappers.hs" #-}+{-# LINE 107 "templates/wrappers.hs" #-} -{-# LINE 121 "templates/wrappers.hs" #-}+{-# LINE 122 "templates/wrappers.hs" #-}  -- ----------------------------------------------------------------------------- -- Token positions@@ -187,6 +208,19 @@  newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) } +instance Functor Alex where+  fmap f a = Alex $ \s -> case unAlex a s of+                            Left msg -> Left msg+                            Right (s', a') -> Right (s', f a')++instance Applicative Alex where+  pure a   = Alex $ \s -> Right (s, a)+  fa <*> a = Alex $ \s -> case unAlex fa s of+                            Left msg -> Left msg+                            Right (s', f) -> case unAlex a s' of+                                               Left msg -> Left msg+                                               Right (s'', b) -> Right (s'', f b)+ instance Monad Alex where   m >>= k  = Alex $ \s -> case unAlex m s of                                  Left msg -> Left msg@@ -258,35 +292,35 @@ -- ----------------------------------------------------------------------------- -- Monad (with ByteString input) -{-# LINE 333 "templates/wrappers.hs" #-}+{-# LINE 347 "templates/wrappers.hs" #-}   -- ----------------------------------------------------------------------------- -- Basic wrapper -{-# LINE 360 "templates/wrappers.hs" #-}+{-# LINE 374 "templates/wrappers.hs" #-}   -- ----------------------------------------------------------------------------- -- Basic wrapper, ByteString version -{-# LINE 378 "templates/wrappers.hs" #-}- {-# LINE 392 "templates/wrappers.hs" #-} +{-# LINE 406 "templates/wrappers.hs" #-} + -- ----------------------------------------------------------------------------- -- Posn wrapper  -- Adds text positions to the basic model. -{-# LINE 409 "templates/wrappers.hs" #-}+{-# LINE 423 "templates/wrappers.hs" #-}   -- ----------------------------------------------------------------------------- -- Posn wrapper, ByteString version -{-# LINE 424 "templates/wrappers.hs" #-}+{-# LINE 438 "templates/wrappers.hs" #-}   -- -----------------------------------------------------------------------------@@ -637,11 +671,31 @@ alex_action_43 =  tok LTokEllipsis  {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# LINE 9 "<command-line>" #-} # 1 "/usr/include/stdc-predef.h" 1 3 4  # 17 "/usr/include/stdc-predef.h" 3 4+++++++++++++++++++   

@@ -5,7 +5,15 @@     .     Changelog:     .-+    \0.6.2:+    .+    - `base` dependency is relaxed for GHC 7.10. Note that alex version+      >3.1.4 is required to compile with GHC 7.10.+    .+    \0.6.1:+    .+    - `Generic` and `NFData` instances are implemented for syntax trees.+    .     \0.6.0:     .     - Fixed a long string literal parsing bug which was causing long strings to@@ -79,7 +87,7 @@     - Syntax tree is annotated. All parsers(`parseText`, `parseFile`) annotate       resulting tree with source positions. -Version:             0.6.0+Version:             0.6.2 Synopsis:            Lua parser and pretty-printer Homepage:            http://github.com/osa1/language-lua Bug-reports:         http://github.com/osa1/language-lua/issues@@ -115,7 +123,8 @@    Other-modules:     Text.PrettyPrint.Leijen -  Build-depends:     base >= 4.5 && < 4.8,+  Build-depends:     base >= 4.5 && < 4.9,+                     deepseq,                      array >= 0.4 && < 0.6,                      mtl >= 2.0 && < 2.3,                      parsec >= 3.1.3 && < 3.2,@@ -127,7 +136,7 @@   Type:              exitcode-stdio-1.0   Hs-source-dirs:    tests   Main-is:           Main.hs-  Build-depends:     base >= 4.5 && < 4.8,+  Build-depends:     base >= 4.5 && < 4.9,                      deepseq,                      directory,                      filepath,@@ -139,3 +148,16 @@                      tasty-quickcheck    ghc-options:       -Wall++Benchmark bench+  type:              exitcode-stdio-1.0+  default-language:  Haskell2010+  main-is:           Main.hs+  hs-source-dirs:    bench+  ghc-options:       -Wall++  build-depends:     base,+                     criterion,+                     directory,+                     filepath,+                     language-lua

@@ -8,7 +8,8 @@   , pprint   ) where -import Prelude hiding (exp)-import Language.Lua.Syntax-import Language.Lua.Parser-import Language.Lua.PrettyPrinter+import           Prelude                    hiding (exp)++import           Language.Lua.Parser+import           Language.Lua.PrettyPrinter+import           Language.Lua.Syntax

@@ -7,6 +7,7 @@   , chunk   ) where -import Prelude hiding (exp)-import Language.Lua.Annotated.Syntax-import Language.Lua.Annotated.Parser+import           Prelude                       hiding (exp)++import           Language.Lua.Annotated.Parser+import           Language.Lua.Annotated.Syntax

@@ -1,6 +1,3 @@-{-# OPTIONS_GHC -fno-warn-hi-shadowing-                -fno-warn-name-shadowing-                -fno-warn-unused-do-bind #-} {-# LANGUAGE LambdaCase, TupleSections #-}  module Language.Lua.Annotated.Parser@@ -11,16 +8,15 @@   , chunk   ) where -import Prelude hiding (exp, LT, GT, EQ)--import Language.Lua.Annotated.Lexer-import Language.Lua.Annotated.Syntax-import Language.Lua.Token+import           Control.Applicative           ((<$>), (<*), (<*>))+import           Control.Monad                 (liftM)+import           Prelude                       hiding (EQ, GT, LT, exp)+import           Text.Parsec                   hiding (string)+import           Text.Parsec.LTok -import Text.Parsec hiding (string)-import Text.Parsec.LTok-import Control.Applicative ((<*), (<$>), (<*>))-import Control.Monad (liftM)+import           Language.Lua.Annotated.Lexer+import           Language.Lua.Annotated.Syntax+import           Language.Lua.Token  -- | Runs Lua lexer before parsing. Use @parseText stat@ to parse -- statements, and @parseText exp@ to parse expressions.

@@ -1,10 +1,11 @@ -- | Remove annotations. module Language.Lua.Annotated.Simplify where -import qualified Language.Lua.Annotated.Syntax as A-import Language.Lua.Syntax+import           Data.Maybe                    (isJust)+import           Prelude                       hiding (EQ, GT, LT) -import Prelude hiding (LT, EQ, GT)+import qualified Language.Lua.Annotated.Syntax as A+import           Language.Lua.Syntax  sName :: A.Name a -> Name sName (A.Name _ s) = s@@ -57,7 +58,7 @@  sFunBody :: A.FunBody a -> FunBody sFunBody (A.FunBody _ ns vararg b) =-    FunBody (map sName ns) (maybe False (const True) vararg) (sBlock b)+    FunBody (map sName ns) (isJust vararg) (sBlock b)  sFunDef :: A.FunDef a -> FunBody sFunDef (A.FunDef _ fb) = sFunBody fb

@@ -1,14 +1,15 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveGeneric #-}  -- | Lua 5.2 syntax tree, as specified in <http://www.lua.org/manual/5.2/manual.html#9>. -- Annotation implementation is inspired by haskell-src-exts. module Language.Lua.Annotated.Syntax where -import Prelude hiding (LT, EQ, GT)-import Data.Data+import           Control.DeepSeq (NFData)+import           Data.Data       (Data, Typeable)+import           GHC.Generics    (Generic)+import           Prelude         hiding (EQ, GT, LT) -data Name a = Name a String deriving (Show, Eq, Functor, Data, Typeable)+data Name a = Name a String deriving (Show, Eq, Functor, Data, Typeable, Generic)  data Stat a     = Assign a [Var a] [Exp a] -- ^var1, var2 .. = exp1, exp2 ..@@ -26,7 +27,7 @@     | LocalFunAssign a (Name a) (FunBody a) -- ^local function \<var\> (..) .. end     | LocalAssign a [Name a] (Maybe [Exp a]) -- ^local var1, var2 .. = exp1, exp2 ..     | EmptyStat a -- ^/;/-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  data Exp a     = Nil a@@ -39,59 +40,59 @@     | TableConst a (Table a) -- ^table constructor     | Binop a (Binop a) (Exp a) (Exp a) -- ^binary operators, /+ - * ^ % .. < <= > >= == ~= and or/     | Unop a (Unop a) (Exp a) -- ^unary operators, /- not #/-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  data Var a     = VarName a (Name a) -- ^variable     | Select a (PrefixExp a) (Exp a) -- ^/table[exp]/     | SelectName a (PrefixExp a) (Name a) -- ^/table.variable/-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  data Binop a = Add a | Sub a | Mul a | Div a | Exp a | Mod a | Concat a     | LT a | LTE a | GT a | GTE a | EQ a | NEQ a | And a | Or a-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  data Unop a = Neg a | Not a | Len a-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  data PrefixExp a     = PEVar a (Var a)     | PEFunCall a (FunCall a)     | Paren a (Exp a)-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  data Table a = Table a [TableField a] -- ^list of table fields-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  data TableField a     = ExpField a (Exp a) (Exp a) -- ^/[exp] = exp/     | NamedField a (Name a) (Exp a) -- ^/name = exp/     | Field a (Exp a)-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  -- | A block is list of statements with optional return statement. data Block a = Block a [Stat a] (Maybe [Exp a])-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  data FunName a = FunName a (Name a) [Name a] (Maybe (Name a))-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  data FunDef a = FunDef a (FunBody a)-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  data FunBody a = FunBody a [Name a] (Maybe a) (Block a) -- ^(args, vararg, block)-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  data FunCall a     = NormalFunCall a (PrefixExp a) (FunArg a) -- ^/prefixexp ( funarg )/     | MethodCall a (PrefixExp a) (Name a) (FunArg a) -- ^/prefixexp : name ( funarg )/-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)  data FunArg a     = Args a [Exp a] -- ^list of args     | TableArg a (Table a) -- ^table constructor     | StringArg a String -- ^string-    deriving (Show, Eq, Functor, Data, Typeable)+    deriving (Show, Eq, Functor, Data, Typeable, Generic)   class Functor ast => Annotated ast where@@ -262,3 +263,19 @@     amap f (Args a x1) = Args (f a) x1     amap f (TableArg a x1) = TableArg (f a) x1     amap f (StringArg a x1) = StringArg (f a) x1++instance NFData a => NFData (Name a)+instance NFData a => NFData (Stat a)+instance NFData a => NFData (Exp a)+instance NFData a => NFData (Var a)+instance NFData a => NFData (Binop a)+instance NFData a => NFData (Unop a)+instance NFData a => NFData (PrefixExp a)+instance NFData a => NFData (Table a)+instance NFData a => NFData (TableField a)+instance NFData a => NFData (Block a)+instance NFData a => NFData (FunName a)+instance NFData a => NFData (FunDef a)+instance NFData a => NFData (FunBody a)+instance NFData a => NFData (FunCall a)+instance NFData a => NFData (FunArg a)

@@ -6,15 +6,14 @@   , chunk   ) where -import qualified Language.Lua.Annotated.Parser as A-import Language.Lua.Annotated.Simplify-import Language.Lua.Syntax--import Text.Parsec-import Text.Parsec.LTok-import Control.Monad (liftM)+import           Control.Monad                   (liftM)+import           Prelude                         hiding (exp)+import           Text.Parsec+import           Text.Parsec.LTok -import Prelude hiding (exp)+import qualified Language.Lua.Annotated.Parser   as A+import           Language.Lua.Annotated.Simplify+import           Language.Lua.Syntax  parseText :: Parser a -> String -> Either ParseError a parseText = A.parseText

@@ -1,6 +1,3 @@-{-# OPTIONS_GHC -fno-warn-hi-shadowing-                -fno-warn-name-shadowing-                -fno-warn-unused-do-bind #-} {-# LANGUAGE FlexibleInstances #-}  -- | Lua pretty-printer.@@ -12,10 +9,10 @@   , LPretty   ) where -import Prelude hiding (EQ, GT, LT)-import Text.PrettyPrint.Leijen hiding ((<$>))+import           Prelude                 hiding (EQ, GT, LT)+import           Text.PrettyPrint.Leijen hiding ((<$>)) -import Language.Lua.Syntax+import           Language.Lua.Syntax  intercalate :: Doc -> [Doc] -> Doc intercalate s elems = sep (punctuate s elems)

@@ -1,11 +1,12 @@-{-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}  -- | Lua 5.2 syntax tree, as specified in <http://www.lua.org/manual/5.2/manual.html#9>. module Language.Lua.Syntax where -import Prelude hiding (LT, EQ, GT)-import Data.Data+import           Control.DeepSeq (NFData)+import           Data.Data       (Data, Typeable)+import           GHC.Generics    (Generic)+import           Prelude         hiding (EQ, GT, LT)  type Name = String @@ -25,7 +26,7 @@     | LocalFunAssign Name FunBody -- ^local function \<var\> (..) .. end     | LocalAssign [Name] (Maybe [Exp]) -- ^local var1, var2 .. = exp1, exp2 ..     | EmptyStat -- ^/;/-    deriving (Show, Eq, Data, Typeable)+    deriving (Show, Eq, Data, Typeable, Generic)  data Exp     = Nil@@ -38,50 +39,63 @@     | TableConst [TableField] -- ^table constructor     | Binop Binop Exp Exp -- ^binary operators, /+ - * ^ % .. < <= > >= == ~= and or/     | Unop Unop Exp -- ^unary operators, /- not #/-    deriving (Show, Eq, Data, Typeable)+    deriving (Show, Eq, Data, Typeable, Generic)  data Var     = VarName Name -- ^variable     | Select PrefixExp Exp -- ^/table[exp]/     | SelectName PrefixExp Name -- ^/table.variable/-    deriving (Show, Eq, Data, Typeable)+    deriving (Show, Eq, Data, Typeable, Generic)  data Binop = Add | Sub | Mul | Div | Exp | Mod | Concat     | LT | LTE | GT | GTE | EQ | NEQ | And | Or-    deriving (Show, Eq, Data, Typeable)+    deriving (Show, Eq, Data, Typeable, Generic)  data Unop = Neg | Not | Len-    deriving (Show, Eq, Data, Typeable)+    deriving (Show, Eq, Data, Typeable, Generic)  data PrefixExp     = PEVar Var     | PEFunCall FunCall     | Paren Exp-    deriving (Show, Eq, Data, Typeable)+    deriving (Show, Eq, Data, Typeable, Generic)  data TableField     = ExpField Exp Exp -- ^/[exp] = exp/     | NamedField Name Exp -- ^/name = exp/     | Field Exp-    deriving (Show, Eq, Data, Typeable)+    deriving (Show, Eq, Data, Typeable, Generic)  -- | A block is list of statements with optional return statement. data Block = Block [Stat] (Maybe [Exp])-    deriving (Show, Eq, Data, Typeable)+    deriving (Show, Eq, Data, Typeable, Generic)  data FunName = FunName Name [Name] (Maybe Name)-    deriving (Show, Eq, Data, Typeable)+    deriving (Show, Eq, Data, Typeable, Generic)  data FunBody = FunBody [Name] Bool Block -- ^(args, vararg, block)-    deriving (Show, Eq, Data, Typeable)+    deriving (Show, Eq, Data, Typeable, Generic)  data FunCall     = NormalFunCall PrefixExp FunArg -- ^/prefixexp ( funarg )/     | MethodCall PrefixExp Name FunArg -- ^/prefixexp : name ( funarg )/-    deriving (Show, Eq, Data, Typeable)+    deriving (Show, Eq, Data, Typeable, Generic)  data FunArg     = Args [Exp] -- ^list of args     | TableArg [TableField] -- ^table constructor     | StringArg String -- ^string-    deriving (Show, Eq, Data, Typeable)+    deriving (Show, Eq, Data, Typeable, Generic)++instance NFData Stat+instance NFData Exp+instance NFData Var+instance NFData Binop+instance NFData Unop+instance NFData PrefixExp+instance NFData TableField+instance NFData Block+instance NFData FunName+instance NFData FunBody+instance NFData FunCall+instance NFData FunArg

@@ -1,6 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE DeriveGeneric, FlexibleInstances, ScopedTypeVariables,-             StandaloneDeriving #-}+{-# LANGUAGE DeriveGeneric, FlexibleInstances, ScopedTypeVariables #-}  module Main where @@ -20,7 +18,7 @@ import           Test.Tasty.QuickCheck  import           Control.Applicative-import           Control.DeepSeq                 (deepseq)+import           Control.DeepSeq                 (deepseq, force) import           Control.Monad                   (forM_) import           Data.Char                       (isSpace) import           GHC.Generics@@ -85,7 +83,7 @@  regressions :: TestTree regressions = testGroup "Regression tests"-    [ testCase "Lexing comment with text \"EOF\" in it" $ do+    [ testCase "Lexing comment with text \"EOF\" in it" $         assertEqual "Lexing is wrong" [(T.LTokEof, L.AlexPn (-1) (-1) (-1))] (L.llex "--EOF")     , testCase "Binary/unary operator parsing/printing" $ do         pp "2^3^2 == 2^(3^2)"@@ -103,9 +101,9 @@     , testCase "Lexing unnecessarily escaped quotes" $ do         show (L.llex "'\\\"'") `deepseq` return ()         show (L.llex "\"\\\'\"") `deepseq` return ()-    , testCase "Lexing long literal `[====[ ... ]====]`" $ do+    , testCase "Lexing long literal `[====[ ... ]====]`" $         show (L.llex "[=[]]=]") `deepseq` return ()-    , testCase "Handling \\z" $ do+    , testCase "Handling \\z" $         show (L.llex "\"\\z\n  \"") `deepseq` return ()     ]   where@@ -117,7 +115,6 @@           assertEqual "Printed string is not equal to original one modulo whitespace"             (filter (not . isSpace) expr) (filter (not . isSpace) (show $ pprint expr')) - parseFilesTest :: String -> FilePath -> TestTree parseFilesTest msg root = testCase msg $ do   luaFiles <- map (root </>) . filter ((==) ".lua" . takeExtension) <$> getDirectoryContents root@@ -127,7 +124,11 @@     ret <- P.parseFile luaFile     case ret of       Left err -> assertFailure ("Parser error in " ++ luaFile ++ ": " ++ show err)-      Right _  -> return ()+      Right st -> force st `seq` return ()+        -- case P.parseText P.chunk (show (pprint st)) of+        --   Left err -> assertFailure ("Parser error while parsing printed version of "+        --                               ++ luaFile ++ ": " ++ show err)+        --   Right _  -> return ()  genPrintParse :: TestTree genPrintParse =@@ -147,7 +148,7 @@  -- * Arbitrary instances -newtype LuaString = LuaString { unwrapLuaString :: String } -- deriving (Generic)+newtype LuaString = LuaString { unwrapLuaString :: String } deriving (Generic)  -- FIXME: either fix this or implement separate lexer tests instance Arbitrary LuaString where@@ -268,19 +269,3 @@     , StringArg <$> arbitrary     ]   shrink = recursivelyShrink---- * Generic instances--deriving instance Generic LuaString-deriving instance Generic Stat-deriving instance Generic Exp-deriving instance Generic Var-deriving instance Generic Binop-deriving instance Generic Unop-deriving instance Generic PrefixExp-deriving instance Generic TableField-deriving instance Generic Block-deriving instance Generic FunName-deriving instance Generic FunBody-deriving instance Generic FunCall-deriving instance Generic FunArg