packages feed

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 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