GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-21 10:49:33 -06:00
Code Issues Packages Projects Releases Wiki Activity

restricted inheritance almost implemented

Browse Source
This commit is contained in:
aarne
2005-05-30 20:08:14 +00:00
parent 5bf9a7fe70
commit 3a3342a0f9
10 changed files with 77 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
src/GF/Source/GrammarToSource.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/26 14:18:17 $
-- > CVS $Date: 2005/05/30 21:08:15 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.21 $
-- > CVS $Revision: 1.22 $
--
-- From internal source syntax to BNFC-generated (used for printing).
-----------------------------------------------------------------------------
@@ -45,12 +45,17 @@ trModule (i,mo) = case mo of
MTInstance a -> P.MTInstance i' (tri a)
MTInterface -> P.MTInterface i'
body = P.MBody
(trExtend (extends m))
(trExtends (extend m))
(mkOpens (map trOpen (opens m)))
(mkTopDefs (concatMap trAnyDef (tree2list (jments m)) ++ map trFlag (flags m)))
trExtend :: [Ident] -> P.Extend
trExtend i = ifNull P.NoExt (P.Ext . map (P.IAll . tri)) i ---- IAll
trExtends :: [(Ident,MInclude Ident)] -> P.Extend
trExtends [] = P.NoExt
trExtends es = (P.Ext $ map tre es) where
tre (i,c) = case c of
MIAll -> P.IAll (tri i)
MIOnly is -> P.ISome (tri i) (map tri is)
MIExcept is -> P.IMinus (tri i) (map tri is)
---- this has to be completed with other mtys
forName (MTConcrete a) = tri a

18
src/GF/Source/SourceToGrammar.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/30 18:39:44 $
-- > CVS $Date: 2005/05/30 21:08:15 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.25 $
-- > CVS $Revision: 1.26 $
--
-- based on the skeleton Haskell module generated by the BNF converter
-----------------------------------------------------------------------------
@@ -112,7 +112,7 @@ transModDef x = case x of
opens' <- mapM transOpen opens
return (id', GM.ModWith mtyp' mstat' m' [] opens')
MWithE extends m opens -> do
extends' <- mapM transIncludedExt extends
extends' <- liftM (map fst) $ mapM transIncludedExt extends
m' <- transIdent m
opens' <- mapM transOpen opens
return (id', GM.ModWith mtyp' mstat' m' extends' opens')
@@ -168,7 +168,7 @@ transTransfer x = case x of
TransferIn open -> liftM Left $ transOpen open
TransferOut open -> liftM Right $ transOpen open
transExtend :: Extend -> Err [Ident]
transExtend :: Extend -> Err [(Ident,GM.MInclude Ident)]
transExtend x = case x of
Ext ids -> mapM transIncludedExt ids
NoExt -> return []
@@ -192,15 +192,15 @@ transQualOpen x = case x of
transIncluded :: Included -> Err (Ident,[Ident])
transIncluded x = case x of
IAll i -> liftM (flip (curry id) []) $ transIdent i
IAll i -> liftM (flip (curry id) []) $ transIdent i
ISome i ids -> liftM2 (curry id) (transIdent i) (mapM transIdent ids)
IMinus i ids -> liftM2 (curry id) (transIdent i) (mapM transIdent ids) ----
transIncludedExt :: Included -> Err Ident ---- (Ident,[Ident])
transIncludedExt :: Included -> Err (Ident, GM.MInclude Ident)
transIncludedExt x = case x of
IAll i -> transIdent i
ISome i ids -> transIdent i
IMinus i ids -> transIdent i
IAll i -> liftM2 (,) (transIdent i) (return GM.MIAll)
ISome i ids -> liftM2 (,) (transIdent i) (liftM GM.MIOnly $ mapM transIdent ids)
IMinus i ids -> liftM2 (,) (transIdent i) (liftM GM.MIExcept $ mapM transIdent ids)
transAbsDef :: TopDef -> Err (Either [(Ident, G.Info)] [GO.Option])
transAbsDef x = case x of