mirror of
https://github.com/github/semantic.git
synced 2024-12-24 23:42:31 +03:00
Allow binds to process non-binding statements.
This commit is contained in:
parent
a25d971250
commit
724ae1763f
@ -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"))))
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user