packages feed

mulang 4.0.1 → 4.2.1

raw patch · 15 files changed

+188/−66 lines, 15 filesdep +ghcjs-base

Dependencies added: ghcjs-base

Files

app/Main.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE DeriveGeneric, QuasiQuotes, OverloadedStrings #-}+{-# LANGUAGE CPP, DeriveGeneric, QuasiQuotes, OverloadedStrings #-} -module Main (main) where+module Main where  import Language.Mulang.Analyzer (analyse) import Language.Mulang.Analyzer.Analysis.Json ()@@ -11,12 +11,27 @@ import           Data.List (intercalate) import           Version (prettyVersion) import           Data.Text.Lazy.Encoding (encodeUtf8)+import           Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as LBS (putStrLn) import qualified Data.Text.Lazy as T (pack) import           Data.Text (unpack) import           NeatInterpolation (text) +#ifdef ghcjs_HOST_OS+import           Data.JSString (JSString)+import qualified Data.JSString as JSS (pack, unpack) +import qualified Data.ByteString.Lazy.Char8 as C8 (unpack)++analyseIO :: JSString -> IO JSString+analyseIO = fmap  (JSS.pack . C8.unpack) . analyseJson . JSS.unpack+#endif++analyseJson :: String -> IO ByteString+analyseJson = fmap encode . analyse . decode . encodeUtf8 . T.pack+  where+    decode = orFail . eitherDecode+ main :: IO () main = do   argsBody <- fmap parseArgs $ getArgs@@ -25,15 +40,12 @@   result <- analyseJson body   LBS.putStrLn result -analyseJson = fmap encode . analyse . decode . encodeUtf8 . T.pack--parseArgs :: [String] -> String-parseArgs [jsonBody] = jsonBody-parseArgs _          = error (intercalate "\n" [prettyVersion, usage])--decode = orFail . eitherDecode+  where+    parseArgs :: [String] -> String+    parseArgs [jsonBody] = jsonBody+    parseArgs _          = error (intercalate "\n" [prettyVersion, usage]) -usage = unpack [text|+    usage = unpack [text|         Wrong usage.           #read from STDIN
app/Version.hs view
@@ -6,7 +6,7 @@ prettyVersion = "Mulang Release " ++ version ++ ", compiled on " ++ compilationTimestamp  version :: String-version = "4.0.1"+version = "4.2.1"  compilationTimestamp :: String compilationTimestamp = __DATE__ ++ " " ++ __TIME__
mulang.cabal view
@@ -1,5 +1,5 @@ name:                mulang-version:             4.0.1+version:             4.2.1 synopsis:            An intermediate language designed to perform advanced code analysis description:         Mulang is an intermediate language, a combinators library for static code analysis and a multilanguage comand line tool license:             GPL@@ -103,6 +103,10 @@     process                   ,     neat-interpolation        ,     mulang+  if impl(ghcjs)+    build-depends:+      ghcjs-base+   build-tools:     happy,     alex
src/Language/Mulang/Analyzer/Analysis.hs view
@@ -20,6 +20,7 @@ import GHC.Generics  import Language.Mulang.Ast+import Language.Mulang.Builder (NormalizationOptions)  --- -- Common structures@@ -77,7 +78,7 @@   | PrologStyle deriving (Show, Eq, Generic)  data Sample-  = MulangSample { ast :: Expression }+  = MulangSample { ast :: Expression, normalizationOptions :: Maybe NormalizationOptions }   | CodeSample { language :: Language, content :: Code } deriving (Show, Eq, Generic)  data Language
src/Language/Mulang/Analyzer/Analysis/Json.hs view
@@ -3,6 +3,7 @@ import Data.Aeson import Language.Mulang import Language.Mulang.Analyzer.Analysis+import Language.Mulang.Builder (NormalizationOptions, SequenceSortMode)  instance FromJSON Analysis instance FromJSON AnalysisSpec@@ -15,6 +16,9 @@  instance FromJSON SignatureAnalysisType instance FromJSON SignatureStyle++instance FromJSON NormalizationOptions+instance FromJSON SequenceSortMode  instance FromJSON Sample instance FromJSON Language
src/Language/Mulang/Analyzer/SampleParser.hs view
@@ -9,10 +9,11 @@ import        Language.Mulang.Parsers.Java (parseJava) import        Language.Mulang.Parsers.Python (parsePython) import        Language.Mulang.Analyzer.Analysis (Sample(..), Language(..))+import        Language.Mulang.Builder (normalize, normalizeWith, NormalizationOptions)  parseSample :: Sample -> Either String Expression parseSample (CodeSample language content) = (parserFor language) content-parseSample (MulangSample ast)            = Right ast+parseSample (MulangSample ast options)    = Right . (normalizerFor options) $ ast  parserFor :: Language -> EitherParser parserFor Haskell        = parseHaskell@@ -20,3 +21,7 @@ parserFor JavaScript     = maybeToEither parseJavaScript parserFor Prolog         = parseProlog parserFor Python         = parsePython++normalizerFor :: (Maybe NormalizationOptions) -> (Expression -> Expression)+normalizerFor Nothing        = normalize+normalizerFor (Just options) = normalizeWith options
src/Language/Mulang/Analyzer/SmellsAnalyzer.hs view
@@ -38,6 +38,7 @@   "HasRedundantReduction",   "HasTooManyMethods",   "HasTooShortIdentifiers",+  "HasUnreachableCode",   "HasWrongCaseIdentifiers",   "IsLongCode",   "OverridesEqualOrHashButNotBoth",@@ -67,6 +68,7 @@ detectionFor "HasTooManyMethods"               = simple hasTooManyMethods detectionFor "HasTooShortIdentifiers"          = withLanguage hasTooShortIdentifiers detectionFor "HasTooShortBindings"             = withLanguage hasTooShortIdentifiers+detectionFor "HasUnreachableCode"              = simple hasUnreachableCode detectionFor "HasWrongCaseIdentifiers"         = withLanguage hasWrongCaseIdentifiers detectionFor "HasWrongCaseBinding"             = withLanguage hasWrongCaseIdentifiers detectionFor "IsLongCode"                      = unsupported
src/Language/Mulang/Ast.hs view
@@ -48,12 +48,12 @@ type Code = String  -- | An equation. See @Function@ and @Procedure@ above-data Equation = Equation [Pattern] EquationBody deriving (Eq, Show, Read, Generic)+data Equation = Equation [Pattern] EquationBody deriving (Eq, Show, Read, Generic, Ord)  data EquationBody         = UnguardedBody Expression         | GuardedBody  [(Expression, Expression)]-        deriving (Eq, Show, Read, Generic)+        deriving (Eq, Show, Read, Generic, Ord)  type SubroutineBody = [Equation] @@ -72,7 +72,7 @@         -- Usefull for modelling classes and interfaces types         | OtherType (Maybe Code) (Maybe Type)         -- ^ unrecognized type, with optional code and nested type-        deriving (Eq, Show, Read, Generic)+        deriving (Eq, Show, Read, Generic, Ord)  -- | Expression is the root element of a Mulang program. -- | With the exception of Patterns, nearly everything is an Expression: variable declarations, literals,@@ -181,11 +181,13 @@     -- ^ Generic boolean literal     | MuString String     -- ^ Generic string literal+    | MuChar Char+    -- ^ Generic char literal     | MuSymbol String     -- ^ Generic symbol/atom literal     | MuTuple [Expression]     | MuList [Expression]-  deriving (Eq, Show, Read, Generic)+  deriving (Eq, Show, Read, Generic, Ord)  -- | Mulang Patterns are not expressions, but are aimed to match them. -- | They are modeled after Haskell, Prolog, Elixir, Scala and Erlang patterns@@ -212,12 +214,12 @@     | UnionPattern [Pattern]     | OtherPattern (Maybe Code) (Maybe Pattern)     -- ^ Other unrecognized pattern with optional code and nested pattern-  deriving (Eq, Show, Read, Generic)+  deriving (Eq, Show, Read, Generic, Ord)  data Statement   = Generator Pattern Expression   | Guard Expression-  deriving (Eq, Show, Read, Generic)+  deriving (Eq, Show, Read, Generic, Ord)  debug :: Show a => a -> Expression debug a = Other (Just (show a)) Nothing
src/Language/Mulang/Builder.hs view
@@ -1,7 +1,36 @@-module Language.Mulang.Builder (compact, compactMap, compactConcatMap, normalize) where+{-# LANGUAGE DeriveGeneric #-} +module Language.Mulang.Builder (+    compact,+    compactMap,+    compactConcatMap,+    normalize,+    normalizeWith,+    defaultNormalizationOptions,+    NormalizationOptions (..),+    SequenceSortMode (..)) where++import           GHC.Generics++import Data.List (sort, nub) import Language.Mulang.Ast+import Language.Mulang.Generator (declarators, declaredIdentifiers) +data NormalizationOptions = NormalizationOptions {+  convertObjectVariableIntoObject :: Bool,+  convertLambdaVariableIntoFunction :: Bool,+  convertObjectLevelFunctionIntoMethod :: Bool,+  convertObjectLevelLambdaVariableIntoMethod :: Bool,+  convertObjectLevelVariableIntoAttribute :: Bool,+  sortSequenceDeclarations :: SequenceSortMode+} deriving (Eq, Show, Read, Generic)++data SequenceSortMode+  = SortNothing+  | SortUniqueNonVariables+  | SortAllNonVarables+  | SortAll deriving (Eq, Show, Read, Generic)+ compactConcatMap :: (a -> [Expression]) -> [a] -> Expression compactConcatMap f = compact . concat . map f @@ -13,41 +42,80 @@ compact [e] = e compact es  = Sequence es +defaultNormalizationOptions :: NormalizationOptions+defaultNormalizationOptions = NormalizationOptions {+  convertObjectVariableIntoObject = True,+  convertLambdaVariableIntoFunction = True,+  convertObjectLevelFunctionIntoMethod = True,+  convertObjectLevelLambdaVariableIntoMethod = True,+  convertObjectLevelVariableIntoAttribute = True,+  sortSequenceDeclarations = SortAllNonVarables+}+ normalize :: Expression -> Expression-normalize (Variable n (MuObject e))        = Object n (normalizeInObject e)-normalize (Variable n (Lambda vars e))     = SimpleFunction n vars (normalize e)-normalize (Variable n e)                   = Variable n (normalize e)-normalize (Function n equations)           = Function n (map normalizeEquation equations)-normalize (Procedure n equations)          = Procedure n (map normalizeEquation equations)-normalize (Fact n args)                    = Fact n args-normalize (Rule n args es)                 = Rule n args (map normalize es)-normalize (Method n equations)             = Method n (map normalizeEquation equations)-normalize (Attribute n e)                  = Attribute n (normalize e)-normalize (Object n e)                     = Object n (normalizeInObject e)-normalize (Application (Send r m []) args) = Send (normalize r) (normalize m) (map normalize args)-normalize (Application e es)               = Application (normalize e) (map normalize es)-normalize (Send r e es)                    = Send (normalize r) (normalize e) (map normalize es)-normalize (Lambda ps e2)                   = Lambda ps (normalize e2)-normalize (If e1 e2 e3)                    = If (normalize e1) (normalize e2) (normalize e3)-normalize (While e1 e2)                    = While (normalize e1) (normalize e2)-normalize (Match e1 equations)             = Match (normalize e1) (map normalizeEquation equations)-normalize (For stms e1)                    = For stms (normalize e1)-normalize (ForLoop init cond prog stmt)    = ForLoop (normalize init) (normalize cond) (normalize prog) (normalize stmt)-normalize (Return e)                       = Return (normalize e)-normalize (Not e)                          = Not (normalize e)-normalize (Forall e1 e2)                   = Forall (normalize e1) (normalize e2)-normalize (Sequence es)                    = Sequence (map normalize es)-normalize (MuObject e)                     = MuObject (normalize e)-normalize (MuTuple es)                     = MuTuple (map normalize es)-normalize (MuList es)                      = MuList (map normalize es)-normalize e = e+normalize = normalizeWith defaultNormalizationOptions -normalizeInObject (Function n eqs)             = Method n (map normalizeEquation eqs)-normalizeInObject (Variable n (Lambda vars e)) = SimpleMethod n vars (normalize e)-normalizeInObject (Variable n e)               = Attribute n (normalize e)-normalizeInObject (Sequence es)                = Sequence (map normalizeInObject es)-normalizeInObject e                            = normalize e+normalizeWith :: NormalizationOptions -> Expression -> Expression+normalizeWith ops (Variable n (MuObject e))        | convertObjectVariableIntoObject ops = Object n (normalizeObjectLevelWith ops e)+normalizeWith ops (Variable n (Lambda vars e))     | convertLambdaVariableIntoFunction ops = SimpleFunction n vars (normalizeWith ops e)+normalizeWith ops (Variable n e)                   = Variable n (normalizeWith ops e)+normalizeWith ops (Function n equations)           = Function n (mapNormalizeEquationWith ops equations)+normalizeWith ops (Procedure n equations)          = Procedure n (mapNormalizeEquationWith ops equations)+normalizeWith _   (Fact n args)                    = Fact n args+normalizeWith ops (Rule n args es)                 = Rule n args (mapNormalizeWith ops es)+normalizeWith ops (Method n equations)             = Method n (mapNormalizeEquationWith ops equations)+normalizeWith ops (Attribute n e)                  = Attribute n (normalizeWith ops e)+normalizeWith ops (Object n e)                     = Object n (normalizeObjectLevelWith ops e)+normalizeWith ops (Application (Send r m []) args) = Send (normalizeWith ops r) (normalizeWith ops m) (mapNormalizeWith ops args)+normalizeWith ops (Application e es)               = Application (normalizeWith ops e) (mapNormalizeWith ops es)+normalizeWith ops (Send r e es)                    = Send (normalizeWith ops r) (normalizeWith ops e) (mapNormalizeWith ops es)+normalizeWith ops (Lambda ps e2)                   = Lambda ps (normalizeWith ops e2)+normalizeWith ops (If e1 e2 e3)                    = If (normalizeWith ops e1) (normalizeWith ops e2) (normalizeWith ops e3)+normalizeWith ops (While e1 e2)                    = While (normalizeWith ops e1) (normalizeWith ops e2)+normalizeWith ops (Match e1 equations)             = Match (normalizeWith ops e1) (mapNormalizeEquationWith ops equations)+normalizeWith ops (For stms e1)                    = For stms (normalizeWith ops e1)+normalizeWith ops (ForLoop init cond prog stmt)    = ForLoop (normalizeWith ops init) (normalizeWith ops cond) (normalizeWith ops prog) (normalizeWith ops stmt)+normalizeWith ops (Return e)                       = Return (normalizeWith ops e)+normalizeWith ops (Not e)                          = Not (normalizeWith ops e)+normalizeWith ops (Forall e1 e2)                   = Forall (normalizeWith ops e1) (normalizeWith ops e2)+normalizeWith ops (Sequence es)                    = Sequence . sortDeclarationsWith ops .  mapNormalizeWith ops $ es+normalizeWith ops (MuObject e)                     = MuObject (normalizeWith ops e)+normalizeWith ops (MuTuple es)                     = MuTuple (mapNormalizeWith ops es)+normalizeWith ops (MuList es)                      = MuList (mapNormalizeWith ops es)+normalizeWith _ e = e -normalizeEquation :: Equation -> Equation-normalizeEquation (Equation ps (UnguardedBody e))   = Equation ps (UnguardedBody (normalize e))-normalizeEquation (Equation ps (GuardedBody b))     = Equation ps (GuardedBody (map (\(c, e) -> (normalize c, normalize e)) b))+mapNormalizeWith ops = map (normalizeWith ops)+mapNormalizeEquationWith ops = map (normalizeEquationWith ops)++normalizeObjectLevelWith :: NormalizationOptions -> Expression -> Expression+normalizeObjectLevelWith ops (Function n eqs)             | convertObjectLevelFunctionIntoMethod ops       = Method n (mapNormalizeEquationWith ops eqs)+normalizeObjectLevelWith ops (Variable n (Lambda vars e)) | convertObjectLevelLambdaVariableIntoMethod ops = SimpleMethod n vars (normalizeWith ops e)+normalizeObjectLevelWith ops (Variable n e)               | convertObjectLevelVariableIntoAttribute ops    = Attribute n (normalizeWith ops e)+normalizeObjectLevelWith ops (Sequence es)                = Sequence (map (normalizeObjectLevelWith ops) es)+normalizeObjectLevelWith ops e                            = normalizeWith ops e++normalizeEquationWith :: NormalizationOptions -> Equation -> Equation+normalizeEquationWith ops (Equation ps (UnguardedBody e))   = Equation ps (UnguardedBody (normalizeWith ops e))+normalizeEquationWith ops (Equation ps (GuardedBody b))     = Equation ps (GuardedBody (map (\(c, e) -> (normalizeWith ops c, normalizeWith ops e)) b))++isSafeDeclaration :: Expression -> Bool+isSafeDeclaration (Attribute _ _) = False+isSafeDeclaration (Variable _ _)  = False+isSafeDeclaration e = isDeclaration e++isDeclaration :: Expression -> Bool+isDeclaration = not.null.declarators++sortDeclarationsWith :: NormalizationOptions -> [Expression] -> [Expression]+sortDeclarationsWith ops expressions | shouldSort (sortSequenceDeclarations ops) = sort expressions+                                     | otherwise                                 = expressions+  where+    shouldSort :: SequenceSortMode -> Bool+    shouldSort SortNothing             = False+    shouldSort SortUniqueNonVariables  = all isSafeDeclaration expressions && identifiersAreUnique expressions+    shouldSort SortAllNonVarables      = all isSafeDeclaration expressions+    shouldSort SortAll                 = all isDeclaration expressions++    identifiersAreUnique = unique . map declaredIdentifiers++    unique xs = nub xs == xs
src/Language/Mulang/Inspector/Generic/Duplication.hs view
@@ -12,10 +12,11 @@ isLightweight :: Inspection isLightweight (MuNumber _)              = True isLightweight (MuString _)              = True+isLightweight (MuChar _)                = True isLightweight (MuBool _)                = True isLightweight (Reference _)             = True isLightweight Self                      = True-isLightweight None                    = True+isLightweight None                      = True isLightweight MuNil                     = True isLightweight Equal                     = True isLightweight (Application _ es)        = not $ any isApplication es@@ -43,6 +44,7 @@ hash Self                          = 15 hash (SimpleProcedure _ _ body)    = 17 * (37 + hash body) hash (Sequence es)                 = 19 * (37 + positionalHash es)+hash (MuChar e)                    = 23 * H.hash e hash _                             = 1  positionalHash :: [Expression] -> Int
src/Language/Mulang/Inspector/Generic/Smell.hs view
@@ -15,7 +15,8 @@   doesConsolePrint,   hasLongParameterList,   hasTooManyMethods,-  overridesEqualOrHashButNotBoth) where+  overridesEqualOrHashButNotBoth,+  hasUnreachableCode) where  import Language.Mulang.Ast import Language.Mulang.Generator (identifierReferences)@@ -149,3 +150,21 @@ hasEmptyIfBranches = containsExpression f   where f (If _ None elseBranch) = elseBranch /= None         f _                        = False++hasUnreachableCode :: Inspection+hasUnreachableCode = containsExpression f+  where f subroutine@(Subroutine _ equations) = any equationMatchesAnyValue . init $ equations +        f _                                   = False+        +        equationMatchesAnyValue (Equation patterns body) = all patternMatchesAnyValue patterns && bodyMatchesAnyValue body       ++        patternMatchesAnyValue WildcardPattern     = True+        patternMatchesAnyValue (VariablePattern _) = True+        patternMatchesAnyValue _                   = False++        bodyMatchesAnyValue (UnguardedBody _)    = True+        bodyMatchesAnyValue (GuardedBody guards) = any (isTruthy . fst) guards++        isTruthy (MuBool True)           = True+        isTruthy (Reference "otherwise") = True+        isTruthy _                       = False
src/Language/Mulang/Parsers/Haskell.hs view
@@ -1,7 +1,7 @@ module Language.Mulang.Parsers.Haskell (hs, parseHaskell) where  import Language.Mulang.Ast-import Language.Mulang.Builder+import Language.Mulang.Builder (compact, normalizeWith, defaultNormalizationOptions, NormalizationOptions(..), SequenceSortMode(..)) import Language.Mulang.Parsers  import Language.Haskell.Syntax@@ -24,6 +24,7 @@  parseHaskell' :: String -> ParseResult Expression parseHaskell' = fmap (normalize . mu) . parseModule . (++"\n")+    where normalize = normalizeWith (defaultNormalizationOptions { sortSequenceDeclarations = SortAll })  mu :: HsModule -> Expression mu (HsModule _ _ _ _ decls) = compact (concatMap muDecls decls)@@ -76,7 +77,7 @@     muExp (HsApp (HsApp e1 e2) e3)                               = Application (muExp e1) [muExp e2, muExp e3]     muExp (HsApp e1 e2)                                          = Application (muExp e1) [muExp e2]     muExp (HsLeftSection e1 e2)                                  = Application (muVar $ muQOp e2) [muExp e1]-    muExp (HsRightSection e1 e2)                                 = Application (muVar $ muQOp e1) [muExp e2]+    muExp (HsRightSection e1 e2)                                 = Application (Reference "flip") [muVar $ muQOp e1, muExp e2]     muExp (HsNegApp e) = Application (Reference "-") [muExp e]     muExp (HsLambda _ args body) = Lambda (map muPat args) (muBody body)     --muExp HsLet = Let [Declaration] Expression          -- ^ local declarations with @let@@@ -94,9 +95,9 @@     muExp (HsExpTypeSig _ exp (HsQualType cs t))          = TypeCast (muExp exp) (muType t cs)     muExp e = debug e -    muLit (HsCharPrim    v) = MuString [v]+    muLit (HsCharPrim    v) = MuChar v     muLit (HsStringPrim  v) = MuString v-    muLit (HsChar        v) = MuString [v]+    muLit (HsChar        v) = MuChar v     muLit (HsString      v) = MuString v     muLit (HsIntPrim     v) = MuNumber . fromIntegral $ v     muLit (HsInt         v) = MuNumber . fromIntegral $ v
src/Language/Mulang/Parsers/Java.hs view
@@ -6,7 +6,7 @@ import Language.Mulang.Ast hiding (While, Return, Equal, Lambda, Try, Switch) import qualified Language.Mulang.Ast as M (Expression(While, Return, Equal, Lambda, Try, Switch)) import Language.Mulang.Parsers-import Language.Mulang.Builder (compact, compactMap, compactConcatMap)+import Language.Mulang.Builder (compact, compactMap, compactConcatMap, normalize)  import Language.Java.Parser import Language.Java.Syntax@@ -25,7 +25,7 @@ parseJava :: EitherParser parseJava = orLeft . parseJava' -parseJava' = fmap m . j+parseJava' = fmap (normalize . m) . j  m (CompilationUnit _ _ typeDecls) = compactMap muTypeDecl $ typeDecls @@ -129,7 +129,7 @@ muName (Name names) = Reference . ns $ names  muLit (String s)  = MuString s-muLit (Char c)    = MuString [c]+muLit (Char c)    = MuChar c muLit (Int i)     = MuNumber (fromIntegral i) muLit (Float d)   = MuNumber d muLit (Double d)  = MuNumber d
src/Language/Mulang/Parsers/JavaScript.hs view
@@ -1,7 +1,7 @@ module Language.Mulang.Parsers.JavaScript (js, parseJavaScript) where  import Language.Mulang.Ast-import Language.Mulang.Builder+import Language.Mulang.Builder (compactMap, normalizeWith, defaultNormalizationOptions, NormalizationOptions(..), SequenceSortMode(..)) import Language.Mulang.Parsers  import Language.JavaScript.Parser.Parser (parse)@@ -21,6 +21,7 @@  parseJavaScript' :: String -> Either String Expression parseJavaScript' = fmap (normalize . muJSAST) . (`parse` "src")+  where normalize = normalizeWith (defaultNormalizationOptions { sortSequenceDeclarations = SortUniqueNonVariables })  muJSAST:: JSAST -> Expression muJSAST (JSAstProgram statements _)     = compactMap muJSStatement statements
src/Language/Mulang/Parsers/Prolog.hs view
@@ -44,6 +44,7 @@     otherToPattern ("mod", [p1, p2])      = ApplicationPattern "mod" [p1, p2]     otherToPattern ("div", [p1, p2])      = ApplicationPattern "div" [p1, p2]     otherToPattern ("rem", [p1, p2])      = ApplicationPattern "rem" [p1, p2]+    otherToPattern ("round", [p1])        = ApplicationPattern "round" [p1]     otherToPattern (name, args)           = FunctorPattern name args  op :: String -> ParsecParser (Pattern -> Pattern -> Pattern)