GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-13 23:09:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

SourceToGF working though not complete

Browse Source
This commit is contained in:
aarne
2007-12-04 07:40:47 +00:00
parent 735790a1b6
commit 476a92ba19
2 changed files with 42 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
src/GF/Devel/Grammar/GF.cf
View File

@@ -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] ; --%

43
src/GF/Devel/Grammar/SourceToGF.hs
View File

@@ -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]