mulang 3.6.1 → 4.0.0
raw patch · 28 files changed
+780/−249 lines, 28 filesdep +language-pythondep ~inflections
Dependencies added: language-python
Dependency ranges changed: inflections
Files
- app/Version.hs +12/−0
- mulang.cabal +10/−2
- src/Data/List/Extra.hs +7/−2
- src/Language/Mulang/Analyzer/Analysis.hs +2/−1
- src/Language/Mulang/Analyzer/Analysis/Json.hs +4/−2
- src/Language/Mulang/Analyzer/ExpectationsCompiler.hs +17/−1
- src/Language/Mulang/Analyzer/SampleParser.hs +2/−0
- src/Language/Mulang/Analyzer/SmellsAnalyzer.hs +5/−4
- src/Language/Mulang/Ast.hs +83/−31
- src/Language/Mulang/Builder.hs +3/−2
- src/Language/Mulang/Generator.hs +38/−24
- src/Language/Mulang/Inspector.hs +7/−1
- src/Language/Mulang/Inspector/Combiner.hs +1/−1
- src/Language/Mulang/Inspector/Functional.hs +11/−5
- src/Language/Mulang/Inspector/Generic.hs +28/−61
- src/Language/Mulang/Inspector/Generic/Duplication.hs +2/−2
- src/Language/Mulang/Inspector/Generic/Smell.hs +17/−14
- src/Language/Mulang/Inspector/Logic.hs +6/−5
- src/Language/Mulang/Inspector/ObjectOriented.hs +10/−7
- src/Language/Mulang/Inspector/ObjectOriented/Polymorphism.hs +77/−0
- src/Language/Mulang/Inspector/Primitive.hs +36/−0
- src/Language/Mulang/Inspector/Procedural.hs +14/−3
- src/Language/Mulang/Inspector/Typed.hs +41/−0
- src/Language/Mulang/Parsers/Haskell.hs +34/−18
- src/Language/Mulang/Parsers/Java.hs +49/−32
- src/Language/Mulang/Parsers/JavaScript.hs +25/−24
- src/Language/Mulang/Parsers/Python.hs +227/−0
- src/Language/Mulang/Signature.hs +12/−7
+ app/Version.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++module Version (prettyVersion, version, compilationTimestamp) where++prettyVersion :: String+prettyVersion = "Mulang Release " ++ version ++ ", compiled on " ++ compilationTimestamp++version :: String+version = "4.0.0"++compilationTimestamp :: String+compilationTimestamp = __DATE__ ++ " " ++ __TIME__
mulang.cabal view
@@ -1,5 +1,5 @@ name: mulang-version: 3.6.1+version: 4.0.0 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@@ -40,8 +40,11 @@ Language.Mulang.Signature Language.Mulang.DomainLanguage Language.Mulang.Inspector+ Language.Mulang.Inspector.Primitive Language.Mulang.Inspector.Generic+ Language.Mulang.Inspector.Typed Language.Mulang.Inspector.ObjectOriented+ Language.Mulang.Inspector.ObjectOriented.Polymorphism Language.Mulang.Inspector.Functional Language.Mulang.Inspector.Logic Language.Mulang.Inspector.Procedural@@ -53,6 +56,7 @@ Language.Mulang.Parsers.Prolog Language.Mulang.Parsers.Java Language.Mulang.Parsers.JavaScript+ Language.Mulang.Parsers.Python Language.Mulang.Analyzer Language.Mulang.Analyzer.Analysis Language.Mulang.Analyzer.Analysis.Json@@ -74,8 +78,9 @@ haskell-src , language-java , language-javascript ,+ language-python , aeson ,- inflections ,+ inflections <= 0.2.0.1, parsec , ParsecTools , split ,@@ -101,6 +106,9 @@ build-tools: happy, alex++ other-modules:+ Version ghc-options: -Wall
src/Data/List/Extra.hs view
@@ -1,5 +1,10 @@-module Data.List.Extra (headOrElse) where+module Data.List.Extra (+ headOrElse,+ has) where -headOrElse:: a -> [a] -> a+headOrElse :: a -> [a] -> a headOrElse x [] = x headOrElse _ (x:_) = x++has :: (a -> Bool) -> (b -> [a]) -> (b -> Bool)+has f g = any f . g
src/Language/Mulang/Analyzer/Analysis.hs view
@@ -85,7 +85,8 @@ | Java | JavaScript | Prolog- | Haskell deriving (Show, Eq, Generic)+ | Haskell+ | Python deriving (Show, Eq, Generic) -- -- Analysis Output structures
src/Language/Mulang/Analyzer/Analysis/Json.hs view
@@ -23,7 +23,8 @@ instance FromJSON EquationBody instance FromJSON Expression instance FromJSON Pattern-instance FromJSON ComprehensionStatement+instance FromJSON Statement+instance FromJSON Type instance ToJSON AnalysisResult instance ToJSON ExpectationResult@@ -34,5 +35,6 @@ instance ToJSON EquationBody instance ToJSON Expression instance ToJSON Pattern-instance ToJSON ComprehensionStatement+instance ToJSON Statement+instance ToJSON Type
src/Language/Mulang/Analyzer/ExpectationsCompiler.hs view
@@ -86,26 +86,42 @@ f "Instantiates" = binded instantiates f "Raises" = binded raises f "Rescues" = binded rescues+ f "TypesParameterAs" = binded typesParameterAs+ f "TypesAs" = binded typesAs+ f "TypesReturnAs" = binded typesReturnAs f "Uses" = binded uses f "UsesAnonymousVariable" = simple usesAnonymousVariable f "UsesComposition" = simple usesComposition- f "UsesComprehension" = simple usesComprehension+ f "UsesComprehension" = f "UsesForComprehension" f "UsesConditional" = simple usesConditional+ f "UsesDyamicPolymorphism" = simple usesDyamicPolymorphism+ f "UsesDynamicMethodOverload" = simple usesDynamicMethodOverload f "UsesExceptionHandling" = simple usesExceptionHandling f "UsesExceptions" = simple usesExceptions f "UsesFindall" = simple usesFindall+ f "UsesFor" = simple usesFor f "UsesForall" = simple usesForall+ f "UsesForComprehension" = simple usesForComprehension+ f "UsesForeach" = simple usesForEach+ f "UsesForLoop" = simple usesForLoop f "UsesGuards" = simple usesGuards f "UsesIf" = simple usesIf f "UsesInheritance" = simple usesInheritance f "UsesLambda" = simple usesLambda f "UsesMixins" = simple usesMixins f "UsesNot" = simple usesNot+ f "UsesObjectComposition" = simple usesObjectComposition f "UsesPatternMatching" = simple usesPatternMatching f "UsesRepeat" = simple usesRepeat+ f "UsesStaticMethodOverload" = simple usesStaticMethodOverload+ f "UsesStaticPolymorphism" = simple usesStaticPolymorphism f "UsesSwitch" = simple usesSwitch+ f "UsesTemplateMethod" = simple usesTemplateMethod+ f "UsesType" = binded usesType f "UsesWhile" = simple usesWhile+ f "UsesYield" = simple usesYield f _ = const Nothing simple i _ = Just i binded i b = Just $ i b+
src/Language/Mulang/Analyzer/SampleParser.hs view
@@ -7,6 +7,7 @@ import Language.Mulang.Parsers.JavaScript (parseJavaScript) import Language.Mulang.Parsers.Prolog (parseProlog) import Language.Mulang.Parsers.Java (parseJava)+import Language.Mulang.Parsers.Python (parsePython) import Language.Mulang.Analyzer.Analysis (Sample(..), Language(..)) parseSample :: Sample -> Either String Expression@@ -18,3 +19,4 @@ parserFor Java = parseJava parserFor JavaScript = maybeToEither parseJavaScript parserFor Prolog = parseProlog+parserFor Python = parsePython
src/Language/Mulang/Analyzer/SmellsAnalyzer.hs view
@@ -22,10 +22,11 @@ allSmells = [ "DiscardsExceptions", "DoesConsolePrint",- "DoesNullTest",+ "DoesNilTest", "DoesTypeTest", "HasAssignmentReturn", "HasCodeDuplication",+ "HasEmptyIfBranches", "HasLongParameterList", "HasMisspelledIdentifiers", "HasRedundantBooleanComparison",@@ -40,7 +41,7 @@ "HasWrongCaseIdentifiers", "IsLongCode", "OverridesEqualOrHashButNotBoth",- "ReturnsNull",+ "ReturnsNil", "UsesCut", "UsesFail", "UsesUnificationOperator" ]@@ -48,7 +49,7 @@ detectionFor :: Smell -> Detection detectionFor "DiscardsExceptions" = simple discardsExceptions detectionFor "DoesConsolePrint" = simple doesConsolePrint-detectionFor "DoesNullTest" = simple doesNullTest+detectionFor "DoesNilTest" = simple doesNilTest detectionFor "DoesTypeTest" = simple doesTypeTest detectionFor "HasAssignmentReturn" = simple hasAssignmentReturn detectionFor "HasCodeDuplication" = unsupported@@ -70,7 +71,7 @@ detectionFor "HasWrongCaseBinding" = withLanguage hasWrongCaseIdentifiers detectionFor "IsLongCode" = unsupported detectionFor "OverridesEqualOrHashButNotBoth" = simple overridesEqualOrHashButNotBoth-detectionFor "ReturnsNull" = simple returnsNull+detectionFor "ReturnsNil" = simple returnsNil detectionFor "UsesCut" = simple usesCut detectionFor "UsesFail" = simple usesFail detectionFor "UsesUnificationOperator" = simple usesUnificationOperator
src/Language/Mulang/Ast.hs view
@@ -12,19 +12,28 @@ -- | * logic programing -- | module Language.Mulang.Ast (- equationParams,+ subroutineBodyPatterns,+ equationPatterns, Code, Equation(..), EquationBody(..),+ Type(..), Expression(..),- ComprehensionStatement(..),+ Statement(..), Pattern(..), Identifier,+ SubroutineBody,+ debug,+ debugType,+ debugPattern, pattern SimpleEquation, pattern SimpleFunction, pattern SimpleProcedure, pattern SimpleMethod, pattern SimpleSend,+ pattern SubroutineSignature,+ pattern VariableSignature,+ pattern ModuleSignature, pattern MuTrue, pattern MuFalse, pattern Subroutine,@@ -42,11 +51,29 @@ data Equation = Equation [Pattern] EquationBody deriving (Eq, Show, Read, Generic) data EquationBody- = UnguardedBody Expression- | GuardedBody [(Expression, Expression)]- deriving (Eq, Show, Read, Generic)+ = UnguardedBody Expression+ | GuardedBody [(Expression, Expression)]+ deriving (Eq, Show, Read, Generic) +type SubroutineBody = [Equation] +-- A Generic Type, that can be used for typing expressions,+-- classes, functions, variables and so on, using a @TypeSignature@+-- or a @TypeCast@+data Type+ = SimpleType Identifier [Identifier]+ -- ^ simple types, with a type identifier and type constraints+ -- Useful for modelling variable types+ | ParameterizedType [Identifier] Identifier [Identifier]+ -- ^ parameterized types, with type inputs, type identifier and type constraints+ -- Useful for modelling functions, methods and procedures types+ | ConstrainedType [Identifier]+ -- ^ constrained type, with just type constraints.+ -- Usefull for modelling classes and interfaces types+ | OtherType (Maybe String) (Maybe Type)+ -- ^ unrecognized type, with optional code and nested type+ deriving (Eq, Show, Read, Generic)+ -- | Expression is the root element of a Mulang program. -- | With the exception of Patterns, nearly everything is an Expression: variable declarations, literals, -- | control structures, even object oriented classes declarations.@@ -54,25 +81,29 @@ -- | However, although all those elements can be used as subexpressions and have an dohave an associated value, -- | Mulang does not state WHICH is that value. data Expression- = TypeAlias Identifier+ = TypeAlias Identifier Identifier -- ^ Functional programming type alias. -- Only the type alias identifier is parsed | Record Identifier -- ^ Imperative / Functional programming struct declaration. -- Only the record name is parsed- | TypeSignature Identifier [Identifier] Identifier+ | TypeSignature Identifier Type -- ^ Generic type signature for a computation,- -- composed by a name, parameter types and return type+ -- composed by a name and its type+ | TypeCast Expression Type+ -- ^ Generic type annotation for an expression. For example,+ -- a Java cast: (String) anObject => TypeAnnotation (Variable "anObject") "String"+ -- a Haskell inline type declaration: ... = x :: Int => TypeAnnotation (Variable "x") "Int" | EntryPoint Identifier Expression -- ^ Entry point with its body- | Function Identifier [Equation]+ | Function Identifier SubroutineBody -- ^ Functional / Imperative programming function declaration. -- It is is composed by an identifier and one or more equations- | Procedure Identifier [Equation]+ | Procedure Identifier SubroutineBody -- ^ Imperative programming procedure declaration. It is composed by a name and one or more equations- | Method Identifier [Equation]- | EqualMethod [Equation]- | HashMethod [Equation]+ | Method Identifier SubroutineBody+ | EqualMethod SubroutineBody+ | HashMethod SubroutineBody | Variable Identifier Expression | Assignment Identifier Expression | Attribute Identifier Expression@@ -106,15 +137,16 @@ -- ^ Generic, non-curried application of a function or procedure, composed by the applied element itself, and the application arguments | Send Expression Expression [Expression] -- ^ Object oriented programming message send, composed by the reciever, selector and arguments- | New Identifier [Expression]+ | New Expression [Expression] -- ^ Object oriented instantiation, composed by the class reference and instantiation arguments- | Implement Identifier+ | Implement Expression -- ^ Object oriented instantiation, interface implementation- | Include Identifier+ | Include Expression -- ^ Object oriented instantiation, mixin inclusion | Lambda [Pattern] Expression | If Expression Expression Expression | Return Expression+ | Yield Expression | While Expression Expression -- ^ Imperative programming conditional repetition control structure, composed by a condition and a body | Repeat Expression Expression@@ -127,14 +159,17 @@ -- ^ Generic raise expression, like a throw or raise statament, composed by the raised expression | Print Expression -- ^ Generic print expression- | Comprehension Expression [ComprehensionStatement]+ | For [Statement] Expression+ | ForLoop Expression Expression Expression Expression+ -- ^ Imperative / OOP programming c-style for loop | Sequence [Expression] -- ^ Generic sequence of statements- | Other+ | Other (Maybe String) (Maybe Expression)+ -- ^ Unrecognized expression, with optional description and body | Equal | NotEqual | Self- | MuNull+ | None -- ^ Generic value indicating an absent expression, such as when there is no finally in a try or default in a switch or js' undefined | MuNil -- ^ Generic nothing value literal - nil, null or unit@@ -175,17 +210,28 @@ | WildcardPattern -- ^ wildcard pattern @_@ | UnionPattern [Pattern]- | OtherPattern- -- ^ Other unrecognized pattern+ | OtherPattern (Maybe String) (Maybe Pattern)+ -- ^ Other unrecognized pattern with optional code and nested pattern deriving (Eq, Show, Read, Generic) -data ComprehensionStatement- = MuGenerator Pattern Expression- | MuQualifier Expression- | LetStmt Expression+data Statement+ = Generator Pattern Expression+ | Guard Expression deriving (Eq, Show, Read, Generic) +debug :: Show a => a -> Expression+debug a = Other (Just (show a)) Nothing +debugType :: Show a => a -> Type+debugType a = OtherType (Just (show a)) Nothing++debugPattern :: Show a => a -> Pattern+debugPattern a = OtherPattern (Just (show a)) Nothing++pattern VariableSignature name t cs = TypeSignature name (SimpleType t cs)+pattern SubroutineSignature name args t cs = TypeSignature name (ParameterizedType args t cs)+pattern ModuleSignature name cs = TypeSignature name (ConstrainedType cs)+ pattern SimpleEquation params body = Equation params (UnguardedBody body) pattern SimpleSend receptor selector args = Send receptor (Reference selector) args@@ -197,7 +243,7 @@ pattern MuTrue = MuBool True pattern MuFalse = MuBool False -pattern Subroutine name equations <- (extractSubroutine -> Just (name, equations))+pattern Subroutine name body <- (extractSubroutine -> Just (name, body)) pattern Clause name patterns expressions <- (extractClause -> Just (name, patterns, expressions)) pattern Call operation arguments <- (extractCall -> Just (operation, arguments))@@ -207,11 +253,17 @@ equationParams :: Equation -> [Pattern] equationParams (Equation p _) = p -extractSubroutine :: Expression -> Maybe (Identifier, [Equation])-extractSubroutine (Function name equations) = Just (name, equations)-extractSubroutine (Procedure name equations) = Just (name, equations)-extractSubroutine (Method name equations) = Just (name, equations)-extractSubroutine _ = Nothing+subroutineBodyPatterns :: SubroutineBody -> [Pattern]+subroutineBodyPatterns = concatMap equationPatterns++equationPatterns :: Equation -> [Pattern]+equationPatterns (Equation p _) = p++extractSubroutine :: Expression -> Maybe (Identifier, SubroutineBody)+extractSubroutine (Function name body) = Just (name, body)+extractSubroutine (Procedure name body) = Just (name, body)+extractSubroutine (Method name body) = Just (name, body)+extractSubroutine _ = Nothing extractParams :: Expression -> Maybe ([Pattern]) extractParams (Subroutine _ equations) = Just (equationParams.head $ equations)
src/Language/Mulang/Builder.hs view
@@ -9,7 +9,7 @@ compactMap f = compact . map f compact :: [Expression] -> Expression-compact [] = MuNull+compact [] = None compact [e] = e compact es = Sequence es @@ -31,7 +31,8 @@ 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 (Comprehension e1 stms) = Comprehension (normalize e1) stms+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)
src/Language/Mulang/Generator.hs view
@@ -1,5 +1,6 @@ module Language.Mulang.Generator ( boundDeclarations,+ declarators, declarations, declarationsOf, declaredIdentifiers,@@ -10,6 +11,7 @@ identifierReferences, transitiveReferencedIdentifiers, Generator,+ Declarator, Expression(..)) where import Language.Mulang.Ast@@ -19,32 +21,36 @@ import Data.List (nub) type Generator a = Expression -> [a]+type Declarator = (Identifier, Expression) -- | Returns all the declarations their identifiers - -- | classes, methods, functions, records, local and global variables, and so on -- | -- | For example, in 'f x = g x where x = y', it returns '(f, f x = ...)' and '(x, x = y)'-declarations :: Generator (Identifier, Expression)-declarations (Sequence es) = concatMap declarations es-declarations e@(Attribute n _) = [(n, e)]-declarations e@(Class n _ b) = (n, e) : declarations b-declarations e@(Clause n _ es) = (n, e) : concatMap declarations es-declarations e@(Enumeration n _) = [(n, e)]-declarations e@(Interface n _ b) = (n, e) : declarations b-declarations e@(EntryPoint n b) = (n, e) : declarations b-declarations e@(Subroutine n b) = (n, e) : concatMap declarations (equationExpressions b)-declarations e@(Object n b) = (n, e) : declarations b-declarations e@(Clause n _ _) = [(n, e)]-declarations e@(Record n) = [(n, e)]-declarations e@(TypeAlias n) = [(n, e)]-declarations e@(TypeSignature n _ _)= [(n, e)]-declarations e@(Variable n _) = [(n, e)]-declarations _ = []+declarators :: Generator Declarator+declarators (Sequence es) = concatMap declarators es+declarators e@(Attribute n _) = [(n, e)]+declarators e@(Class n _ b) = (n, e) : declarators b+declarators e@(Clause n _ es) = (n, e) : concatMap declarators es+declarators e@(Enumeration n _) = [(n, e)]+declarators e@(Interface n _ b) = (n, e) : declarators b+declarators e@(EntryPoint n b) = (n, e) : declarators b+declarators e@(Subroutine n b) = (n, e) : concatMap declarators (equationExpressions b)+declarators e@(Object n b) = (n, e) : declarators b+declarators e@(Clause n _ _) = [(n, e)]+declarators e@(Record n) = [(n, e)]+declarators e@(TypeAlias n _) = [(n, e)]+declarators e@(TypeSignature n _) = [(n, e)]+declarators e@(Variable n _) = [(n, e)]+declarators _ = [] +declarations :: Generator Expression+declarations = map snd . declarators+ -- | Returns all declarations bound to the given identifier predicate -- | boundDeclarations :: IdentifierPredicate -> Generator Expression-boundDeclarations f = map snd . filter (f.fst) . declarations+boundDeclarations f = map snd . filter (f.fst) . declarators -- | Returns the given expression and all its subexpressions -- For example: in 'f x = x + 1', it returns 'f x = x + 1', 'x + 1', 'x' and '1'@@ -57,27 +63,33 @@ subExpressions (Call op args) = op:args subExpressions (Class _ _ v) = [v] subExpressions (Clause _ _ es) = es- subExpressions (Comprehension a _) = [a] --TODO subExpressions (EntryPoint _ e) = [e]+ subExpressions (For stmts a) = statementExpressions stmts ++ [a] subExpressions (Forall e1 e2) = [e1, e2]+ subExpressions (ForLoop i c p s) = [i, c, p, s] subExpressions (If a b c) = [a, b, c]+ subExpressions (Implement e) = [e]+ subExpressions (Include e) = [e] subExpressions (Interface _ _ v) = [v] subExpressions (Lambda _ a) = [a] subExpressions (Match e1 equations) = e1:equationExpressions equations subExpressions (MuList as) = as subExpressions (MuObject es) = [es] subExpressions (MuTuple as) = as- subExpressions (New _ es) = es+ subExpressions (New e es) = e:es subExpressions (Not e) = [e] subExpressions (Object _ v) = [v]+ subExpressions (Other _ (Just e)) = [e] subExpressions (Repeat e1 e2) = [e1, e2] subExpressions (Return v) = [v] subExpressions (Sequence es) = es subExpressions (Subroutine _ es) = equationExpressions es subExpressions (Switch e1 list _) = e1 : concatMap (\(x,y) -> [x,y]) list subExpressions (Try t cs f) = t : map snd cs ++ [f]+ subExpressions (TypeCast e _) = [e] subExpressions (Variable _ v) = [v] subExpressions (While e1 e2) = [e1, e2]+ subExpressions (Yield v) = [v] subExpressions _ = [] @@ -106,7 +118,7 @@ -- | Returns all the declared identifiers -- For example, in 'f x = g x where x = y', it returns 'f' and 'x' declaredIdentifiers :: Generator Identifier-declaredIdentifiers = map fst . declarations+declaredIdentifiers = map fst . declarators mainDeclaredIdentifiers :: Generator Identifier mainDeclaredIdentifiers (Sequence _) = []@@ -114,7 +126,7 @@ -- | Returns all the body equations of functions, procedures and methods equationBodies :: Generator EquationBody-equationBodies = concatMap (bodiesOf . snd) . declarations+equationBodies = concatMap bodiesOf . declarations where bodiesOf :: Generator EquationBody bodiesOf (Subroutine _ equations) = equationBodies equations@@ -128,12 +140,14 @@ extractReference :: Expression -> Maybe Identifier extractReference (Reference n) = Just n extractReference (Exist n _) = Just n-extractReference (New n _) = Just n-extractReference (Implement n) = Just n-extractReference (Include n) = Just n extractReference _ = Nothing equationExpressions = concatMap (\(Equation _ body) -> bodyExpressions body) where bodyExpressions (UnguardedBody e) = [e] bodyExpressions (GuardedBody b) = b >>= \(es1, es2) -> [es1, es2]++statementExpressions = map expression+ where+ expression (Generator _ e) = e+ expression (Guard e) = e
src/Language/Mulang/Inspector.hs view
@@ -1,15 +1,21 @@ module Language.Mulang.Inspector (+ Inspection,+ IdentifierInspection, module Language.Mulang.Inspector.Generic, module Language.Mulang.Inspector.Combiner,+ module Language.Mulang.Inspector.Typed, module Language.Mulang.Inspector.ObjectOriented,+ module Language.Mulang.Inspector.ObjectOriented.Polymorphism, module Language.Mulang.Inspector.Functional, module Language.Mulang.Inspector.Logic, module Language.Mulang.Inspector.Procedural) where -+import Language.Mulang.Inspector.Primitive (Inspection, IdentifierInspection) import Language.Mulang.Inspector.Generic+import Language.Mulang.Inspector.Typed import Language.Mulang.Inspector.Combiner import Language.Mulang.Inspector.ObjectOriented+import Language.Mulang.Inspector.ObjectOriented.Polymorphism import Language.Mulang.Inspector.Functional import Language.Mulang.Inspector.Logic import Language.Mulang.Inspector.Procedural
src/Language/Mulang/Inspector/Combiner.hs view
@@ -9,7 +9,7 @@ import Language.Mulang.Ast import Language.Mulang.Generator (transitiveReferencedIdentifiers, declarationsOf, declaredIdentifiers)-import Language.Mulang.Inspector.Generic+import Language.Mulang.Inspector.Primitive detect :: Inspection -> Expression -> [Identifier] detect i expression =
src/Language/Mulang/Inspector/Functional.hs view
@@ -3,12 +3,14 @@ usesComposition, usesLambda, usesPatternMatching,+ usesForComprehension, usesComprehension, usesConditional) where import Language.Mulang.Ast-import Language.Mulang.Inspector.Generic-import Language.Mulang.Inspector.Combiner+import Language.Mulang.Inspector.Primitive (Inspection, containsExpression, containsBody)+import Language.Mulang.Inspector.Generic (usesIf, usesYield)+import Language.Mulang.Inspector.Combiner (alternative) usesConditional :: Inspection usesConditional = alternative usesIf usesGuards@@ -38,10 +40,14 @@ -- | Inspection that tells whether an expression uses -- comprehensions - list comprehension, for comprehension, do-syntax, etc - -- in its definitions+usesForComprehension :: Inspection+usesForComprehension = containsExpression f+ where f (For _ e) = usesYield e+ f _ = False++-- alias for usesForComprehension inspection usesComprehension :: Inspection-usesComprehension = containsExpression f- where f (Comprehension _ _) = True- f _ = False+usesComprehension = usesForComprehension -- | Inspection that tells whether an expression uses a lambda expression -- in its definition
src/Language/Mulang/Inspector/Generic.hs view
@@ -4,6 +4,8 @@ calls, uses, usesIf,+ usesYield,+ usesFor, declares, declaresVariable, declaresRecursively,@@ -12,29 +14,20 @@ declaresComputation, declaresComputationWithArity, declaresComputationWithArity',- declaresTypeAlias,- declaresTypeSignature, usesAnonymousVariable, raises, rescues, usesExceptions,- usesExceptionHandling,- containsExpression,- containsDeclaration,- containsBoundDeclaration,- containsBody,- matchesType,- Inspection,- IdentifierInspection) where+ usesExceptionHandling) where import Language.Mulang.Ast import Language.Mulang.Identifier-import Language.Mulang.Generator (expressions, boundDeclarations, equationBodies, declarations, referencedIdentifiers)+import Language.Mulang.Inspector.Primitive+import Language.Mulang.Generator (declaredIdentifiers, referencedIdentifiers) import Data.Maybe (listToMaybe)+import Data.List.Extra (has) -type Inspection = Expression -> Bool-type IdentifierInspection = IdentifierPredicate -> Inspection -- | Inspection that tells whether an expression is equal to a given piece of code after being parsed parses :: (String -> Expression) -> String -> Inspection@@ -66,11 +59,22 @@ where f (If _ _ _) = True f _ = False +usesYield :: Inspection+usesYield = containsExpression f+ where f (Yield _) = True+ f _ = False++usesFor :: Inspection+usesFor = containsExpression f+ where f (For _ _) = True+ f _ = False++ -- | Inspection that tells whether a top level declaration exists declares :: IdentifierInspection declares = containsBoundDeclaration f- where f (TypeSignature _ _ _) = False- f _ = True+ where f (TypeSignature _ _) = False+ f _ = True -- | Inspection that tells whether an expression is direct recursive declaresRecursively :: IdentifierInspection@@ -79,7 +83,7 @@ | otherwise = False nameOf :: Expression -> Maybe Identifier- nameOf = fmap fst . listToMaybe . declarations+ nameOf = listToMaybe . declaredIdentifiers declaresFunction :: IdentifierInspection@@ -114,21 +118,11 @@ argsHaveArity = arityPredicate.length -declaresTypeAlias :: IdentifierInspection-declaresTypeAlias = containsBoundDeclaration f- where f (TypeAlias _) = True- f _ = False--declaresTypeSignature :: IdentifierInspection-declaresTypeSignature = containsBoundDeclaration f- where f (TypeSignature _ _ _) = True- f _ = False- raises :: IdentifierInspection raises predicate = containsExpression f- where f (Raise (New n _)) = predicate n- f (Raise (Reference n)) = predicate n- f _ = False+ where f (Raise (New (Reference n) _)) = predicate n+ f (Raise (Reference n)) = predicate n+ f _ = False usesExceptions :: Inspection usesExceptions = containsExpression f@@ -147,13 +141,12 @@ usesAnonymousVariable :: Inspection usesAnonymousVariable = containsExpression f- where f (Subroutine _ equations) = equationContainsWildcard equations---TODO f (Lambda args _) = equationContainsWildcard equations- f (Clause _ params _) = paramsContainsWildcard params- f _ = False+ where f (Subroutine _ body) = equationContainsWildcard body+--TODO f (Lambda args _) = equationContainsWildcard equations+ f (Clause _ params _) = any isOrContainsWildcard params+ f _ = False - equationContainsWildcard = any (paramsContainsWildcard . equationParams)- paramsContainsWildcard = any isOrContainsWildcard+ equationContainsWildcard = has isOrContainsWildcard subroutineBodyPatterns isOrContainsWildcard (InfixApplicationPattern p1 _ p2) = any isOrContainsWildcard [p1, p2] isOrContainsWildcard (ApplicationPattern _ ps) = any isOrContainsWildcard ps@@ -163,29 +156,3 @@ isOrContainsWildcard (AsPattern _ p) = isOrContainsWildcard p isOrContainsWildcard WildcardPattern = True isOrContainsWildcard _ = False---containsExpression :: (Expression -> Bool) -> Inspection-containsExpression f = has f expressions--containsBody :: (EquationBody -> Bool)-> Inspection-containsBody f = has f equationBodies--containsBoundDeclaration :: (Expression -> Bool) -> IdentifierInspection-containsBoundDeclaration f b = has f (boundDeclarations b)--containsDeclaration :: (Expression -> Bool) -> Inspection-containsDeclaration f = has f (map snd . declarations)--matchesType :: IdentifierPredicate -> Pattern -> Bool-matchesType predicate (TypePattern n) = predicate n-matchesType predicate (AsPattern _ (TypePattern n)) = predicate n-matchesType predicate (UnionPattern patterns) = any (matchesType predicate) patterns-matchesType _ _ = False---- private--has f g = any f . g---
src/Language/Mulang/Inspector/Generic/Duplication.hs view
@@ -1,7 +1,7 @@ module Language.Mulang.Inspector.Generic.Duplication (hasCodeDuplication) where import Language.Mulang.Ast-import Language.Mulang.Inspector+import Language.Mulang.Inspector.Primitive import Language.Mulang.Generator (expressions) import qualified Data.Hashable as H (hash) import Data.List (nub, subsequences)@@ -15,7 +15,7 @@ isLightweight (MuBool _) = True isLightweight (Reference _) = True isLightweight Self = True-isLightweight MuNull = True+isLightweight None = True isLightweight MuNil = True isLightweight Equal = True isLightweight (Application _ es) = not $ any isApplication es
src/Language/Mulang/Inspector/Generic/Smell.hs view
@@ -7,10 +7,10 @@ hasRedundantLocalVariableReturn, hasAssignmentReturn, hasEmptyIfBranches,- doesNullTest,+ doesNilTest, doesTypeTest, isLongCode,- returnsNull,+ returnsNil, discardsExceptions, doesConsolePrint, hasLongParameterList,@@ -18,15 +18,15 @@ overridesEqualOrHashButNotBoth) where import Language.Mulang.Ast-import Language.Mulang.Inspector-import Language.Mulang.Generator(identifierReferences)+import Language.Mulang.Generator (identifierReferences)+import Language.Mulang.Inspector.Primitive -- | Inspection that tells whether an identifier has expressions like 'x == True' hasRedundantBooleanComparison :: Inspection hasRedundantBooleanComparison = compares isBooleanLiteral -doesNullTest :: Inspection-doesNullTest = compares f+doesNilTest :: Inspection+doesNilTest = compares f where f MuNil = True f _ = False @@ -47,8 +47,8 @@ comparisonOperands (Call NotEqual [a1, a2]) = [a1, a2] comparisonOperands _ = [] -returnsNull :: Inspection-returnsNull = containsExpression f+returnsNil :: Inspection+returnsNil = containsExpression f where f (Return MuNil) = True f _ = False @@ -59,6 +59,7 @@ where f (If _ (Assignment v1 x) (Assignment v2 y)) = all isBooleanLiteral [x, y] && v1 == v2 f (If _ (Variable v1 x) (Variable v2 y)) = all isBooleanLiteral [x, y] && v1 == v2 f (If _ (Return x) (Return y)) = all isBooleanLiteral [x, y]+ f (If _ (Yield x) (Yield y)) = all isBooleanLiteral [x, y] f (If _ x y) = all isBooleanLiteral [x, y] f _ = False @@ -83,11 +84,13 @@ -- can be avoided using point-free hasRedundantParameter :: Inspection hasRedundantParameter = containsExpression f- where f function@(SimpleFunction _ params (Return (Application _ args))) | (VariablePattern param) <- last params,- (Reference arg) <- last args = param == arg && showsUpOnlyOnce param (identifierReferences function)+ where f function@(SimpleFunction _ params (Return (Application _ args))) | Just (VariablePattern param) <- safeLast params,+ Just (Reference arg) <- safeLast args = param == arg && showsUpOnlyOnce param (identifierReferences function) f _ = False showsUpOnlyOnce p = (==1).countElem p countElem p = length.filter (==p)+ safeLast [] = Nothing+ safeLast l = Just $ last l isBooleanLiteral (MuBool _) = True isBooleanLiteral _ = False@@ -106,7 +109,7 @@ discardsExceptions :: Inspection discardsExceptions = containsExpression f- where f (Try _ [(_, MuNull)] _) = True+ where f (Try _ [(_, None)] _) = True f (Try _ [(_, Print _)] _) = True f _ = False @@ -125,7 +128,7 @@ hasTooManyMethods = containsExpression f where f (Sequence expressions) = (>15).length.filter isMethod $ expressions f _ = False- + isMethod (Method _ _) = True isMethod _ = False @@ -138,11 +141,11 @@ isEqual (EqualMethod _) = True isEqual _ = False- + isHash (HashMethod _) = True isHash _ = False hasEmptyIfBranches :: Inspection hasEmptyIfBranches = containsExpression f- where f (If _ MuNull elseBranch) = elseBranch /= MuNull+ where f (If _ None elseBranch) = elseBranch /= None f _ = False
src/Language/Mulang/Inspector/Logic.hs view
@@ -12,15 +12,16 @@ import Language.Mulang.Ast import Language.Mulang.Identifier-import Language.Mulang.Inspector.Generic-import Language.Mulang.Inspector.Combiner+import Language.Mulang.Inspector.Primitive (Inspection, IdentifierInspection, containsExpression, containsBoundDeclaration)+import Language.Mulang.Inspector.Generic (uses)+import Language.Mulang.Inspector.Combiner (alternative) -declaresFact :: IdentifierPredicate -> Inspection+declaresFact :: IdentifierInspection declaresFact = containsBoundDeclaration f where f (Fact _ _) = True f _ = False -declaresRule :: IdentifierPredicate -> Inspection+declaresRule :: IdentifierInspection declaresRule = containsBoundDeclaration f where f (Rule _ _ _) = True f _ = False@@ -55,5 +56,5 @@ f (Exist "is" [(VariablePattern _), _]) = True f _ = False -declaresPredicate :: IdentifierPredicate -> Inspection+declaresPredicate :: IdentifierInspection declaresPredicate pred = alternative (declaresFact pred) (declaresRule pred)
src/Language/Mulang/Inspector/ObjectOriented.hs view
@@ -15,17 +15,19 @@ import Language.Mulang.Ast import Language.Mulang.Identifier-import Language.Mulang.Inspector.Generic+import Language.Mulang.Inspector.Primitive (+ Inspection, IdentifierInspection,+ containsExpression, containsDeclaration, containsBoundDeclaration) implements :: IdentifierInspection implements predicate = containsExpression f- where f (Implement name) = predicate name- f _ = False+ where f (Implement (Reference name)) = predicate name+ f _ = False includes :: IdentifierInspection includes predicate = containsExpression f- where f (Include name) = predicate name- f _ = False+ where f (Include (Reference name)) = predicate name+ f _ = False inherits :: IdentifierInspection inherits predicate = containsDeclaration f@@ -34,8 +36,8 @@ instantiates :: IdentifierInspection instantiates predicate = containsExpression f- where f (New name _) = predicate name- f _ = False+ where f (New (Reference name) _) = predicate name+ f _ = False usesInheritance :: Inspection usesInheritance = declaresSuperclass anyone@@ -75,3 +77,4 @@ declaresMethod = containsBoundDeclaration f where f (Method _ _) = True f _ = False+
+ src/Language/Mulang/Inspector/ObjectOriented/Polymorphism.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE ViewPatterns #-}++module Language.Mulang.Inspector.ObjectOriented.Polymorphism (+ usesDyamicPolymorphism,+ usesStaticPolymorphism,+ usesTemplateMethod,+ usesObjectComposition,+ usesDynamicMethodOverload,+ usesStaticMethodOverload) where++import Language.Mulang.Ast+import Language.Mulang.Identifier+import Language.Mulang.Inspector.Primitive (Inspection)+import Language.Mulang.Inspector.ObjectOriented (implements, declaresMethod)+import Language.Mulang.Inspector.Typed (usesType)++import Control.Monad (MonadPlus, guard)+import Language.Mulang.Generator (Generator, declarations, expressions)++usesDynamicMethodOverload :: Inspection+usesDynamicMethodOverload expression = inspect $ do+ klass@(Class _ _ _) <- declarations expression+ (SimpleMethod n1 (length -> a1) _) <- declarations klass+ (SimpleMethod n2 (length -> a2) _) <- declarations klass+ guard (n1 == n2 && a1 /= a2)++usesStaticMethodOverload :: Inspection+usesStaticMethodOverload expression = inspect $ do+ klass@(Class _ _ _) <- declarations expression+ s1@(SubroutineSignature n1 _ _ _) <- declarations klass+ s2@(SubroutineSignature n2 _ _ _) <- declarations klass+ guard (n1 == n2 && s1 /= s2)++usesObjectComposition :: Inspection+usesObjectComposition expression = inspect $ do+ klass@(Class _ _ _) <- declarations expression+ (Attribute name1 _) <- declarations klass+ (Send (Reference name2) _ _) <- expressions klass+ guard (name1 == name2)++usesTemplateMethod :: Inspection+usesTemplateMethod expression = inspect $ do+ klass@(Class _ _ _) <- declarations expression+ (SimpleSend Self selector _) <- expressions klass+ guard (not . declaresMethod (named selector) $ klass)++usesDyamicPolymorphism :: Inspection+usesDyamicPolymorphism expression = inspect $ do+ (SimpleSend _ selector _) <- expressions expression+ guardCount (>1) (methodDeclarationsOf selector expression)++usesStaticPolymorphism :: Inspection+usesStaticPolymorphism expression = inspect $ do+ interface@(Interface interfaceId _ _) <- declarations expression+ (SubroutineSignature _ _ _ _) <- declarations interface+ guard (usesType (named interfaceId) expression)+ guardCount (>1) (implementorsOf interfaceId expression)++-- private++inspect :: [a] -> Bool+inspect = not.null++guardCount :: MonadPlus m => (Int -> Bool) -> [a] -> m ()+guardCount condition list = guard (condition . length $ list)++methodDeclarationsOf :: Identifier -> Generator Expression+methodDeclarationsOf selector e = do+ m@(Method s _) <- declarations e+ guard (s == selector)+ return m++implementorsOf :: Identifier -> Generator Expression+implementorsOf id e = do+ m@(Class _ _ _) <- declarations e+ guard (implements (named id) m)+ return m
+ src/Language/Mulang/Inspector/Primitive.hs view
@@ -0,0 +1,36 @@+module Language.Mulang.Inspector.Primitive (+ containsExpression,+ containsDeclaration,+ containsBoundDeclaration,+ containsBody,+ matchesType,+ Inspection,+ IdentifierInspection) where++import Language.Mulang.Ast+import Language.Mulang.Identifier (IdentifierPredicate)+import Language.Mulang.Generator (expressions, boundDeclarations, equationBodies, declarations)++import Data.List.Extra (has)++type Inspection = Expression -> Bool+type IdentifierInspection = IdentifierPredicate -> Inspection++containsExpression :: (Expression -> Bool) -> Inspection+containsExpression f = has f expressions++containsBody :: (EquationBody -> Bool)-> Inspection+containsBody f = has f equationBodies++containsBoundDeclaration :: (Expression -> Bool) -> IdentifierInspection+containsBoundDeclaration f b = has f (boundDeclarations b)++containsDeclaration :: (Expression -> Bool) -> Inspection+containsDeclaration f = has f declarations++matchesType :: IdentifierPredicate -> Pattern -> Bool+matchesType predicate (TypePattern n) = predicate n+matchesType predicate (AsPattern _ (TypePattern n)) = predicate n+matchesType predicate (UnionPattern patterns) = any (matchesType predicate) patterns+matchesType _ _ = False+
src/Language/Mulang/Inspector/Procedural.hs view
@@ -2,13 +2,15 @@ usesRepeat, usesWhile, usesSwitch,+ usesForEach,+ usesForLoop, declaresProcedure) where import Language.Mulang.Ast-import Language.Mulang.Identifier-import Language.Mulang.Inspector.Generic+import Language.Mulang.Inspector.Primitive (Inspection, IdentifierInspection, containsExpression, containsBoundDeclaration)+import Language.Mulang.Inspector.Generic (usesYield) -declaresProcedure :: IdentifierPredicate -> Inspection+declaresProcedure :: IdentifierInspection declaresProcedure = containsBoundDeclaration f where f (Procedure _ _) = True f _ = False@@ -34,3 +36,12 @@ where f (Repeat _ _) = True f _ = False +usesForEach :: Inspection+usesForEach = containsExpression f+ where f (For _ e) = not $ usesYield e+ f _ = False++usesForLoop :: Inspection+usesForLoop = containsExpression f+ where f (ForLoop _ _ _ _) = True+ f _ = False
+ src/Language/Mulang/Inspector/Typed.hs view
@@ -0,0 +1,41 @@+module Language.Mulang.Inspector.Typed (+ declaresTypeAlias,+ declaresTypeSignature,+ typesAs,+ typesParameterAs,+ typesReturnAs,+ usesType) where++import Language.Mulang.Ast+import Language.Mulang.Inspector.Primitive (IdentifierInspection, containsDeclaration, containsBoundDeclaration)++declaresTypeAlias :: IdentifierInspection+declaresTypeAlias = containsBoundDeclaration f+ where f (TypeAlias _ _) = True+ f _ = False++typesReturnAs :: IdentifierInspection+typesReturnAs predicate = containsDeclaration f+ where f (SubroutineSignature _ _ name _) = predicate name+ f _ = False++typesParameterAs :: IdentifierInspection+typesParameterAs predicate = containsDeclaration f+ where f (SubroutineSignature _ names _ _) = any predicate names+ f _ = False++typesAs :: IdentifierInspection+typesAs predicate = containsDeclaration f+ where f (VariableSignature _ name _) = predicate name+ f _ = False++usesType :: IdentifierInspection+usesType predicate = containsDeclaration f+ where f (VariableSignature _ name _) = predicate name+ f (SubroutineSignature _ args ret _) = any predicate (ret:args)+ f _ = False++declaresTypeSignature :: IdentifierInspection+declaresTypeSignature = containsBoundDeclaration f+ where f (TypeSignature _ _) = True+ f _ = False
src/Language/Mulang/Parsers/Haskell.hs view
@@ -29,9 +29,10 @@ where mergeDecls decls exp = compact (decls ++ [exp]) - muDecls (HsTypeDecl _ name _ _) = [TypeAlias (muName name)]+ muDecls (HsTypeDecl _ name args t) = [TypeAlias (unwords . map muName $ name : args) (muTypeId t)] muDecls (HsDataDecl _ _ name _ _ _ ) = [Record (muName name)]- muDecls (HsTypeSig _ names (HsQualType _ t)) = map (muTypeSignature t) names+ muDecls (HsTypeSig _ names (HsQualType constraints t))+ = map (muTypeSignature constraints t) names muDecls (HsFunBind equations) | (HsMatch _ name _ _ _) <- head equations = [Function (muName name) (map muEquation equations)] muDecls (HsPatBind _ (HsPVar name) (HsUnGuardedRhs exp) _) = [Variable (muName name) (muExp exp)]@@ -57,7 +58,7 @@ muPat (HsPParen pattern) = muPat pattern muPat (HsPAsPat name pattern) = AsPattern (muName name) (muPat pattern) muPat HsPWildCard = WildcardPattern- muPat _ = OtherPattern+ muPat p = debugPattern p muExp (HsVar (UnQual (HsIdent "undefined"))) = Raise (MuString "undefined") @@ -87,9 +88,10 @@ muExp (HsEnumFromTo from to) = Application (Reference "enumFromTo") [(muExp from), (muExp to)] muExp (HsEnumFromThen from thn) = Application (Reference "enumFromThen") [(muExp from), (muExp thn)] muExp (HsEnumFromThenTo from thn to) = Application (Reference "enumFromThenTo") [(muExp from), (muExp thn), (muExp to)]- muExp (HsListComp exp stmts) = Comprehension (muExp exp) (map muStmt stmts)- muExp (HsDo stmts) | (HsQualifier exp) <- last stmts = Comprehension (muExp exp) (map muStmt stmts)- muExp _ = Other+ muExp (HsListComp exp stmts) = For (map muStmt stmts) (Yield (muExp exp))+ muExp (HsDo stmts) | (HsQualifier exp) <- last stmts = For (map muStmt stmts) (Yield (muExp exp))+ muExp (HsExpTypeSig _ exp (HsQualType cs t)) = TypeCast (muExp exp) (muType t cs)+ muExp e = debug e muLit (HsCharPrim v) = MuString [v] muLit (HsStringPrim v) = MuString v@@ -121,19 +123,33 @@ muQOp (HsQVarOp name) = muQName name muQOp (HsQConOp name) = muQName name - muStmt (HsGenerator _ pat exp) = MuGenerator (muPat pat) (muExp exp)- muStmt (HsQualifier exp) = MuQualifier (muExp exp)+ muStmt (HsGenerator _ pat exp) = Generator (muPat pat) (muExp exp)+ muStmt (HsQualifier exp) = Guard (muExp exp) - muTypeSignature t name = TypeSignature (muName name) (init topTypes) (last topTypes)- where topTypes = muTopTypes t+ muTypeSignature :: [HsAsst] -> HsType -> HsName -> Expression+ muTypeSignature cs t name = TypeSignature (muName name) (muType t cs) - muTopTypes (HsTyFun i o) = muType i : muTopTypes o- muTopTypes t = [muType t]+ muType :: HsType -> [HsAsst] -> Type+ muType t cs | null initTypes = SimpleType lastType constraints+ | otherwise = ParameterizedType initTypes lastType constraints+ where+ initTypes = init topTypes+ lastType = last topTypes+ topTypes = muTopTypes t+ constraints = map muConstraint cs - muType (HsTyFun i o) = muType i ++ " -> " ++ muType o- muType (HsTyCon name) = muQName name- muType (HsTyVar name) = muName name- muType (HsTyTuple ts) = "(" ++ (intercalate ", " . map muType $ ts) ++ ")"- muType (HsTyApp (HsTyCon (Special HsListCon)) t2) = "[" ++ muType t2 ++ "]"- muType (HsTyApp t1 t2) = muType t1 ++ " " ++ muType t2+ muConstraint :: HsAsst -> Identifier+ muConstraint (constraint, targets) =+ intercalate " " (muQName constraint : map muTypeId targets)++ muTopTypes (HsTyFun i o) = muTypeId i : muTopTypes o+ muTopTypes t = [muTypeId t]++ muTypeId :: HsType -> Identifier+ muTypeId (HsTyFun i o) = muTypeId i ++ " -> " ++ muTypeId o+ muTypeId (HsTyCon name) = muQName name+ muTypeId (HsTyVar name) = muName name+ muTypeId (HsTyTuple ts) = "(" ++ (intercalate ", " . map muTypeId $ ts) ++ ")"+ muTypeId (HsTyApp (HsTyCon (Special HsListCon)) t2) = "[" ++ muTypeId t2 ++ "]"+ muTypeId (HsTyApp t1 t2) = muTypeId t1 ++ " " ++ muTypeId t2
src/Language/Mulang/Parsers/Java.hs view
@@ -10,6 +10,7 @@ import Language.Java.Parser import Language.Java.Syntax+import Language.Java.Pretty (prettyPrint) import Control.Fallible @@ -28,35 +29,45 @@ m (CompilationUnit _ _ typeDecls) = compactMap muTypeDecl $ typeDecls -muTypeDecl (ClassTypeDecl decl) = muClassTypeDecl decl+muTypeDecl (ClassTypeDecl decl) = muClassTypeDecl decl muTypeDecl (InterfaceTypeDecl decl) = muInterfaceTypeDecl decl -muClassTypeDecl (ClassDecl _ name _ superclass interfaces (ClassBody body)) =+muClass (ClassDecl _ name _ superclass interfaces (ClassBody body)) = Class (i name) (fmap muRefType superclass) (compact (map muImplements interfaces ++ concatMap muDecl body))-muClassTypeDecl (EnumDecl _ name _ (EnumBody constants _)) =++muInterface (InterfaceDecl _ name _ interfaces (InterfaceBody body)) =+ Interface (i name) (map muRefType interfaces) (compactConcatMap muMemberDecl body)++muClassTypeDecl clazz@(ClassDecl _ name args _ _ _) = muDeclaration name args $ muClass clazz++muClassTypeDecl (EnumDecl _ name _ (EnumBody constants _)) = Enumeration (i name) (map muEnumConstant constants) -muImplements interface = Implement $ muRefType interface+muImplements interface = Implement $ Reference (muRefType interface) -muInterfaceTypeDecl (InterfaceDecl _ name _ interfaces (InterfaceBody body)) =- Interface (i name) (map muRefType interfaces) (compactConcatMap muMemberDecl body )+muInterfaceTypeDecl interface@(InterfaceDecl _ name args _ _) = muDeclaration name args $ muInterface interface +muDeclaration _ [] decl = decl+muDeclaration name args decl = Sequence [ModuleSignature (i name) (map prettyPrint args), decl]+ muDecl :: Decl -> [Expression] muDecl (MemberDecl memberDecl) = muMemberDecl memberDecl-muDecl (InitDecl _ _) = return Other+muDecl e = return . debug $ e muMemberDecl :: MemberDecl -> [Expression]-muMemberDecl (FieldDecl _ _type varDecls) = map (variableToAttribute.muVarDecl) varDecls-muMemberDecl (MethodDecl _ _ typ name params _ (MethodBody Nothing)) = return $ TypeSignature (i name) (map muFormalParamType params) (muMaybeType typ)+muMemberDecl (FieldDecl _ typ varDecls) = concatMap (variableToAttribute.muVarDecl typ) varDecls+muMemberDecl (MethodDecl _ _ typ name params _ (MethodBody Nothing)) = return $ muMethodSignature name params typ muMemberDecl (MethodDecl (elem Static -> True) _ Nothing (Ident "main") [_] _ body) = return $ EntryPoint "main" (muMethodBody body) muMemberDecl (MethodDecl _ _ _ (Ident "equals") params _ body) = return $ EqualMethod [SimpleEquation (map muFormalParam params) (muMethodBody body)] muMemberDecl (MethodDecl _ _ _ (Ident "hashCode") params _ body) = return $ HashMethod [SimpleEquation (map muFormalParam params) (muMethodBody body)]-muMemberDecl (MethodDecl _ _ _ name params _ body) = return $ SimpleMethod (i name) (map muFormalParam params) (muMethodBody body)-muMemberDecl (ConstructorDecl _ _ _ _params _ _constructorBody) = return $ Other+muMemberDecl (MethodDecl _ _ returnType name params _ body) = [ muMethodSignature name params returnType,+ SimpleMethod (i name) (map muFormalParam params) (muMethodBody body)]+muMemberDecl e@(ConstructorDecl _ _ _ _params _ _constructorBody) = return . debug $ e muMemberDecl (MemberClassDecl decl) = return $ muClassTypeDecl decl muMemberDecl (MemberInterfaceDecl decl) = return $ muInterfaceTypeDecl decl +muMethodSignature name params returnType = SubroutineSignature (i name) (map muFormalParamType params) (muReturnType returnType) [] muEnumConstant (EnumConstant name _ _) = i name muFormalParam (FormalParam _ _ _ id) = VariablePattern (v id)@@ -66,29 +77,29 @@ muBlockStmt (BlockStmt stmt) = [muStmt stmt] muBlockStmt (LocalClass decl) = [muClassTypeDecl decl]-muBlockStmt (LocalVars _ _type vars) = map muVarDecl vars--muMaybeType Nothing = "void"-muMaybeType (Just typ) = muType typ+muBlockStmt (LocalVars _ typ vars) = concatMap (muVarDecl typ) vars muType (PrimType t) = muPrimType t muType (RefType t) = muRefType t+muReturnType = fromMaybe "void" . fmap muType muStmt (StmtBlock block) = muBlock block-muStmt (IfThen exp ifTrue) = If (muExp exp) (muStmt ifTrue) MuNull+muStmt (IfThen exp ifTrue) = If (muExp exp) (muStmt ifTrue) None muStmt (IfThenElse exp ifTrue ifFalse) = If (muExp exp) (muStmt ifTrue) (muStmt ifFalse) muStmt (While cond body) = M.While (muExp cond) (muStmt body)-muStmt (Return exp) = M.Return $ fmapOrNull muExp exp+muStmt (Do body cond) = M.While (muStmt body) (muExp cond)+muStmt (Return exp) = M.Return $ fmapOrNone muExp exp muStmt (ExpStmt exp) = muExp exp-muStmt Empty = MuNull+muStmt Empty = None muStmt (Assert exp _) = SimpleSend Self "assert" [muExp exp] muStmt (Synchronized _ block) = muBlock block muStmt (Labeled _ stmt) = muStmt stmt muStmt (Throw exp) = Raise $ muExp exp-muStmt (Try block catches finally) = M.Try (muBlock block) (map muCatch catches) (fmapOrNull muBlock finally)---muStmt (EnhancedFor _ _ name gen body) = Other-muStmt (Switch exp cases) = muSwitch exp . partition isDefault $ cases -muStmt _ = Other+muStmt (Try block catches finally) = M.Try (muBlock block) (map muCatch catches) (fmapOrNone muBlock finally)+muStmt (BasicFor init cond prog stmt) = ForLoop (fmapOrNone muForInit init) (fmapOrNone muExp cond) (fmapOrNone (compactMap muExp) prog) (muStmt stmt)+muStmt (EnhancedFor _ _ name gen body) = For [Generator (VariablePattern (i name)) (muExp gen)] (muStmt body)+muStmt (Switch exp cases) = muSwitch exp . partition isDefault $ cases+muStmt e = debug e muExp (Lit lit) = muLit lit muExp (MethodInv invoke) = muMethodInvocation invoke@@ -97,11 +108,11 @@ muExp (Cond cond ifTrue ifFalse) = If (muExp cond) (muExp ifTrue) (muExp ifFalse) muExp (ExpName name) = muName name muExp (Assign lhs EqualA exp) = Assignment (muLhs lhs) (muExp exp)-muExp (InstanceCreation _ clazz args _) = New (r clazz) (map muExp args)+muExp (InstanceCreation _ clazz args _) = New (Reference $ r clazz) (map muExp args) muExp (PreNot exp) = SimpleSend (muExp exp) "!" [] muExp (Lambda params exp) = M.Lambda (muLambdaParams params) (muLambdaExp exp) muExp (MethodRef _ message) = M.Lambda [VariablePattern "it"] (SimpleSend (Reference "it") (i message) [])-muExp _ = Other+muExp e = debug e muLambdaExp (LambdaExpression exp) = muExp exp muLambdaExp (LambdaBlock block) = muBlock block@@ -124,7 +135,7 @@ muLit (Double d) = MuNumber d muLit (Boolean b) = MuBool b muLit Null = MuNil-muLit _ = Other+muLit e = debug e muOp Mult = Reference "*" muOp Div = Reference "/"@@ -139,14 +150,16 @@ muOp Or = Reference "||" muOp Equal = M.Equal muOp NotEq = NotEqual-muOp _ = Other+muOp e = debug e -muVarDecl (VarDecl id init) = Variable (v id) (fmapOrNull muVarInit init)+muVarDecl typ (VarDecl id init) = [+ TypeSignature (v id) (SimpleType (muType typ) []),+ Variable (v id) (fmapOrNone muVarInit init)] muMethodBody (MethodBody (Just block)) = muBlock block muVarInit (InitExp exp) = muExp exp-muVarInit (InitArray _ArrayInit) = Other+muVarInit e = debug e muMethodInvocation (MethodCall (Name [Ident "System", Ident "out", Ident "println"]) [expr]) = Print (muExp expr) muMethodInvocation (MethodCall (Name [Ident "System", Ident "out", Ident "print"]) [expr]) = Print (muExp expr)@@ -155,29 +168,33 @@ muMethodInvocation (MethodCall (Name [message]) args) = SimpleSend Self (i message) (map muExp args) muMethodInvocation (MethodCall (Name receptorAndMessage) args) = SimpleSend (Reference (ns . init $ receptorAndMessage)) (i . last $ receptorAndMessage) (map muExp args) muMethodInvocation (PrimaryMethodCall receptor _ selector args) = SimpleSend (muExp receptor) (i selector) (map muExp args)-muMethodInvocation _ = Other+muMethodInvocation e = debug e muRefType (ClassRefType clazz) = r clazz muRefType (ArrayType t) = (muType t) ++ "[]" muPrimType = map toLower . dropLast 1 . show -muSwitch exp (def, cases) = M.Switch (muExp exp) (map muCase cases) (headOrElse MuNull . map muDefault $ def)+muSwitch exp (def, cases) = M.Switch (muExp exp) (map muCase cases) (headOrElse None . map muDefault $ def) muCase (SwitchBlock (SwitchCase exp) block) = (muExp exp, compactConcatMap muBlockStmt block) muDefault (SwitchBlock Default block) = compactConcatMap muBlockStmt block +muForInit:: ForInit -> Expression+muForInit (ForLocalVars _ typ varDecls) = compactConcatMap (muVarDecl typ) varDecls+muForInit (ForInitExps exps) = compactMap muExp exps+ isDefault (SwitchBlock Default _) = True isDefault _ = False -- Combinators -fmapOrNull f = fromMaybe MuNull . fmap f+fmapOrNone f = fromMaybe None . fmap f -- Helpers -variableToAttribute (Variable id init) = Attribute id init+variableToAttribute [typ, (Variable id init)] = [typ, Attribute id init] v (VarId name) = i name v (VarDeclArray id) = (v id) ++ "[]"
src/Language/Mulang/Parsers/JavaScript.hs view
@@ -33,30 +33,36 @@ muJSStatement (JSStatementBlock _ statements _ _) = compactMap muJSStatement statements --muJSStatement (JSConstant _ (JSCommaList JSExpression) _) -- ^const, decl, autosemi muJSStatement (JSDoWhile _ statement _ _ expression _ _) = While (muJSExpression expression) (muJSStatement statement)---muJSStatement (JSFor _ _ (JSCommaList JSExpression) _ (JSCommaList JSExpression) _ (JSCommaList JSExpression) _ JSStatement) -- ^for,lb,expr,semi,expr,semi,expr,rb.stmt---muJSStatement (JSForIn _ _ (JSIdentifier _ name) _ JSExpression _ JSStatement) = For [muJSExpression ]---muJSStatement (JSForVar _ _ _ (JSCommaList JSExpression) _ (JSCommaList JSExpression) _ (JSCommaList JSExpression) _ JSStatement) -- ^for,lb,var,vardecl,semi,expr,semi,expr,rb,stmt---muJSStatement (JSForVarIn _ _ _ JSExpression _ JSExpression _ JSStatement) -- ^for,lb,var,vardecl,in,expr,rb,stmt+muJSStatement (JSFor _ _ inits _ conds _ progs _ body) = muFor inits conds progs body+muJSStatement (JSForIn _ _ id _ gen _ body) = muForIn id gen body+muJSStatement (JSForVar _ _ _ inits _ conds _ progs _ body) = muFor inits conds progs body+muJSStatement (JSForVarIn _ _ _ (JSVarInitExpression id _) _ gen _ body) = muForIn id gen body muJSStatement (JSFunction _ ident _ params _ body _) = muComputation ident params body-muJSStatement (JSIf _ _ expression _ statement) = If (muJSExpression expression) (muJSStatement statement) MuNull+muJSStatement (JSIf _ _ expression _ statement) = If (muJSExpression expression) (muJSStatement statement) None muJSStatement (JSIfElse _ _ expression _ ifStatement _ elseStatement) = If (muJSExpression expression) (muJSStatement ifStatement) (muJSStatement elseStatement) muJSStatement (JSLabelled _ _ statement) = muJSStatement statement-muJSStatement (JSEmptyStatement _) = MuNull+muJSStatement (JSEmptyStatement _) = None muJSStatement (JSExpressionStatement (JSIdentifier _ val) _) = Reference val muJSStatement (JSExpressionStatement expression _) = muJSExpression expression muJSStatement (JSAssignStatement (JSIdentifier _ name) op value _) = Assignment name (muJSAssignOp op name (muJSExpression value)) muJSStatement (JSMethodCall (JSMemberDot receptor _ message) _ params _ _) = Send (muJSExpression receptor) (muJSExpression message) (map muJSExpression (muJSCommaList params)) muJSStatement (JSMethodCall ident _ params _ _) = Application (muJSExpression ident) (map muJSExpression (muJSCommaList params))-muJSStatement (JSReturn _ maybeExpression _) = Return (maybe MuNull muJSExpression maybeExpression)+muJSStatement (JSReturn _ maybeExpression _) = Return (maybe None muJSExpression maybeExpression) muJSStatement (JSSwitch _ _ expression _ _ cases _ _) = muSwitch expression . partition isDefault $ cases muJSStatement (JSThrow _ expression _) = Raise (muJSExpression expression) muJSStatement (JSTry _ block catches finally) = Try (muJSBlock block) (map muJSTryCatch catches) (muJSTryFinally finally) muJSStatement (JSVariable _ list _) = compactMap muJSExpression.muJSCommaList $ list muJSStatement (JSWhile _ _ expression _ statement) = While (muJSExpression expression) (muJSStatement statement)-muJSStatement _ = Other+muJSStatement e = debug e -muSwitch expression (def, cases) = Switch (muJSExpression expression) (map muCase cases) (headOrElse MuNull . map muDefault $ def)+muJSExpressionFromList = compactMap muJSExpression . muJSCommaList +muFor inits conds progs body = ForLoop (muJSExpressionFromList inits) (muJSExpressionFromList conds) (muJSExpressionFromList progs) (muJSStatement body)++muForIn (JSIdentifier _ id) generator body = For [Generator (VariablePattern id) (muJSExpression generator)] (muJSStatement body)++muSwitch expression (def, cases) = Switch (muJSExpression expression) (map muCase cases) (headOrElse None . map muDefault $ def)+ muCase (JSCase _ expression _ statements) = (muJSExpression expression, compactMap muJSStatement statements) muDefault (JSDefault _ _ statements) = compactMap muJSStatement statements@@ -84,7 +90,7 @@ muJSExpression:: JSExpression -> Expression-muJSExpression (JSIdentifier _ "undefined") = MuNull+muJSExpression (JSIdentifier _ "undefined") = None muJSExpression (JSIdentifier _ name) = Reference name muJSExpression (JSDecimal _ val) = MuNumber (read val) muJSExpression (JSLiteral _ "null") = MuNil@@ -107,14 +113,14 @@ muJSExpression (JSFunctionExpression _ ident _ params _ body) = muComputation ident params body --muJSExpression (JSMemberDot JSExpression _ JSExpression) -- ^firstpart, dot, name muJSExpression (JSMemberExpression id _ params _) = Application (muJSExpression id) (map muJSExpression.muJSCommaList $ params)-muJSExpression (JSMemberNew _ (JSIdentifier _ name) _ args _) = New name (map muJSExpression.muJSCommaList $ args)+muJSExpression (JSMemberNew _ (JSIdentifier _ name) _ args _) = New (Reference name) (map muJSExpression.muJSCommaList $ args) --muJSExpression (JSMemberSquare JSExpression _ JSExpression _) -- ^firstpart, lb, expr, rb-muJSExpression (JSNewExpression _ (JSIdentifier _ name)) = New name []+muJSExpression (JSNewExpression _ (JSIdentifier _ name)) = New (Reference name) [] muJSExpression (JSObjectLiteral _ propertyList _) = MuObject (compactMap id.map muJSObjectProperty.muJSCommaTrailingList $ propertyList) muJSExpression (JSUnaryExpression (JSUnaryOpNot _) e) = Application (Reference "!") [muJSExpression e] muJSExpression (JSUnaryExpression op (JSIdentifier _ name)) = Assignment name (muJSUnaryOp op name) muJSExpression (JSVarInitExpression (JSIdentifier _ name) initial) = Variable name (muJSVarInitializer initial)-muJSExpression _ = Other+muJSExpression e = debug e removeQuotes = filter (flip notElem quoteMarks) where quoteMarks = "\"'"@@ -152,7 +158,7 @@ --muJSUnaryOp (JSUnaryOpTilde _) --muJSUnaryOp (JSUnaryOpTypeof _) --muJSUnaryOp (JSUnaryOpVoid _)-muJSUnaryOp _ _ = Other+muJSUnaryOp e _ = debug e muJSAssignOp:: JSAssignOp -> Identifier -> Expression -> Expression muJSAssignOp (JSAssign _) _ v = v@@ -170,16 +176,16 @@ muJSAssignOp' (JSBwAndAssign _) = Reference "&" muJSAssignOp' (JSBwXorAssign _) = Reference "^" muJSAssignOp' (JSBwOrAssign _) = Reference "|"-muJSAssignOp' _ = Other+muJSAssignOp' e = debug e muJSTryCatch:: JSTryCatch -> (Pattern, Expression) --muJSTryCatch JSCatch _ _ JSExpression _ JSBlock -- ^catch,lb,ident,rb,block --muJSTryCatch JSCatchIf _ _ JSExpression _ JSExpression _ JSBlock -- ^catch,lb,ident,if,expr,rb,block-muJSTryCatch _ = (WildcardPattern, Other)+muJSTryCatch e = (WildcardPattern, debug e) muJSTryFinally:: JSTryFinally -> Expression muJSTryFinally (JSFinally _ block) = muJSBlock block-muJSTryFinally JSNoFinally = MuNull+muJSTryFinally JSNoFinally = None muJSBlock:: JSBlock -> Expression muJSBlock (JSBlock _ statements _) = compactMap muJSStatement statements@@ -187,14 +193,14 @@ muJSVarInitializer:: JSVarInitializer -> Expression muJSVarInitializer (JSVarInit _ expression) = muJSExpression expression --muJSVarInitializer JSVarInitNone-muJSVarInitializer _ = Other+muJSVarInitializer e = debug e muJSObjectProperty:: JSObjectProperty -> Expression --muJSObjectProperty JSPropertyAccessor JSAccessor JSPropertyName _ [JSExpression] _ JSBlock -- ^(get|set), name, lb, params, rb, block muJSObjectProperty (JSPropertyNameandValue id _ [JSFunctionExpression _ _ _ params _ block]) = Method (muJSPropertyName id) (muEquation (map muPattern (muJSCommaList params)) (muJSBlock block)) muJSObjectProperty (JSPropertyNameandValue id _ [expression]) = Variable (muJSPropertyName id) (muJSExpression expression)-muJSObjectProperty _ = Other+muJSObjectProperty e = debug e muJSPropertyName:: JSPropertyName -> Identifier muJSPropertyName = removeQuotes.muJSPropertyName'@@ -203,11 +209,6 @@ muJSPropertyName' (JSPropertyIdent _ name) = name muJSPropertyName' (JSPropertyString _ name) = name muJSPropertyName' (JSPropertyNumber _ name) = name--muJSAccessor:: JSAccessor -> Expression---muJSAccessor JSAccessorGet _---muJSAccessor JSAccessorSet _-muJSAccessor _ = Other muJSArrayList:: [JSArrayElement] -> [Expression] muJSArrayList list = [muJSExpression expression | (JSArrayElement expression) <- list]
+ src/Language/Mulang/Parsers/Python.hs view
@@ -0,0 +1,227 @@+module Language.Mulang.Parsers.Python (py, parsePython) where++import qualified Language.Mulang.Ast as M+import Language.Mulang.Builder+import Language.Mulang.Parsers++import Language.Python.Version3.Parser (parseModule)+import Language.Python.Common.Token (Token)+import Language.Python.Common.AST++import Data.List (intercalate)+import Data.Maybe (fromMaybe, listToMaybe)++import Control.Fallible++py:: Parser+py = orFail . parsePython'++parsePython:: EitherParser+parsePython = orLeft . parsePython'++parsePython' = fmap (normalize . muPyAST) . (`parseModule` "")++muPyAST:: (ModuleSpan, [Token]) -> M.Expression+muPyAST (modul, _) = muModule modul++muModule:: ModuleSpan -> M.Expression+muModule (Module statements) = compactMap muStatement statements+++muStatement:: StatementSpan -> M.Expression+muStatement (While cond body _ _) = M.While (muExpr cond) (muSuite body)+muStatement (For targets generator body _ _) = M.For [M.Generator (M.TuplePattern (map (M.VariablePattern . muVariable) targets)) (muExpr generator)] (muSuite body)+muStatement (Fun name args _ body _) = muComputation (muIdent name) (map muParameter args) (muSuite body)+muStatement (Class name parents body _) = M.Class (muIdent name) (listToMaybe . map muParent $ parents) (muSuite body)+muStatement (Conditional guards els _ ) = foldr muIf (muSuite els) guards+muStatement (Assign [to] from _) = M.Assignment (muVariable to) (muExpr from)+muStatement (AugmentedAssign to op from _) = M.Assignment (muVariable to) (M.Application (M.Reference . muAssignOp $ op) [M.Reference . muVariable $ to, muExpr from])+--muStatement (Decorated+-- { decorated_decorators :: [Decorator annot] -- ^ Decorators.+-- , decorated_def :: Statement annot -- ^ Function or class definition to be decorated.+-- , stmt_annot :: annot+-- }+muStatement (Return expr _) = M.Return $ fmapOrNull muExpr expr+muStatement (Try body handlers _ finally _) = M.Try (muSuite body) (map muHandler handlers) (muSuite finally)+muStatement (Raise expr _) = M.Raise $ muRaiseExpr expr+--muStatement (With+-- { with_context :: [(Expr annot, Maybe (Expr annot))] -- ^ Context expression(s) (yields a context manager).+-- , with_body :: Suite annot -- ^ Suite to be managed.+-- , stmt_annot :: annot+-- }+muStatement (Pass _) = M.None+--muStatement (Break { stmt_annot :: annot }+--muStatement (Continue { stmt_annot :: annot }+--muStatement (Delete+-- { del_exprs :: [Expr annot] -- ^ Items to delete.+-- , stmt_annot :: annot+-- }+muStatement (StmtExpr expr _) = muExpr expr+--muStatement (Global+-- { global_vars :: [Ident annot] -- ^ Variables declared global in the current block.+-- , stmt_annot :: annot+-- }+--muStatement (NonLocal+-- { nonLocal_vars :: [Ident annot] -- ^ Variables declared nonlocal in the current block (their binding comes from bound the nearest enclosing scope).+-- , stmt_annot :: annot+-- }+--muStatement (Assert+-- { assert_exprs :: [Expr annot] -- ^ Expressions being asserted.+-- , stmt_annot :: annot+-- }+muStatement (Print _ exprs _ _) = M.Print $ compactMap muExpr exprs+muStatement (Exec expr _ _) = muExpr expr+muStatement e = M.debug e+++muIf (condition, body) otherwise = M.If (muExpr condition) (muSuite body) otherwise++muParent (ArgExpr (Var ident _) _) = muIdent ident++muComputation name params body | containsReturn body = M.SimpleFunction name params body+ | otherwise = M.SimpleProcedure name params body+++containsReturn :: M.Expression -> Bool+containsReturn (M.Return _) = True+containsReturn (M.Sequence xs) = any containsReturn xs+containsReturn _ = False++muParameter:: ParameterSpan -> M.Pattern+muParameter (Param name _ _ _) = M.VariablePattern (muIdent name)++muIdent:: IdentSpan -> String+muIdent (Ident id _) = id++muSuite:: SuiteSpan -> M.Expression+muSuite = compactMap muStatement+++muExpr:: ExprSpan -> M.Expression+muExpr (Var ident _) = M.Reference (muIdent ident)+muExpr (Int value _ _) = muNumberFromInt value+muExpr (LongInt value _ _) = muNumberFromInt value+muExpr (Float value _ _) = M.MuNumber value+--muExpr (Imaginary { imaginary_value :: Double, expr_literal :: String, expr_annot :: annot }+muExpr (Bool value _) = M.MuBool value+muExpr (None _) = M.MuNil+--muExpr (Ellipsis { expr_annot :: annot }+--muExpr (ByteStrings { byte_string_strings :: [String], expr_annot :: annot }+muExpr (Strings strings _) = muString strings+muExpr (UnicodeStrings strings _) = muString strings+muExpr (Call fun args _) = muCallType fun (map muArgument args)+--muExpr (Subscript { subscriptee :: Expr annot, subscript_expr :: Expr annot, expr_annot :: annot }+--muExpr (SlicedExpr { slicee :: Expr annot, slices :: [Slice annot], expr_annot :: annot }+--muExpr (CondExpr+-- { ce_true_branch :: Expr annot -- ^ Expression to evaluate if condition is True.+-- , ce_condition :: Expr annot -- ^ Boolean condition.+-- , ce_false_branch :: Expr annot -- ^ Expression to evaluate if condition is False.+-- , expr_annot :: annot+-- }+muExpr (BinaryOp op left right _) = muApplication op [left, right]+muExpr (UnaryOp op arg _) = muApplication op [arg]+--muExpr (Dot { dot_expr :: Expr annot, dot_attribute :: Ident annot, expr_annot :: annot }+muExpr (Lambda args body _) = M.Lambda (map muParameter args) (muExpr body)+muExpr (Tuple exprs _) = M.MuTuple $ map muExpr exprs+muExpr (Yield arg _) = M.Yield $ fmapOrNull muYieldArg arg+--muExpr (Generator { gen_comprehension :: Comprehension annot, expr_annot :: annot }+--muExpr (ListComp { list_comprehension :: Comprehension annot, expr_annot :: annot }+muExpr (List exprs _) = muList exprs+--muExpr (Dictionary { dict_mappings :: [DictMappingPair annot], expr_annot :: annot }+--muExpr (DictComp { dict_comprehension :: Comprehension annot, expr_annot :: annot }+muExpr (Set exprs _) = muList exprs+--muExpr (SetComp { set_comprehension :: Comprehension annot, expr_annot :: annot }+--muExpr (Starred { starred_expr :: Expr annot, expr_annot :: annot }+muExpr (Paren expr _) = muExpr expr+--muExpr (StringConversion { backquoted_expr :: Expr annot, expr_anot :: annot }+muExpr e = M.debug e+++muList = M.MuList . map muExpr++muCallType (Dot receiver ident _) = muCall (M.Send $ muExpr receiver) ident+muCallType (Var ident _) = muCall M.Application ident++muCall callType ident = callType (M.Reference $ muIdent ident)+++muApplication op args = M.Application (M.Reference (muOp op)) (map muExpr args)++muString = M.MuString . intercalate "\n"++muNumberFromInt = M.MuNumber . fromInteger++muVariable:: ExprSpan -> M.Identifier+muVariable (Var ident _) = muIdent ident++muArgument (ArgExpr expr _) = muExpr expr+muArgument (ArgVarArgsPos expr _ ) = muExpr expr+muArgument (ArgVarArgsKeyword expr _ ) = muExpr expr+--muArgument ArgKeyword+-- { arg_keyword :: Ident annot -- ^ Keyword name.+-- , arg_expr :: Expr annot -- ^ Argument expression.+-- , arg_annot :: annot+-- }+muArgument e = M.debug e++--muYieldArg (YieldFrom expr _)(Expr annot) annot -- ^ Yield from a generator (Version 3 only)+muYieldArg (YieldExpr expr) = muExpr expr++muOp (And _) = "and"+muOp (Or _) = "or"+muOp (Not _) = "not"+muOp (Exponent _) = "**"+muOp (LessThan _) = "<"+muOp (GreaterThan _) = ">"+muOp (Equality _) = "=="+muOp (GreaterThanEquals _) = ">="+muOp (LessThanEquals _) = "<="+muOp (NotEquals _) = "!="+muOp (NotEqualsV2 _) = "<>" -- Version 2 only.+muOp (In _) = "in"+muOp (Is _) = "is"+muOp (IsNot _) = "is not"+muOp (NotIn _) = "not in"+muOp (BinaryOr _) = "|"+muOp (Xor _) = "^"+muOp (BinaryAnd _) = "&"+muOp (ShiftLeft _) = "<<"+muOp (ShiftRight _) = ">>"+muOp (Multiply _) = "*"+muOp (Plus _) = "+"+muOp (Minus _) = "-"+muOp (Divide _) = "/"+muOp (FloorDivide _) = "//"+muOp (Invert _) = "~"+muOp (Modulo _) = "%"++muAssignOp (PlusAssign _) = "+"+muAssignOp (MinusAssign _) = "-"+muAssignOp (MultAssign _) = "*"+muAssignOp (DivAssign _) = "/"+muAssignOp (ModAssign _) = "%"+muAssignOp (PowAssign _) = "**"+muAssignOp (BinAndAssign _) = "&"+muAssignOp (BinOrAssign _) = "|"+muAssignOp (BinXorAssign _) = "^"+muAssignOp (LeftShiftAssign _) = "<"+muAssignOp (RightShiftAssign _) = ">"+muAssignOp (FloorDivAssign _) = "/"++muHandler (Handler (ExceptClause clause _) suite _) = (muExceptClause clause, muSuite suite)++muExceptClause Nothing = M.WildcardPattern+muExceptClause (Just (except, maybeVar)) = muPattern maybeVar (M.TypePattern $ muVarToId except)++muPattern Nothing = id+muPattern (Just var) = M.AsPattern (muVarToId var)++muRaiseExpr (RaiseV3 Nothing) = M.None+muRaiseExpr (RaiseV3 (Just (expr, _))) = muExpr expr+--muRaiseExpr RaiseV2 (Maybe (Expr annot, (Maybe (Expr annot, Maybe (Expr annot))))) -- ^ /Version 2 only/.++-- Helpers++fmapOrNull f = fromMaybe M.None . fmap f++muVarToId (Var ident _) = muIdent ident
src/Language/Mulang/Signature.hs view
@@ -49,17 +49,22 @@ parameterNames (NamedSignature _ names) = names signaturesOf :: Expression -> [Signature]-signaturesOf = nub . mapMaybe (signatureOf.snd) . declarations+signaturesOf = nub . mapMaybe signatureOf . declarations signatureOf :: Expression -> Maybe Signature-signatureOf (Subroutine name es) = Just $ NamedSignature name (parameterNamesOf es)-signatureOf (Clause name args _) = Just $ AritySignature name (length args)-signatureOf (TypeSignature name args ret) = Just $ TypedSignature name args ret-signatureOf (Variable name _) = Just $ AritySignature name 0-signatureOf _ = Nothing+signatureOf (Subroutine name es) = Just $ NamedSignature name (parameterNamesOf es)+signatureOf (Clause name args _) = Just $ AritySignature name (length args)+signatureOf (TypeSignature name t) = typedSignatureOf name t+signatureOf (Variable name _) = Just $ AritySignature name 0+signatureOf _ = Nothing +typedSignatureOf :: Identifier -> Type -> Maybe Signature+typedSignatureOf name (ParameterizedType args ret []) = Just $ TypedSignature name args ret+typedSignatureOf name (SimpleType ret []) = Just $ TypedSignature name [] ret+typedSignatureOf _ _ = Nothing+ parameterNamesOf :: [Equation] -> [Maybe Identifier]-parameterNamesOf = map msum . transpose . map (map parameterNameOf . equationParams)+parameterNamesOf = map msum . transpose . map (map parameterNameOf . equationPatterns) parameterNameOf :: Pattern -> Maybe Identifier parameterNameOf (VariablePattern v) = Just v