diff options
Diffstat (limited to 'src/GF/Compile')
| -rw-r--r-- | src/GF/Compile/GFCCtoHaskell.hs | 28 | ||||
| -rw-r--r-- | src/GF/Compile/GFCCtoJS.hs | 2 |
2 files changed, 15 insertions, 15 deletions
diff --git a/src/GF/Compile/GFCCtoHaskell.hs b/src/GF/Compile/GFCCtoHaskell.hs index eb428f221..d44d6705c 100644 --- a/src/GF/Compile/GFCCtoHaskell.hs +++ b/src/GF/Compile/GFCCtoHaskell.hs @@ -59,11 +59,11 @@ haskPreamble name = " gf :: a -> Tree", " fg :: Tree -> a", "", - predefInst "GString" "String" "Lit (LStr s)", + predefInst "GString" "String" "unStr" "mkStr", "", - predefInst "GInt" "Integer" "Lit (LInt s)", + predefInst "GInt" "Integer" "unInt" "mkInt", "", - predefInst "GFloat" "Double" "Lit (LFlt s)", + predefInst "GFloat" "Double" "unDouble" "mkDouble", "", "----------------------------------------------------", "-- below this line machine-generated", @@ -71,14 +71,14 @@ haskPreamble name = "" ] -predefInst gtyp typ patt = +predefInst gtyp typ destr consr = "newtype" +++ gtyp +++ "=" +++ gtyp +++ typ +++ " deriving Show" +++++ "instance Gf" +++ gtyp +++ "where" ++++ - " gf (" ++ gtyp +++ "s) =" +++ patt ++++ + " gf (" ++ gtyp +++ "x) =" +++ consr +++ "x" ++++ " fg t =" ++++ - " case t of" ++++ - " " +++ patt +++ " ->" +++ gtyp +++ "s" ++++ - " _ -> error (\"no" +++ gtyp +++ "\" ++ show t)" + " case "++destr++" t of" ++++ + " Just x -> " +++ gtyp +++ "x" ++++ + " Nothing -> error (\"no" +++ gtyp +++ "\" ++ show t)" type OIdent = String @@ -151,7 +151,7 @@ hInstance gId lexical m (cat,rules) | otherwise = "instance Gf" +++ gId cat +++ "where\n" ++ unlines ([mkInst f xx | (f,xx) <- nonLexicalRules (lexical cat) rules] - ++ if lexical cat then [" gf (" ++ lexicalConstructor cat +++ "x) = Fun (mkCId x) []"] else []) + ++ if lexical cat then [" gf (" ++ lexicalConstructor cat +++ "x) = mkApp (mkCId x) []"] else []) where ec = elemCat cat baseVars = mkVars (baseSize (cat,rules)) @@ -159,7 +159,7 @@ hInstance gId lexical m (cat,rules) (if length xx == 0 then gId f else prParenth (gId f +++ foldr1 (+++) xx')) +++ "=" +++ mkRHS f xx' mkVars n = ["x" ++ show i | i <- [1..n]] - mkRHS f vars = "Fun (mkCId \"" ++ f ++ "\")" +++ + mkRHS f vars = "mkApp (mkCId \"" ++ f ++ "\")" +++ "[" ++ prTList ", " ["gf" +++ x | x <- vars] ++ "]" @@ -167,14 +167,14 @@ hInstance gId lexical m (cat,rules) fInstance _ _ m (cat,[]) = "" fInstance gId lexical m (cat,rules) = " fg t =" ++++ - " case t of" ++++ + " case unApp t of" ++++ unlines [mkInst f xx | (f,xx) <- nonLexicalRules (lexical cat) rules] ++++ - (if lexical cat then " Fun i [] -> " ++ lexicalConstructor cat +++ "(prCId i)" else "") ++++ + (if lexical cat then " (i,[]) -> " ++ lexicalConstructor cat +++ "(prCId i)" else "") ++++ " _ -> error (\"no" +++ cat ++ " \" ++ show t)" where mkInst f xx = - " Fun i " ++ - "[" ++ prTList "," xx' ++ "]" +++ + " Just (i," ++ + "[" ++ prTList "," xx' ++ "])" +++ "| i == mkCId \"" ++ f ++ "\" ->" +++ mkRHS f xx' where xx' = ["x" ++ show i | (_,i) <- zip xx [1..]] mkRHS f vars diff --git a/src/GF/Compile/GFCCtoJS.hs b/src/GF/Compile/GFCCtoJS.hs index dce3949c6..312701e3b 100644 --- a/src/GF/Compile/GFCCtoJS.hs +++ b/src/GF/Compile/GFCCtoJS.hs @@ -1,7 +1,7 @@ module GF.Compile.GFCCtoJS (pgf2js) where import PGF.CId -import PGF.Data +import PGF.Data hiding (mkStr) import qualified PGF.Macros as M import qualified GF.JavaScript.AbsJS as JS import qualified GF.JavaScript.PrintJS as JS |