github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
Code Issues Projects Releases Wiki Activity

Address Rob's changes.

Browse Source
This commit is contained in:
Patrick Thomson 2018-03-14 10:36:56 -04:00
parent 0d248e2aab
commit 81aab6572e
6 changed files with 136 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
semantic.cabal
View File

@ -49,6 +49,7 @@ library
, Data.Abstract.FreeVariables
, Data.Abstract.Live
, Data.Abstract.ModuleTable
, Data.Abstract.Number
, Data.Abstract.Store
, Data.Abstract.Type
, Data.Abstract.Value

51
src/Control/Abstract/Value.hs
View File

@ -5,6 +5,7 @@ import Control.Abstract.Addressable
import Control.Abstract.Analysis
import Data.Abstract.Environment
import Data.Abstract.FreeVariables
import Data.Abstract.Number as Number
import Data.Abstract.Type as Type
import Data.Abstract.Value as Value
import qualified Data.Map as Map
@ -117,14 +118,14 @@ instance ( MonadAddressable location (Value location term) m
)
=> MonadValue term (Value location term) m where
unit = pure . injValue $ Value.Unit
integer = pure . injValue . Integer . Whole
boolean = pure . injValue . Boolean
string = pure . injValue . Value.String
float = pure . injValue . Value.Float . Decim
unit = pure . injValue $ Value.Unit
integer = pure . injValue . Value.Integer . Number.Integer
boolean = pure . injValue . Boolean
string = pure . injValue . Value.String
float = pure . injValue . Value.Float . Decimal
rational = pure . injValue . Value.Rational . Ratio
multiple vals =
pure . injValue $ Value.Tuple vals
multiple = pure . injValue . Value.Tuple
interface v = do
-- TODO: If the set of exports is empty because no exports have been
@ -140,38 +141,38 @@ instance ( MonadAddressable location (Value location term) m
| otherwise = fail ("not defined for non-boolean conditions: " <> show cond)
liftNumeric f arg
| Just (Integer (Whole i)) <- prjValue arg = integer $ f i
| Just (Value.Float (Decim d)) <- prjValue arg = float $ f d
| Just (Value.Rational (Ratio r)) <- prjValue arg = rational $ f r
| Just (Value.Integer (Number.Integer i)) <- prjValue arg = integer $ f i
| Just (Value.Float (Decimal d)) <- prjValue arg = float $ f d
| Just (Value.Rational (Ratio r)) <- prjValue arg = rational $ f r
| otherwise = fail ("Invalid operand to liftNumeric: " <> show arg)
liftNumeric2 f left right
| Just (Integer i, Integer j) <- prjPair pair = f i j & specialize
| Just (Integer i, Value.Rational j) <- prjPair pair = f i j & specialize
| Just (Integer i, Value.Float j) <- prjPair pair = f i j & specialize
| Just (Value.Rational i, Integer j) <- prjPair pair = f i j & specialize
| Just (Value.Integer i, Value.Integer j) <- prjPair pair = f i j & specialize
| Just (Value.Integer i, Value.Rational j) <- prjPair pair = f i j & specialize
| Just (Value.Integer i, Value.Float j) <- prjPair pair = f i j & specialize
| Just (Value.Rational i, Value.Integer j) <- prjPair pair = f i j & specialize
| Just (Value.Rational i, Value.Rational j) <- prjPair pair = f i j & specialize
| Just (Value.Rational i, Value.Float j) <- prjPair pair = f i j & specialize
| Just (Value.Float i, Integer j) <- prjPair pair = f i j & specialize
| Just (Value.Float i, Value.Integer j) <- prjPair pair = f i j & specialize
| Just (Value.Float i, Value.Rational j) <- prjPair pair = f i j & specialize
| Just (Value.Float i, Value.Float j) <- prjPair pair = f i j & specialize
| otherwise = fail ("Invalid operands to liftNumeric2: " <> show pair)
where
-- Dispatch whatever's contained inside a 'SomeNumber' to its appropriate 'MonadValue' ctor
specialize :: MonadValue term value m => SomeNumber -> m value
specialize (SomeNumber (Whole i)) = integer i
specialize (SomeNumber (Ratio r)) = rational r
specialize (SomeNumber (Decim d)) = float d
specialize (SomeNumber (Number.Integer i)) = integer i
specialize (SomeNumber (Ratio r)) = rational r
specialize (SomeNumber (Decimal d)) = float d
pair = (left, right)
liftComparison comparator left right
| Just (Integer (Whole i), Integer (Whole j)) <- prjPair pair = go i j
| Just (Integer (Whole i), Value.Float (Decim j)) <- prjPair pair = go (fromIntegral i) j
| Just (Value.Float (Decim i), Integer (Whole j)) <- prjPair pair = go i (fromIntegral j)
| Just (Value.Float (Decim i), Value.Float (Decim j)) <- prjPair pair = go i j
| Just (Value.String i, Value.String j) <- prjPair pair = go i j
| Just (Boolean i, Boolean j) <- prjPair pair = go i j
| Just (Value.Unit, Value.Unit) <- prjPair pair = boolean True
| Just (Value.Integer (Number.Integer i), Value.Integer (Number.Integer j)) <- prjPair pair = go i j
| Just (Value.Integer (Number.Integer i), Value.Float (Decimal j)) <- prjPair pair = go (fromIntegral i) j
| Just (Value.Float (Decimal i), Value.Integer (Number.Integer j)) <- prjPair pair = go i (fromIntegral j)
| Just (Value.Float (Decimal i), Value.Float (Decimal j)) <- prjPair pair = go i j
| Just (Value.String i, Value.String j) <- prjPair pair = go i j
| Just (Boolean i, Boolean j) <- prjPair pair = go i j
| Just (Value.Unit, Value.Unit) <- prjPair pair = boolean True
| otherwise = fail ("Type error: invalid arguments to liftComparison: " <> show pair)
where
-- Explicit type signature is necessary here because we're passing all sorts of things

98
src/Data/Abstract/Number.hs Normal file
View File

@ -0,0 +1,98 @@
{-# LANGUAGE GADTs, StandaloneDeriving, Rank2Types #-}
module Data.Abstract.Number
( Number (..)
, SomeNumber (..)
, liftReal
, liftIntegralFrac
, liftedExponent
) where
import Data.Scientific
import qualified Prelude
import Prelude hiding (Integer)
import Prologue
-- | A generalized number type that unifies all interpretable numeric types.
-- This is a GADT, so you can specialize the 'a' parameter and be confident
-- that, say, a @Number Scientific@ contains a 'Scientific' and not an integer
-- in disguise. This unified type is used to provide mathematical operations
-- that can change their representation based on an operation's operands—e.g.
-- raising a rational number to a ratio may not produce another rational number.
-- This also neatly encapsulates the "coalescing" behavior of adding numbers
-- of different type in dynamic languages: operating on a whole and a rational
-- produces a rational, operating on a rational and a decimal produces a decimal,
-- and so on and so forth. When we add complex numbers, they will in turn subsume
-- the other numeric types.
data Number a where
Integer :: !Prelude.Integer -> Number Prelude.Integer
Ratio :: !Prelude.Rational -> Number Prelude.Rational
Decimal :: !Scientific -> Number Scientific
deriving instance Eq a => Eq (Number a)
instance Show (Number a) where
show (Integer i) = show i
show (Ratio r) = show r
show (Decimal d) = show d
-- | Every 'Number' can be coerced to a 'Scientific'. Used in the 'Ord' instance.
toScientific :: Number a -> Scientific
toScientific (Integer i) = fromInteger i
toScientific (Ratio r) = fromRational r
toScientific (Decimal s) = s
instance Eq a => Ord (Number a) where compare = compare `on` toScientific
-- | A box that hides the @a@ parameter to a given 'Number'. Pattern-match
-- on it to extract the information contained; because there are only three
-- possible constructors, pattern-matching all three cases is possible.
data SomeNumber = forall a . SomeNumber (Number a)
-- | Smart constructors for 'SomeNumber'.
whole :: Prelude.Integer -> SomeNumber
whole = SomeNumber . Integer
ratio :: Prelude.Rational -> SomeNumber
ratio = SomeNumber . Ratio
decim :: Scientific -> SomeNumber
decim = SomeNumber . Decimal
-- | In order to provide truly generic math operations, where functions like
-- exponentiation handle the fact that they are not closed over the rational
-- numbers, we must promote standard Haskell math functions from operations
-- on 'Real', 'Integral', and 'Fractional' numbers into functions that operate
-- on two 'Number' values and return a temporarily-indeterminate 'SomeNumber'
-- value. At the callsite, we can then unwrap the 'SomeNumber' and handle the
-- specific cases.
--
-- Promote a function on 'Real' values into one operating on 'Number's.
-- You pass things like @+@ and @-@ here.
liftReal :: (forall n . Real n => n -> n -> n)
-> (Number a -> Number b -> SomeNumber)
liftReal f = liftIntegralFrac f f
-- | Promote two functions, one on 'Integral' and one on 'Fractional' and 'Real' values,
-- to operate on 'Numbers'. Examples of this: 'mod' and 'mod'', 'div' and '/'.
liftIntegralFrac :: (forall n . Integral n => n -> n -> n)
-> (forall f . (Fractional f, Real f) => f -> f -> f)
-> (Number a -> Number b -> SomeNumber)
liftIntegralFrac f _ (Integer i) (Integer j) = whole (f i j)
liftIntegralFrac _ g (Integer i) (Ratio j) = ratio (g (toRational i) j)
liftIntegralFrac _ g (Integer i) (Decimal j) = decim (g (fromIntegral i) j)
liftIntegralFrac _ g (Ratio i) (Ratio j) = ratio (g i j)
liftIntegralFrac _ g (Ratio i) (Integer j) = ratio (g i (fromIntegral j))
liftIntegralFrac _ g (Ratio i) (Decimal j) = decim (g (fromRational i) j)
liftIntegralFrac _ g (Decimal i) (Integer j) = decim (g i (fromIntegral j))
liftIntegralFrac _ g (Decimal i) (Ratio j) = decim (g i (fromRational j))
liftIntegralFrac _ g (Decimal i) (Decimal j) = decim (g i j)
-- | Exponential behavior is too hard to generalize, so here's a manually implemented version.
-- TODO: Given a 'Ratio' raised to some 'Integer', we could check to see if it's an integer
-- and round it before the exponentiation, giving back a 'Integer'.
liftedExponent :: Number a -> Number b -> SomeNumber
liftedExponent (Integer i) (Integer j) = whole (i ^ j)
liftedExponent (Ratio i) (Integer j) = ratio (i ^^ j)
liftedExponent i j = decim (fromFloatDigits ((munge i) ** (munge j)))
where munge = (toRealFloat . toScientific) :: Number a -> Double

75
src/Data/Abstract/Value.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE ConstraintKinds, DataKinds, FunctionalDependencies, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators #-}
{-# LANGUAGE ConstraintKinds, DataKinds, FunctionalDependencies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
module Data.Abstract.Value where
import Data.Abstract.Address
@ -6,9 +6,10 @@ import Data.Abstract.Environment
import Data.Abstract.Store
import Data.Abstract.FreeVariables
import Data.Abstract.Live
import Data.Abstract.Number
import qualified Data.Abstract.Type as Type
import qualified Data.Set as Set
import Data.Scientific (Scientific, toRealFloat, fromFloatDigits)
import Data.Scientific (Scientific)
import Prologue
import Prelude hiding (Float, Integer, String, Rational, fail)
import qualified Prelude
@ -44,75 +45,7 @@ prjPair :: ( f :< ValueConstructors loc term1 , g :< ValueConstructors loc term2
-> Maybe (f (Value loc term1), g (Value loc term2))
prjPair = bitraverse prjValue prjValue
-- | A generalized number type that unifies all interpretable numeric types.
-- This is a GADT, so you can specialize the 'a' parameter and be confident
-- that, say, a @Number Scientific@ contains a 'Scientific' and not an integer
-- in disguise.
data Number a where
Whole :: !Prelude.Integer -> Number Prelude.Integer
Ratio :: !Prelude.Rational -> Number Prelude.Rational
Decim :: !Scientific -> Number Scientific
deriving instance Eq a => Eq (Number a)
instance Show (Number a) where
show (Whole i) = show i
show (Ratio r) = show r
show (Decim d) = show d
-- | Every 'Number' can be coerced to a 'Scientific'. Used in the 'Ord' instance.
collapse :: Number a -> Scientific
collapse (Whole i) = fromInteger i
collapse (Ratio r) = fromRational r
collapse (Decim s) = s
instance Eq a => Ord (Number a) where compare = compare `on` collapse
-- | A box that hides the @a@ parameter to a given 'Number'. Pattern-match
-- on it to extract the information contained.
data SomeNumber = forall a . SomeNumber (Number a)
-- | Smart constructors for 'SomeNumber'.
whole :: Prelude.Integer -> SomeNumber
whole = SomeNumber . Whole
ratio :: Prelude.Rational -> SomeNumber
ratio = SomeNumber . Ratio
decim :: Scientific -> SomeNumber
decim = SomeNumber . Decim
-- | Promote a function on 'Real' values into one operating on 'Number's.
-- You pass things like @+@ and @-@ here.
liftSimple :: (forall n . Real n => n -> n -> n)
-> (Number a -> Number b -> SomeNumber)
liftSimple f = liftThorny f f
-- | Promote two functions, one on 'Integral' and one on 'Fractional' and 'Real' values,
-- to operate on 'Numbers'. Examples of this: 'mod' and 'mod'', 'div' and '/'.
liftThorny :: (forall n . Integral n => n -> n -> n)
-> (forall f . (Fractional f, Real f) => f -> f -> f)
-> (Number a -> Number b -> SomeNumber)
liftThorny f _ (Whole i) (Whole j) = whole (f i j)
liftThorny _ g (Whole i) (Ratio j) = ratio (g (toRational i) j)
liftThorny _ g (Whole i) (Decim j) = decim (g (fromIntegral i) j)
liftThorny _ g (Ratio i) (Ratio j) = ratio (g i j)
liftThorny _ g (Ratio i) (Whole j) = ratio (g i (fromIntegral j))
liftThorny _ g (Ratio i) (Decim j) = decim (g (fromRational i) j)
liftThorny _ g (Decim i) (Whole j) = decim (g i (fromIntegral j))
liftThorny _ g (Decim i) (Ratio j) = decim (g i (fromRational j))
liftThorny _ g (Decim i) (Decim j) = decim (g i j)
-- | Exponential behavior is too hard to generalize, so here's a manually implemented version.
-- TODO: Given a 'Ratio' raised to some 'Whole', we could check to see if it's an integer
-- and round it before the exponentiation, giving back a 'Whole'.
safeExp :: Number a -> Number b -> SomeNumber
safeExp (Whole i) (Whole j) = whole (i ^ j)
safeExp (Ratio i) (Whole j) = ratio (i ^^ j)
safeExp i j = decim (fromFloatDigits ((munge i) ** (munge j)))
where munge = (toRealFloat . collapse) :: Number a -> Double
-- TODO: Parameerize Value by the set of constructors s.t. each language can have a distinct value union.
-- TODO: Parameterize Value by the set of constructors s.t. each language can have a distinct value union.
-- | A function value consisting of a list of parameters, the body of the function, and an environment of bindings captured by the body.
data Closure location term value = Closure [Name] term (Environment location value)

14
src/Data/Syntax/Expression.hs
View File

@ -2,11 +2,11 @@
module Data.Syntax.Expression where
import Data.Abstract.Evaluatable
import Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent)
import Data.Fixed
import Diffing.Algorithm
import Prelude hiding (fail)
import Prologue hiding (apply)
import Data.Abstract.Value (liftThorny, liftSimple, safeExp)
-- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell.
data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a], callBlock :: !a }
@ -62,12 +62,12 @@ 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 = liftSimple (+)
go (Minus a b) = liftNumeric2 sub a b where sub = liftSimple (-)
go (Times a b) = liftNumeric2 mul a b where mul = liftSimple (*)
go (DividedBy a b) = liftNumeric2 div' a b where div' = liftThorny div (/)
go (Modulo a b) = liftNumeric2 mod'' a b where mod'' = liftThorny mod mod'
go (Power a b) = liftNumeric2 safeExp a b
go (Plus a b) = liftNumeric2 add a b where add = liftReal (+)
go (Minus a b) = liftNumeric2 sub a b where sub = liftReal (-)
go (Times a b) = liftNumeric2 mul a b where mul = liftReal (*)
go (DividedBy a b) = liftNumeric2 div' a b where div' = liftIntegralFrac div (/)
go (Modulo a b) = liftNumeric2 mod'' a b where mod'' = liftIntegralFrac mod mod'
go (Power a b) = liftNumeric2 liftedExponent a b
go (Negate a) = liftNumeric negate a
-- | Boolean operators.

1
src/Data/Syntax/Literal.hs
View File

@ -105,7 +105,6 @@ instance Eq1 Data.Syntax.Literal.Rational where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Literal.Rational where liftCompare = genericLiftCompare
instance Show1 Data.Syntax.Literal.Rational where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Rational
instance Evaluatable Data.Syntax.Literal.Rational where
eval (Rational r) = let trimmed = B.takeWhile (/= 'r') r in
case readMaybe @Prelude.Integer (unpack trimmed) of