diff options
| author | aarne <aarne@chalmers.se> | 2013-07-24 08:11:16 +0000 |
|---|---|---|
| committer | aarne <aarne@chalmers.se> | 2013-07-24 08:11:16 +0000 |
| commit | 850e02cb6e620aeb9ee37a8867f47ef6b6432009 (patch) | |
| tree | 3da16af5b61b2e10684509482e9918b5fe3e1e5f /src | |
| parent | 5a6f4c3d52ddc3ec6d52b61cf35e6940d2a9cab0 (diff) | |
hs datatype generation for empty abstract types added
Diffstat (limited to 'src')
| -rw-r--r-- | src/compiler/GF/Compile/PGFtoHaskell.hs | 15 |
1 files changed, 12 insertions, 3 deletions
diff --git a/src/compiler/GF/Compile/PGFtoHaskell.hs b/src/compiler/GF/Compile/PGFtoHaskell.hs index 846b1df14..d1032983d 100644 --- a/src/compiler/GF/Compile/PGFtoHaskell.hs +++ b/src/compiler/GF/Compile/PGFtoHaskell.hs @@ -105,7 +105,7 @@ gfinstances gId lexical (m,g) = (foldr (+++++) "") $ (filter (/="")) $ (map (gfI hDatatype :: Prefix -> (OIdent -> Bool) -> (OIdent, [(OIdent, [OIdent])]) -> String hDatatype _ _ ("Cn",_) = "" --- -hDatatype _ _ (cat,[]) = "" +hDatatype gId _ (cat,[]) = "data" +++ gId cat hDatatype gId _ (cat,rules) | isListCat (cat,rules) = "newtype" +++ gId cat +++ "=" +++ gId cat +++ "[" ++ gId (elemCat cat) ++ "]" +++ "deriving Show" @@ -201,7 +201,13 @@ gfInstance :: Prefix -> (OIdent -> Bool) -> String -> (OIdent, [(OIdent, [OIdent gfInstance gId lexical m crs = hInstance gId lexical m crs ++++ fInstance gId lexical m crs ----hInstance m ("Cn",_) = "" --- seems to belong to an old applic. AR 18/5/2004 -hInstance _ _ m (cat,[]) = "" +hInstance gId _ m (cat,[]) = unlines [ + "instance Show" +++ gId cat, + "", + "instance Gf" +++ gId cat +++ "where", + " gf _ = undefined", + " fg _ = undefined" + ] hInstance gId lexical m (cat,rules) | isListCat (cat,rules) = "instance Gf" +++ gId cat +++ "where" ++++ @@ -257,10 +263,13 @@ fInstance gId lexical m (cat,rules) = hSkeleton :: PGF -> (String,HSkeleton) hSkeleton gr = (showCId (absname gr), - [(showCId c, [(showCId f, map showCId cs) | (f, (cs,_)) <- fs]) | + let fs = + [(showCId c, [(showCId f, map showCId cs) | (f, (cs,_)) <- fs]) | fs@((_, (_,c)):_) <- fns] + in fs ++ [(sc, []) | c <- cts, let sc = showCId c, notElem sc (["Int", "Float", "String"] ++ map fst fs)] ) where + cts = Map.keys (cats (abstract gr)) fns = groupBy valtypg (sortBy valtyps (map jty (Map.assocs (funs (abstract gr))))) valtyps (_, (_,x)) (_, (_,y)) = compare x y valtypg (_, (_,x)) (_, (_,y)) = x == y |