Define a helper for constructing Named User.

Author: robrix

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

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

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