forked from GitHub/gf-core
data defs
This commit is contained in:
@@ -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" ;
|
||||
|
||||
@@ -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" ;
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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))]]
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user