summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Infra
diff options
context:
space:
mode:
authorInari Listenmaa <inari.listenmaa@gmail.com>2021-07-06 09:16:52 +0200
committerGitHub <noreply@github.com>2021-07-06 09:16:52 +0200
commit4e8859aa752c65e8445cd54cb6ca80089492fd31 (patch)
tree644c80d65bc8b70b79d76776f8f786f5753b0d0d /src/compiler/GF/Infra
parent09d772046e78f9bab6c8c75035b812985d18d0f7 (diff)
parenta27b07542d731ee0287383feb7a97d5d4708b85e (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.hs39
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