GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-09 19:22:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

resources and new instantiation syntax

Browse Source
This commit is contained in:
aarne
2005-02-04 19:17:57 +00:00
parent b8b5139a8a
commit bc05653e82
14 changed files with 584 additions and 535 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
src/GF/Source/AbsGF.hs
View File

@@ -54,6 +54,7 @@ data ModType =
data ModBody =
MBody Extend Opens [TopDef]
| MWith Ident [Open]
| MWithE [Ident] Ident [Open]
| MReuse Ident
| MUnion [Included]
deriving (Eq,Ord,Show)
@@ -65,7 +66,7 @@ data Extend =
data Opens =
NoOpens
| Opens [Open]
| OpenIn [Open]
deriving (Eq,Ord,Show)
data Open =
@@ -138,7 +139,7 @@ data DataConstr =
deriving (Eq,Ord,Show)
data ParDef =
ParDef Ident [ParConstr]
ParDefDir Ident [ParConstr]
| ParDefIndir Ident Ident
| ParDefAbs Ident
deriving (Eq,Ord,Show)

7
src/GF/Source/GF.cf
View File

@@ -39,7 +39,8 @@ MTInstance. ModType ::= "instance" Ident "of" Ident ;
MTTransfer. ModType ::= "transfer" Ident ":" Open "->" Open ;
MBody. ModBody ::= Extend Opens "{" [TopDef] "}" ;
MWith. ModBody ::= Ident "with" [Open] ;
MWith. ModBody ::= Ident "with" [Open] ;
MWithE. ModBody ::= [Ident] "**" Ident "with" [Open] ;
MReuse. ModBody ::= "reuse" Ident ;
MUnion. ModBody ::= "union" [Included] ;
@@ -50,7 +51,7 @@ NoExt. Extend ::= ;
separator Open "," ;
NoOpens. Opens ::= ;
Opens. Opens ::= "open" [Open] "in" ;
OpenIn. Opens ::= "open" [Open] "in" ;
OName. Open ::= Ident ;
OQualQO. Open ::= "(" QualOpen Ident ")" ;
@@ -105,7 +106,7 @@ DataQId. DataConstr ::= Ident "." Ident ;
separator DataConstr "|" ;
ParDef. ParDef ::= Ident "=" [ParConstr] ;
ParDefDir. ParDef ::= Ident "=" [ParConstr] ;
ParDefIndir. ParDef ::= Ident "=" "(" "in" Ident ")" ;
ParDefAbs. ParDef ::= Ident ;

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

