1
0
forked from GitHub/gf-core

data defs

This commit is contained in:
aarne
2005-10-04 10:05:06 +00:00
parent df4027f798
commit ecea6794e9
5 changed files with 26 additions and 20 deletions

View File

@@ -2,10 +2,9 @@
concrete BasicDan of Basic = CategoriesDan ** open ParadigmsDan,VerbsDan in {
flags startcat=Phr ; lexer=textlit ; parser=chart ; unlexer=text ;
flags startcat=Phr ; lexer=textlit ; unlexer=text ;
optimize=values ;
lin
airplane_N = mk2N "fly" "flyet" ;
answer_V2S = mkV2S (regV "svare") "til" ;

View File

@@ -2,10 +2,9 @@
concrete BasicNor of Basic = CategoriesNor ** open ParadigmsNor,VerbsNor in {
flags startcat=Phr ; lexer=textlit ; parser=chart ; unlexer=text ;
flags startcat=Phr ; lexer=textlit ; unlexer=text ;
optimize=values ;
lin
airplane_N = mk2N "fly" "flyet" ;
answer_V2S = mkV2S (regV "svare") "til" ;

View File

@@ -2,7 +2,7 @@
concrete BasicSwe of Basic = CategoriesSwe ** open ParadigmsSwe in {
flags startcat=Phr ; lexer=textlit ; parser=chart ; unlexer=text ;
flags startcat=Phr ; lexer=textlit ; unlexer=text ;
optimize=values ;
lin

View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/30 21:08:15 $
-- > CVS $Date: 2005/10/04 11:05:07 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.22 $
-- > CVS $Revision: 1.23 $
--
-- From internal source syntax to BNFC-generated (used for printing).
-----------------------------------------------------------------------------
@@ -77,11 +77,9 @@ mkTopDefs ds = ds
trAnyDef :: (Ident,Info) -> [P.TopDef]
trAnyDef (i,info) = let i' = tri i in case info of
AbsCat (Yes co) pd -> [P.DefCat [P.SimpleCatDef i' (map trDecl co)]] ++ case pd of
Yes fs -> [P.DefData [P.DataDef i' [P.DataQId (tri m) (tri c) | QC m c <- fs]]]
_ -> []
AbsCat (Yes co) pd -> [P.DefCat [P.SimpleCatDef i' (map trDecl co)]]
AbsFun (Yes ty) (Yes EData) -> [P.DefFunData [P.FunDef [i'] (trt ty)]]
AbsFun (Yes ty) pt -> [P.DefFun [P.FunDef [i'] (trt ty)]] ++ case pt of
Yes EData -> [] -- keep this information in data defs only
Yes t -> [P.DefDef [P.DDef [mkName i'] (trt t)]]
_ -> []
AbsFun (May b) _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]]

View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/10/02 20:50:19 $
-- > CVS $Date: 2005/10/04 11:05:07 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.27 $
-- > CVS $Revision: 1.28 $
--
-- based on the skeleton Haskell module generated by the BNF converter
-----------------------------------------------------------------------------
@@ -210,7 +210,12 @@ transAbsDef x = case x of
returnl [(fun, G.AbsFun (yes typ) nope) | (funs,typ) <- fundefs', fun <- funs]
DefFunData fundefs -> do
fundefs' <- mapM transFunDef fundefs
returnl [(fun, G.AbsFun (yes typ) (yes G.EData)) | (funs,typ) <- fundefs', fun <- funs]
returnl $
[(cat, G.AbsCat nope (yes [M.cn fun])) | (funs,typ) <- fundefs',
fun <- funs,
Ok (_,cat) <- [M.valCat typ]
] ++
[(fun, G.AbsFun (yes typ) (yes G.EData)) | (funs,typ) <- fundefs', fun <- funs]
DefDef defs -> do
defs' <- liftM concat $ mapM getDefsGen defs
returnl [(c, G.AbsFun nope pe) | (c,(_,pe)) <- defs']
@@ -246,25 +251,29 @@ transCatDef x = case x of
SimpleCatDef id ddecls -> liftM (:[]) $ cat id ddecls
ListCatDef id ddecls -> listCat id ddecls 0
ListSizeCatDef id ddecls size -> listCat id ddecls size
where cat id ddecls = do
where
cat id ddecls = do
i <- transIdent id
cont <- liftM concat $ mapM transDDecl ddecls
return (i, G.AbsCat (yes cont) nope)
listCat id ddecls size = do
listCat id ddecls size = do
let
li = mkListId id
catd@(_,G.AbsCat (Yes cont0) _) <- cat li ddecls
baseId = mkBaseId id
consId = mkConsId id
catd0@(c,G.AbsCat (Yes cont0) _) <- cat li ddecls
let
catd = (c,G.AbsCat (Yes cont0) (Yes [M.cn baseId,M.cn consId]))
cont = [(mkId x i,ty) | (i,(x,ty)) <- zip [0..] cont0]
xs = map (G.Vr . fst) cont
cd = M.mkDecl (M.mkApp (G.Vr id) xs)
lc = M.mkApp (G.Vr li) xs
niltyp = M.mkProdSimple (cont ++ genericReplicate size cd) lc
nilfund = (mkBaseId id, G.AbsFun (yes niltyp) nope)
nilfund = (baseId, G.AbsFun (yes niltyp) (yes G.EData))
constyp = M.mkProdSimple (cont ++ [cd, M.mkDecl lc]) lc
consfund = (mkConsId id, G.AbsFun (yes constyp) nope)
consfund = (consId, G.AbsFun (yes constyp) (yes G.EData))
return [catd,nilfund,consfund]
mkId x i = if isWildIdent x then (mkIdent "x" i) else x
mkId x i = if isWildIdent x then (mkIdent "x" i) else x
transFunDef :: FunDef -> Err ([Ident], G.Type)
transFunDef x = case x of
@@ -583,6 +592,7 @@ transOldGrammar opts name0 x = case x of
srt d (a,r,c,ps) = case d of
DefCat catdefs -> (d:a,r,c,ps)
DefFun fundefs -> (d:a,r,c,ps)
DefFunData fundefs -> (d:a,r,c,ps)
DefDef defs -> (d:a,r,c,ps)
DefData pardefs -> (d:a,r,c,ps)
DefPar pardefs -> (a,d:r,c,ps)