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

generalize while and dowhile

Browse Source
This commit is contained in:
Patrick Thomson 2018-03-13 12:25:57 -04:00
parent 3c5ab01f95
commit 2bcc40edc1
1 changed files with 10 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -73,9 +73,6 @@ class (MonadAnalysis term value m, Show value) => MonadValue term value m where
-- | Eliminate boolean values. TODO: s/boolean/truthy
ifthenelse :: value -> m a -> m a -> m a
-- | Simple control flow
while :: m value -> m value -> m value
-- | Evaluate an abstraction (a binder like a lambda or method definition).
abstract :: [Name] -> Subterm term (m value) -> m value
-- | Evaluate an application (like a function call).
@ -92,9 +89,18 @@ toBool v = ifthenelse v (pure True) (pure False)
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
this <- cond
ifthenelse this (body *> while cond body) unit
-- | Do-while loop, built on top of while.
doWhile :: MonadValue term value m => m value -> m value -> m value
doWhile body cond = body *> while cond body
doWhile body cond = do
void body
this <- cond
ifthenelse this (doWhile body cond) unit
-- | Construct a 'Value' wrapping the value arguments (if any).
instance ( MonadAddressable location (Value location term) m
@ -118,13 +124,6 @@ instance ( MonadAddressable location (Value location term) m
| Just (Boolean b) <- prjValue cond = if b then if' else else'
| otherwise = fail ("not defined for non-boolean conditions: " <> show cond)
while cond body = do
this <- cond
case prjValue this of
Just (Boolean True) -> body *> while cond body
Just (Boolean False) -> unit
Nothing -> fail ("type error: non-boolean condition " <> show this)
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
@ -204,8 +203,6 @@ instance (Alternative m, MonadAnalysis term Type m, MonadFresh m) => MonadValue
ifthenelse cond if' else' = unify cond Bool *> (if' <|> else')
while _ _ = pure Type.Unit
liftNumeric _ Type.Float = pure Type.Float
liftNumeric _ Int = pure Int
liftNumeric _ _ = fail "Invalid type in unary numeric operation"