@@ -62,7 +62,7 @@ trQualOpen q = case q of
OQInterface -> P.QOInterface
mkOpens ds = if null ds then P.NoOpens else P.Opens ds
mkOpens ds = if null ds then P.NoOpens else P.OpenIn ds
mkTopDefs ds = ds
trAnyDef :: (Ident,Info) -> [P.TopDef]
@@ -80,7 +80,7 @@ trAnyDef (i,info) = let i' = tri i in case info of
ResOper pty ptr -> [P.DefOper [trDef i' pty ptr]]
ResParam pp -> [P.DefPar [case pp of
Yes ps -> P.ParDef i' [P.ParConstr (tri c) (map trDecl co) | (c,co) <- ps]
Yes ps -> P.ParDefDir i' [P.ParConstr (tri c) (map trDecl co) | (c,co) <- ps]
May b -> P.ParDefIndir i' $ tri b
_ -> P.ParDefAbs i']]

22
src/GF/Source/LexGF.hs
View File

@@ -62,20 +62,18 @@ prToken t = case t of
_ -> show t
data BTree = N | B String Tok BTree BTree deriving (Show)
eitherResIdent :: (String -> Tok) -> String -> Tok
eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
isResWord s = isInTree s $
B "lincat" (B "def" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "data" (B "concrete" N N) N))) (B "include" (B "fun" (B "fn" (B "flags" N N) N) (B "in" (B "grammar" N N) N)) (B "interface" (B "instance" (B "incomplete" N N) N) (B "lin" (B "let" N N) N)))) (B "resource" (B "out" (B "of" (B "lintype" (B "lindef" N N) N) (B "oper" (B "open" N N) N)) (B "pattern" (B "param" (B "package" N N) N) (B "printname" (B "pre" N N) N))) (B "union" (B "table" (B "strs" (B "reuse" N N) N) (B "transfer" (B "tokenizer" N N) N)) (B "where" (B "variants" (B "var" N N) N) (B "with" N N))))
eitherResIdent tv s = treeFind resWords
where
treeFind N = tv s
treeFind (B a t left right) | s < a = treeFind left
| s > a = treeFind right
| s == a = t
data BTree = N | B String BTree BTree deriving (Show)
isInTree :: String -> BTree -> Bool
isInTree x tree = case tree of
N -> False
B a left right
| x < a -> isInTree x left
| x > a -> isInTree x right
| x == a -> True
resWords = b "lincat" (b "def" (b "Type" (b "Str" (b "PType" (b "Lin" N N) N) (b "Tok" (b "Strs" N N) N)) (b "cat" (b "case" (b "abstract" N N) N) (b "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "lin" (b "let" N N) N)))) (b "resource" (b "out" (b "of" (b "lintype" (b "lindef" N N) N) (b "oper" (b "open" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "union" (b "table" (b "strs" (b "reuse" N N) N) (b "transfer" (b "tokenizer" N N) N)) (b "where" (b "variants" (b "var" N N) N) (b "with" N N))))
where b s = B s (TS s)
unescapeInitTail :: String -> String
unescapeInitTail = unesc . tail where

22
src/GF/Source/LexGF.x
View File

@@ -68,20 +68,18 @@ prToken t = case t of
_ -> show t
data BTree = N | B String Tok BTree BTree deriving (Show)
eitherResIdent :: (String -> Tok) -> String -> Tok
eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
isResWord s = isInTree s $
B "lincat" (B "def" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "data" (B "concrete" N N) N))) (B "include" (B "fun" (B "fn" (B "flags" N N) N) (B "in" (B "grammar" N N) N)) (B "interface" (B "instance" (B "incomplete" N N) N) (B "lin" (B "let" N N) N)))) (B "resource" (B "out" (B "of" (B "lintype" (B "lindef" N N) N) (B "oper" (B "open" N N) N)) (B "pattern" (B "param" (B "package" N N) N) (B "printname" (B "pre" N N) N))) (B "union" (B "table" (B "strs" (B "reuse" N N) N) (B "transfer" (B "tokenizer" N N) N)) (B "where" (B "variants" (B "var" N N) N) (B "with" N N))))
eitherResIdent tv s = treeFind resWords
where
treeFind N = tv s
treeFind (B a t left right) | s < a = treeFind left
| s > a = treeFind right
| s == a = t
data BTree = N | B String BTree BTree deriving (Show)
isInTree :: String -> BTree -> Bool
isInTree x tree = case tree of
N -> False
B a left right
| x < a -> isInTree x left
| x > a -> isInTree x right
| x == a -> True
resWords = b "lincat" (b "def" (b "Type" (b "Str" (b "PType" (b "Lin" N N) N) (b "Tok" (b "Strs" N N) N)) (b "cat" (b "case" (b "abstract" N N) N) (b "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "lin" (b "let" N N) N)))) (b "resource" (b "out" (b "of" (b "lintype" (b "lindef" N N) N) (b "oper" (b "open" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "union" (b "table" (b "strs" (b "reuse" N N) N) (b "transfer" (b "tokenizer" N N) N)) (b "where" (b "variants" (b "var" N N) N) (b "with" N N))))
where b s = B s (TS s)
unescapeInitTail :: String -> String
unescapeInitTail = unesc . tail where

947
src/GF/Source/ParGF.hs
View File

File diff suppressed because one or more lines are too long

5
src/GF/Source/PrintGF.hs
View File

@@ -158,6 +158,7 @@ instance Print ModBody where
prt i e = case e of
MBody extend opens topdefs -> prPrec i 0 (concatD [prt 0 extend , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
MWith id opens -> prPrec i 0 (concatD [prt 0 id , doc (showString "with") , prt 0 opens])
MWithE ids id opens -> prPrec i 0 (concatD [prt 0 ids , doc (showString "**") , prt 0 id , doc (showString "with") , prt 0 opens])
MReuse id -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 id])
MUnion includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
@@ -171,7 +172,7 @@ instance Print Extend where
instance Print Opens where
prt i e = case e of
NoOpens -> prPrec i 0 (concatD [])
Opens opens -> prPrec i 0 (concatD [doc (showString "open") , prt 0 opens , doc (showString "in")])
OpenIn opens -> prPrec i 0 (concatD [doc (showString "open") , prt 0 opens , doc (showString "in")])
instance Print Open where
@@ -282,7 +283,7 @@ instance Print DataConstr where
instance Print ParDef where
prt i e = case e of
ParDef id parconstrs -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 parconstrs])
ParDefDir id parconstrs -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 parconstrs])
ParDefIndir id0 id -> prPrec i 0 (concatD [prt 0 id0 , doc (showString "=") , doc (showString "(") , doc (showString "in") , prt 0 id , doc (showString ")")])
ParDefAbs id -> prPrec i 0 (concatD [prt 0 id])

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

@@ -96,9 +96,14 @@ transModDef x = case x of
GM.ModMod (GM.Module (GM.MTUnion mtyp' imps') mstat' [] [] [] NT))
MWith m opens -> do
m' <- transIdent m
opens' <- mapM transOpen opens
return (id', GM.ModWith mtyp' mstat' m' opens')
m' <- transIdent m
opens' <- mapM transOpen opens
return (id', GM.ModWith mtyp' mstat' m' [] opens')
MWithE extends m opens -> do
extends' <- mapM transIdent extends
m' <- transIdent m
opens' <- mapM transOpen opens
return (id', GM.ModWith mtyp' mstat' m' extends' opens')
where
mkModRes id mtyp body = do
id' <- transIdent id
@@ -159,7 +164,7 @@ transExtend x = case x of
transOpens :: Opens -> Err [GM.OpenSpec Ident]
transOpens x = case x of
NoOpens -> return []
Opens opens -> mapM transOpen opens
OpenIn opens -> mapM transOpen opens
transOpen :: Open -> Err (GM.OpenSpec Ident)
transOpen x = case x of
@@ -257,7 +262,7 @@ transResDef x = case x of
transParDef :: ParDef -> Err (Ident, [G.Param])
transParDef x = case x of
ParDef id params -> liftM2 (,) (transIdent id) (mapM transParConstr params)
ParDefDir id params -> liftM2 (,) (transIdent id) (mapM transParConstr params)
ParDefAbs id -> liftM2 (,) (transIdent id) (return [])
_ -> Bad $ "illegal definition in resource:" ++++ printTree x
@@ -549,12 +554,12 @@ transOldGrammar opts name0 x = case x of
DefPrintOld printdefs -> (a,r,d:c,ps)
DefPackage m ds -> (a,r,c,(m,ds):ps)
_ -> (a,r,c,ps)
mkAbs a = MModule q (MTAbstract absName) (MBody ne (Opens []) (topDefs a))
mkRes ps r = MModule q (MTResource resName) (MBody ne (Opens ops) (topDefs r))
mkAbs a = MModule q (MTAbstract absName) (MBody ne (OpenIn []) (topDefs a))
mkRes ps r = MModule q (MTResource resName) (MBody ne (OpenIn ops) (topDefs r))
where ops = map OName ps
mkCnc ps r = MModule q (MTConcrete cncName absName)
(MBody ne (Opens (map OName (resName:ps))) (topDefs r))
mkPack (m, ds) = MModule q (MTResource m) (MBody ne (Opens []) (topDefs ds))
(MBody ne (OpenIn (map OName (resName:ps))) (topDefs r))
mkPack (m, ds) = MModule q (MTResource m) (MBody ne (OpenIn []) (topDefs ds))
topDefs t = t
ne = NoExt
q = CMCompl