From 476a92ba1900205b012380b5146a36b00d554319 Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 4 Dec 2007 07:40:47 +0000 Subject: [PATCH] SourceToGF working though not complete --- src/GF/Devel/Grammar/GF.cf | 49 +++++++++++------------------- src/GF/Devel/Grammar/SourceToGF.hs | 43 ++++++++++++++------------ 2 files changed, 42 insertions(+), 50 deletions(-) diff --git a/src/GF/Devel/Grammar/GF.cf b/src/GF/Devel/Grammar/GF.cf index 0e2a6a0d8..6fc9307b2 100644 --- a/src/GF/Devel/Grammar/GF.cf +++ b/src/GF/Devel/Grammar/GF.cf @@ -34,8 +34,6 @@ MGrammar. ModType ::= "grammar" PIdent ; MInterface. ModType ::= "interface" PIdent ; MConcrete. ModType ::= "concrete" PIdent "of" PIdent ; MInstance. ModType ::= "instance" PIdent "of" PIdent ; -MTransfer. ModType ::= "transfer" PIdent ":" Open "->" Open ; - MBody. ModBody ::= Extend Opens "{" [TopDef] "}" ; MNoBody. ModBody ::= [Included] ; @@ -69,13 +67,6 @@ IAll. Included ::= PIdent ; ISome. Included ::= PIdent "[" [PIdent] "]" ; IMinus. Included ::= PIdent "-" "[" [PIdent] "]" ; --- definitions after the $oper$ keywords - -DDecl. Def ::= [Name] ":" Exp ; -DDef. Def ::= [Name] "=" Exp ; -DPatt. Def ::= Name [Patt] "=" Exp ; -- non-empty pattern list -DFull. Def ::= [Name] ":" Exp "=" Exp ; - -- top-level definitions DefCat. TopDef ::= "cat" [CatDef] ; @@ -84,50 +75,46 @@ DefFunData.TopDef ::= "data" [FunDef] ; DefDef. TopDef ::= "def" [Def] ; DefData. TopDef ::= "data" [DataDef] ; -DefTrans. TopDef ::= "transfer" [Def] ;--% - DefPar. TopDef ::= "param" [ParDef] ; DefOper. TopDef ::= "oper" [Def] ; -DefLincat. TopDef ::= "lincat" [PrintDef] ; +DefLincat. TopDef ::= "lincat" [Def] ; DefLindef. TopDef ::= "lindef" [Def] ; DefLin. TopDef ::= "lin" [Def] ; -DefPrintCat. TopDef ::= "printname" "cat" [PrintDef] ; -DefPrintFun. TopDef ::= "printname" "fun" [PrintDef] ; -DefFlag. TopDef ::= "flags" [FlagDef] ; +DefPrintCat. TopDef ::= "printname" "cat" [Def] ; +DefPrintFun. TopDef ::= "printname" "fun" [Def] ; +DefFlag. TopDef ::= "flags" [Def] ; + +-- definitions after most keywords + +DDecl. Def ::= [Name] ":" Exp ; +DDef. Def ::= [Name] "=" Exp ; +DPatt. Def ::= Name [Patt] "=" Exp ; -- non-empty pattern list +DFull. Def ::= [Name] ":" Exp "=" Exp ; + +FDecl. FunDef ::= [Name] ":" Exp ; SimpleCatDef. CatDef ::= PIdent [DDecl] ; ListCatDef. CatDef ::= "[" PIdent [DDecl] "]" ; ListSizeCatDef. CatDef ::= "[" PIdent [DDecl] "]" "{" Integer "}" ; -FunDef. FunDef ::= [PIdent] ":" Exp ; - -DataDef. DataDef ::= PIdent "=" [DataConstr] ; +DataDef. DataDef ::= Name "=" [DataConstr] ; DataId. DataConstr ::= PIdent ; DataQId. DataConstr ::= PIdent "." PIdent ; separator DataConstr "|" ; - ParDefDir. ParDef ::= PIdent "=" [ParConstr] ; -ParDefIndir. ParDef ::= PIdent "=" "(" "in" PIdent ")" ; ParDefAbs. ParDef ::= PIdent ; ParConstr. ParConstr ::= PIdent [DDecl] ; -PrintDef. PrintDef ::= [Name] "=" Exp ; - -FlagDef. FlagDef ::= PIdent "=" PIdent ; - terminator nonempty Def ";" ; -terminator nonempty CatDef ";" ; terminator nonempty FunDef ";" ; +terminator nonempty CatDef ";" ; terminator nonempty DataDef ";" ; terminator nonempty ParDef ";" ; -terminator nonempty PrintDef ";" ; -terminator nonempty FlagDef ";" ; - separator ParConstr "|" ; separator nonempty PIdent "," ; @@ -149,7 +136,7 @@ separator LocDef ";" ; -- terms and types -EPIdent. Exp6 ::= PIdent ; +EPIdent. Exp6 ::= PIdent ; EConstr. Exp6 ::= "{" PIdent "}" ;--% ECons. Exp6 ::= "%" PIdent "%" ;--% ESort. Exp6 ::= Sort ; @@ -310,7 +297,7 @@ FString. FileName ::= String ; --% terminator nonempty FileName ";" ; --% -FPIdent. FileName ::= PIdent ; --% +FPIdent. FileName ::= PIdent ; --% FSlash. FileName ::= "/" FileName ; --% FDot. FileName ::= "." FileName ; --% FMinus. FileName ::= "-" FileName ; --% @@ -320,7 +307,7 @@ token LString '\'' (char - '\'')* '\'' ; --% ELString. Exp6 ::= LString ; --% ELin. Exp4 ::= "Lin" PIdent ; --% -DefPrintOld. TopDef ::= "printname" [PrintDef] ; --% +DefPrintOld. TopDef ::= "printname" [Def] ; --% DefLintype. TopDef ::= "lintype" [Def] ; --% DefPattern. TopDef ::= "pattern" [Def] ; --% diff --git a/src/GF/Devel/Grammar/SourceToGF.hs b/src/GF/Devel/Grammar/SourceToGF.hs index a7b8b7a09..496202e80 100644 --- a/src/GF/Devel/Grammar/SourceToGF.hs +++ b/src/GF/Devel/Grammar/SourceToGF.hs @@ -14,10 +14,10 @@ module GF.Devel.Grammar.SourceToGF ( transGrammar, - transInclude, transModDef, - transOldGrammar, transExp, +---- transOldGrammar, +---- transInclude, newReservedWords ) where @@ -73,7 +73,7 @@ transModDef :: ModDef -> Err (Ident,Module) transModDef x = case x of MModule compl mtyp body -> do - ---- let mstat' = transComplMod compl + --- let mstat' = transComplMod compl (trDef, mtyp', id') <- case mtyp of MAbstract id -> do @@ -98,8 +98,8 @@ transModDef x = case x of extends' <- transExtend extends opens' <- transOpens opens defs0 <- mapM trDef $ getTopDefs defs - defs' <- return $ Map.fromList [d | Left ds <- defs0, d <- ds] - flags' <- return Map.empty ---- [f | Right fs <- defs0, f <- fs] + let defs' = Map.fromList [(i,Left d) | Left ds <- defs0, (i,d) <- ds] + let flags' = Map.fromList [f | Right fs <- defs0, f <- fs] return (id', Module mtyp' [] [] extends' opens' flags' defs') MWith m insts -> mkBody xx $ MWithEBody [] m insts NoOpens [] @@ -111,8 +111,8 @@ transModDef x = case x of insts' <- mapM transOpen insts opens' <- transOpens opens defs0 <- mapM trDef $ getTopDefs defs - defs' <- return $ Map.fromList [d | Left ds <- defs0, d <- ds] - flags' <- return Map.empty ---- [f | Right fs <- defs0, f <- fs] + let defs' = Map.fromList [(i,Left d) | Left ds <- defs0, (i,d) <- ds] + let flags' = Map.fromList [f | Right fs <- defs0, f <- fs] return (id', Module mtyp' [] [(m',insts')] extends' opens' flags' defs') _ -> fail "deprecated module form" @@ -169,9 +169,10 @@ transAbsDef x = case x of returnl $ [(c, G.AbsCat nope (yes ps)) | (c,ps) <- ds'] ++ [(f, G.AbsFun nope (yes G.EData)) | (_,fs) <- ds', tf <- fs, f <- funs tf] - DefFlag defs -> liftM Right $ mapM transFlagDef defs -} - _ -> Bad $ "illegal definition in abstract module:" ++++ printTree x + DefFlag defs -> liftM (Right . concat) $ mapM transFlagDef defs + _ -> return $ Left [] ---- +---- _ -> Bad $ "illegal definition in abstract module:" ++++ printTree x where -- to get data constructors as terms funs t = case t of @@ -183,12 +184,17 @@ transAbsDef x = case x of returnl :: a -> Err (Either a b) returnl = return . Left -transFlagDef :: FlagDef -> Err [(Ident,String)] +transFlagDef :: Def -> Err [(Ident,String)] transFlagDef x = case x of - FlagDef f x -> do - f' <- transIdent f - x' <- transIdent f - return $ [(f',prIdent x')] + DDef f x -> do + fs <- mapM transName f + x' <- transExp x + v <- case x' of + G.K s -> return s + G.Vr (IC s) -> return s + G.EInt i -> return $ show i + _ -> fail $ "illegal flag value" +++ printTree x + return $ [(f',v) | f' <- fs] -- | Cat definitions can also return some fun defs @@ -226,7 +232,7 @@ transCatDef x = case x of transFunDef :: FunDef -> Err ([Ident], G.Type) transFunDef x = case x of - FunDef ids typ -> liftM2 (,) (mapM transIdent ids) (transExp typ) + FDecl ids typ -> liftM2 (,) (mapM transName ids) (transExp typ) {- ---- transDataDef :: DataDef -> Err (Ident,[G.Term]) @@ -258,7 +264,7 @@ transResDef x = case x of defs' <- liftM concat $ mapM getDefs defs returnl [(f, resOper pt pe) | (f,(pt,pe)) <- defs'] - DefFlag defs -> liftM Right $ mapM transFlagDef defs + DefFlag defs -> liftM (Right . concat) $ mapM transFlagDef defs _ -> Bad $ "illegal definition form in resource" +++ printTree x where mkOverload (c,j) = case j of @@ -280,7 +286,6 @@ transParDef :: ParDef -> Err (Ident, [(Ident,G.Context)]) transParDef x = case x of ParDefDir id params -> liftM2 (,) (transIdent id) (mapM transParConstr params) ParDefAbs id -> liftM2 (,) (transIdent id) (return []) - _ -> Bad $ "illegal definition in resource:" ++++ printTree x transCncDef :: TopDef -> Err (Either [(Ident,Judgement)] [(Ident,String)]) transCncDef x = case x of @@ -311,9 +316,9 @@ transCncDef x = case x of -} _ -> errIn ("illegal definition in concrete syntax:") $ transResDef x -transPrintDef :: PrintDef -> Err [(Ident,G.Term)] +transPrintDef :: Def -> Err [(Ident,G.Term)] transPrintDef x = case x of - PrintDef ids exp -> do + DDef ids exp -> do (ids,e) <- liftM2 (,) (mapM transName ids) (transExp exp) return $ [(i,e) | i <- ids]