github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00
Code Issues Projects Releases Wiki Activity

Redefine records as a flat list of bindings.

Browse Source
This commit is contained in:
Rob Rix 2019-07-19 14:21:39 -04:00
parent f373ca410f
commit 1398c995a0
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
2 changed files with 5 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -37,7 +37,6 @@ import Control.Applicative (Alternative (..))
import Control.Effect.Carrier
import Control.Monad.Module
import Data.Foldable (foldl')
import Data.List (elemIndex)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Loc
import Data.Name
@ -69,7 +68,7 @@ data Core f a
-- | Allocation of a new frame.
| Frame
-- | A record holding simultaneously-bound, potentially mutually-recursive definitions.
| Record [Named (Scope Int f a)]
| Record [(User, f a)]
| f a :. f a
-- | Assignment of a value to the reference returned by the lhs.
| f a := f a
@ -101,7 +100,7 @@ instance RightModule Core where
Load b >>=* f = Load (b >>= f)
Edge e b >>=* f = Edge e (b >>= f)
Frame >>=* _ = Frame
Record fs >>=* f = Record (map (fmap (>>=* f)) fs)
Record fs >>=* f = Record (map (fmap (>>= f)) fs)
(a :. b) >>=* f = (a >>= f) :. (b >>= f)
(a := b) >>=* f = (a >>= f) := (b >>= f)
Ann l b >>=* f = Ann l (b >>= f)
@ -188,9 +187,8 @@ edge e b = send (Edge e b)
frame :: (Carrier sig m, Member Core sig) => m a
frame = send Frame
record :: (Eq a, Carrier sig m, Member Core sig) => [(Named a, m a)] -> m a
record fs = send (Record (map bind' fs))
where bind' (n, f) = bind (`elemIndex` map (namedValue . fst) fs) f <$ n
record :: (Carrier sig m, Member Core sig) => [(User, m a)] -> m a
record fs = send (Record fs)
(...) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
a ... b = send (a :. b)

2
semantic-core/src/Data/Core/Pretty.hs
View File

@ -86,7 +86,7 @@ prettyCore style = run . runReader @Prec 0 . go
pure (lambda <> name x <+> arrow <+> body)
Record fs -> do
fs' <- for fs $ \ (Named (Ignored x) v) -> (name x <+> symbol "=" <+>) <$> go (instantiate (pure . namedName . (fs !!)) v)
fs' <- for fs $ \ (x, v) -> (name x <+> symbol "=" <+>) <$> go v
pure $ Pretty.encloseSep Pretty.lbrace Pretty.rbrace Pretty.semi fs'
Frame -> pure $ primitive "frame"