fix Haskell embedded grammars

This commit is contained in:
krasimir
2008-06-23 08:48:17 +00:00
parent 9d6e3c7b95
commit 8b47619361
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