Merge remote-tracking branch 'origin/master' into classes

semantic.cabal

@@ -38,8 +38,8 @@ library
                      -- Control flow
                      , Control.Effect
                      -- Effects used for program analysis
-                     , Control.Monad.Effect.Fresh
-                     , Control.Monad.Effect.NonDet
+                     , Control.Effect.Fresh
+                     , Control.Effect.NonDet
                      -- Datatypes for abstract interpretation
                      , Data.Abstract.Address
                      , Data.Abstract.Cache
@@ -263,8 +263,10 @@ test-suite doctests
   hs-source-dirs:      test
   main-is:             Doctests.hs
   default-language:    Haskell2010
+  ghc-options:         -dynamic -threaded -j
   build-depends:       base
                      , doctest
+                     , QuickCheck
 
 benchmark evaluation
   hs-source-dirs: bench

src/Analysis/Abstract/Evaluating.hs

@@ -8,8 +8,6 @@ module Analysis.Abstract.Evaluating
 import Control.Abstract.Evaluator
 import Control.Monad.Effect hiding (run)
 import Control.Monad.Effect.Fail
-import Control.Monad.Effect.Fresh
-import Control.Monad.Effect.NonDet
 import Control.Monad.Effect.Reader
 import Control.Monad.Effect.State
 import Data.Abstract.Configuration

src/Assigning/Assignment.hs

@@ -37,9 +37,7 @@
 --
 --   Assignments can represent alternatives as either committed or uncommitted choices, both written with '<|>'. “Committed” in this context means that a failure in one of the alternatives will not result in backtracking followed by an attempt of one of the other alternatives; thus, committed choice is more efficient. (By the same token, it enables much better error messages since backtracking erases most of the relevant context.) Committed choices are constructed via the following rules:
 --
---   1. 'empty' is dropped from choices:
---   prop> empty <|> a = a -- empty is the left-identity of <|>
---   prop> a <|> empty = a -- empty is the right-identity of <|>
+--   1. 'empty' is dropped from choices.
 --
 --   2. 'symbol' rules construct a committed choice (with only a single alternative).
 --

src/Control/Abstract/Analysis.hs

@@ -14,10 +14,10 @@ module Control.Abstract.Analysis
 
 import Control.Abstract.Evaluator as X
 import Control.Effect as X
+import Control.Effect.Fresh as X
+import Control.Effect.NonDet as X
 import qualified Control.Monad.Effect as Effect
 import Control.Monad.Effect.Fail as X
-import Control.Monad.Effect.Fresh as X
-import Control.Monad.Effect.NonDet as X
 import Control.Monad.Effect.Reader as X
 import Control.Monad.Effect.State as X
 import Data.Abstract.Environment (Environment)

src/Control/Abstract/Value.hs

@@ -80,7 +80,7 @@ class (Monad m, Show value) => MonadValue value m where
   -- | Construct an array of zero or more values.
   array :: [value] -> m value
 
--- | Extract a 'ByteString' from a given value.
+  -- | Extract a 'ByteString' from a given value.
   asString :: value -> m ByteString
 
   -- | Eliminate boolean values. TODO: s/boolean/truthy

src/Control/Effect/Fresh.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE GADTs, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
-module Control.Monad.Effect.Fresh where
+module Control.Effect.Fresh where
 
 import Control.Effect
 import Control.Monad.Effect.Internal

src/Control/Effect/NonDet.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE TypeFamilies, TypeOperators, UndecidableInstances #-}
-module Control.Monad.Effect.NonDet
+module Control.Effect.NonDet
 ( MonadNonDet(..)
 , NonDetEff
 ) where

src/Data/Range.hs

