diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs index dab6a5c1e..ce5e529ee 100644 --- a/semantic-core/src/Data/Core.hs +++ b/semantic-core/src/Data/Core.hs @@ -115,7 +115,7 @@ lam :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a lam (Named u n) b = send (Lam u (bind1 n b)) lam' :: (Carrier sig m, Member Core sig) => User -> m User -> m User -lam' u = lam (named u u) +lam' u = lam (named' u) lams :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Named a) -> m a -> m a lams names body = foldr lam body names diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs index 6d2633062..a0ab97a80 100644 --- a/semantic-core/src/Data/Core/Parser.hs +++ b/semantic-core/src/Data/Core/Parser.hs @@ -93,7 +93,7 @@ lvalue = choice -- * Literals name :: (TokenParsing m, Monad m) => m (Named User) -name = (named <*> id) <$> identifier "name" where +name = named' <$> identifier "name" where lit :: (TokenParsing m, Monad m) => m (Term Core User) lit = let x `given` n = x <$ reserved n in choice diff --git a/semantic-core/src/Data/Name.hs b/semantic-core/src/Data/Name.hs index ecba61ae9..cf2bb4b2d 100644 --- a/semantic-core/src/Data/Name.hs +++ b/semantic-core/src/Data/Name.hs @@ -5,6 +5,7 @@ module Data.Name , Name(..) , Named(..) , named +, named' , namedName , namedValue , Ignored(..) @@ -65,6 +66,9 @@ data Named a = Named (Ignored User) a named :: User -> a -> Named a named = Named . Ignored +named' :: User -> Named User +named' u = Named (Ignored u) u + namedName :: Named a -> User namedName (Named (Ignored n) _) = n