Build cfgm files using the nondeterministic conversion. Allow coercions in cfgm rule functions and remove the name.

This commit is contained in:
bringert
2005-03-21 13:27:04 +00:00
parent 96a08c9df4
commit 75d228629a
9 changed files with 312 additions and 254 deletions

View File

@@ -1,5 +1,5 @@
i -src examples/stoneage/StoneageEng.gf i -src -conversion=nondet -optimize=share examples/stoneage/StoneageEng.gf
i -src examples/stoneage/StoneageFre.gf i -src -conversion=nondet -optimize=share examples/stoneage/StoneageFre.gf
i -src examples/stoneage/StoneageNor.gf i -src -conversion=nondet -optimize=share examples/stoneage/StoneageNor.gf
i -src examples/stoneage/StoneageSwe.gf i -src -conversion=nondet -optimize=share examples/stoneage/StoneageSwe.gf
pm -printer=gfcm | wf stoneage.gfcm pm -printer=gfcm | wf stoneage.gfcm

View File

@@ -1,4 +1,3 @@
module AbsCFG where module AbsCFG where
-- Haskell module generated by the BNF converter -- Haskell module generated by the BNF converter
@@ -18,7 +17,12 @@ data Flag =
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Rule = data Rule =
Rule Ident Name Profile Category [Symbol] Rule Fun Profile Category [Symbol]
deriving (Eq,Ord,Show)
data Fun =
Cons Ident
| Coerce
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Profile = data Profile =
@@ -34,10 +38,6 @@ data Symbol =
| TermS String | TermS String
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Name =
Name SingleQuoteString
deriving (Eq,Ord,Show)
data Category = data Category =
Category SingleQuoteString Category SingleQuoteString
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)

View File

@@ -8,9 +8,12 @@ separator Grammar "";
StartCat. Flag ::= "startcat" Category; StartCat. Flag ::= "startcat" Category;
terminator Flag ";"; terminator Flag ";";
Rule. Rule ::= Ident ":" Name Profile "." Category "->" [Symbol]; Rule. Rule ::= Fun ":" Profile "." Category "->" [Symbol];
terminator Rule ";"; terminator Rule ";";
Cons. Fun ::= Ident ;
Coerce. Fun ::= "_" ;
Profile. Profile ::= "[" [Ints] "]"; Profile. Profile ::= "[" [Ints] "]";
Ints. Ints ::= "[" [Integer] "]"; Ints. Ints ::= "[" [Integer] "]";
@@ -25,7 +28,6 @@ TermS. Symbol ::= String;
(:[]). [Symbol] ::= Symbol ; (:[]). [Symbol] ::= Symbol ;
(:). [Symbol] ::= Symbol [Symbol] ; (:). [Symbol] ::= Symbol [Symbol] ;
Name. Name ::= SingleQuoteString ;
Category. Category ::= SingleQuoteString ; Category. Category ::= SingleQuoteString ;
token SingleQuoteString '\'' ((char - ["'\\"]) | ('\\' ["'\\"]))* '\'' ; token SingleQuoteString '\'' ((char - ["'\\"]) | ('\\' ["'\\"]))* '\'' ;

File diff suppressed because one or more lines are too long

View File