@@ -36,6 +36,13 @@ subtractRange range1 range2 = Range (start range1) (end range1 - rangeLength (Ra
 
 -- Instances
 
+-- $setup
+-- >>> import Test.QuickCheck
+-- >>> instance Arbitrary Range where arbitrary = Range <$> arbitrary <*> arbitrary
+
+-- $
+-- Associativity:
+-- prop> \ a b c -> a <> (b <> c) == (a <> b) <> (c :: Range)
 instance Semigroup Range where
   Range start1 end1 <> Range start2 end2 = Range (min start1 start2) (max end1 end2)
 

src/Data/Syntax/Expression.hs

@@ -59,7 +59,6 @@ instance Eq1 Arithmetic where liftEq = genericLiftEq
 instance Ord1 Arithmetic where liftCompare = genericLiftCompare
 instance Show1 Arithmetic where liftShowsPrec = genericLiftShowsPrec
 
--- TODO: Implement Eval instance for Arithmetic
 instance Evaluatable Arithmetic where
   eval = traverse subtermValue >=> go where
     go (Plus a b)      = liftNumeric2 add a b  where add    = liftReal (+)
@@ -70,6 +69,19 @@ instance Evaluatable Arithmetic where
     go (Power a b)     = liftNumeric2 liftedExponent a b
     go (Negate a)      = liftNumeric negate a
 
+-- | Regex matching operators (Ruby's =~ and ~!)
+data Match a
+  = Matches !a !a
+  | NotMatches !a !a
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
+
+instance Eq1 Match where liftEq = genericLiftEq
+instance Ord1 Match where liftCompare = genericLiftCompare
+instance Show1 Match where liftShowsPrec = genericLiftShowsPrec
+
+-- TODO: Implement Eval instance for Match
+instance Evaluatable Match
+
 -- | Boolean operators.
 data Boolean a
   = Or !a !a

src/Language/Ruby/Assignment.hs

@@ -36,6 +36,7 @@ type Syntax = '[
   , Expression.Call
   , Expression.Comparison
   , Expression.Enumeration
+  , Expression.Match
   , Expression.MemberAccess
   , Expression.ScopeResolution
   , Expression.Subscript
@@ -368,7 +369,6 @@ unary = symbol Unary >>= \ location ->
   <|> children ( symbol AnonPlus *> expression )
 
 -- TODO: Distinguish `===` from `==` ?
--- TODO: Distinuish `=~` and `!~` ?
 binary :: Assignment
 binary = makeTerm' <$> symbol Binary <*> children (infixTerm expression expression
   [ (inj .) . Expression.Plus             <$ symbol AnonPlus
@@ -382,8 +382,8 @@ binary = makeTerm' <$> symbol Binary <*> children (infixTerm expression expressi
   , (inj .) . Expression.Or               <$ (symbol AnonOr <|> symbol AnonPipePipe)
   , (inj .) . Expression.BOr              <$ symbol AnonPipe
   , (inj .) . Expression.BXOr             <$ symbol AnonCaret
-  , (inj .) . Expression.Equal            <$ (symbol AnonEqualEqual <|> symbol AnonEqualEqualEqual <|> symbol AnonEqualTilde)
-  , (inj .) . invert Expression.Equal     <$ (symbol AnonBangEqual <|> symbol AnonBangTilde)
+  , (inj .) . Expression.Equal            <$ (symbol AnonEqualEqual <|> symbol AnonEqualEqualEqual)
+  , (inj .) . invert Expression.Equal     <$ symbol AnonBangEqual
   , (inj .) . Expression.LShift           <$ symbol AnonLAngleLAngle
   , (inj .) . Expression.RShift           <$ symbol AnonRAngleRAngle
   , (inj .) . Expression.Comparison       <$ symbol AnonLAngleEqualRAngle
@@ -391,6 +391,8 @@ binary = makeTerm' <$> symbol Binary <*> children (infixTerm expression expressi
   , (inj .) . Expression.GreaterThan      <$ symbol AnonRAngle
   , (inj .) . Expression.LessThanEqual    <$ symbol AnonLAngleEqual
   , (inj .) . Expression.GreaterThanEqual <$ symbol AnonRAngleEqual
+  , (inj .) . Expression.Matches          <$ symbol AnonEqualTilde
+  , (inj .) . Expression.NotMatches       <$ symbol AnonBangTilde
   ])
   where invert cons a b = Expression.Not (makeTerm1 (cons a b))
 

test/Doctests.hs

@@ -6,10 +6,9 @@ import System.Environment
 import Test.DocTest
 
 main :: IO ()
-main = getArgs >>= run
-
-run :: [String] -> IO ()
-run args = doctest (map ("-X" ++) extensions ++ args ++ ["-isrc"] ++ sources)
+main = do
+  args <- getArgs
+  doctest (map ("-X" ++) extensions ++ "-isrc" : "--fast" : if null args then ["src"] else args)
 
 extensions :: [String]
 extensions =
@@ -23,8 +22,3 @@ extensions =
   , "RecordWildCards"
   , "StrictData"
   ]
-
-sources :: [String]
-sources =
-  [ "src/Data/Abstract/Environment.hs"
-  ]

test/fixtures/ruby/relational-operator.diffA-B.txt

@@ -1,18 +1,20 @@
 (Program
-{+(Comparison
+{(Equal
+  {-(Identifier)-}
+  {-(Identifier)-})
+->(Comparison
+  {+(Identifier)+}
+  {+(Identifier)+}) }
+{+(Matches
   {+(Identifier)+}
   {+(Identifier)+})+}
-  (Equal
-    (Identifier)
-    (Identifier))
 {+(Assignment
   {+(Identifier)+}
-  {+(Not
-    {+(Identifier)+})+})+}
+  {+(Not{+(Identifier)+})+})+}
 {-(Not
   {-(Equal
     {-(Identifier)-}
     {-(Identifier)-})-})-}
 {-(Equal
   {-(Identifier)-}
-  {-(Identifier)-})-})
+  {-(Identifier)-})- })

test/fixtures/ruby/relational-operator.diffB-A.txt

@@ -1,10 +1,10 @@
 (Program
-{-(Comparison
+{(Comparison
   {-(Identifier)-}
-  {-(Identifier)-})-}
-  (Equal
-    (Identifier)
-    (Identifier))
+  {-(Identifier)-})
+->(Equal
+  {+(Identifier)+}
+  {+(Identifier)+}) }
 {+(Not
   {+(Equal
     {+(Identifier)+}
@@ -12,7 +12,9 @@
 {+(Equal
   {+(Identifier)+}
   {+(Identifier)+})+}
+{-(Matches
+  {-(Identifier)-}
+  {-(Identifier)-})-}
 {-(Assignment
   {-(Identifier)-}
-  {-(Not
-    {-(Identifier)-})-})-})
+  {-(Not{-(Identifier)-})-})- })

test/fixtures/ruby/relational-operator.parseB.txt

@@ -2,7 +2,7 @@
   (Comparison
     (Identifier)
     (Identifier))
-  (Equal
+  (Matches
     (Identifier)
     (Identifier))
   (Assignment