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 {
|
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 ;
|
optimize=values ;
|
||||||
|
|
||||||
|
|
||||||
lin
|
lin
|
||||||
airplane_N = mk2N "fly" "flyet" ;
|
airplane_N = mk2N "fly" "flyet" ;
|
||||||
answer_V2S = mkV2S (regV "svare") "til" ;
|
answer_V2S = mkV2S (regV "svare") "til" ;
|
||||||
|
|||||||
@@ -2,10 +2,9 @@
|
|||||||
|
|
||||||
concrete BasicNor of Basic = CategoriesNor ** open ParadigmsNor,VerbsNor in {
|
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 ;
|
optimize=values ;
|
||||||
|
|
||||||
|
|
||||||
lin
|
lin
|
||||||
airplane_N = mk2N "fly" "flyet" ;
|
airplane_N = mk2N "fly" "flyet" ;
|
||||||
answer_V2S = mkV2S (regV "svare") "til" ;
|
answer_V2S = mkV2S (regV "svare") "til" ;
|
||||||
|
|||||||
@@ -2,7 +2,7 @@
|
|||||||
|
|
||||||
concrete BasicSwe of Basic = CategoriesSwe ** open ParadigmsSwe in {
|
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 ;
|
optimize=values ;
|
||||||
|
|
||||||
lin
|
lin
|
||||||
|
|||||||
@@ -5,9 +5,9 @@
|
|||||||
-- Stability : (stable)
|
-- Stability : (stable)
|
||||||
-- Portability : (portable)
|
-- Portability : (portable)
|
||||||
--
|
--
|
||||||
-- > CVS $Date: 2005/05/30 21:08:15 $
|
-- > CVS $Date: 2005/10/04 11:05:07 $
|
||||||
-- > CVS $Author: aarne $
|
-- > CVS $Author: aarne $
|
||||||
-- > CVS $Revision: 1.22 $
|
-- > CVS $Revision: 1.23 $
|
||||||
--
|
--
|
||||||
-- From internal source syntax to BNFC-generated (used for printing).
|
-- From internal source syntax to BNFC-generated (used for printing).
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
@@ -77,11 +77,9 @@ mkTopDefs ds = ds
|
|||||||
|
|
||||||
trAnyDef :: (Ident,Info) -> [P.TopDef]
|
trAnyDef :: (Ident,Info) -> [P.TopDef]
|
||||||
trAnyDef (i,info) = let i' = tri i in case info of
|
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
|
AbsCat (Yes co) pd -> [P.DefCat [P.SimpleCatDef i' (map trDecl co)]]
|
||||||
Yes fs -> [P.DefData [P.DataDef i' [P.DataQId (tri m) (tri c) | QC m c <- fs]]]
|
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
|
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)]]
|
Yes t -> [P.DefDef [P.DDef [mkName i'] (trt t)]]
|
||||||
_ -> []
|
_ -> []
|
||||||
AbsFun (May b) _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]]
|
AbsFun (May b) _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]]
|
||||||
|
|||||||
@@ -5,9 +5,9 @@
|
|||||||
-- Stability : (stable)
|
-- Stability : (stable)
|
||||||
-- Portability : (portable)
|
-- Portability : (portable)
|
||||||
--
|
--
|
||||||
-- > CVS $Date: 2005/10/02 20:50:19 $
|
-- > CVS $Date: 2005/10/04 11:05:07 $
|
||||||
-- > CVS $Author: aarne $
|
-- > CVS $Author: aarne $
|
||||||
-- > CVS $Revision: 1.27 $
|
-- > CVS $Revision: 1.28 $
|
||||||
--
|
--
|
||||||
-- based on the skeleton Haskell module generated by the BNF converter
|
-- 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]
|
returnl [(fun, G.AbsFun (yes typ) nope) | (funs,typ) <- fundefs', fun <- funs]
|
||||||
DefFunData fundefs -> do
|
DefFunData fundefs -> do
|
||||||
fundefs' <- mapM transFunDef fundefs
|
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
|
DefDef defs -> do
|
||||||
defs' <- liftM concat $ mapM getDefsGen defs
|
defs' <- liftM concat $ mapM getDefsGen defs
|
||||||
returnl [(c, G.AbsFun nope pe) | (c,(_,pe)) <- 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
|
SimpleCatDef id ddecls -> liftM (:[]) $ cat id ddecls
|
||||||
ListCatDef id ddecls -> listCat id ddecls 0
|
ListCatDef id ddecls -> listCat id ddecls 0
|
||||||
ListSizeCatDef id ddecls size -> listCat id ddecls size
|
ListSizeCatDef id ddecls size -> listCat id ddecls size
|
||||||
where cat id ddecls = do
|
where
|
||||||
|
cat id ddecls = do
|
||||||
i <- transIdent id
|
i <- transIdent id
|
||||||
cont <- liftM concat $ mapM transDDecl ddecls
|
cont <- liftM concat $ mapM transDDecl ddecls
|
||||||
return (i, G.AbsCat (yes cont) nope)
|
return (i, G.AbsCat (yes cont) nope)
|
||||||
listCat id ddecls size = do
|
listCat id ddecls size = do
|
||||||
let
|
let
|
||||||
li = mkListId id
|
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
|
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]
|
cont = [(mkId x i,ty) | (i,(x,ty)) <- zip [0..] cont0]
|
||||||
xs = map (G.Vr . fst) cont
|
xs = map (G.Vr . fst) cont
|
||||||
cd = M.mkDecl (M.mkApp (G.Vr id) xs)
|
cd = M.mkDecl (M.mkApp (G.Vr id) xs)
|
||||||
lc = M.mkApp (G.Vr li) xs
|
lc = M.mkApp (G.Vr li) xs
|
||||||
niltyp = M.mkProdSimple (cont ++ genericReplicate size cd) lc
|
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
|
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]
|
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 :: FunDef -> Err ([Ident], G.Type)
|
||||||
transFunDef x = case x of
|
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
|
srt d (a,r,c,ps) = case d of
|
||||||
DefCat catdefs -> (d:a,r,c,ps)
|
DefCat catdefs -> (d:a,r,c,ps)
|
||||||
DefFun fundefs -> (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)
|
DefDef defs -> (d:a,r,c,ps)
|
||||||
DefData pardefs -> (d:a,r,c,ps)
|
DefData pardefs -> (d:a,r,c,ps)
|
||||||
DefPar pardefs -> (a,d:r,c,ps)
|
DefPar pardefs -> (a,d:r,c,ps)
|
||||||
|
|||||||
Reference in New Issue
Block a user