Generated GF and GFC lexers with BNFC with string sharing support.

4 files changed, 78 insertions, 66 deletions

diff --git a/src/GF/Canon/LexGFC.hs b/src/GF/Canon/LexGFC.hs
index f26ed3e61..77f70159f 100644
--- a/src/GF/Canon/LexGFC.hs
+++ b/src/GF/Canon/LexGFC.hs
@@ -1,8 +1,9 @@
 {-# OPTIONS -fglasgow-exts -cpp #-}
-{-# LINE 4 "LexGFC.x" #-}
+{-# LINE 3 "LexGFC.x" #-}
 module LexGFC where
-import SharedString -- H
+
 import ErrM
+import SharedString
 
 #if __GLASGOW_HASKELL__ >= 503
 import Data.Array
@@ -34,13 +35,16 @@ alex_accept = listArray (0::Int,14) [[],[],[(AlexAccSkip)],[(AlexAcc (alex_actio
 
 tok f p s = f p s
 
+share :: String -> String
+share = shareString
+
 data Tok =
-   TS !String     -- reserved words  -- H
- | TL !String     -- string literals -- H
- | TI String     -- integer literals
- | TV !String     -- identifiers     -- H
- | TD String     -- double precision float literals
- | TC String     -- character literals
+   TS !String     -- reserved words
+ | TL !String     -- string literals
+ | TI !String     -- integer literals
+ | TV !String     -- identifiers
+ | TD !String     -- double precision float literals
+ | TC !String     -- character literals
 
  deriving (Eq,Show,Ord)
 
@@ -69,15 +73,14 @@ data BTree = N | B String Tok BTree BTree deriving (Show)
 
 eitherResIdent :: (String -> Tok) -> String -> Tok
 eitherResIdent tv s = treeFind resWords
-    where 
-    treeFind N = tv s
-    treeFind (B a t left right) | s < a  = treeFind left
-				| s > a  = treeFind right
-				| s == a = t
+  where
+  treeFind N = tv s
+  treeFind (B a t left right) | s < a  = treeFind left
+                              | s > a  = treeFind right
+                              | s == a = t
 
 resWords = b "lin" (b "concrete" (b "Type" (b "Str" (b "Ints" N N) N) (b "cat" (b "abstract" N N) N)) (b "fun" (b "flags" (b "data" N N) N) (b "in" (b "grammar" N N) N))) (b "pre" (b "open" (b "of" (b "lincat" N N) N) (b "param" (b "oper" N N) N)) (b "transfer" (b "table" (b "resource" N N) N) (b "variants" N N)))
-      where b s = B s (TS s)
-
+   where b s = B s (TS s)
 
 unescapeInitTail :: String -> String
 unescapeInitTail = unesc . tail where
@@ -129,10 +132,10 @@ alexGetChar (p, _, (c:s)) =
 alexInputPrevChar :: AlexInput -> Char
 alexInputPrevChar (p, c, s) = c
 
-alex_action_1 = tok (\p s -> PT p (TS $ shareString s)) 
-alex_action_2 = tok (\p s -> PT p (eitherResIdent (TV . shareString) s)) 
-alex_action_3 = tok (\p s -> PT p (TL $ shareString $ unescapeInitTail s)) 
-alex_action_4 = tok (\p s -> PT p (TI s))    
+alex_action_1 = tok (\p s -> PT p (TS $ share s)) 
+alex_action_2 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) 
+alex_action_3 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) 
+alex_action_4 = tok (\p s -> PT p (TI $ share s))    
 {-# LINE 1 "GenericTemplate.hs" #-}
 {-# LINE 1 "<built-in>" #-}
 {-# LINE 1 "<command line>" #-}
diff --git a/src/GF/Canon/LexGFC.x b/src/GF/Canon/LexGFC.x
index b3332a48b..d1dfaa1b4 100644
--- a/src/GF/Canon/LexGFC.x
+++ b/src/GF/Canon/LexGFC.x
@@ -1,10 +1,10 @@
 -- -*- haskell -*-
 -- This Alex file was machine-generated by the BNF converter
--- Lines with -- H have been hacked for greater performance
 {
 module LexGFC where
-import SharedString -- H
+
 import ErrM
+import SharedString
 }
 
 
@@ -21,25 +21,28 @@ $u = [\0-\255]          -- universal: any character
 :-
 
 $white+ ;
-@rsyms { tok (\p s -> PT p (TS $ shareString s)) }
+@rsyms { tok (\p s -> PT p (TS $ share s)) }
 
-$l $i*   { tok (\p s -> PT p (eitherResIdent (TV . shareString) s)) } -- H
-\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ shareString $ unescapeInitTail s)) } -- H
+$l $i*   { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
+\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
 
-$d+      { tok (\p s -> PT p (TI s))    }
+$d+      { tok (\p s -> PT p (TI $ share s))    }
 
 
 {
 
 tok f p s = f p s
 
+share :: String -> String
+share = shareString
+
 data Tok =
-   TS !String     -- reserved words  -- H
- | TL !String     -- string literals -- H
- | TI String     -- integer literals
- | TV !String     -- identifiers     -- H
- | TD String     -- double precision float literals
- | TC String     -- character literals
+   TS !String     -- reserved words
+ | TL !String     -- string literals
+ | TI !String     -- integer literals
+ | TV !String     -- identifiers
+ | TD !String     -- double precision float literals
+ | TC !String     -- character literals
 
  deriving (Eq,Show,Ord)
 
@@ -68,15 +71,14 @@ data BTree = N | B String Tok BTree BTree deriving (Show)
 
 eitherResIdent :: (String -> Tok) -> String -> Tok
 eitherResIdent tv s = treeFind resWords
-    where 
-    treeFind N = tv s
-    treeFind (B a t left right) | s < a  = treeFind left
-				| s > a  = treeFind right
-				| s == a = t
+  where
+  treeFind N = tv s
+  treeFind (B a t left right) | s < a  = treeFind left
+                              | s > a  = treeFind right
+                              | s == a = t
 
 resWords = b "lin" (b "concrete" (b "Type" (b "Str" (b "Ints" N N) N) (b "cat" (b "abstract" N N) N)) (b "fun" (b "flags" (b "data" N N) N) (b "in" (b "grammar" N N) N))) (b "pre" (b "open" (b "of" (b "lincat" N N) N) (b "param" (b "oper" N N) N)) (b "transfer" (b "table" (b "resource" N N) N) (b "variants" N N)))
-      where b s = B s (TS s)
-
+   where b s = B s (TS s)
 
 unescapeInitTail :: String -> String
 unescapeInitTail = unesc . tail where
diff --git a/src/GF/Source/LexGF.hs b/src/GF/Source/LexGF.hs
index 4453650bc..cda4582f0 100644
--- a/src/GF/Source/LexGF.hs
+++ b/src/GF/Source/LexGF.hs
@@ -1,8 +1,9 @@
 {-# OPTIONS -fglasgow-exts -cpp #-}
-{-# LINE 4 "LexGF.x" #-}
+{-# LINE 3 "LexGF.x" #-}
 module LexGF where
-import SharedString -- H
+
 import ErrM
+import SharedString
 
 #if __GLASGOW_HASKELL__ >= 503
 import Data.Array
@@ -34,14 +35,17 @@ alex_accept = listArray (0::Int,27) [[],[],[(AlexAccSkip)],[(AlexAccSkip)],[],[(
 
 tok f p s = f p s
 
+share :: String -> String
+share = shareString
+
 data Tok =
-   TS !String     -- reserved words    -- H
- | TL !String     -- string literals   -- H
- | TI String     -- integer literals
- | TV !String     -- identifiers       -- H
- | TD String     -- double precision float literals
- | TC String     -- character literals
- | T_LString !String                   -- H
+   TS !String     -- reserved words
+ | TL !String     -- string literals
+ | TI !String     -- integer literals
+ | TV !String     -- identifiers
+ | TD !String     -- double precision float literals
+ | TC !String     -- character literals
+ | T_LString !String
 
  deriving (Eq,Show,Ord)
 
@@ -130,11 +134,11 @@ alexGetChar (p, _, (c:s)) =
 alexInputPrevChar :: AlexInput -> Char
 alexInputPrevChar (p, c, s) = c
 
-alex_action_3 = tok (\p s -> PT p (TS $ shareString s)) 
-alex_action_4 = tok (\p s -> PT p (eitherResIdent (T_LString . shareString) s)) 
-alex_action_5 = tok (\p s -> PT p (eitherResIdent (TV . shareString) s)) 
-alex_action_6 = tok (\p s -> PT p (TL $ shareString $ unescapeInitTail s)) 
-alex_action_7 = tok (\p s -> PT p (TI s))    
+alex_action_3 = tok (\p s -> PT p (TS $ share s)) 
+alex_action_4 = tok (\p s -> PT p (eitherResIdent (T_LString . share) s)) 
+alex_action_5 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) 
+alex_action_6 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) 
+alex_action_7 = tok (\p s -> PT p (TI $ share s))    
 {-# LINE 1 "GenericTemplate.hs" #-}
 {-# LINE 1 "<built-in>" #-}
 {-# LINE 1 "<command line>" #-}
diff --git a/src/GF/Source/LexGF.x b/src/GF/Source/LexGF.x
index e249f1705..72431c578 100644
--- a/src/GF/Source/LexGF.x
+++ b/src/GF/Source/LexGF.x
@@ -1,10 +1,10 @@
 -- -*- haskell -*-
 -- This Alex file was machine-generated by the BNF converter
--- Lines with -- H have been hacked for greater performance
 {
 module LexGF where
-import SharedString -- H
+
 import ErrM
+import SharedString
 }
 
 
@@ -23,27 +23,30 @@ $u = [\0-\255]          -- universal: any character
 "{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; 
 
 $white+ ;
-@rsyms { tok (\p s -> PT p (TS $ shareString s)) } -- H
-\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent (T_LString . shareString) s)) } -- H
+@rsyms { tok (\p s -> PT p (TS $ share s)) }
+\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent (T_LString . share) s)) }
 
-$l $i*   { tok (\p s -> PT p (eitherResIdent (TV . shareString) s)) } -- H
-\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ shareString $ unescapeInitTail s)) } -- H
+$l $i*   { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
+\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
 
-$d+      { tok (\p s -> PT p (TI s))    }
+$d+      { tok (\p s -> PT p (TI $ share s))    }
 
 
 {
 
 tok f p s = f p s
 
+share :: String -> String
+share = shareString
+
 data Tok =
-   TS !String     -- reserved words    -- H
- | TL !String     -- string literals   -- H
- | TI String     -- integer literals
- | TV !String     -- identifiers       -- H
- | TD String     -- double precision float literals
- | TC String     -- character literals
- | T_LString !String                   -- H
+   TS !String     -- reserved words
+ | TL !String     -- string literals
+ | TI !String     -- integer literals
+ | TV !String     -- identifiers
+ | TD !String     -- double precision float literals
+ | TC !String     -- character literals
+ | T_LString !String
 
  deriving (Eq,Show,Ord)