packages feed

mulang (empty) → 0.1.0.0

raw patch · 11 files changed

+617/−0 lines, 11 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, haskell-src, hspec, mulang

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Franco Leonardo Bulgarelli++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mulang.cabal view
@@ -0,0 +1,56 @@+name:                mulang+version:             0.1.0.0+synopsis:            The Mu Language, a non-computable extended Lambda Calculus+-- description:+license:             MIT+license-file:        LICENSE+author:              Franco Leonardo Bulgarelli+maintainer:          franco@mumuki.org+category:            Language+build-type:          Simple+cabal-version:       >=1.10++library+  build-depends:       base >=4.6 && <4.7+  default-language:    Haskell2010+  ghc-options:+      -Wall+      -fno-warn-missing-signatures+      -fno-warn-orphans+      -fno-warn-name-shadowing+  hs-source-dirs:+      src+  exposed-modules:+    Language.Mulang+    Language.Mulang.Explorer+    Language.Mulang.Inspector.Smell+    Language.Mulang.Inspector.Combiner+    Language.Mulang.Inspector+    Language.Mulang.Parsers.Haskell+    Language.Mulang.Parsers.Json+  build-depends:+    base                      >= 4     && < 5,+    bytestring                == 0.10.6.0,+    haskell-src               >= 1     && < 1.1,+    aeson                     == 0.8.1.1+++test-suite spec+  type:+      exitcode-stdio-1.0+  ghc-options:+      -Wall+      -fno-warn-missing-signatures+      -fno-warn-orphans+      -fno-warn-name-shadowing+  hs-source-dirs:+      spec+  main-is:+      Spec.hs+  build-depends:+    base                      >= 4     && < 5,+    bytestring                == 0.10.6.0,+    aeson                     == 0.8.1.1,+    haskell-src               >= 1     && < 1.1,+    hspec                     >= 2     && < 3,+    mulang
+ spec/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ src/Language/Mulang.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE DeriveGeneric #-}++module Language.Mulang (+    Program(..),+    Declaration(..),+    Equation(..),+    Rhs(..),+    GuardedRhs(..),+    Expression(..),+    ComprehensionStatement(..),+    Alternative(..),+    GuardedAlternatives(..),+    GuardedAlternative(..),+    Pattern(..),+    LiteralValue(..)+  ) where++import           GHC.Generics++data Program = Program [Declaration] deriving (Eq, Show, Read, Generic)++type Identifier = String++-- declaration or directive+data Declaration+         = TypeAlias Identifier+         | RecordDeclaration Identifier+         | TypeSignature Identifier+         | FunctionDeclaration Identifier [Equation]    -- functional, maybe pure,+                                                        -- optionally guarded,+                                                        -- optionally pattern matched function+         | ProcedureDeclaration Identifier              -- classic imperative-style procedure+         | ConstantDeclaration Identifier Rhs [Declaration]+  deriving (Eq, Show, Read, Generic)++data Equation = Equation [Pattern] Rhs [Declaration] deriving (Eq, Show, Read, Generic)++data Rhs+         = UnguardedRhs Expression+         | GuardedRhss  [GuardedRhs]+  deriving (Eq, Show, Read, Generic)++data GuardedRhs = GuardedRhs Expression Expression deriving (Eq, Show, Read, Generic)++-- expression or statement+-- may have effects+data Expression+        = Variable Identifier+        | Literal LiteralValue+        | InfixApplication Expression String Expression+        | Application Expression Expression+        | Lambda [Pattern] Expression+        | Let [Declaration] Expression+        | If Expression Expression Expression+        | Match Expression [Alternative]+        | MuTuple [Expression]+        | MuList [Expression]+        | Comprehension Expression [ComprehensionStatement]+        | Sequence [Expression]                   -- sequence of statements+        | ExpressionOther+  deriving (Eq, Show, Read, Generic)++data Pattern+        = VariablePattern String                 -- ^ variable+        | LiteralPattern String              -- ^ literal constant+        | InfixApplicationPattern Pattern String Pattern+        | ApplicationPattern String [Pattern]        -- ^ data constructor and argument+        | TuplePattern [Pattern]              -- ^ tuple pattern+        | ListPattern [Pattern]               -- ^ list pattern+        | AsPattern String Pattern         -- ^ @\@@-pattern+        | WildcardPattern                   -- ^ wildcard pattern (@_@)+        | OtherPattern+  deriving (Eq, Show, Read, Generic)++data ComprehensionStatement+        = MuGenerator Pattern Expression+        | MuQualifier Expression+        | LetStmt [Declaration]+  deriving (Eq, Show, Read, Generic)+++data Alternative = Alternative Pattern GuardedAlternatives [Declaration] deriving (Eq, Show, Read, Generic)++data GuardedAlternatives+        = UnguardedAlternative Expression          -- ^ @->@ /exp/+        | GuardedAlternatives  [GuardedAlternative] -- ^ /gdpat/+  deriving (Eq, Show, Read, Generic)+++data GuardedAlternative = GuardedAlternative Expression Expression deriving (Eq, Show, Read, Generic)++data LiteralValue+          = MuBool Bool+          | MuInteger Integer+          | MuFloat Rational+          | MuString String+    deriving (Eq, Show, Read, Generic)
+ src/Language/Mulang/Explorer.hs view
@@ -0,0 +1,92 @@+module Language.Mulang.Explorer (+  parseDecls,+  parseBindings,+  declsOf,+  rhssOf,+  bindingsOf,+  transitiveBindingsOf,+  expressionsOf,+  expressionToBinding,+  Expression(..),+  Binding) where++import Language.Mulang+import Data.Maybe (maybeToList)+import Data.List (nub)++type Binding = String++declName :: Declaration -> String+declName (TypeSignature b ) = b+declName (TypeAlias b ) = b+declName (ConstantDeclaration n _ _) = n+declName (FunctionDeclaration n _)  = n+declName _                  = []++declsOf :: Binding -> Program -> [Declaration]+declsOf binding = filter (isBinding binding) . parseDecls++rhssOf :: Binding -> Program -> [Rhs]+rhssOf binding = concatMap rhsForBinding . declsOf binding++expressionsOf :: Binding -> Program -> [Expression]+expressionsOf binding code = do+  rhs <- rhssOf binding code+  top <- topExpressions rhs+  unfoldExpression top++bindingsOf :: Binding -> Program -> [Binding]+bindingsOf binding code = nub $ do+          expr <- expressionsOf binding code+          maybeToList . expressionToBinding $ expr++transitiveBindingsOf :: Binding -> Program -> [Binding]+transitiveBindingsOf binding code =  expand (`bindingsOf` code) binding++parseDecls :: Program -> [Declaration]+parseDecls (Program decls) = decls++parseBindings :: Program -> [Binding]+parseBindings = map declName . parseDecls++expressionToBinding :: Expression -> Maybe Binding+expressionToBinding (Variable    q) = Just q+expressionToBinding _                = Nothing++-- private++topExpressions :: Rhs -> [Expression]+topExpressions (UnguardedRhs e) = [e]+topExpressions (GuardedRhss rhss) = rhss >>= \(GuardedRhs es1 es2) -> [es1, es2]++unfoldExpression :: Expression -> [Expression]+unfoldExpression expr = expr : concatMap unfoldExpression (subExpressions expr)++subExpressions :: Expression -> [Expression]+subExpressions (InfixApplication a b c) = [a, (Variable b), c]+subExpressions (Application a b)        = [a, b]+subExpressions (Lambda _ a)   = [a]+subExpressions (MuList as)      = as+subExpressions (Comprehension a _)   = [a] --TODO+subExpressions (MuTuple as)      = as+subExpressions (If a b c)       = [a, b, c]+subExpressions _ = []++isBinding :: Binding -> Declaration -> Bool+isBinding binding = (==binding).declName++rhsForBinding :: Declaration -> [Rhs]+rhsForBinding (ConstantDeclaration _ rhs localDecls) = concatRhs rhs localDecls+rhsForBinding (FunctionDeclaration _ cases) = cases >>= \(Equation _ rhs localDecls) -> concatRhs rhs localDecls+rhsForBinding _ = []++concatRhs rhs l = [rhs] ++ concatMap rhsForBinding l+++expand :: Eq a => (a-> [a]) -> a -> [a]+expand f x = expand' [] f [x]++expand' _ _ [] = []+expand' ps f (x:xs) | elem x ps = expand' ps f xs+                    | otherwise = [x] ++ expand' (x:ps) f (xs ++ f x)+
+ src/Language/Mulang/Inspector.hs view
@@ -0,0 +1,133 @@+module Language.Mulang.Inspector (+  hasComposition,+  hasGuards,+  hasIf,+  hasConditional,+  hasLambda,+  hasDirectRecursion,+  hasUsage,+  hasComprehension,+  hasBinding,+  hasFunctionDeclaration,+  hasArity,+  hasTypeDeclaration,+  hasTypeSignature,+  hasAnonymousVariable,+  hasExpression,+  hasDecl,+  hasRhs,+  Inspection,+  GlobalInspection+  ) where++import  Language.Mulang+import  Language.Mulang.Explorer++type Inspection = Binding -> Program  -> Bool+type GlobalInspection = Program  -> Bool++-- | Inspection that tells whether a binding uses the composition operator '.'+-- in its definition+hasComposition :: Inspection+hasComposition = hasExpression f+  where f (Variable ".") = True+        f _ = False++-- | Inspection that tells whether a binding uses guards+-- in its definition+hasGuards :: Inspection+hasGuards = hasRhs f+  where f (GuardedRhss _) = True+        f _ = False++-- | Inspection that tells whether a binding uses ifs+-- in its definition+hasIf :: Inspection+hasIf = hasExpression f+  where f (If _ _ _) = True+        f _ = False++-- | Inspection that tells whether a binding uses ifs or guards+-- in its definition+hasConditional :: Inspection+hasConditional target code = hasIf target code || hasGuards target code++-- | Inspection that tells whether a binding uses a lambda expression+-- in its definition+hasLambda :: Inspection+hasLambda = hasExpression f+  where f (Lambda _ _) = True+        f _ = False+++-- | Inspection that tells whether a binding is direct recursive+hasDirectRecursion :: Inspection+hasDirectRecursion binding = hasUsage binding binding++-- | Inspection that tells whether a binding uses the the given target binding+-- in its definition+hasUsage :: String -> Inspection+hasUsage target = hasExpression f+  where f expr | (Just n) <- expressionToBinding expr = n == target+               | otherwise = False++-- | Inspection that tells whether a binding uses+-- comprehensions - list comprehension, for comprehension, do-syntax, etc -+-- in its definitions+hasComprehension :: Inspection+hasComprehension = hasExpression f+  where f (Comprehension _ _) = True+        f _ = False++-- | Inspection that tells whether a top level binding exists+hasBinding :: Inspection+hasBinding binding = not.null.rhssOf binding++hasFunctionDeclaration :: Inspection+hasFunctionDeclaration funBinding = has f (declsOf funBinding)+  where f (FunctionDeclaration _ _) = True+        f (ConstantDeclaration _ (UnguardedRhs (Lambda _ _)) _) = True+        f (ConstantDeclaration _ (UnguardedRhs (Variable _)) _) = True -- not actually always true+        f _  = False++hasArity :: Int -> Inspection+hasArity arity funBinding = has f (declsOf funBinding)+  where f (FunctionDeclaration _ equations) = any equationHasArity equations+        f (ConstantDeclaration _ (UnguardedRhs (Lambda args _)) _) = argsHaveArity args+        f _  = False++        equationHasArity = \(Equation args _ _) -> argsHaveArity args++        argsHaveArity args = length args == arity++hasTypeDeclaration :: Inspection+hasTypeDeclaration binding = hasDecl f+  where f (TypeAlias name) = binding == name+        f _                   = False++hasTypeSignature :: Inspection+hasTypeSignature binding = hasDecl f+  where f (TypeSignature name)  = binding == name+        f _                       = False++hasAnonymousVariable :: Inspection+hasAnonymousVariable binding = has f (declsOf binding)+  where f (FunctionDeclaration _ equations)    = any (any (== WildcardPattern) . p) equations+        f _                        = False+        p (Equation params _ _) = params++hasExpression :: (Expression -> Bool) -> Inspection+hasExpression f binding = has f (expressionsOf binding)++hasRhs :: (Rhs -> Bool)-> Inspection+hasRhs f binding = has f (rhssOf binding)++hasDecl :: (Declaration -> Bool) -> GlobalInspection+hasDecl f = has f parseDecls++-- private++has f g = any f . g+++
+ src/Language/Mulang/Inspector/Combiner.hs view
@@ -0,0 +1,18 @@+module Language.Mulang.Inspector.Combiner (+  detect,+  negative,+  transitive) where++import Language.Mulang+import Language.Mulang.Inspector+import Language.Mulang.Explorer++detect :: Inspection -> Program -> [Binding]+detect inspection code = filter (`inspection` code) $ parseBindings code++negative :: Inspection -> Inspection+negative f code = not . f code++transitive :: Inspection -> Inspection+transitive inspection binding code = inspection binding code || inUsage+  where inUsage = any (`inspection` code) . transitiveBindingsOf binding $ code
+ src/Language/Mulang/Inspector/Smell.hs view
@@ -0,0 +1,54 @@+module Language.Mulang.Inspector.Smell (+  hasRedundantBooleanComparison,+  hasRedundantIf,+  hasRedundantGuards,+  hasRedundantLambda,+  hasRedundantParameter) where++import Language.Mulang+import Language.Mulang.Explorer+import Language.Mulang.Inspector+++-- | Inspection that tells whether a binding has expressions like 'x == True'+hasRedundantBooleanComparison :: Inspection+hasRedundantBooleanComparison = hasExpression f+  where f (InfixApplication x c y) = any isBooleanLiteral [x, y] && isComp c+        f _ = False++        isComp c = c == "==" || c == "/="++-- | Inspection that tells whether a binding has an if expression where both branches return+-- boolean literals+hasRedundantIf :: Inspection+hasRedundantIf = hasExpression f+  where f (If _ x y) = all isBooleanLiteral [x, y]+        f _            = False+++-- | Inspection that tells whether a binding has guards where both branches return+-- boolean literals+hasRedundantGuards :: Inspection+hasRedundantGuards = hasRhs f -- TODO not true when condition is a pattern+  where f (GuardedRhss [+            GuardedRhs _ x,+            GuardedRhs (Variable "otherwise") y]) = all isBooleanLiteral [x, y]+        f _ = False+++-- | Inspection that tells whether a binding has lambda expressions like '\x -> g x'+hasRedundantLambda :: Inspection+hasRedundantLambda = hasExpression f+  where f (Lambda [VariablePattern (x)] (Application _ (Variable (y)))) = x == y+        f _ = False -- TODO consider parenthesis and symbols++-- | Inspection that tells whether a binding has parameters that+-- can be avoided using point-free+hasRedundantParameter :: Inspection+hasRedundantParameter binding = any f . declsOf binding+  where f (FunctionDeclaration _ [+             Equation params (UnguardedRhs (Application _ (Variable arg))) _ ]) | (VariablePattern param) <- last params = param == arg+        f _ = False++isBooleanLiteral (Literal (MuBool _)) = True+isBooleanLiteral _                  = False
+ src/Language/Mulang/Parsers/Haskell.hs view
@@ -0,0 +1,98 @@+module Language.Mulang.Parsers.Haskell (parseHaskell) where++import Language.Mulang+import Language.Haskell.Syntax+import Language.Haskell.Parser++import Data.String (IsString(..))+import Data.Maybe (fromJust)+import Data.List (intercalate)++instance IsString Program where+  fromString = fromJust.parseHaskell++parseHaskell :: String -> Maybe Program+parseHaskell code | ParseOk ast <- parseModule code = Just (mu ast)+                  | otherwise = Nothing++mu :: HsModule -> Program+mu (HsModule _ _ _ _ decls) = (Program (concatMap muDecls decls))+  where+    muDecls (HsTypeDecl _ name _ _)      = [TypeAlias (muName name)]+    muDecls (HsDataDecl _ _ name _ _ _ ) = [RecordDeclaration (muName name)]+    muDecls (HsTypeSig _ names _) = map (\name -> TypeSignature (muName name)) names+    muDecls (HsFunBind equations) | (HsMatch _ name _ _ _) <- head equations =+                                        [FunctionDeclaration (muName name) (map muEquation equations)]+    muDecls (HsPatBind _ (HsPVar name) rhs decls) = [ConstantDeclaration (muName name) (muRhs rhs) (concatMap muDecls decls)]+    muDecls _ = []++    muEquation :: HsMatch -> Equation+    muEquation (HsMatch _ _ patterns rhs locals) =+         Equation (map muPat patterns) (muRhs rhs) (concatMap muDecls locals)++    muRhs (HsUnGuardedRhs exp)          = UnguardedRhs (muExp exp)+    muRhs (HsGuardedRhss  guards) = GuardedRhss (map muGuardedRhs guards)++    muGuardedRhs (HsGuardedRhs _ condition body) = (GuardedRhs (muExp condition) (muExp body))++    muPat (HsPVar name) = VariablePattern (muName name)                 -- ^ variable+    muPat (HsPLit _) = LiteralPattern ""              -- ^ literal constant+    --Pattern HsPInfixApp = InfixApplicationPattern Pattern MuQName Pattern+    --Pattern HsPApp = ApplicationPattern MuQName [Pattern]        -- ^ data constructor and argument+    muPat (HsPTuple elements) = TuplePattern (map muPat elements)+    muPat (HsPList elements) = ListPattern (map muPat elements)+    muPat (HsPParen pattern) = muPat pattern+    --Pattern HsPAsPat = AsPattern String Pattern+    muPat HsPWildCard = WildcardPattern+    muPat _ = OtherPattern++    muExp (HsVar name) = Variable (muQName name)+    muExp (HsCon (UnQual (HsIdent "True")))  = Literal (MuBool True)+    muExp (HsCon (UnQual (HsIdent "False"))) = Literal (MuBool False)+    muExp (HsCon name)                       = Variable (muQName name)+    muExp (HsLit lit) = Literal (muLit lit)+    muExp (HsInfixApp e1 op e2) = InfixApplication (muExp e1) (muQOp op) (muExp e2)  -- ^ infix application+    muExp (HsApp e1 e2) = Application (muExp e1) (muExp e2)             -- ^ ordinary application+    muExp (HsNegApp e) = Application (Variable "-") (muExp e)+    muExp (HsLambda _ args exp) = Lambda (map muPat args) (muExp exp)+    --muExp HsLet = Let [Declaration] Expression          -- ^ local declarations with @let@+    muExp (HsIf e1 e2 e3) = If (muExp e1) (muExp e2) (muExp e3)+    --muExp HsMatch = Match Expression [Alternative]          -- ^ @case@ /exp/ @of@ /alts/+    muExp (HsTuple elements) = MuTuple (map muExp elements)               -- ^ tuple Expression+    muExp (HsList elements) = MuList (map muExp elements)+    muExp (HsParen e) = (muExp e)+    muExp (HsEnumFrom from)              = Application (Variable "enumFrom") (muExp from)+    muExp (HsEnumFromTo from to)         = Application (Application (Variable "enumFromTo") (muExp from)) (muExp to)+    muExp (HsEnumFromThen from thn)      = Application (Application (Variable "enumFromThen") (muExp from)) (muExp thn)+    muExp (HsEnumFromThenTo from thn to) = Application (Application (Application (Variable "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 _ = ExpressionOther++    muLit (HsChar        v) = MuString [v]+    muLit (HsString      v) = MuString v+    muLit (HsInt         v) = MuInteger v+    muLit (HsFrac        v) = MuFloat v+    muLit (HsCharPrim    v) = MuString [v]+    muLit (HsStringPrim  v) = MuString v+    muLit (HsIntPrim     v) = MuInteger v+    muLit (HsFloatPrim   v) = MuFloat v+    muLit (HsDoublePrim  v) = MuFloat v++    muName :: HsName -> String+    muName (HsSymbol n) = n+    muName (HsIdent  n) = n++    muQName (Qual _ n) = muName n+    muQName (UnQual n) = muName n+    muQName (Special HsUnitCon) = "()"+    muQName (Special HsListCon) = "[]"+    muQName (Special HsFunCon) =  "->"+    muQName (Special (HsTupleCon times)) =  intercalate "" . replicate times $ ","+    muQName (Special (HsCons)) =  ":"++    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)
+ src/Language/Mulang/Parsers/Json.hs view
@@ -0,0 +1,46 @@+module Language.Mulang.Parsers.Json (parseJson) where++import Language.Mulang++import Data.Aeson++import qualified Data.ByteString.Lazy.Char8 as LBS (pack)++parseJson :: String -> Maybe Program+parseJson  = decode . LBS.pack++instance FromJSON Program+instance ToJSON Program++instance FromJSON Declaration+instance ToJSON Declaration++instance FromJSON Equation+instance ToJSON Equation++instance FromJSON Rhs+instance ToJSON Rhs++instance FromJSON GuardedRhs+instance ToJSON GuardedRhs++instance FromJSON Expression+instance ToJSON Expression++instance FromJSON Pattern+instance ToJSON Pattern++instance FromJSON ComprehensionStatement+instance ToJSON ComprehensionStatement++instance FromJSON Alternative+instance ToJSON Alternative++instance FromJSON GuardedAlternatives+instance ToJSON GuardedAlternatives++instance FromJSON GuardedAlternative+instance ToJSON GuardedAlternative++instance FromJSON LiteralValue+instance ToJSON LiteralValue