@@ -4,6 +4,7 @@
module LexCFG where module LexCFG where
import ErrM import ErrM
} }
@@ -15,32 +16,35 @@ $i = [$l $d _ '] -- identifier character
$u = [\0-\255] -- universal: any character $u = [\0-\255] -- universal: any character
@rsyms = -- reserved words consisting of special symbols @rsyms = -- reserved words consisting of special symbols
\; | \: | \. | \- \> | \[ | \] | \, \; | \: | \. | \- \> | \_ | \[ | \] | \,
:- :-
$white+ ; $white+ ;
@rsyms { tok (\p s -> PT p (TS s)) } @rsyms { tok (\p s -> PT p (TS $ share s)) }
\' ($u # [\' \\]| \\ [\' \\]) * \' { tok (\p s -> PT p (eitherResIdent T_SingleQuoteString s)) } \' ($u # [\' \\]| \\ [\' \\]) * \' { tok (\p s -> PT p (eitherResIdent (T_SingleQuoteString . share) s)) }
$l $i* { tok (\p s -> PT p (eitherResIdent TV s)) } $l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ unescapeInitTail 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 tok f p s = f p s
share :: String -> String
share = id
data Tok = data Tok =
TS String -- reserved words TS !String -- reserved words
| TL String -- string literals | TL !String -- string literals
| TI String -- integer literals | TI !String -- integer literals
| TV String -- identifiers | TV !String -- identifiers
| TD String -- double precision float literals | TD !String -- double precision float literals
| TC String -- character literals | TC !String -- character literals
| T_SingleQuoteString String | T_SingleQuoteString !String
deriving (Eq,Show,Ord) deriving (Eq,Show,Ord)
@@ -62,24 +66,22 @@ prToken t = case t of
PT _ (TV s) -> s PT _ (TV s) -> s
PT _ (TD s) -> s PT _ (TD s) -> s
PT _ (TC s) -> s PT _ (TC s) -> s
_ -> show t
PT _ (T_SingleQuoteString s) -> s PT _ (T_SingleQuoteString s) -> s
_ -> show t
data BTree = N | B String Tok BTree BTree deriving (Show)
eitherResIdent :: (String -> Tok) -> String -> Tok eitherResIdent :: (String -> Tok) -> String -> Tok
eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where eitherResIdent tv s = treeFind resWords
isResWord s = isInTree s $ where
B "grammar" (B "end" N N) (B "startcat" N N) treeFind N = tv s
treeFind (B a t left right) | s < a = treeFind left
| s > a = treeFind right
| s == a = t
data BTree = N | B String BTree BTree deriving (Show) resWords = b "grammar" (b "end" N N) (b "startcat" N N)
where b s = B s (TS s)
isInTree :: String -> BTree -> Bool
isInTree x tree = case tree of
N -> False
B a left right
| x < a -> isInTree x left
| x > a -> isInTree x right
| x == a -> True
unescapeInitTail :: String -> String unescapeInitTail :: String -> String
unescapeInitTail = unesc . tail where unescapeInitTail = unesc . tail where

View File

@@ -1,6 +1,4 @@
{-# OPTIONS -fglasgow-exts -cpp #-} {-# OPTIONS -fglasgow-exts -cpp #-}
-- parser produced by Happy Version 1.13
module ParCFG where module ParCFG where
import AbsCFG import AbsCFG
import LexCFG import LexCFG
@@ -12,6 +10,8 @@ import GHC.Exts
import GlaExts import GlaExts
#endif #endif
-- parser produced by Happy Version 1.15
newtype HappyAbsSyn t4 t5 t6 t7 = HappyAbsSyn (() -> ()) newtype HappyAbsSyn t4 t5 t6 t7 = HappyAbsSyn (() -> ())
happyIn4 :: t4 -> (HappyAbsSyn t4 t5 t6 t7) happyIn4 :: t4 -> (HappyAbsSyn t4 t5 t6 t7)
happyIn4 x = unsafeCoerce# x happyIn4 x = unsafeCoerce# x
@@ -79,46 +79,46 @@ happyIn14 x = unsafeCoerce# x
happyOut14 :: (HappyAbsSyn t4 t5 t6 t7) -> ([Rule]) happyOut14 :: (HappyAbsSyn t4 t5 t6 t7) -> ([Rule])
happyOut14 x = unsafeCoerce# x happyOut14 x = unsafeCoerce# x
{-# INLINE happyOut14 #-} {-# INLINE happyOut14 #-}
happyIn15 :: (Profile) -> (HappyAbsSyn t4 t5 t6 t7) happyIn15 :: (Fun) -> (HappyAbsSyn t4 t5 t6 t7)
happyIn15 x = unsafeCoerce# x happyIn15 x = unsafeCoerce# x
{-# INLINE happyIn15 #-} {-# INLINE happyIn15 #-}
happyOut15 :: (HappyAbsSyn t4 t5 t6 t7) -> (Profile) happyOut15 :: (HappyAbsSyn t4 t5 t6 t7) -> (Fun)
happyOut15 x = unsafeCoerce# x happyOut15 x = unsafeCoerce# x
{-# INLINE happyOut15 #-} {-# INLINE happyOut15 #-}
happyIn16 :: (Ints) -> (HappyAbsSyn t4 t5 t6 t7) happyIn16 :: (Profile) -> (HappyAbsSyn t4 t5 t6 t7)
happyIn16 x = unsafeCoerce# x happyIn16 x = unsafeCoerce# x
{-# INLINE happyIn16 #-} {-# INLINE happyIn16 #-}
happyOut16 :: (HappyAbsSyn t4 t5 t6 t7) -> (Ints) happyOut16 :: (HappyAbsSyn t4 t5 t6 t7) -> (Profile)
happyOut16 x = unsafeCoerce# x happyOut16 x = unsafeCoerce# x
{-# INLINE happyOut16 #-} {-# INLINE happyOut16 #-}
happyIn17 :: ([Ints]) -> (HappyAbsSyn t4 t5 t6 t7) happyIn17 :: (Ints) -> (HappyAbsSyn t4 t5 t6 t7)
happyIn17 x = unsafeCoerce# x happyIn17 x = unsafeCoerce# x
{-# INLINE happyIn17 #-} {-# INLINE happyIn17 #-}
happyOut17 :: (HappyAbsSyn t4 t5 t6 t7) -> ([Ints]) happyOut17 :: (HappyAbsSyn t4 t5 t6 t7) -> (Ints)
happyOut17 x = unsafeCoerce# x happyOut17 x = unsafeCoerce# x
{-# INLINE happyOut17 #-} {-# INLINE happyOut17 #-}
happyIn18 :: ([Integer]) -> (HappyAbsSyn t4 t5 t6 t7) happyIn18 :: ([Ints]) -> (HappyAbsSyn t4 t5 t6 t7)
happyIn18 x = unsafeCoerce# x happyIn18 x = unsafeCoerce# x
{-# INLINE happyIn18 #-} {-# INLINE happyIn18 #-}
happyOut18 :: (HappyAbsSyn t4 t5 t6 t7) -> ([Integer]) happyOut18 :: (HappyAbsSyn t4 t5 t6 t7) -> ([Ints])
happyOut18 x = unsafeCoerce# x happyOut18 x = unsafeCoerce# x
{-# INLINE happyOut18 #-} {-# INLINE happyOut18 #-}
happyIn19 :: (Symbol) -> (HappyAbsSyn t4 t5 t6 t7) happyIn19 :: ([Integer]) -> (HappyAbsSyn t4 t5 t6 t7)
happyIn19 x = unsafeCoerce# x happyIn19 x = unsafeCoerce# x
{-# INLINE happyIn19 #-} {-# INLINE happyIn19 #-}
happyOut19 :: (HappyAbsSyn t4 t5 t6 t7) -> (Symbol) happyOut19 :: (HappyAbsSyn t4 t5 t6 t7) -> ([Integer])
happyOut19 x = unsafeCoerce# x happyOut19 x = unsafeCoerce# x
{-# INLINE happyOut19 #-} {-# INLINE happyOut19 #-}
happyIn20 :: ([Symbol]) -> (HappyAbsSyn t4 t5 t6 t7) happyIn20 :: (Symbol) -> (HappyAbsSyn t4 t5 t6 t7)
happyIn20 x = unsafeCoerce# x happyIn20 x = unsafeCoerce# x
{-# INLINE happyIn20 #-} {-# INLINE happyIn20 #-}
happyOut20 :: (HappyAbsSyn t4 t5 t6 t7) -> ([Symbol]) happyOut20 :: (HappyAbsSyn t4 t5 t6 t7) -> (Symbol)
happyOut20 x = unsafeCoerce# x happyOut20 x = unsafeCoerce# x
{-# INLINE happyOut20 #-} {-# INLINE happyOut20 #-}
happyIn21 :: (Name) -> (HappyAbsSyn t4 t5 t6 t7) happyIn21 :: ([Symbol]) -> (HappyAbsSyn t4 t5 t6 t7)
happyIn21 x = unsafeCoerce# x happyIn21 x = unsafeCoerce# x
{-# INLINE happyIn21 #-} {-# INLINE happyIn21 #-}
happyOut21 :: (HappyAbsSyn t4 t5 t6 t7) -> (Name) happyOut21 :: (HappyAbsSyn t4 t5 t6 t7) -> ([Symbol])
happyOut21 x = unsafeCoerce# x happyOut21 x = unsafeCoerce# x
{-# INLINE happyOut21 #-} {-# INLINE happyOut21 #-}
happyIn22 :: (Category) -> (HappyAbsSyn t4 t5 t6 t7) happyIn22 :: (Category) -> (HappyAbsSyn t4 t5 t6 t7)
@@ -135,21 +135,21 @@ happyOutTok x = unsafeCoerce# x
{-# INLINE happyOutTok #-} {-# INLINE happyOutTok #-}
happyActOffsets :: HappyAddr happyActOffsets :: HappyAddr
happyActOffsets = HappyA# "\x00\x00\x33\x00\x00\x00\x27\x00\x34\x00\x00\x00\x31\x00\x00\x00\x30\x00\x38\x00\x19\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x36\x00\x35\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x2e\x00\x2f\x00\x2b\x00\x2a\x00\x29\x00\x22\x00\x1f\x00\x28\x00\x24\x00\x20\x00\x00\x00\x00\x00\x1d\x00\x00\x00\x00\x00\x1e\x00\x11\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# happyActOffsets = HappyA# "\x00\x00\x37\x00\x00\x00\x31\x00\x34\x00\x00\x00\x30\x00\x00\x00\x2e\x00\x36\x00\x17\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x33\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x2f\x00\x2b\x00\x27\x00\x29\x00\x21\x00\x1e\x00\x28\x00\x22\x00\x24\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x11\x00\x0b\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
happyGotoOffsets :: HappyAddr happyGotoOffsets :: HappyAddr
happyGotoOffsets = HappyA# "\x21\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x0d\x00\x01\x00\x16\x00\x00\x00\x1a\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x00\x00\xf9\xff\x00\x00\x1c\x00\x00\x00\x00\x00\x0b\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x02\x00\x03\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# happyGotoOffsets = HappyA# "\x19\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x0c\x00\x05\x00\x01\x00\x00\x00\x1b\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf7\xff\x00\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x09\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x08\x00\x02\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
happyDefActions :: HappyAddr happyDefActions :: HappyAddr
happyDefActions = HappyA# "\xf8\xff\x00\x00\xfe\xff\x00\x00\xfa\xff\xf7\xff\x00\x00\xf5\xff\xf2\xff\x00\x00\x00\x00\x00\x00\xe2\xff\xf6\xff\xfb\xff\x00\x00\x00\x00\x00\x00\xf4\xff\xf9\xff\xf1\xff\x00\x00\xe3\xff\x00\x00\x00\x00\xee\xff\xed\xff\x00\x00\xeb\xff\x00\x00\x00\x00\xea\xff\x00\x00\xfd\xff\xf0\xff\xee\xff\xec\xff\xef\xff\xeb\xff\x00\x00\xe7\xff\xe5\xff\xf3\xff\xe8\xff\xe6\xff\xfc\xff\xe9\xff\xe4\xff"# happyDefActions = HappyA# "\xf8\xff\x00\x00\xfe\xff\x00\x00\xfa\xff\xf7\xff\x00\x00\xf5\xff\xf2\xff\x00\x00\x00\x00\x00\x00\xe1\xff\xf6\xff\xfb\xff\xf0\xff\x00\x00\x00\x00\xef\xff\x00\x00\xf4\xff\xf9\xff\x00\x00\xf1\xff\x00\x00\xec\xff\xeb\xff\x00\x00\xe9\xff\x00\x00\x00\x00\xe8\xff\x00\x00\xfd\xff\xee\xff\xec\xff\xea\xff\xed\xff\xe9\xff\x00\x00\xe5\xff\xe3\xff\xf3\xff\xe6\xff\xe4\xff\xfc\xff\xe7\xff\xe2\xff"#
happyCheck :: HappyAddr happyCheck :: HappyAddr
happyCheck = HappyA# "\xff\xff\x02\x00\x03\x00\x01\x00\x0b\x00\x02\x00\x03\x00\x03\x00\x03\x00\x08\x00\x03\x00\x05\x00\x01\x00\x00\x00\x0f\x00\x10\x00\x0e\x00\x12\x00\x0f\x00\x10\x00\x03\x00\x12\x00\x12\x00\x12\x00\x11\x00\x0e\x00\x00\x00\x0c\x00\x0d\x00\x07\x00\x0d\x00\x0e\x00\x0a\x00\x08\x00\x05\x00\x09\x00\x0b\x00\x04\x00\x06\x00\x06\x00\x0c\x00\x0d\x00\x0c\x00\x07\x00\x04\x00\x0e\x00\x0c\x00\x06\x00\x05\x00\x07\x00\x03\x00\x05\x00\x0e\x00\x09\x00\x01\x00\x10\x00\x02\x00\x01\x00\x0a\x00\x0e\x00\x0b\x00\x09\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# happyCheck = HappyA# "\xff\xff\x02\x00\x03\x00\x0c\x00\x02\x00\x03\x00\x03\x00\x03\x00\x07\x00\x01\x00\x01\x00\x0a\x00\x00\x00\x08\x00\x03\x00\x10\x00\x11\x00\x12\x00\x10\x00\x11\x00\x12\x00\x12\x00\x12\x00\x0f\x00\x0f\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x04\x00\x0d\x00\x06\x00\x09\x00\x0d\x00\x0e\x00\x0c\x00\x09\x00\x05\x00\x0b\x00\x0d\x00\x0e\x00\x06\x00\x08\x00\x07\x00\x04\x00\x0f\x00\x0d\x00\x08\x00\x07\x00\x06\x00\x03\x00\x06\x00\x0a\x00\x02\x00\x01\x00\x01\x00\xff\xff\x0b\x00\xff\xff\x0f\x00\x0c\x00\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\x11\x00\x0c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
happyTable :: HappyAddr happyTable :: HappyAddr
happyTable = HappyA# "\x00\x00\x28\x00\x0c\x00\x1f\x00\x18\x00\x28\x00\x0c\x00\x0c\x00\x0c\x00\x08\x00\x16\x00\x05\x00\x1f\x00\x07\x00\x29\x00\x2f\x00\x2e\x00\x2b\x00\x29\x00\x2a\x00\x2d\x00\x2b\x00\x1e\x00\x0d\x00\x17\x00\x20\x00\x0f\x00\x1a\x00\x24\x00\x09\x00\x2e\x00\x0f\x00\x0a\x00\x12\x00\x1d\x00\x10\x00\x03\x00\x03\x00\x26\x00\x04\x00\x1a\x00\x1b\x00\x22\x00\x27\x00\x28\x00\x0f\x00\x22\x00\x23\x00\x1d\x00\x24\x00\x1e\x00\x1a\x00\x0f\x00\x14\x00\x15\x00\xff\xff\x16\x00\x13\x00\x0c\x00\x0f\x00\x03\x00\x07\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# happyTable = HappyA# "\x00\x00\x28\x00\x0c\x00\x18\x00\x28\x00\x0c\x00\x0c\x00\x0c\x00\x09\x00\x1f\x00\x1f\x00\x0a\x00\x07\x00\x08\x00\x2d\x00\x29\x00\x2f\x00\x2b\x00\x29\x00\x2a\x00\x2b\x00\x1e\x00\x0d\x00\x2e\x00\x20\x00\x2e\x00\x0f\x00\x0f\x00\x13\x00\x03\x00\x22\x00\x04\x00\x14\x00\x1a\x00\x24\x00\x03\x00\x10\x00\x05\x00\x11\x00\x1a\x00\x1b\x00\x1d\x00\x27\x00\x26\x00\x28\x00\x0f\x00\x22\x00\x24\x00\x23\x00\x1d\x00\x1e\x00\x1a\x00\x16\x00\x17\x00\x18\x00\x15\x00\x00\x00\x0c\x00\x00\x00\x0f\x00\x03\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\xff\xff\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
happyReduceArr = array (1, 29) [ happyReduceArr = array (1, 30) [
(1 , happyReduce_1), (1 , happyReduce_1),
(2 , happyReduce_2), (2 , happyReduce_2),
(3 , happyReduce_3), (3 , happyReduce_3),
@@ -178,10 +178,11 @@ happyReduceArr = array (1, 29) [
(26 , happyReduce_26), (26 , happyReduce_26),
(27 , happyReduce_27), (27 , happyReduce_27),
(28 , happyReduce_28), (28 , happyReduce_28),
(29 , happyReduce_29) (29 , happyReduce_29),
(30 , happyReduce_30)
] ]
happy_n_terms = 17 :: Int happy_n_terms = 18 :: Int
happy_n_nonterms = 19 :: Int happy_n_nonterms = 19 :: Int
happyReduce_1 = happySpecReduce_1 0# happyReduction_1 happyReduce_1 = happySpecReduce_1 0# happyReduction_1
@@ -271,9 +272,8 @@ happyReduction_11 happy_x_3
(flip (:) happy_var_1 happy_var_2 (flip (:) happy_var_1 happy_var_2
)}} )}}
happyReduce_12 = happyReduce 8# 9# happyReduction_12 happyReduce_12 = happyReduce 7# 9# happyReduction_12
happyReduction_12 (happy_x_8 `HappyStk` happyReduction_12 (happy_x_7 `HappyStk`
happy_x_7 `HappyStk`
happy_x_6 `HappyStk` happy_x_6 `HappyStk`
happy_x_5 `HappyStk` happy_x_5 `HappyStk`
happy_x_4 `HappyStk` happy_x_4 `HappyStk`
@@ -281,14 +281,13 @@ happyReduction_12 (happy_x_8 `HappyStk`
happy_x_2 `HappyStk` happy_x_2 `HappyStk`
happy_x_1 `HappyStk` happy_x_1 `HappyStk`
happyRest) happyRest)
= case happyOut4 happy_x_1 of { happy_var_1 -> = case happyOut15 happy_x_1 of { happy_var_1 ->
case happyOut21 happy_x_3 of { happy_var_3 -> case happyOut16 happy_x_3 of { happy_var_3 ->
case happyOut15 happy_x_4 of { happy_var_4 -> case happyOut22 happy_x_5 of { happy_var_5 ->
case happyOut22 happy_x_6 of { happy_var_6 -> case happyOut21 happy_x_7 of { happy_var_7 ->
case happyOut20 happy_x_8 of { happy_var_8 ->
happyIn13 happyIn13
(Rule happy_var_1 happy_var_3 happy_var_4 happy_var_6 happy_var_8 (Rule happy_var_1 happy_var_3 happy_var_5 happy_var_7
) `HappyStk` happyRest}}}}} ) `HappyStk` happyRest}}}}
happyReduce_13 = happySpecReduce_0 10# happyReduction_13 happyReduce_13 = happySpecReduce_0 10# happyReduction_13
happyReduction_13 = happyIn14 happyReduction_13 = happyIn14
@@ -305,120 +304,126 @@ happyReduction_14 happy_x_3
(flip (:) happy_var_1 happy_var_2 (flip (:) happy_var_1 happy_var_2
)}} )}}
happyReduce_15 = happySpecReduce_3 11# happyReduction_15 happyReduce_15 = happySpecReduce_1 11# happyReduction_15
happyReduction_15 happy_x_3 happyReduction_15 happy_x_1
happy_x_2 = case happyOut4 happy_x_1 of { happy_var_1 ->
happy_x_1
= case happyOut17 happy_x_2 of { happy_var_2 ->
happyIn15 happyIn15
(Profile happy_var_2 (Cons happy_var_1
)} )}
happyReduce_16 = happySpecReduce_3 12# happyReduction_16 happyReduce_16 = happySpecReduce_1 11# happyReduction_16
happyReduction_16 happy_x_3 happyReduction_16 happy_x_1
= happyIn15
(Coerce
)
happyReduce_17 = happySpecReduce_3 12# happyReduction_17
happyReduction_17 happy_x_3
happy_x_2 happy_x_2
happy_x_1 happy_x_1
= case happyOut18 happy_x_2 of { happy_var_2 -> = case happyOut18 happy_x_2 of { happy_var_2 ->
happyIn16 happyIn16
(Profile happy_var_2
)}
happyReduce_18 = happySpecReduce_3 13# happyReduction_18
happyReduction_18 happy_x_3
happy_x_2
happy_x_1
= case happyOut19 happy_x_2 of { happy_var_2 ->
happyIn17
(Ints happy_var_2 (Ints happy_var_2
)} )}
happyReduce_17 = happySpecReduce_0 13# happyReduction_17 happyReduce_19 = happySpecReduce_0 14# happyReduction_19
happyReduction_17 = happyIn17 happyReduction_19 = happyIn18
([] ([]
) )
happyReduce_18 = happySpecReduce_1 13# happyReduction_18 happyReduce_20 = happySpecReduce_1 14# happyReduction_20
happyReduction_18 happy_x_1 happyReduction_20 happy_x_1
= case happyOut16 happy_x_1 of { happy_var_1 -> = case happyOut17 happy_x_1 of { happy_var_1 ->
happyIn17
((:[]) happy_var_1
)}
happyReduce_19 = happySpecReduce_3 13# happyReduction_19
happyReduction_19 happy_x_3
happy_x_2
happy_x_1
= case happyOut16 happy_x_1 of { happy_var_1 ->
case happyOut17 happy_x_3 of { happy_var_3 ->
happyIn17
((:) happy_var_1 happy_var_3
)}}
happyReduce_20 = happySpecReduce_0 14# happyReduction_20
happyReduction_20 = happyIn18
([]
)
happyReduce_21 = happySpecReduce_1 14# happyReduction_21
happyReduction_21 happy_x_1
= case happyOut5 happy_x_1 of { happy_var_1 ->
happyIn18 happyIn18
((:[]) happy_var_1 ((:[]) happy_var_1
)} )}
happyReduce_22 = happySpecReduce_3 14# happyReduction_22 happyReduce_21 = happySpecReduce_3 14# happyReduction_21
happyReduction_22 happy_x_3 happyReduction_21 happy_x_3
happy_x_2 happy_x_2
happy_x_1 happy_x_1
= case happyOut5 happy_x_1 of { happy_var_1 -> = case happyOut17 happy_x_1 of { happy_var_1 ->
case happyOut18 happy_x_3 of { happy_var_3 -> case happyOut18 happy_x_3 of { happy_var_3 ->
happyIn18 happyIn18
((:) happy_var_1 happy_var_3 ((:) happy_var_1 happy_var_3
)}} )}}
happyReduce_23 = happySpecReduce_1 15# happyReduction_23 happyReduce_22 = happySpecReduce_0 15# happyReduction_22
happyReduction_23 happy_x_1 happyReduction_22 = happyIn19
= case happyOut22 happy_x_1 of { happy_var_1 ->
happyIn19
(CatS happy_var_1
)}
happyReduce_24 = happySpecReduce_1 15# happyReduction_24
happyReduction_24 happy_x_1
= case happyOut6 happy_x_1 of { happy_var_1 ->
happyIn19
(TermS happy_var_1
)}
happyReduce_25 = happySpecReduce_1 16# happyReduction_25
happyReduction_25 happy_x_1
= happyIn20
([] ([]
) )
happyReduce_26 = happySpecReduce_1 16# happyReduction_26 happyReduce_23 = happySpecReduce_1 15# happyReduction_23
happyReduction_26 happy_x_1 happyReduction_23 happy_x_1
= case happyOut19 happy_x_1 of { happy_var_1 -> = case happyOut5 happy_x_1 of { happy_var_1 ->
happyIn20 happyIn19
((:[]) happy_var_1 ((:[]) happy_var_1
)} )}
happyReduce_27 = happySpecReduce_2 16# happyReduction_27 happyReduce_24 = happySpecReduce_3 15# happyReduction_24
happyReduction_27 happy_x_2 happyReduction_24 happy_x_3
happy_x_2
happy_x_1 happy_x_1
= case happyOut19 happy_x_1 of { happy_var_1 -> = case happyOut5 happy_x_1 of { happy_var_1 ->
case happyOut20 happy_x_2 of { happy_var_2 -> case happyOut19 happy_x_3 of { happy_var_3 ->
happyIn20 happyIn19
((:) happy_var_1 happy_var_2 ((:) happy_var_1 happy_var_3
)}} )}}
happyReduce_25 = happySpecReduce_1 16# happyReduction_25
happyReduction_25 happy_x_1
= case happyOut22 happy_x_1 of { happy_var_1 ->
happyIn20
(CatS happy_var_1
)}
happyReduce_26 = happySpecReduce_1 16# happyReduction_26
happyReduction_26 happy_x_1
= case happyOut6 happy_x_1 of { happy_var_1 ->
happyIn20
(TermS happy_var_1
)}
happyReduce_27 = happySpecReduce_1 17# happyReduction_27
happyReduction_27 happy_x_1
= happyIn21
([]
)
happyReduce_28 = happySpecReduce_1 17# happyReduction_28 happyReduce_28 = happySpecReduce_1 17# happyReduction_28
happyReduction_28 happy_x_1 happyReduction_28 happy_x_1
= case happyOut7 happy_x_1 of { happy_var_1 -> = case happyOut20 happy_x_1 of { happy_var_1 ->
happyIn21 happyIn21
(Name happy_var_1 ((:[]) happy_var_1
)} )}
happyReduce_29 = happySpecReduce_1 18# happyReduction_29 happyReduce_29 = happySpecReduce_2 17# happyReduction_29
happyReduction_29 happy_x_1 happyReduction_29 happy_x_2
happy_x_1
= case happyOut20 happy_x_1 of { happy_var_1 ->
case happyOut21 happy_x_2 of { happy_var_2 ->
happyIn21
((:) happy_var_1 happy_var_2
)}}
happyReduce_30 = happySpecReduce_1 18# happyReduction_30
happyReduction_30 happy_x_1
= case happyOut7 happy_x_1 of { happy_var_1 -> = case happyOut7 happy_x_1 of { happy_var_1 ->
happyIn22 happyIn22
(Category happy_var_1 (Category happy_var_1
)} )}
happyNewToken action sts stk [] = happyNewToken action sts stk [] =
happyDoAction 16# (error "reading EOF!") action sts stk [] happyDoAction 17# (error "reading EOF!") action sts stk []
happyNewToken action sts stk (tk:tks) = happyNewToken action sts stk (tk:tks) =
let cont i = happyDoAction i tk action sts stk tks in let cont i = happyDoAction i tk action sts stk tks in
@@ -427,28 +432,35 @@ happyNewToken action sts stk (tk:tks) =
PT _ (TS ":") -> cont 2#; PT _ (TS ":") -> cont 2#;
PT _ (TS ".") -> cont 3#; PT _ (TS ".") -> cont 3#;
PT _ (TS "->") -> cont 4#; PT _ (TS "->") -> cont 4#;
PT _ (TS "[") -> cont 5#; PT _ (TS "_") -> cont 5#;
PT _ (TS "]") -> cont 6#; PT _ (TS "[") -> cont 6#;
PT _ (TS ",") -> cont 7#; PT _ (TS "]") -> cont 7#;
PT _ (TS "end") -> cont 8#; PT _ (TS ",") -> cont 8#;
PT _ (TS "grammar") -> cont 9#; PT _ (TS "end") -> cont 9#;
PT _ (TS "startcat") -> cont 10#; PT _ (TS "grammar") -> cont 10#;
PT _ (TV happy_dollar_dollar) -> cont 11#; PT _ (TS "startcat") -> cont 11#;
PT _ (TI happy_dollar_dollar) -> cont 12#; PT _ (TV happy_dollar_dollar) -> cont 12#;
PT _ (TL happy_dollar_dollar) -> cont 13#; PT _ (TI happy_dollar_dollar) -> cont 13#;
PT _ (T_SingleQuoteString happy_dollar_dollar) -> cont 14#; PT _ (TL happy_dollar_dollar) -> cont 14#;
_ -> cont 15#; PT _ (T_SingleQuoteString happy_dollar_dollar) -> cont 15#;
_ -> happyError tks _ -> cont 16#;
_ -> happyError' (tk:tks)
} }
happyThen :: Err a -> (a -> Err b) -> Err b happyError_ tk tks = happyError' (tk:tks)
happyThen :: () => Err a -> (a -> Err b) -> Err b
happyThen = (thenM) happyThen = (thenM)
happyReturn :: a -> Err a happyReturn :: () => a -> Err a
happyReturn = (returnM) happyReturn = (returnM)
happyThen1 m k tks = (thenM) m (\a -> k a tks) happyThen1 m k tks = (thenM) m (\a -> k a tks)
happyReturn1 :: () => a -> b -> Err a
happyReturn1 = \a tks -> (returnM) a happyReturn1 = \a tks -> (returnM) a
happyError' :: () => [Token] -> Err a
happyError' = happyError
pGrammars tks = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut8 x)) pGrammars tks = happySomeParser where
happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut8 x))
happySeq = happyDontSeq happySeq = happyDontSeq
@@ -464,7 +476,7 @@ happyError ts =
myLexer = tokens myLexer = tokens
{-# LINE 1 "GenericTemplate.hs" #-} {-# LINE 1 "GenericTemplate.hs" #-}
-- $Id: ParCFG.hs,v 1.5 2005/02/04 14:17:06 bringert Exp $ -- $Id: ParCFG.hs,v 1.6 2005/03/21 14:27:06 bringert Exp $
@@ -532,9 +544,13 @@ happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Accepting the parse -- Accepting the parse
happyAccept j tk st sts (HappyStk ans _) = (happyTcHack j -- If the current token is 0#, it means we've just accepted a partial
(happyTcHack st)) -- parse (a %partial parser). We must ignore the saved token on the top of
(happyReturn1 ans) -- the stack in this case.
happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
happyReturn1 ans
happyAccept j tk st sts (HappyStk ans _) =
(happyTcHack j (happyTcHack st)) (happyReturn1 ans)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Arrays only: do the next action -- Arrays only: do the next action
@@ -607,7 +623,7 @@ data HappyAddr = HappyA# Addr#
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- HappyState data type (not arrays) -- HappyState data type (not arrays)
{-# LINE 165 "GenericTemplate.hs" #-} {-# LINE 169 "GenericTemplate.hs" #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -687,8 +703,7 @@ happyGoto nt j tk st =
-- parse error if we are in recovery and we fail again -- parse error if we are in recovery and we fail again
happyFail 0# tk old_st _ stk = happyFail 0# tk old_st _ stk =
-- trace "failing" $ -- trace "failing" $
happyError happyError_ tk
{- We don't need state discarding for our restricted implementation of {- We don't need state discarding for our restricted implementation of
"error". In fact, it can cause some bogus parses, so I've disabled it "error". In fact, it can cause some bogus parses, so I've disabled it

View File

@@ -16,6 +16,7 @@ import ErrM
':' { PT _ (TS ":") } ':' { PT _ (TS ":") }
'.' { PT _ (TS ".") } '.' { PT _ (TS ".") }
'->' { PT _ (TS "->") } '->' { PT _ (TS "->") }
'_' { PT _ (TS "_") }
'[' { PT _ (TS "[") } '[' { PT _ (TS "[") }
']' { PT _ (TS "]") } ']' { PT _ (TS "]") }
',' { PT _ (TS ",") } ',' { PT _ (TS ",") }
@@ -60,7 +61,7 @@ ListFlag : {- empty -} { [] }
Rule :: { Rule } Rule :: { Rule }
Rule : Ident ':' Name Profile '.' Category '->' ListSymbol { Rule $1 $3 $4 $6 $8 } Rule : Fun ':' Profile '.' Category '->' ListSymbol { Rule $1 $3 $5 $7 }
ListRule :: { [Rule] } ListRule :: { [Rule] }
@@ -68,6 +69,11 @@ ListRule : {- empty -} { [] }
| ListRule Rule ';' { flip (:) $1 $2 } | ListRule Rule ';' { flip (:) $1 $2 }
Fun :: { Fun }
Fun : Ident { Cons $1 }
| '_' { Coerce }
Profile :: { Profile } Profile :: { Profile }
Profile : '[' ListInts ']' { Profile $2 } Profile : '[' ListInts ']' { Profile $2 }
@@ -99,10 +105,6 @@ ListSymbol : '.' { [] }
| Symbol ListSymbol { (:) $1 $2 } | Symbol ListSymbol { (:) $1 $2 }
Name :: { Name }
Name : SingleQuoteString { Name $1 }
Category :: { Category } Category :: { Category }
Category : SingleQuoteString { Category $1 } Category : SingleQuoteString { Category $1 }

View File

@@ -1,4 +1,3 @@
module PrintCFG where module PrintCFG where
-- pretty-printer generated by the BNF converter -- pretty-printer generated by the BNF converter
@@ -15,20 +14,22 @@ type Doc = [ShowS] -> [ShowS]
doc :: ShowS -> Doc doc :: ShowS -> Doc
doc = (:) doc = (:)
-- seriously hacked spacing
render :: Doc -> String render :: Doc -> String
render d = rend 0 (map ($ "") $ d []) "" where render d = rend 0 (map ($ "") $ d []) "" where
rend i ss = case ss of rend i ss = case ss of
";" :ts -> showString ";" . new i . rend i ts "[" :ts -> showChar '[' . rend i ts
-- H removed a bunch of cases here "(" :ts -> showChar '(' . rend i ts
"]":".":ts -> showString "]" . space "." . rend i ts -- H "{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts
t:t' :ts | noSpace t' -> showString t . showString t' . rend i ts -- H "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
t :ts | noSpace t -> showString t . rend i ts -- H "}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
t :ts -> space t . rend i ts ";" :ts -> showChar ';' . new i . rend i ts
_ -> id t : "," :ts -> showString t . space "," . rend i ts
t : ")" :ts -> showString t . showChar ')' . rend i ts
t : "]" :ts -> showString t . showChar ']' . rend i ts
t :ts -> space t . rend i ts
_ -> id
new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
space t = showString t . (\s -> if null s then "" else (' ':s)) space t = showString t . (\s -> if null s then "" else (' ':s))
noSpace t = t `elem` ["[","]","{","}",",","/",":",".","!"] -- H
parenth :: Doc -> Doc parenth :: Doc -> Doc
parenth ss = doc (showChar '(') . ss . doc (showChar ')') parenth ss = doc (showChar '(') . ss . doc (showChar ')')
@@ -111,12 +112,18 @@ instance Print Flag where
instance Print Rule where instance Print Rule where
prt i e = case e of prt i e = case e of
Rule id name profile category symbols -> prPrec i 0 (concatD [prt 0 id , doc (showString ":") , prt 0 name , prt 0 profile , doc (showString ".") , prt 0 category , doc (showString "->") , prt 0 symbols]) Rule fun profile category symbols -> prPrec i 0 (concatD [prt 0 fun , doc (showString ":") , prt 0 profile , doc (showString ".") , prt 0 category , doc (showString "->") , prt 0 symbols])
prtList es = case es of prtList es = case es of
[] -> (concatD []) [] -> (concatD [])
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Fun where
prt i e = case e of
Cons id -> prPrec i 0 (concatD [prt 0 id])
Coerce -> prPrec i 0 (concatD [doc (showString "_")])
instance Print Profile where instance Print Profile where
prt i e = case e of prt i e = case e of
Profile intss -> prPrec i 0 (concatD [doc (showString "[") , prt 0 intss , doc (showString "]")]) Profile intss -> prPrec i 0 (concatD [doc (showString "[") , prt 0 intss , doc (showString "]")])
@@ -141,11 +148,6 @@ instance Print Symbol where
[x] -> (concatD [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concatD [prt 0 x , prt 0 xs]) x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print Name where
prt i e = case e of
Name singlequotestring -> prPrec i 0 (concatD [prt 0 singlequotestring])
instance Print Category where instance Print Category where
prt i e = case e of prt i e = case e of
Category singlequotestring -> prPrec i 0 (concatD [prt 0 singlequotestring]) Category singlequotestring -> prPrec i 0 (concatD [prt 0 singlequotestring])

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/03/21 14:17:44 $ -- > CVS $Date: 2005/03/21 14:27:10 $
-- > CVS $Author: peb $ -- > CVS $Author: bringert $
-- > CVS $Revision: 1.10 $ -- > CVS $Revision: 1.11 $
-- --
-- Handles printing a CFGrammar in CFGM format. -- Handles printing a CFGrammar in CFGM format.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -49,7 +49,7 @@ getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x]
-- instead of 'Cnv.pInfo' (which recalculates the grammar every time) -- instead of 'Cnv.pInfo' (which recalculates the grammar every time)
prLangAsCFGM :: CanonGrammar -> Ident -> Maybe String -> String prLangAsCFGM :: CanonGrammar -> Ident -> Maybe String -> String
prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.cfg (Cnv.pInfo opts gr i)) i start prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.cfg (Cnv.pInfo opts gr i)) i start
where opts = Option.noOptions where opts = Option.Opts [Option.gfcConversion "nondet"]
{- {-
prCFGrammarAsCFGM :: GT.CFGrammar -> Ident -> Maybe String -> String prCFGrammarAsCFGM :: GT.CFGrammar -> Ident -> Maybe String -> String
@@ -71,11 +71,10 @@ cfGrammarToCFGM gr i start = AbsCFG.Grammar (identToCFGMIdent i) flags (map rule
ruleToCFGMRule :: GT.CFRule -> AbsCFG.Rule ruleToCFGMRule :: GT.CFRule -> AbsCFG.Rule
-- new version, without the MCFName constructor: -- new version, without the MCFName constructor:
ruleToCFGMRule (CFGrammar.Rule c rhs (GT.CFName ({-GT.MCFName-} fun {-cat args-}) {-lbl-} profile)) ruleToCFGMRule (CFGrammar.Rule c rhs (GT.CFName fun profile))
= AbsCFG.Rule fun' n' p' c' rhs' = AbsCFG.Rule fun' p' c' rhs'
where where
fun' = identToCFGMIdent fun fun' = identToFun fun
n' = strToCFGMName "this_should_disappear"
p' = profileToCFGMProfile profile p' = profileToCFGMProfile profile
c' = catToCFGMCat c c' = catToCFGMCat c
rhs' = map symbolToGFCMSymbol rhs rhs' = map symbolToGFCMSymbol rhs
@@ -97,15 +96,16 @@ profileToCFGMProfile = AbsCFG.Profile . map (AbsCFG.Ints . map fromIntegral)
identToCFGMIdent :: Ident -> AbsCFG.Ident identToCFGMIdent :: Ident -> AbsCFG.Ident
identToCFGMIdent = AbsCFG.Ident . Prt.prt identToCFGMIdent = AbsCFG.Ident . Prt.prt
identToFun :: Ident -> AbsCFG.Fun
identToFun IW = AbsCFG.Coerce
identToFun i = AbsCFG.Cons (identToCFGMIdent i)
strToCFGMCat :: String -> AbsCFG.Category strToCFGMCat :: String -> AbsCFG.Category
strToCFGMCat = AbsCFG.Category . AbsCFG.SingleQuoteString . quoteSingle strToCFGMCat = AbsCFG.Category . AbsCFG.SingleQuoteString . quoteSingle
catToCFGMCat :: GT.CFCat -> AbsCFG.Category catToCFGMCat :: GT.CFCat -> AbsCFG.Category
catToCFGMCat = strToCFGMCat . Prt.prt catToCFGMCat = strToCFGMCat . Prt.prt
strToCFGMName :: String -> AbsCFG.Name
strToCFGMName = AbsCFG.Name . AbsCFG.SingleQuoteString . quoteSingle
symbolToGFCMSymbol :: Parser.Symbol GT.CFCat GT.Tokn -> AbsCFG.Symbol symbolToGFCMSymbol :: Parser.Symbol GT.CFCat GT.Tokn -> AbsCFG.Symbol
symbolToGFCMSymbol (Parser.Cat c) = AbsCFG.CatS (catToCFGMCat c) symbolToGFCMSymbol (Parser.Cat c) = AbsCFG.CatS (catToCFGMCat c)
symbolToGFCMSymbol (Parser.Tok t) = AbsCFG.TermS (Prt.prt t) symbolToGFCMSymbol (Parser.Tok t) = AbsCFG.TermS (Prt.prt t)