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:
parent
06e3c7f0be
commit
e9968caa45
@ -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
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
|
{-# LANGUAGE FlexibleContexts, OverloadedStrings, ScopedTypeVariables #-}
|
||||||
module Analysis.FlowInsensitive
|
module Analysis.FlowInsensitive
|
||||||
( Heap
|
( Heap
|
||||||
, FrameId(..)
|
, FrameId(..)
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE FlexibleContexts, RecordWildCards #-}
|
{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards #-}
|
||||||
module Analysis.ImportGraph
|
module Analysis.ImportGraph
|
||||||
( ImportGraph
|
( ImportGraph
|
||||||
, importGraph
|
, importGraph
|
||||||
|
@ -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
|
||||||
|
@ -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)
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user