fix Haskell embedded grammars

This commit is contained in:
krasimir
2008-06-23 08:48:17 +00:00
parent 683a87ad59
commit b3d03db7bd
2 changed files with 8 additions and 8 deletions

View File

@@ -54,14 +54,14 @@ haskPreamble name =
"----------------------------------------------------", "----------------------------------------------------",
"", "",
"class Gf a where", "class Gf a where",
" gf :: a -> Exp", " gf :: a -> Tree",
" fg :: Exp -> a", " fg :: Tree -> a",
"", "",
predefInst "GString" "String" "EStr s", predefInst "GString" "String" "Lit (LStr s)",
"", "",
predefInst "GInt" "Integer" "EInt s", predefInst "GInt" "Integer" "Lit (LInt s)",
"", "",
predefInst "GFloat" "Double" "EFloat s", predefInst "GFloat" "Double" "Lit (LFlt s)",
"", "",
"----------------------------------------------------", "----------------------------------------------------",
"-- below this line machine-generated", "-- below this line machine-generated",
@@ -143,7 +143,7 @@ hInstance m (cat,rules)
(if length xx == 0 then gId f else prParenth (gId f +++ foldr1 (+++) xx')) +++ (if length xx == 0 then gId f else prParenth (gId f +++ foldr1 (+++) xx')) +++
"=" +++ mkRHS f xx' "=" +++ mkRHS f xx'
mkVars n = ["x" ++ show i | i <- [1..n]] mkVars n = ["x" ++ show i | i <- [1..n]]
mkRHS f vars = "EApp (mkCId \"" ++ f ++ "\")" +++ mkRHS f vars = "Fun (mkCId \"" ++ f ++ "\")" +++
"[" ++ prTList ", " ["gf" +++ x | x <- vars] ++ "]" "[" ++ prTList ", " ["gf" +++ x | x <- vars] ++ "]"
@@ -156,7 +156,7 @@ fInstance m (cat,rules) =
" _ -> error (\"no" +++ cat ++ " \" ++ show t)" " _ -> error (\"no" +++ cat ++ " \" ++ show t)"
where where
mkInst f xx = mkInst f xx =
" EApp i " ++ " Fun i " ++
"[" ++ prTList "," xx' ++ "]" +++ "[" ++ prTList "," xx' ++ "]" +++
"| i == mkCId \"" ++ f ++ "\" ->" +++ mkRHS f xx' "| i == mkCId \"" ++ f ++ "\" ->" +++ mkRHS f xx'
where xx' = ["x" ++ show i | (_,i) <- zip xx [1..]] where xx' = ["x" ++ show i | (_,i) <- zip xx [1..]]

View File

@@ -29,7 +29,7 @@ module PGF(
-- * Expressions -- * Expressions
-- ** Tree -- ** Tree
Tree(..), Tree(..), Literal(..),
showTree, readTree, showTree, readTree,
-- ** Expr -- ** Expr