1
1
mirror of https://github.com/github/semantic.git synced 2024-12-26 00:12:29 +03:00

Use Text for gensym’d names.

This commit is contained in:
Rob Rix 2019-06-12 10:55:04 -04:00
parent 06e3c7f0be
commit e9968caa45
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
5 changed files with 12 additions and 12 deletions

View File

@ -202,8 +202,8 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
fromName (User s) = s fromName (User s) = s
fromName (Gen sym) = fromGensym sym fromName (Gen sym) = fromGensym sym
fromName (Path p) = pack $ show p fromName (Path p) = pack $ show p
fromGensym (Root s) = pack s fromGensym (Root s) = s
fromGensym (ss :/ (s, i)) = fromGensym ss <> "." <> pack s <> pack (show i) fromGensym (ss :/ (s, i)) = fromGensym ss <> "." <> s <> pack (show i)
data EdgeType data EdgeType
= Edge Core.Edge = Edge Core.Edge

View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts, OverloadedStrings, ScopedTypeVariables #-}
module Analysis.FlowInsensitive module Analysis.FlowInsensitive
( Heap ( Heap
, FrameId(..) , FrameId(..)

View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleContexts, RecordWildCards #-} {-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards #-}
module Analysis.ImportGraph module Analysis.ImportGraph
( ImportGraph ( ImportGraph
, importGraph , importGraph

View File

@ -1,4 +1,4 @@
{-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, LambdaCase, RecordWildCards, ScopedTypeVariables, TypeApplications #-} {-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, LambdaCase, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications #-}
module Analysis.Typecheck module Analysis.Typecheck
( Monotype (..) ( Monotype (..)
, Meta , Meta

View File

@ -77,8 +77,8 @@ isSimpleCharacter = \case
c -> Char.isAlphaNum c c -> Char.isAlphaNum c
data Gensym data Gensym
= Root String = Root Text
| Gensym :/ (String, Int) | Gensym :/ (Text, Int)
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
instance Pretty Gensym where instance Pretty Gensym where
@ -86,21 +86,21 @@ instance Pretty Gensym where
Root s -> pretty s Root s -> pretty s
p :/ (n, x) -> Pretty.hcat [pretty p, "/", pretty n, "^", pretty x] p :/ (n, x) -> Pretty.hcat [pretty p, "/", pretty n, "^", pretty x]
(//) :: Gensym -> String -> Gensym (//) :: Gensym -> Text -> Gensym
root // s = root :/ (s, 0) root // s = root :/ (s, 0)
infixl 6 // infixl 6 //
gensym :: (Carrier sig m, Member Naming sig) => String -> m Gensym gensym :: (Carrier sig m, Member Naming sig) => Text -> m Gensym
gensym s = send (Gensym s pure) gensym s = send (Gensym s pure)
namespace :: (Carrier sig m, Member Naming sig) => String -> m a -> m a namespace :: (Carrier sig m, Member Naming sig) => Text -> m a -> m a
namespace s m = send (Namespace s m pure) namespace s m = send (Namespace s m pure)
data Naming m k data Naming m k
= Gensym String (Gensym -> k) = Gensym Text (Gensym -> k)
| forall a . Namespace String (m a) (a -> k) | forall a . Namespace Text (m a) (a -> k)
deriving instance Functor (Naming m) deriving instance Functor (Naming m)