diff options
| author | Inari Listenmaa <inari.listenmaa@gmail.com> | 2021-07-06 09:16:52 +0200 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2021-07-06 09:16:52 +0200 |
| commit | 4e8859aa752c65e8445cd54cb6ca80089492fd31 (patch) | |
| tree | 644c80d65bc8b70b79d76776f8f786f5753b0d0d /src/compiler/GF/Infra | |
| parent | 09d772046e78f9bab6c8c75035b812985d18d0f7 (diff) | |
| parent | a27b07542d731ee0287383feb7a97d5d4708b85e (diff) | |
Merge pull request #118 from GrammaticalFramework/canonical
Fixes to canonical compilation
Diffstat (limited to 'src/compiler/GF/Infra')
| -rw-r--r-- | src/compiler/GF/Infra/Ident.hs | 39 |
1 files changed, 20 insertions, 19 deletions
diff --git a/src/compiler/GF/Infra/Ident.hs b/src/compiler/GF/Infra/Ident.hs index b856d3995..ad47d91cd 100644 --- a/src/compiler/GF/Infra/Ident.hs +++ b/src/compiler/GF/Infra/Ident.hs @@ -5,7 +5,7 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/11/15 11:43:33 $ +-- > CVS $Date: 2005/11/15 11:43:33 $ -- > CVS $Author: aarne $ -- > CVS $Revision: 1.8 $ -- @@ -13,18 +13,18 @@ ----------------------------------------------------------------------------- module GF.Infra.Ident (-- ** Identifiers - ModuleName(..), moduleNameS, - Ident, ident2utf8, showIdent, prefixIdent, - -- *** Normal identifiers (returned by the parser) - identS, identC, identW, - -- *** Special identifiers for internal use - identV, identA, identAV, - argIdent, isArgIdent, getArgIndex, - varStr, varX, isWildIdent, varIndex, - -- *** Raw identifiers - RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent, - isPrefixOf, showRawIdent - ) where + ModuleName(..), moduleNameS, + Ident, ident2utf8, showIdent, prefixIdent, + -- *** Normal identifiers (returned by the parser) + identS, identC, identW, + -- *** Special identifiers for internal use + identV, identA, identAV, + argIdent, isArgIdent, getArgIndex, + varStr, varX, isWildIdent, varIndex, + -- *** Raw identifiers + RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent, + isPrefixOf, showRawIdent +) where import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.Char8 as BS(append,isPrefixOf) @@ -46,7 +46,7 @@ instance Pretty ModuleName where pp (MN m) = pp m -- | the constructors labelled /INTERNAL/ are -- internal representation never returned by the parser -data Ident = +data Ident = IC {-# UNPACK #-} !RawIdent -- ^ raw identifier after parsing, resolved in Rename | IW -- ^ wildcard -- @@ -54,7 +54,7 @@ data Ident = | IV {-# UNPACK #-} !RawIdent {-# UNPACK #-} !Int -- ^ /INTERNAL/ variable | IA {-# UNPACK #-} !RawIdent {-# UNPACK #-} !Int -- ^ /INTERNAL/ argument of cat at position | IAV {-# UNPACK #-} !RawIdent {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ /INTERNAL/ argument of cat with bindings at position --- +-- deriving (Eq, Ord, Show, Read) -- | Identifiers are stored as UTF-8-encoded bytestrings. @@ -70,14 +70,13 @@ rawIdentS = Id . pack rawIdentC = Id showRawIdent = unpack . rawId2utf8 -prefixRawIdent (Id x) (Id y) = Id (BS.append x y) +prefixRawIdent (Id x) (Id y) = Id (BS.append x y) isPrefixOf (Id x) (Id y) = BS.isPrefixOf x y instance Binary RawIdent where put = put . rawId2utf8 get = fmap rawIdentC get - -- | This function should be used with care, since the returned ByteString is -- UTF-8-encoded. ident2utf8 :: Ident -> UTF8.ByteString @@ -88,6 +87,7 @@ ident2utf8 i = case i of IAV (Id s) b j -> BS.append s (pack ('_':show b ++ '_':show j)) IW -> pack "_" +ident2raw :: Ident -> RawIdent ident2raw = Id . ident2utf8 showIdent :: Ident -> String @@ -95,13 +95,14 @@ showIdent i = unpack $! ident2utf8 i instance Pretty Ident where pp = pp . showIdent +instance Pretty RawIdent where pp = pp . showRawIdent + identS :: String -> Ident identS = identC . rawIdentS identC :: RawIdent -> Ident identW :: Ident - prefixIdent :: String -> Ident -> Ident prefixIdent pref = identC . Id . BS.append (pack pref) . ident2utf8 @@ -112,7 +113,7 @@ identV :: RawIdent -> Int -> Ident identA :: RawIdent -> Int -> Ident identAV:: RawIdent -> Int -> Int -> Ident -(identC, identV, identA, identAV, identW) = +(identC, identV, identA, identAV, identW) = (IC, IV, IA, IAV, IW) -- | to mark argument variables |
