mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
remove the transfer modules. We don't need anything special, a transfer module is module without concrete syntax
This commit is contained in:
@@ -62,8 +62,6 @@ checkModule ms (name,mo) = checkIn (text "checking module" <+> ppIdent name) $ d
|
||||
js' <- case mtype mo of
|
||||
MTAbstract -> checkMap (checkAbsInfo gr name mo) js
|
||||
|
||||
MTTransfer a b -> checkMap (checkAbsInfo gr name mo) js
|
||||
|
||||
MTResource -> checkMap (checkResInfo gr name mo) js
|
||||
|
||||
MTConcrete a -> do
|
||||
|
||||
@@ -99,8 +99,7 @@ moduleDeps ms = mapM deps ms where
|
||||
_ -> mt0 == mt
|
||||
-- in the same way; this defines what can be opened
|
||||
compatOType mt0 mt = case mt0 of
|
||||
MTAbstract -> mt == MTAbstract
|
||||
MTTransfer _ _ -> mt == MTAbstract
|
||||
MTAbstract -> mt == MTAbstract
|
||||
_ -> case mt of
|
||||
MTResource -> True
|
||||
MTInterface -> True
|
||||
|
||||
@@ -177,7 +177,6 @@ importsOfModule (m,mi) = (modName m,depModInfo mi [])
|
||||
depModType (MTInterface) xs = xs
|
||||
depModType (MTConcrete m2) xs = modName m2:xs
|
||||
depModType (MTInstance m2) xs = modName m2:xs
|
||||
depModType (MTTransfer o1 o2) xs = depOpen o1 (depOpen o2 xs)
|
||||
|
||||
depExtends es xs = foldr depInclude xs es
|
||||
|
||||
|
||||
@@ -131,7 +131,7 @@ tree2status o = case o of
|
||||
buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Err Status
|
||||
buildStatus gr c mo = let mo' = self2status c mo in do
|
||||
let gr1 = MGrammar ((c,mo) : modules gr)
|
||||
ops = [OSimple e | e <- allExtends gr1 c] ++ allOpens mo
|
||||
ops = [OSimple e | e <- allExtends gr1 c] ++ opens mo
|
||||
mods <- mapM (lookupModule gr1 . openedModule) ops
|
||||
let sts = map modInfo2status $ zip ops mods
|
||||
return $ if isModCnc mo
|
||||
@@ -142,9 +142,7 @@ modInfo2status :: (OpenSpec Ident,SourceModInfo) -> (OpenSpec Ident, StatusTree)
|
||||
modInfo2status (o,mo) = (o,tree2status o (jments mo))
|
||||
|
||||
self2status :: Ident -> SourceModInfo -> StatusTree
|
||||
self2status c m = mapTree (info2status (Just c)) js where -- qualify internal
|
||||
js | isModTrans m = sorted2tree $ tree2list $ jments m
|
||||
| otherwise = jments m
|
||||
self2status c m = mapTree (info2status (Just c)) (jments m)
|
||||
|
||||
forceQualif o = case o of
|
||||
OSimple i -> OQualif i i
|
||||
|
||||
@@ -37,7 +37,6 @@ instance (Ord i, Binary i, Binary a) => Binary (ModInfo i a) where
|
||||
|
||||
instance (Binary i) => Binary (ModuleType i) where
|
||||
put MTAbstract = putWord8 0
|
||||
put (MTTransfer i j) = putWord8 1 >> put (i,j)
|
||||
put MTResource = putWord8 2
|
||||
put (MTConcrete i) = putWord8 3 >> put i
|
||||
put MTInterface = putWord8 4
|
||||
@@ -45,7 +44,6 @@ instance (Binary i) => Binary (ModuleType i) where
|
||||
get = do tag <- getWord8
|
||||
case tag of
|
||||
0 -> return MTAbstract
|
||||
1 -> get >>= \(i,j) -> return (MTTransfer i j)
|
||||
2 -> return MTResource
|
||||
3 -> get >>= return . MTConcrete
|
||||
4 -> return MTInterface
|
||||
|
||||
@@ -91,7 +91,6 @@ import GF.Compile.Update (buildAnyTree)
|
||||
'resource' { T_resource }
|
||||
'strs' { T_strs }
|
||||
'table' { T_table }
|
||||
'transfer' { T_transfer }
|
||||
'variants' { T_variants }
|
||||
'where' { T_where }
|
||||
'with' { T_with }
|
||||
@@ -143,7 +142,6 @@ ModType
|
||||
| 'interface' Ident { (MTInterface, $2) }
|
||||
| 'concrete' Ident 'of' Ident { (MTConcrete $4, $2) }
|
||||
| 'instance' Ident 'of' Ident { (MTInstance $4, $2) }
|
||||
| 'transfer' Ident ':' Open '->' Open { (MTTransfer $4 $6,$2) }
|
||||
|
||||
ModHeaderBody :: { ( [(Ident,MInclude Ident)]
|
||||
, Maybe (Ident,MInclude Ident,[(Ident,Ident)])
|
||||
@@ -701,11 +699,6 @@ checkInfoType (MTInstance _) (id,pos,info) =
|
||||
ResValue _ -> return ()
|
||||
ResOper _ _ -> return ()
|
||||
_ -> failLoc (fst pos) "illegal definition in instance module"
|
||||
checkInfoType (MTTransfer _ _) (id,pos,info) =
|
||||
case info of
|
||||
AbsCat _ _ -> return ()
|
||||
AbsFun _ _ _ -> return ()
|
||||
_ -> failLoc (fst pos) "illegal definition in transfer module"
|
||||
|
||||
|
||||
mkAlts cs = case cs of
|
||||
|
||||
@@ -58,7 +58,6 @@ ppModule q (mn, ModInfo mtype mstat opts exts with opens _ jments _) =
|
||||
modTypeDoc =
|
||||
case mtype of
|
||||
MTAbstract -> text "abstract" <+> ppIdent mn
|
||||
MTTransfer src dst -> text "transfer" <+> ppIdent mn <+> colon <+> ppOpenSpec src <+> text "->" <+> ppOpenSpec dst
|
||||
MTResource -> text "resource" <+> ppIdent mn
|
||||
MTConcrete abs -> text "concrete" <+> ppIdent mn <+> text "of" <+> ppIdent abs
|
||||
MTInterface -> text "interface" <+> ppIdent mn
|
||||
|
||||
@@ -26,7 +26,7 @@ module GF.Infra.Modules (
|
||||
addOpenQualif, flagsModule, allFlags, mapModules,
|
||||
OpenSpec(..),
|
||||
ModuleStatus(..),
|
||||
openedModule, allOpens, depPathModule, allDepsModule, partOfGrammar,
|
||||
openedModule, depPathModule, allDepsModule, partOfGrammar,
|
||||
allExtends, allExtendSpecs, allExtendsPlus, allExtensions,
|
||||
searchPathModule, addModule,
|
||||
emptyMGrammar, emptyModInfo,
|
||||
@@ -34,7 +34,7 @@ module GF.Infra.Modules (
|
||||
abstractOfConcrete, abstractModOfConcrete,
|
||||
lookupModule, lookupModuleType, lookupInfo,
|
||||
lookupPosition, ppPosition,
|
||||
isModAbs, isModRes, isModCnc, isModTrans,
|
||||
isModAbs, isModRes, isModCnc,
|
||||
sameMType, isCompilableModule, isCompleteModule,
|
||||
allAbstracts, greatestAbstract, allResources,
|
||||
greatestResource, allConcretes, allConcreteModules
|
||||
@@ -72,7 +72,6 @@ data ModInfo i a = ModInfo {
|
||||
-- | encoding the type of the module
|
||||
data ModuleType i =
|
||||
MTAbstract
|
||||
| MTTransfer (OpenSpec i) (OpenSpec i)
|
||||
| MTResource
|
||||
| MTConcrete i
|
||||
-- ^ up to this, also used in GFC. Below, source only.
|
||||
@@ -141,18 +140,12 @@ openedModule o = case o of
|
||||
OSimple m -> m
|
||||
OQualif _ m -> m
|
||||
|
||||
allOpens :: ModInfo i a -> [OpenSpec i]
|
||||
allOpens m = case mtype m of
|
||||
MTTransfer a b -> a : b : opens m
|
||||
_ -> opens m
|
||||
|
||||
-- | initial dependency list
|
||||
depPathModule :: Ord i => ModInfo i a -> [OpenSpec i]
|
||||
depPathModule m = fors m ++ exts m ++ opens m
|
||||
where
|
||||
fors m =
|
||||
case mtype m of
|
||||
MTTransfer i j -> [i,j]
|
||||
MTConcrete i -> [OSimple i]
|
||||
MTInstance i -> [OSimple i]
|
||||
_ -> []
|
||||
@@ -292,11 +285,6 @@ isModCnc m = case mtype m of
|
||||
MTConcrete _ -> True
|
||||
_ -> False
|
||||
|
||||
isModTrans :: ModInfo i a -> Bool
|
||||
isModTrans m = case mtype m of
|
||||
MTTransfer _ _ -> True
|
||||
_ -> False
|
||||
|
||||
sameMType :: Eq i => ModuleType i -> ModuleType i -> Bool
|
||||
sameMType m n = case (n,m) of
|
||||
(MTConcrete _, MTConcrete _) -> True
|
||||
|
||||
Reference in New Issue
Block a user