diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/app/Version.hs b/app/Version.hs --- a/app/Version.hs +++ b/app/Version.hs @@ -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__ diff --git a/mulang.cabal b/mulang.cabal --- a/mulang.cabal +++ b/mulang.cabal @@ -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 diff --git a/src/Language/Mulang/Analyzer/Analysis.hs b/src/Language/Mulang/Analyzer/Analysis.hs --- a/src/Language/Mulang/Analyzer/Analysis.hs +++ b/src/Language/Mulang/Analyzer/Analysis.hs @@ -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 diff --git a/src/Language/Mulang/Analyzer/Analysis/Json.hs b/src/Language/Mulang/Analyzer/Analysis/Json.hs --- a/src/Language/Mulang/Analyzer/Analysis/Json.hs +++ b/src/Language/Mulang/Analyzer/Analysis/Json.hs @@ -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 diff --git a/src/Language/Mulang/Analyzer/SampleParser.hs b/src/Language/Mulang/Analyzer/SampleParser.hs --- a/src/Language/Mulang/Analyzer/SampleParser.hs +++ b/src/Language/Mulang/Analyzer/SampleParser.hs @@ -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 diff --git a/src/Language/Mulang/Analyzer/SmellsAnalyzer.hs b/src/Language/Mulang/Analyzer/SmellsAnalyzer.hs --- a/src/Language/Mulang/Analyzer/SmellsAnalyzer.hs +++ b/src/Language/Mulang/Analyzer/SmellsAnalyzer.hs @@ -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 diff --git a/src/Language/Mulang/Ast.hs b/src/Language/Mulang/Ast.hs --- a/src/Language/Mulang/Ast.hs +++ b/src/Language/Mulang/Ast.hs @@ -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 diff --git a/src/Language/Mulang/Builder.hs b/src/Language/Mulang/Builder.hs --- a/src/Language/Mulang/Builder.hs +++ b/src/Language/Mulang/Builder.hs @@ -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 diff --git a/src/Language/Mulang/Inspector/Generic/Duplication.hs b/src/Language/Mulang/Inspector/Generic/Duplication.hs --- a/src/Language/Mulang/Inspector/Generic/Duplication.hs +++ b/src/Language/Mulang/Inspector/Generic/Duplication.hs @@ -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 diff --git a/src/Language/Mulang/Inspector/Generic/Smell.hs b/src/Language/Mulang/Inspector/Generic/Smell.hs --- a/src/Language/Mulang/Inspector/Generic/Smell.hs +++ b/src/Language/Mulang/Inspector/Generic/Smell.hs @@ -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 diff --git a/src/Language/Mulang/Parsers/Haskell.hs b/src/Language/Mulang/Parsers/Haskell.hs --- a/src/Language/Mulang/Parsers/Haskell.hs +++ b/src/Language/Mulang/Parsers/Haskell.hs @@ -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 diff --git a/src/Language/Mulang/Parsers/Java.hs b/src/Language/Mulang/Parsers/Java.hs --- a/src/Language/Mulang/Parsers/Java.hs +++ b/src/Language/Mulang/Parsers/Java.hs @@ -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 diff --git a/src/Language/Mulang/Parsers/JavaScript.hs b/src/Language/Mulang/Parsers/JavaScript.hs --- a/src/Language/Mulang/Parsers/JavaScript.hs +++ b/src/Language/Mulang/Parsers/JavaScript.hs @@ -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 diff --git a/src/Language/Mulang/Parsers/Prolog.hs b/src/Language/Mulang/Parsers/Prolog.hs --- a/src/Language/Mulang/Parsers/Prolog.hs +++ b/src/Language/Mulang/Parsers/Prolog.hs @@ -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)