summaryrefslogtreecommitdiff
path: root/src/GF/Source
diff options
context:
space:
mode:
authoraarne <unknown>2003-10-23 15:09:07 +0000
committeraarne <unknown>2003-10-23 15:09:07 +0000
commite620ffbd9432fc9ab4f3174ecf9c117db27af772 (patch)
tree34841dcb47554d6d7a3463d23db1ee92d6f098c8 /src/GF/Source
parent31e0deb017a938bc91f49d8505104d97bc8af14f (diff)
Working with interfaces and incomplete modules.
Diffstat (limited to 'src/GF/Source')
-rw-r--r--src/GF/Source/AbsGF.hs42
-rw-r--r--src/GF/Source/CompileM.hs141
-rw-r--r--src/GF/Source/GF.cf286
-rw-r--r--src/GF/Source/GrammarToSource.hs35
-rw-r--r--src/GF/Source/LexGF.hs4
-rw-r--r--src/GF/Source/PrintGF.hs46
-rw-r--r--src/GF/Source/SkelGF.hs45
-rw-r--r--src/GF/Source/SourceToGrammar.hs117
8 files changed, 474 insertions, 242 deletions
diff --git a/src/GF/Source/AbsGF.hs b/src/GF/Source/AbsGF.hs
index 0dd825891..8acf35349 100644
--- a/src/GF/Source/AbsGF.hs
+++ b/src/GF/Source/AbsGF.hs
@@ -5,7 +5,6 @@ import Ident --H
-- Haskell module generated by the BNF converter, except --H
-- newtype Ident = Ident String deriving (Eq,Ord,Show) --H
-
newtype LString = LString String deriving (Eq,Ord,Show)
data Grammar =
Gr [ModDef]
@@ -13,17 +12,7 @@ data Grammar =
data ModDef =
MMain Ident Ident [ConcSpec]
- | MAbstract Ident Extend Opens [TopDef]
- | MResource Ident Extend Opens [TopDef]
- | MResourceInt Ident Extend Opens [TopDef]
- | MResourceImp Ident Ident Opens [TopDef]
- | MConcrete Ident Ident Extend Opens [TopDef]
- | MConcreteInt Ident Ident Extend Opens [TopDef]
- | MConcreteImp Open Ident Ident
- | MTransfer Ident Open Open Extend Opens [TopDef]
- | MReuseAbs Ident Ident
- | MReuseCnc Ident Ident
- | MReuseAll Ident Extend Ident
+ | MModule ComplMod ModType ModBody
deriving (Eq,Ord,Show)
data ConcSpec =
@@ -39,6 +28,21 @@ data Transfer =
| TransferOut Open
deriving (Eq,Ord,Show)
+data ModType =
+ MTAbstract Ident
+ | MTResource Ident
+ | MTInterface Ident
+ | MTConcrete Ident Ident
+ | MTInstance Ident Ident
+ | MTTransfer Ident Open Open
+ deriving (Eq,Ord,Show)
+
+data ModBody =
+ MBody Extend Opens [TopDef]
+ | MWith Ident [Open]
+ | MReuse Ident
+ deriving (Eq,Ord,Show)
+
data Extend =
Ext Ident
| NoExt
@@ -51,7 +55,19 @@ data Opens =
data Open =
OName Ident
- | OQual Ident Ident
+ | OQualQO QualOpen Ident
+ | OQual QualOpen Ident Ident
+ deriving (Eq,Ord,Show)
+
+data ComplMod =
+ CMCompl
+ | CMIncompl
+ deriving (Eq,Ord,Show)
+
+data QualOpen =
+ QOCompl
+ | QOIncompl
+ | QOInterface
deriving (Eq,Ord,Show)
data Def =
diff --git a/src/GF/Source/CompileM.hs b/src/GF/Source/CompileM.hs
deleted file mode 100644
index 3d97a029e..000000000
--- a/src/GF/Source/CompileM.hs
+++ /dev/null
@@ -1,141 +0,0 @@
-module CompileM where
-
-import Grammar
-import Ident
-import Option
-import PrGrammar
-import Update
-import Lookup
-import Modules
----import Rename
-
-import Operations
-import UseIO
-
-import Monad
-
-compileMGrammar :: Options -> SourceGrammar -> IOE SourceGrammar
-compileMGrammar opts sgr = do
-
- ioeErr $ checkUniqueModuleNames sgr
-
- deps <- ioeErr $ moduleDeps sgr
-
- deplist <- either return
- (\ms -> ioeBad $ "circular modules" +++ unwords (map show ms)) $
- topoTest deps
-
- let deps' = closureDeps deps
-
- foldM (compileModule opts deps' sgr) emptyMGrammar deplist
-
-checkUniqueModuleNames :: MGrammar i f a r c -> Err ()
-checkUniqueModuleNames gr = do
- let ms = map fst $ tree2list $ modules gr
- msg = checkUnique ms
- if null msg then return () else Bad $ unlines msg
-
--- to decide what modules immediately depend on what, and check if the
--- dependencies are appropriate
-
-moduleDeps :: MGrammar i f a c r -> Err Dependencies
-moduleDeps gr = mapM deps $ tree2list $ modules gr where
- deps (c,mi) = errIn ("checking dependencies of module" +++ prt c) $ case mi of
- ModAbs m -> chDep (IdentM c MTAbstract)
- (extends m) MTAbstract (opens m) MTAbstract
- ModRes m -> chDep (IdentM c MTResource)
- (extends m) MTResource (opens m) MTResource
- ModCnc m -> do
- a:ops <- case opens m of
- os@(_:_) -> return os
- _ -> Bad "no abstract indicated for concrete module"
- aty <- lookupModuleType gr a
- testErr (aty == MTAbstract) "the for-module is not an abstract syntax"
- chDep (IdentM c (MTConcrete a)) (extends m) MTResource ops MTResource
-
- chDep it es ety os oty = do
- ests <- mapM (lookupModuleType gr) es
- testErr (all (==ety) ests) "inappropriate extension module type"
- osts <- mapM (lookupModuleType gr) os
- testErr (all (==oty) osts) "inappropriate open module type"
- return (it, [IdentM e ety | e <- es] ++ [IdentM o oty | o <- os])
-
-type Dependencies = [(IdentM Ident,[IdentM Ident])]
-
----compileModule :: Options -> Dependencies -> SourceGrammar ->
---- CanonGrammar -> IdentM -> IOE CanonGrammar
-compileModule opts deps sgr cgr i = do
-
- let name = identM i
-
- testIfCompiled deps name
-
- mi <- ioeErr $ lookupModule sgr name
-
- mi' <- case typeM i of
- -- previously compiled cgr used as symbol table
- MTAbstract -> compileAbstract cgr mi
- MTResource -> compileResource cgr mi
- MTConcrete a -> compileConcrete a cgr mi
-
- ifIsOpt doOutput $ writeCanonFile name mi'
-
- return $ addModule cgr name mi'
-
- where
-
- ifIsOpt o f = if (oElem o opts) then f else return ()
- doOutput = iOpt "o"
-
-
-testIfCompiled :: Dependencies -> Ident -> IOE Bool
-testIfCompiled _ _ = return False ----
-
----writeCanonFile :: Ident -> CanonModInfo -> IOE ()
-writeCanonFile name mi' = ioeIO $ writeFile (canonFileName name) [] ----
-
-canonFileName n = n ++ ".gfc" ---- elsewhere!
-
----compileAbstract :: CanonGrammar -> SourceModInfo -> IOE CanonModInfo
-compileAbstract can (ModAbs m0) = do
- let m1 = renameMAbstract m0
-{-
- checkUnique
- typeCheck
- generateCode
- addToCanon
--}
- ioeBad "compile abs not yet"
-
----compileResource :: CanonGrammar -> SourceModInfo -> IOE CanonModInfo
-compileResource can md = do
-{-
- checkUnique
- typeCheck
- topoSort
- compileOpers -- conservative, since more powerful than lin
- generateCode
- addToCanon
--}
- ioeBad "compile res not yet"
-
----compileConcrete :: Ident -> CanonGrammar -> SourceModInfo -> IOE CanonModInfo
-compileConcrete ab can md = do
-{-
- checkUnique
- checkComplete ab
- typeCheck
- topoSort
- compileOpers
- optimize
- createPreservedOpers
- generateCode
- addToCanon
--}
- ioeBad "compile cnc not yet"
-
-
--- to be imported
-
-closureDeps :: [(a,[a])] -> [(a,[a])]
-closureDeps ds = ds ---- fix-point iteration
diff --git a/src/GF/Source/GF.cf b/src/GF/Source/GF.cf
new file mode 100644
index 000000000..bb1d200cd
--- /dev/null
+++ b/src/GF/Source/GF.cf
@@ -0,0 +1,286 @@
+-- AR 2/5/2003, 14-16 o'clock, Torino
+
+entrypoints Grammar, ModDef, OldGrammar, Exp ; -- let's see if more are needed
+
+comment "--" ;
+comment "{-" "-}" ;
+
+-- the top-level grammar
+
+Gr. Grammar ::= [ModDef] ;
+
+-- semicolon after module is permitted but not obligatory
+
+terminator ModDef "" ;
+_. ModDef ::= ModDef ";" ;
+
+-- The $main$ multilingual grammar structure
+
+MMain. ModDef ::= "grammar" Ident "=" "{" "abstract" "=" Ident ";" [ConcSpec] "}" ;
+
+ConcSpec. ConcSpec ::= Ident "=" ConcExp ;
+separator ConcSpec ";" ;
+
+ConcExp. ConcExp ::= Ident [Transfer] ;
+
+separator Transfer "" ;
+TransferIn. Transfer ::= "(" "transfer" "in" Open ")" ;
+TransferOut. Transfer ::= "(" "transfer" "out" Open ")" ;
+
+-- the individual modules
+
+MModule. ModDef ::= ComplMod ModType "=" ModBody ;
+
+MTAbstract. ModType ::= "abstract" Ident ;
+MTResource. ModType ::= "resource" Ident ;
+MTInterface. ModType ::= "interface" Ident ;
+MTConcrete. ModType ::= "concrete" Ident "of" Ident ;
+MTInstance. ModType ::= "instance" Ident "of" Ident ;
+MTTransfer. ModType ::= "transfer" Ident ":" Open "->" Open ;
+
+MBody. ModBody ::= Extend Opens "{" [TopDef] "}" ;
+MWith. ModBody ::= Ident "with" [Open] ;
+MReuse. ModBody ::= "reuse" Ident ;
+
+separator TopDef "" ;
+
+Ext. Extend ::= Ident "**" ;
+NoExt. Extend ::= ;
+
+separator Open "," ;
+NoOpens. Opens ::= ;
+Opens. Opens ::= "open" [Open] "in" ;
+
+OName. Open ::= Ident ;
+OQualQO. Open ::= "(" QualOpen Ident ")" ;
+OQual. Open ::= "(" QualOpen Ident "=" Ident ")" ;
+
+CMCompl. ComplMod ::= ;
+CMIncompl. ComplMod ::= "incomplete" ;
+
+QOCompl. QualOpen ::= ;
+QOIncompl. QualOpen ::= "incomplete" ;
+QOInterface. QualOpen ::= "interface" ;
+
+-- definitions after the $oper$ keywords
+
+DDecl. Def ::= [Ident] ":" Exp ;
+DDef. Def ::= [Ident] "=" Exp ;
+DPatt. Def ::= Ident [Patt] "=" Exp ; -- non-empty pattern list
+DFull. Def ::= [Ident] ":" Exp "=" Exp ;
+
+-- top-level definitions
+
+DefCat. TopDef ::= "cat" [CatDef] ;
+DefFun. TopDef ::= "fun" [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] ;
+DefLindef. TopDef ::= "lindef" [Def] ;
+DefLin. TopDef ::= "lin" [Def] ;
+
+DefPrintCat. TopDef ::= "printname" "cat" [PrintDef] ;
+DefPrintFun. TopDef ::= "printname" "fun" [PrintDef] ;
+DefFlag. TopDef ::= "flags" [FlagDef] ;
+
+CatDef. CatDef ::= Ident [DDecl] ;
+FunDef. FunDef ::= [Ident] ":" Exp ;
+
+DataDef. DataDef ::= Ident "=" [DataConstr] ;
+DataId. DataConstr ::= Ident ;
+DataQId. DataConstr ::= Ident "." Ident ;
+separator DataConstr "|" ;
+
+
+ParDef. ParDef ::= Ident "=" [ParConstr] ;
+ParDefIndir. ParDef ::= Ident "=" "(" "in" Ident ")" ;
+ParDefAbs. ParDef ::= Ident ;
+
+ParConstr. ParConstr ::= Ident [DDecl] ;
+
+PrintDef. PrintDef ::= [Ident] "=" Exp ;
+
+FlagDef. FlagDef ::= Ident "=" Ident ;
+
+terminator nonempty Def ";" ;
+terminator nonempty CatDef ";" ;
+terminator nonempty FunDef ";" ;
+terminator nonempty DataDef ";" ;
+terminator nonempty ParDef ";" ;
+
+terminator nonempty PrintDef ";" ;
+terminator nonempty FlagDef ";" ;
+
+separator ParConstr "|" ;
+
+separator nonempty Ident "," ;
+
+-- definitions in records and $let$ expressions
+
+LDDecl. LocDef ::= [Ident] ":" Exp ;
+LDDef. LocDef ::= [Ident] "=" Exp ;
+LDFull. LocDef ::= [Ident] ":" Exp "=" Exp ;
+
+separator LocDef ";" ;
+
+-- terms and types
+
+EIdent. Exp4 ::= Ident ;
+EConstr. Exp4 ::= "{" Ident "}" ;
+ECons. Exp4 ::= "[" Ident "]" ;
+ESort. Exp4 ::= Sort ;
+EString. Exp4 ::= String ;
+EInt. Exp4 ::= Integer ;
+EMeta. Exp4 ::= "?" ;
+EEmpty. Exp4 ::= "[" "]" ;
+EStrings. Exp4 ::= "[" String "]" ;
+ERecord. Exp4 ::= "{" [LocDef] "}" ; -- !
+ETuple. Exp4 ::= "<" [TupleComp] ">" ; --- needed for separator ","
+EIndir. Exp4 ::= "(" "in" Ident ")" ; -- indirection, used in judgements
+ETyped. Exp4 ::= "<" Exp ":" Exp ">" ; -- typing, used for annotations
+
+EProj. Exp3 ::= Exp3 "." Label ;
+EQConstr. Exp3 ::= "{" Ident "." Ident "}" ; -- qualified constructor
+EQCons. Exp3 ::= "[" Ident "." Ident "]" ; -- qualified constant
+
+EApp. Exp2 ::= Exp2 Exp3 ;
+ETable. Exp2 ::= "table" "{" [Case] "}" ;
+ETTable. Exp2 ::= "table" Exp4 "{" [Case] "}" ;
+ECase. Exp2 ::= "case" Exp "of" "{" [Case] "}" ;
+EVariants. Exp2 ::= "variants" "{" [Exp] "}" ;
+EPre. Exp2 ::= "pre" "{" Exp ";" [Altern] "}" ;
+EStrs. Exp2 ::= "strs" "{" [Exp] "}" ;
+EConAt. Exp2 ::= Ident "@" Exp4 ;
+
+ESelect. Exp1 ::= Exp1 "!" Exp2 ;
+ETupTyp. Exp1 ::= Exp1 "*" Exp2 ;
+EExtend. Exp1 ::= Exp1 "**" Exp2 ;
+
+EAbstr. Exp ::= "\\" [Bind] "->" Exp ;
+ECTable. Exp ::= "\\""\\" [Bind] "=>" Exp ;
+EProd. Exp ::= Decl "->" Exp ;
+ETType. Exp ::= Exp1 "=>" Exp ; -- these are thus right associative
+EConcat. Exp ::= Exp1 "++" Exp ;
+EGlue. Exp ::= Exp1 "+" Exp ;
+ELet. Exp ::= "let" "{" [LocDef] "}" "in" Exp ;
+EEqs. Exp ::= "fn" "{" [Equation] "}" ;
+
+coercions Exp 4 ;
+
+separator Exp ";" ; -- in variants
+
+-- patterns
+
+PW. Patt1 ::= "_" ;
+PV. Patt1 ::= Ident ;
+PCon. Patt1 ::= "{" Ident "}" ;
+PQ. Patt1 ::= Ident "." Ident ;
+PInt. Patt1 ::= Integer ;
+PStr. Patt1 ::= String ;
+PR. Patt1 ::= "{" [PattAss] "}" ;
+PTup. Patt1 ::= "<" [PattTupleComp] ">" ;
+PC. Patt ::= Ident [Patt] ;
+PQC. Patt ::= Ident "." Ident [Patt] ;
+
+coercions Patt 1 ;
+
+PA. PattAss ::= [Ident] "=" Patt ;
+
+-- labels
+
+LIdent. Label ::= Ident ;
+LVar. Label ::= "$" Integer ;
+
+-- basic types
+
+rules Sort ::= "Type" | "PType" | "Tok" | "Str" | "Strs" ;
+
+separator PattAss ";" ;
+
+AltP. PattAlt ::= Patt ;
+
+-- this is explicit to force higher precedence level on rhs
+(:[]). [Patt] ::= Patt1 ;
+(:). [Patt] ::= Patt1 [Patt] ;
+
+separator nonempty PattAlt "|" ;
+
+-- binds in lambdas and lin rules
+
+BIdent. Bind ::= Ident ;
+BWild. Bind ::= "_" ;
+
+separator Bind "," ;
+
+
+-- declarations in function types
+
+DDec. Decl ::= "(" [Bind] ":" Exp ")" ;
+DExp. Decl ::= Exp2 ; -- can thus be an application
+
+-- tuple component (term or pattern)
+
+TComp. TupleComp ::= Exp ;
+PTComp. PattTupleComp ::= Patt ;
+
+separator TupleComp "," ;
+separator PattTupleComp "," ;
+
+-- case branches
+
+Case. Case ::= [PattAlt] "=>" Exp ;
+
+separator nonempty Case ";" ;
+
+-- cases in abstract syntax
+
+Equ. Equation ::= [Patt] "->" Exp ;
+
+separator Equation ";" ;
+
+-- prefix alternatives
+
+Alt. Altern ::= Exp "/" Exp ;
+
+separator Altern ";" ;
+
+-- in a context, higher precedence is required than in function types
+
+DDDec. DDecl ::= "(" [Bind] ":" Exp ")" ;
+DDExp. DDecl ::= Exp4 ; -- can thus *not* be an application
+
+separator DDecl "" ;
+
+
+--------------------------------------
+
+-- for backward compatibility
+
+OldGr. OldGrammar ::= Include [TopDef] ;
+
+NoIncl. Include ::= ;
+Incl. Include ::= "include" [FileName] ;
+
+FString. FileName ::= String ;
+
+terminator nonempty FileName ";" ;
+
+FIdent. FileName ::= Ident ;
+FSlash. FileName ::= "/" FileName ;
+FDot. FileName ::= "." FileName ;
+FMinus. FileName ::= "-" FileName ;
+FAddId. FileName ::= Ident FileName ;
+
+token LString '\'' (char - '\'')* '\'' ;
+ELString. Exp4 ::= LString ;
+ELin. Exp2 ::= "Lin" Ident ;
+
+DefPrintOld. TopDef ::= "printname" [PrintDef] ;
+DefLintype. TopDef ::= "lintype" [Def] ;
+DefPattern. TopDef ::= "pattern" [Def] ;
diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs
index 73f65c85c..1b4185796 100644
--- a/src/GF/Source/GrammarToSource.hs
+++ b/src/GF/Source/GrammarToSource.hs
@@ -15,16 +15,20 @@ trGrammar (MGrammar ms) = P.Gr (map trModule ms) -- no includes
trModule :: (Ident,SourceModInfo) -> P.ModDef
trModule (i,mo) = case mo of
- ModMod m -> mkModule i' (trExtend (extends m)) (mkOpens (map trOpen (opens m)))
- (mkTopDefs (concatMap trAnyDef (tree2list (jments m)) ++
- (map trFlag (flags m))))
- where
- i' = tri i
- mkModule m = case typeOfModule mo of
- MTResource -> P.MResource m
- MTAbstract -> P.MAbstract m
- MTConcrete a -> P.MConcrete m (tri a)
- MTTransfer a b -> P.MTransfer m (trOpen a) (trOpen b)
+ ModMod m -> P.MModule compl typ body where
+ compl = P.CMCompl -- always complete module
+ i' = tri i
+ typ = case typeOfModule mo of
+ MTResource -> P.MTResource i'
+ MTAbstract -> P.MTAbstract i'
+ MTConcrete a -> P.MTConcrete i' (tri a)
+ MTTransfer a b -> P.MTTransfer i' (trOpen a) (trOpen b)
+ MTInstance a -> P.MTInstance i' (tri a)
+ MTInterface -> P.MTInterface i'
+ body = P.MBody
+ (trExtend (extends m))
+ (mkOpens (map trOpen (opens m)))
+ (mkTopDefs (concatMap trAnyDef (tree2list (jments m)) ++ map trFlag (flags m)))
trExtend :: Maybe Ident -> P.Extend
trExtend i = maybe P.NoExt (P.Ext . tri) i
@@ -34,8 +38,15 @@ forName (MTConcrete a) = tri a
trOpen :: OpenSpec Ident -> P.Open
trOpen o = case o of
- OSimple i -> P.OName (tri i)
- OQualif i j -> P.OQual (tri i) (tri j)
+ OSimple OQNormal i -> P.OQualQO P.QOCompl (tri i)
+ OSimple q i -> P.OQualQO (trQualOpen q) (tri i)
+ OQualif q i j -> P.OQual (trQualOpen q) (tri i) (tri j)
+
+trQualOpen q = case q of
+ OQNormal -> P.QOCompl
+ OQIncomplete -> P.QOIncompl
+ OQInterface -> P.QOInterface
+
mkOpens ds = if null ds then P.NoOpens else P.Opens ds
mkTopDefs ds = ds
diff --git a/src/GF/Source/LexGF.hs b/src/GF/Source/LexGF.hs
index d7ab78725..e27e5b861 100644
--- a/src/GF/Source/LexGF.hs
+++ b/src/GF/Source/LexGF.hs
@@ -55,7 +55,7 @@ tokens_scan = load_scan (tokens_acts,stop_act) tokens_lx
eitherResIdent :: (String -> Tok) -> String -> Tok
eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
isResWord s = isInTree s $
- B "let" (B "concrete" (B "Tok" (B "Str" (B "PType" (B "Lin" N N) N) (B "Strs" N N)) (B "case" (B "abstract" (B "Type" N N) N) (B "cat" N N))) (B "fun" (B "flags" (B "def" (B "data" N N) N) (B "fn" N N)) (B "in" (B "grammar" N N) (B "include" N N)))) (B "pattern" (B "of" (B "lindef" (B "lincat" (B "lin" N N) N) (B "lintype" N N)) (B "out" (B "oper" (B "open" N N) N) (B "param" N N))) (B "strs" (B "resource" (B "printname" (B "pre" N N) N) (B "reuse" N N)) (B "transfer" (B "table" N N) (B "variants" N N))))
+ B "interface" (B "data" (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 "concrete" N N))) (B "grammar" (B "fn" (B "flags" (B "def" N N) N) (B "fun" N N)) (B "incomplete" (B "include" (B "in" N N) N) (B "instance" N N)))) (B "pattern" (B "of" (B "lincat" (B "lin" (B "let" N N) N) (B "lintype" (B "lindef" N N) N)) (B "out" (B "oper" (B "open" N N) N) (B "param" N N))) (B "strs" (B "resource" (B "printname" (B "pre" N N) N) (B "reuse" N N)) (B "variants" (B "transfer" (B "table" N N) N) (B "with" N N))))
data BTree = N | B String BTree BTree deriving (Show)
@@ -114,7 +114,7 @@ lx__14_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('0','0'),[]))
lx__15_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
lx__15_0 = (False,[],15,(('\'','\''),[('\'',16)]))
lx__16_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
-lx__16_0 = (True,[(4,"mk_LString",[],Nothing,Nothing)],15,(('\'','\''),[('\'',16)]))
+lx__16_0 = (True,[(4,"mk_LString",[],Nothing,Nothing)],-1,(('0','0'),[]))
lx__17_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
lx__17_0 = (True,[(5,"ident",[],Nothing,Nothing)],-1,(('\'','\255'),[('\'',17),('0',17),('1',17),('2',17),('3',17),('4',17),('5',17),('6',17),('7',17),('8',17),('9',17),('A',17),('B',17),('C',17),('D',17),('E',17),('F',17),('G',17),('H',17),('I',17),('J',17),('K',17),('L',17),('M',17),('N',17),('O',17),('P',17),('Q',17),('R',17),('S',17),('T',17),('U',17),('V',17),('W',17),('X',17),('Y',17),('Z',17),('_',17),('a',17),('b',17),('c',17),('d',17),('e',17),('f',17),('g',17),('h',17),('i',17),('j',17),('k',17),('l',17),('m',17),('n',17),('o',17),('p',17),('q',17),('r',17),('s',17),('t',17),('u',17),('v',17),('w',17),('x',17),('y',17),('z',17),('\192',17),('\193',17),('\194',17),('\195',17),('\196',17),('\197',17),('\198',17),('\199',17),('\200',17),('\201',17),('\202',17),('\203',17),('\204',17),('\205',17),('\206',17),('\207',17),('\208',17),('\209',17),('\210',17),('\211',17),('\212',17),('\213',17),('\214',17),('\216',17),('\217',17),('\218',17),('\219',17),('\220',17),('\221',17),('\222',17),('\223',17),('\224',17),('\225',17),('\226',17),('\227',17),('\228',17),('\229',17),('\230',17),('\231',17),('\232',17),('\233',17),('\234',17),('\235',17),('\236',17),('\237',17),('\238',17),('\239',17),('\240',17),('\241',17),('\242',17),('\243',17),('\244',17),('\245',17),('\246',17),('\248',17),('\249',17),('\250',17),('\251',17),('\252',17),('\253',17),('\254',17),('\255',17)]))
lx__18_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
diff --git a/src/GF/Source/PrintGF.hs b/src/GF/Source/PrintGF.hs
index 3024d49db..b406f1935 100644
--- a/src/GF/Source/PrintGF.hs
+++ b/src/GF/Source/PrintGF.hs
@@ -7,6 +7,7 @@ import Ident --H
import Char
-- the top-level printing method
+
printTree :: Print a => a -> String
printTree = render . prt 0
@@ -88,17 +89,7 @@ instance Print Grammar where
instance Print ModDef where
prt i e = case e of
MMain id0 id concspecs -> prPrec i 0 (concat [["grammar"] , prt 0 id0 , ["="] , ["{"] , ["abstract"] , ["="] , prt 0 id , [";"] , prt 0 concspecs , ["}"]])
- MAbstract id extend opens topdefs -> prPrec i 0 (concat [["abstract"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
- MResource id extend opens topdefs -> prPrec i 0 (concat [["resource"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
- MResourceInt id extend opens topdefs -> prPrec i 0 (concat [["resource"] , ["abstract"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
- MResourceImp id0 id opens topdefs -> prPrec i 0 (concat [["resource"] , prt 0 id0 , ["of"] , prt 0 id , ["="] , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
- MConcrete id0 id extend opens topdefs -> prPrec i 0 (concat [["concrete"] , prt 0 id0 , ["of"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
- MConcreteInt id0 id extend opens topdefs -> prPrec i 0 (concat [["concrete"] , ["abstract"] , ["of"] , prt 0 id0 , ["in"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
- MConcreteImp open id0 id -> prPrec i 0 (concat [["concrete"] , ["of"] , prt 0 open , ["="] , prt 0 id0 , ["**"] , prt 0 id])
- MTransfer id open0 open extend opens topdefs -> prPrec i 0 (concat [["transfer"] , prt 0 id , [":"] , prt 0 open0 , ["->"] , prt 0 open , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
- MReuseAbs id0 id -> prPrec i 0 (concat [["resource"] , ["abstract"] , prt 0 id0 , ["="] , ["reuse"] , prt 0 id])
- MReuseCnc id0 id -> prPrec i 0 (concat [["resource"] , ["concrete"] , prt 0 id0 , ["="] , ["reuse"] , prt 0 id])
- MReuseAll id0 extend id -> prPrec i 0 (concat [["resource"] , prt 0 id0 , ["="] , prt 0 extend , ["reuse"] , prt 0 id])
+ MModule complmod modtype modbody -> prPrec i 0 (concat [prt 0 complmod , prt 0 modtype , ["="] , prt 0 modbody])
prtList es = case es of
[] -> (concat [])
@@ -127,6 +118,23 @@ instance Print Transfer where
[] -> (concat [])
x:xs -> (concat [prt 0 x , prt 0 xs])
+instance Print ModType where
+ prt i e = case e of
+ MTAbstract id -> prPrec i 0 (concat [["abstract"] , prt 0 id])
+ MTResource id -> prPrec i 0 (concat [["resource"] , prt 0 id])
+ MTInterface id -> prPrec i 0 (concat [["interface"] , prt 0 id])
+ MTConcrete id0 id -> prPrec i 0 (concat [["concrete"] , prt 0 id0 , ["of"] , prt 0 id])
+ MTInstance id0 id -> prPrec i 0 (concat [["instance"] , prt 0 id0 , ["of"] , prt 0 id])
+ MTTransfer id open0 open -> prPrec i 0 (concat [["transfer"] , prt 0 id , [":"] , prt 0 open0 , ["->"] , prt 0 open])
+
+
+instance Print ModBody where
+ prt i e = case e of
+ MBody extend opens topdefs -> prPrec i 0 (concat [prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+ MWith id opens -> prPrec i 0 (concat [prt 0 id , ["with"] , prt 0 opens])
+ MReuse id -> prPrec i 0 (concat [["reuse"] , prt 0 id])
+
+
instance Print Extend where
prt i e = case e of
Ext id -> prPrec i 0 (concat [prt 0 id , ["**"]])
@@ -142,13 +150,27 @@ instance Print Opens where
instance Print Open where
prt i e = case e of
OName id -> prPrec i 0 (concat [prt 0 id])
- OQual id0 id -> prPrec i 0 (concat [["("] , prt 0 id0 , ["="] , prt 0 id , [")"]])
+ OQualQO qualopen id -> prPrec i 0 (concat [["("] , prt 0 qualopen , prt 0 id , [")"]])
+ OQual qualopen id0 id -> prPrec i 0 (concat [["("] , prt 0 qualopen , prt 0 id0 , ["="] , prt 0 id , [")"]])
prtList es = case es of
[] -> (concat [])
[x] -> (concat [prt 0 x])
x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
+instance Print ComplMod where
+ prt i e = case e of
+ CMCompl -> prPrec i 0 (concat [])
+ CMIncompl -> prPrec i 0 (concat [["incomplete"]])
+
+
+instance Print QualOpen where
+ prt i e = case e of
+ QOCompl -> prPrec i 0 (concat [])
+ QOIncompl -> prPrec i 0 (concat [["incomplete"]])
+ QOInterface -> prPrec i 0 (concat [["interface"]])
+
+
instance Print Def where
prt i e = case e of
DDecl ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp])
diff --git a/src/GF/Source/SkelGF.hs b/src/GF/Source/SkelGF.hs
index 5f5c16227..11e5d10a6 100644
--- a/src/GF/Source/SkelGF.hs
+++ b/src/GF/Source/SkelGF.hs
@@ -27,17 +27,7 @@ transGrammar x = case x of
transModDef :: ModDef -> Result
transModDef x = case x of
MMain id0 id concspecs -> failure x
- MAbstract id extend opens topdefs -> failure x
- MResource id extend opens topdefs -> failure x
- MResourceInt id extend opens topdefs -> failure x
- MResourceImp id0 id opens topdefs -> failure x
- MConcrete id0 id extend opens topdefs -> failure x
- MConcreteInt id0 id extend opens topdefs -> failure x
- MConcreteImp open id0 id -> failure x
- MTransfer id open0 open extend opens topdefs -> failure x
- MReuseAbs id0 id -> failure x
- MReuseCnc id0 id -> failure x
- MReuseAll id0 extend id -> failure x
+ MModule complmod modtype modbody -> failure x
transConcSpec :: ConcSpec -> Result
@@ -56,6 +46,23 @@ transTransfer x = case x of
TransferOut open -> failure x
+transModType :: ModType -> Result
+transModType x = case x of
+ MTAbstract id -> failure x
+ MTResource id -> failure x
+ MTInterface id -> failure x
+ MTConcrete id0 id -> failure x
+ MTInstance id0 id -> failure x
+ MTTransfer id open0 open -> failure x
+
+
+transModBody :: ModBody -> Result
+transModBody x = case x of
+ MBody extend opens topdefs -> failure x
+ MWith id opens -> failure x
+ MReuse id -> failure x
+
+
transExtend :: Extend -> Result
transExtend x = case x of
Ext id -> failure x
@@ -71,7 +78,21 @@ transOpens x = case x of
transOpen :: Open -> Result
transOpen x = case x of
OName id -> failure x
- OQual id0 id -> failure x
+ OQualQO qualopen id -> failure x
+ OQual qualopen id0 id -> failure x
+
+
+transComplMod :: ComplMod -> Result
+transComplMod x = case x of
+ CMCompl -> failure x
+ CMIncompl -> failure x
+
+
+transQualOpen :: QualOpen -> Result
+transQualOpen x = case x of
+ QOCompl -> failure x
+ QOIncompl -> failure x
+ QOInterface -> failure x
transDef :: Def -> Result
diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs
index 9e016d711..d01f50fa3 100644
--- a/src/GF/Source/SourceToGrammar.hs
+++ b/src/GF/Source/SourceToGrammar.hs
@@ -35,56 +35,63 @@ transGrammar x = case x of
transModDef :: ModDef -> Err (Ident, G.SourceModInfo)
transModDef x = case x of
+
MMain id0 id concspecs -> do
id0' <- transIdent id0
id' <- transIdent id
concspecs' <- mapM transConcSpec concspecs
return $ (id0', GM.ModMainGrammar (GM.MainGrammar id' concspecs'))
- MAbstract id extends opens defs -> do
- id' <- transIdent id
- extends' <- transExtend extends
- opens' <- transOpens opens
- defs0 <- mapM transAbsDef $ getTopDefs defs
- defs' <- U.buildAnyTree [d | Left ds <- defs0, d <- ds]
- flags <- return [f | Right fs <- defs0, f <- fs]
- return $ (id', GM.ModMod (GM.Module GM.MTAbstract flags extends' opens' defs'))
- MResource id extends opens defs -> do
- id' <- transIdent id
- extends' <- transExtend extends
- opens' <- transOpens opens
- defs0 <- mapM transResDef $ getTopDefs defs
- defs' <- U.buildAnyTree [d | Left ds <- defs0, d <- ds]
- flags <- return [f | Right fs <- defs0, f <- fs]
- return $ (id', GM.ModMod (GM.Module GM.MTResource flags extends' opens' defs'))
- MConcrete id open extends opens defs -> do
- id' <- transIdent id
- open' <- transIdent open
- extends' <- transExtend extends
- opens' <- transOpens opens
- defs0 <- mapM transCncDef $ getTopDefs defs
- defs' <- U.buildAnyTree [d | Left ds <- defs0, d <- ds]
- flags <- return [f | Right fs <- defs0, f <- fs]
- return $ (id',
- GM.ModMod (GM.Module (GM.MTConcrete open') flags extends' opens' defs'))
- MTransfer id open0 open extends opens defs -> do
- id' <- transIdent id
- open0' <- transOpen open0
- open' <- transOpen open
- extends' <- transExtend extends
- opens' <- transOpens opens
- defs0 <- mapM transAbsDef $ getTopDefs defs
- defs' <- U.buildAnyTree [d | Left ds <- defs0, d <- ds]
- flags <- return [f | Right fs <- defs0, f <- fs]
- return $ (id',
- GM.ModMod (GM.Module (GM.MTTransfer open0' open') flags extends' opens' defs'))
-
- MReuseAbs id0 id -> failure x
- MReuseCnc id0 id -> failure x
- MReuseAll r e c -> do
- r' <- transIdent r
- e' <- transExtend e
- c' <- transIdent c
- return $ (r', GM.ModMod (GM.Module (GM.MTReuse c') [] e' [] NT))
+
+ MModule compl mtyp body -> do
+
+ let mstat' = transComplMod compl
+
+ (trDef, mtyp', id') <- case mtyp of
+ MTAbstract id -> do
+ id' <- transIdent id
+ return (transAbsDef, GM.MTAbstract, id')
+ MTResource id -> case body of
+ MReuse c -> do
+ id' <- transIdent id
+ c' <- transIdent c
+ return (transResDef, GM.MTReuse c', id')
+ _ -> do
+ id' <- transIdent id
+ return (transResDef, GM.MTResource, id')
+ MTConcrete id open -> do
+ id' <- transIdent id
+ open' <- transIdent open
+ return (transCncDef, GM.MTConcrete open', id')
+ MTTransfer id a b -> do
+ id' <- transIdent id
+ a' <- transOpen a
+ b' <- transOpen a
+ return (transAbsDef, GM.MTTransfer a' b', id')
+ MTInterface id -> do
+ id' <- transIdent id
+ return (transResDef, GM.MTInterface, id')
+ MTInstance id open -> do
+ id' <- transIdent id
+ open' <- transIdent open
+ return (transResDef, GM.MTInstance open', id')
+
+ (extends', opens', defs',flags') <- case body of
+ MBody extends opens defs -> do
+ extends' <- transExtend extends
+ opens' <- transOpens opens
+ defs0 <- mapM trDef $ getTopDefs defs
+ defs' <- U.buildAnyTree [d | Left ds <- defs0, d <- ds]
+ flags' <- return [f | Right fs <- defs0, f <- fs]
+ return $ (extends', opens', defs',flags')
+ MReuse _ ->
+ return (Nothing,[],NT,[])
+
+ return $ (id', GM.ModMod (GM.Module mtyp' mstat' flags' extends' opens' defs'))
+
+transComplMod :: ComplMod -> GM.ModuleStatus
+transComplMod x = case x of
+ CMCompl -> GM.MSComplete
+ CMIncompl -> GM.MSIncomplete
getTopDefs :: [TopDef] -> [TopDef]
getTopDefs x = x
@@ -130,8 +137,15 @@ transOpens x = case x of
transOpen :: Open -> Err (GM.OpenSpec Ident)
transOpen x = case x of
- OName id -> liftM GM.OSimple $ transIdent id
- OQual id m -> liftM2 GM.OQualif (transIdent id) (transIdent m)
+ OName id -> liftM (GM.OSimple GM.OQNormal) $ transIdent id
+ OQualQO q id -> liftM2 GM.OSimple (transQualOpen q) (transIdent id)
+ OQual q id m -> liftM3 GM.OQualif (transQualOpen q) (transIdent id) (transIdent m)
+
+transQualOpen :: QualOpen -> Err GM.OpenQualif
+transQualOpen x = case x of
+ QOCompl -> return GM.OQNormal
+ QOInterface -> return GM.OQInterface
+ QOIncompl -> return GM.OQIncomplete
transAbsDef :: TopDef -> Err (Either [(Ident, G.Info)] [GO.Option])
transAbsDef x = case x of
@@ -489,10 +503,13 @@ transOldGrammar x name = case x of
DefPrintCat printdefs -> (a,r,d:c)
DefPrintFun printdefs -> (a,r,d:c)
DefPrintOld printdefs -> (a,r,d:c)
- mkAbs a = MAbstract absName NoExt (Opens []) $ topDefs a
- mkRes r = MResource resName NoExt (Opens []) $ topDefs r
- mkCnc r = MConcrete cncName absName NoExt (Opens [OName resName]) $ topDefs r
+ mkAbs a = MModule q (MTAbstract absName) (MBody ne (Opens []) (topDefs a))
+ mkRes r = MModule q (MTResource resName) (MBody ne (Opens []) (topDefs r))
+ mkCnc r = MModule q (MTConcrete cncName absName)
+ (MBody ne (Opens [OName resName]) (topDefs r))
topDefs t = t
+ ne = NoExt
+ q = CMCompl
absName = identC topic
resName = identC ("Res" ++ lang)