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

Allow binds to process non-binding statements.

Browse Source
This commit is contained in:
Rob Rix 2019-07-22 14:42:46 -04:00
parent a25d971250
commit 724ae1763f
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
2 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
semantic-core/src/Analysis/Eval.hs
View File

@ -112,11 +112,11 @@ prog4 = fromBody
prog5 :: File (Term Core User)
prog5 = fromBody $ ann (binds
[ named' "mkPoint" :<- lams [named' "_x", named' "_y"] (ann (Core.record
[ Just (named' "mkPoint") :<- lams [named' "_x", named' "_y"] (ann (Core.record
[ ("x", ann (pure "_x"))
, ("y", ann (pure "_y"))
]))
, named' "point" :<- ann (ann (ann (pure "mkPoint") $$ ann (Core.bool True)) $$ ann (Core.bool False))
, Just (named' "point") :<- ann (ann (ann (pure "mkPoint") $$ ann (Core.bool True)) $$ ann (Core.bool False))
]
(ann ( ann (ann (pure "point") Core.... "x")
>>> ann (ann (pure "point") Core.... "y") .= ann (ann (pure "point") Core.... "x"))))

4
semantic-core/src/Data/Core.hs
View File

@ -139,8 +139,8 @@ Named u n :<- a >>>= b = send (Named u a :>>= abstract1 n b)
infixr 1 >>>=
binds :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Named a :<- m a) -> m a -> m a
binds bindings body = foldr (>>>=) body bindings
binds :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a) :<- m a) -> m a -> m a
binds bindings body = foldr (\ (n :<- a) -> maybe (a >>>) ((>>>=) . (:<- a)) n) body bindings
data a :<- b = a :<- b
deriving (Eq, Ord, Show)