github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-04 13:34:31 +03:00
Code Issues Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into while-evaluation

Browse Source
This commit is contained in:
Patrick Thomson 2018-03-13 12:33:20 -04:00
commit bbda9bdbbc
2 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -85,10 +85,6 @@ class (MonadAnalysis term value m, Show value) => MonadValue term value m where
toBool :: MonadValue term value m => value -> m Bool
toBool v = ifthenelse v (pure True) (pure False)
-- | As with 'toBool', except from a given 'Subterm'.
evalToBool :: MonadValue term value m => Subterm t (m value) -> m Bool
evalToBool = subtermValue >=> toBool
-- | The fundamental looping primitive, built on top of ifthenelse.
while :: MonadValue term value m => m value -> m value -> m value
while cond body = do
@ -127,14 +123,14 @@ instance ( MonadAddressable location (Value location term) m
liftNumeric f arg
| Just (Integer i) <- prjValue arg = pure . injValue . Integer $ f i
| Just (Value.Float i) <- prjValue arg = pure . injValue . Value.Float $ f i
| otherwise = fail "Invalid operand to liftNumeric"
| otherwise = fail ("Invalid operand to liftNumeric: " <> show arg)
liftNumeric2 f g left right
| Just (Integer i, Integer j) <- au pair = pure . injValue . Integer $ g i j
| Just (Integer i, Value.Float j) <- au pair = pure . injValue . float $ f (fromIntegral i) (munge j)
| Just (Value.Float i, Value.Float j) <- au pair = pure . injValue . float $ f (munge i) (munge j)
| Just (Value.Float i, Integer j) <- au pair = pure . injValue . float $ f (munge i) (fromIntegral j)
| otherwise = fail "Invalid operands to liftNumeric2"
| Just (Integer i, Integer j) <- prjPair pair = pure . injValue . Integer $ g i j
| Just (Integer i, Value.Float j) <- prjPair pair = pure . injValue . float $ f (fromIntegral i) (munge j)
| Just (Value.Float i, Value.Float j) <- prjPair pair = pure . injValue . float $ f (munge i) (munge j)
| Just (Value.Float i, Integer j) <- prjPair pair = pure . injValue . float $ f (munge i) (fromIntegral j)
| otherwise = fail ("Invalid operands to liftNumeric2: " <> show pair)
where
-- Yucky hack to work around the lack of a Floating instance for Scientific.
-- This may possibly lose precision, but there's little we can do about that.

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

@ -37,6 +37,13 @@ injValue = Value . inj
prjValue :: (f :< ValueConstructors location term) => Value location term -> Maybe (f (Value location term))
prjValue = prj . deValue
-- | Convenience function for projecting two values.
prjPair :: ( f :< ValueConstructors loc term1 , g :< ValueConstructors loc term2)
=> (Value loc term1, Value loc term2)
-> Maybe (f (Value loc term1), g (Value loc term2))
prjPair = bitraverse prjValue prjValue
-- 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.