diff options
Diffstat (limited to 'src/GF/Compile')
| -rw-r--r-- | src/GF/Compile/CheckGrammar.hs | 4 | ||||
| -rw-r--r-- | src/GF/Compile/GrammarToCanon.hs | 4 | ||||
| -rw-r--r-- | src/GF/Compile/Rename.hs | 15 |
3 files changed, 18 insertions, 5 deletions
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index 544214cb9..07151d8b7 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -42,6 +42,10 @@ checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod js' <- mapMTree (checkAbsInfo gr name) js return $ (name, ModMod (Module mt fs me ops js')) : ms + MTTransfer a b -> do + js' <- mapMTree (checkAbsInfo gr name) js + return $ (name, ModMod (Module mt fs me ops js')) : ms + MTResource -> do js' <- mapMTree (checkResInfo gr) js return $ (name, ModMod (Module mt fs me ops js')) : ms diff --git a/src/GF/Compile/GrammarToCanon.hs b/src/GF/Compile/GrammarToCanon.hs index 23833a3c2..07708dd3c 100644 --- a/src/GF/Compile/GrammarToCanon.hs +++ b/src/GF/Compile/GrammarToCanon.hs @@ -43,6 +43,7 @@ redModInfo (c,info) = do return (a', MTConcrete a') MTAbstract -> return (c',MTAbstract) --- c' not needed MTResource -> return (c',MTResource) --- c' not needed + MTTransfer x y -> return (c',MTTransfer (om x) (om y)) --- c' not needed defss <- mapM (redInfo a) $ tree2list $ jments m defs <- return $ sorted2tree $ concat defss -- sorted, but reduced return $ ModMod $ Module mt flags e os defs @@ -54,6 +55,7 @@ redModInfo (c,info) = do _ -> return Nothing os' <- mapM (\ (OQualif _ i) -> liftM OSimple (redIdent i)) $ opens m return (e',os') + om = OSimple . openedModule --- normalizing away qualif redInfo :: Ident -> (Ident,Info) -> Err [(Ident,C.Info)] redInfo am (c,info) = errIn ("translating definition of" +++ prt c) $ do @@ -69,6 +71,8 @@ redInfo am (c,info) = errIn ("translating definition of" +++ prt c) $ do Yes t -> t _ -> EData --- data vs. primitive returns c' $ C.AbsFun typ df + AbsTrans t -> + returns c' $ C.AbsTrans t ResParam (Yes ps) -> do ps' <- mapM redParam ps diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs index eb6f6dcb9..a4d9b9365 100644 --- a/src/GF/Compile/Rename.hs +++ b/src/GF/Compile/Rename.hs @@ -117,7 +117,7 @@ tree2status o = case o of buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Err Status buildStatus gr c mo = let mo' = self2status c mo in case mo of ModMod m -> do - let ops = opens m + let ops = allOpens m mods <- mapM (lookupModule gr . openedModule) ops let sts = map modInfo2status $ zip ops mods return $ if isModCnc m @@ -130,10 +130,14 @@ modInfo2status (o,i) = (o,case i of ) self2status :: Ident -> SourceModInfo -> StatusTree -self2status c i = case i of - ModMod m -> mapTree (info2status (Just c)) (jments m) -- qualify internal ---- ModMod m -> mapTree (resInfo2status Nothing) (jments m) --- change Lookup.qualifAnnot if you change this +self2status c i = mapTree (info2status (Just c)) js where -- qualify internal + js = case i of + ModMod m + | isModTrans m -> sorted2tree $ filter noTrans $ tree2list $ jments m + | otherwise -> jments m + noTrans (_,d) = case d of -- to enable other than transfer js in transfer module + AbsTrans _ -> False + _ -> True forceQualif o = case o of OSimple i -> OQualif i i @@ -145,6 +149,7 @@ renameInfo status (i,info) = errIn ("renaming definition of" +++ prt i) $ AbsCat pco pfs -> liftM2 AbsCat (renPerh (renameContext status) pco) (renPerh (mapM rent) pfs) AbsFun pty ptr -> liftM2 AbsFun (ren pty) (ren ptr) + AbsTrans f -> liftM AbsTrans (rent f) ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr) ResParam pp -> liftM ResParam (renPerh (mapM (renameParam status)) pp) |