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

switched to unmodified BNFC-generated components

Browse Source
This commit is contained in:
aarne
2008-03-15 14:53:42 +00:00
parent eff08dfe88
commit c73bc4f996
13 changed files with 860 additions and 763 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
src/GF/Compile/GetGrammar.hs
View File

@@ -19,7 +19,7 @@ module GF.Compile.GetGrammar (
) where
import GF.Data.Operations
import qualified GF.Data.ErrM as E ----
import qualified GF.Source.ErrM as E
import GF.Infra.UseIO
import GF.Grammar.Grammar
@@ -62,14 +62,14 @@ getSourceModule opts file0 = do
Just "utf8" -> decodeUTF8 string0
_ -> string0
let tokens = myLexer string
mo1 <- ioeErr $ {- err2err $ -} pModDef tokens
mo1 <- ioeErr $ err2err $ pModDef tokens
ioeErr $ transModDef mo1
getSourceGrammar :: Options -> FilePath -> IOE SourceGrammar
getSourceGrammar opts file = do
string <- readFileIOE file
let tokens = myLexer string
gr1 <- ioeErr $ {- err2err $ -} pGrammar tokens
gr1 <- ioeErr $ err2err $ pGrammar tokens
ioeErr $ transGrammar gr1
@@ -101,7 +101,7 @@ parseOldGrammar :: FilePath -> IOE ([FilePath],[A.TopDef])
parseOldGrammar file = do
putStrLnE $ "reading old file" +++ file
s <- ioeIO $ readFileIf file
A.OldGr incl topdefs <- ioeErr $ pOldGrammar $ oldLexer $ fixNewlines s
A.OldGr incl topdefs <- ioeErr $ err2err $ pOldGrammar $ oldLexer $ fixNewlines s
includes <- ioeErr $ transInclude incl
return (includes, topdefs)

2
src/GF/Compile/PGrammar.hs
View File

@@ -32,7 +32,7 @@ import GF.Data.Operations
pTerm :: String -> Err Term
pTerm s = do
e <- {- err2err $ -} pExp $ myLexer s
e <- err2err $ pExp $ myLexer s
transExp e
pTrm :: String -> Term

1
src/GF/Grammar/Grammar.hs
View File

@@ -191,6 +191,7 @@ data Patt =
| PSeq Patt Patt -- ^ sequence of token parts: p + q
| PRep Patt -- ^ repetition of token part: p*
| PChar -- ^ string of length one
| PChars [Char] -- ^ character list
deriving (Read, Show, Eq, Ord)

17
src/GF/Grammar/PrGrammar.hs
View File

@@ -48,6 +48,8 @@ import GF.Infra.Option
import GF.Infra.Ident
import GF.Data.Str
import GF.Infra.CompactPrint
import Data.List (intersperse)
class Print a where
@@ -71,24 +73,27 @@ class Print a where
prtBad :: Print a => String -> a -> Err b
prtBad s a = Bad (s +++ prt a)
pprintTree :: P.Print a => a -> String
pprintTree = compactPrint . P.printTree
prGrammar :: SourceGrammar -> String
prGrammar = P.printTree . trGrammar
prGrammar = pprintTree . trGrammar
prModule :: (Ident, SourceModInfo) -> String
prModule = P.printTree . trModule
prModule = pprintTree . trModule
instance Print Term where
prt = P.printTree . trt
prt = pprintTree . trt
prt_ = prExp
instance Print Ident where
prt = P.printTree . tri
prt = pprintTree . tri
instance Print Patt where
prt = P.printTree . trp
prt = pprintTree . trp
instance Print Label where
prt = P.printTree . trLabel
prt = pprintTree . trLabel
instance Print MetaSymb where
prt (MetaSymb i) = "?" ++ show i

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

@@ -1,26 +1,24 @@
module GF.Source.AbsGF where --H
module GF.Source.AbsGF where
import GF.Infra.Ident --H
-- Haskell module generated by the BNF converter
-- 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)
newtype PIdent = PIdent ((Int,Int),String) deriving (Eq,Ord,Show)
data Grammar =
Gr [ModDef]
deriving (Eq,Ord,Show)
data ModDef =
MMain Ident Ident [ConcSpec]
MMain PIdent PIdent [ConcSpec]
| MModule ComplMod ModType ModBody
deriving (Eq,Ord,Show)
data ConcSpec =
ConcSpec Ident ConcExp
ConcSpec PIdent ConcExp
deriving (Eq,Ord,Show)
data ConcExp =
ConcExp Ident [Transfer]
ConcExp PIdent [Transfer]
deriving (Eq,Ord,Show)
data Transfer =
@@ -29,22 +27,22 @@ data Transfer =
deriving (Eq,Ord,Show)
data ModType =
MTAbstract Ident
| MTResource Ident
| MTInterface Ident
| MTConcrete Ident Ident
| MTInstance Ident Ident
| MTTransfer Ident Open Open
MTAbstract PIdent
| MTResource PIdent
| MTInterface PIdent
| MTConcrete PIdent PIdent
| MTInstance PIdent PIdent
| MTTransfer PIdent Open Open
deriving (Eq,Ord,Show)
data ModBody =
MNoBody [Included]
| MWithBody Included [Open] Opens [TopDef]
| MWithEBody [Included] Included [Open] Opens [TopDef]
| MBody Extend Opens [TopDef]
MBody Extend Opens [TopDef]
| MNoBody [Included]
| MWith Included [Open]
| MWithBody Included [Open] Opens [TopDef]
| MWithE [Included] Included [Open]
| MReuse Ident
| MWithEBody [Included] Included [Open] Opens [TopDef]
| MReuse PIdent
| MUnion [Included]
deriving (Eq,Ord,Show)
@@ -59,9 +57,9 @@ data Opens =
deriving (Eq,Ord,Show)
data Open =
OName Ident
| OQualQO QualOpen Ident
| OQual QualOpen Ident Ident
OName PIdent
| OQualQO QualOpen PIdent
| OQual QualOpen PIdent PIdent
deriving (Eq,Ord,Show)
data ComplMod =
@@ -76,9 +74,9 @@ data QualOpen =
deriving (Eq,Ord,Show)
data Included =
IAll Ident
| ISome Ident [Ident]
| IMinus Ident [Ident]
IAll PIdent
| ISome PIdent [PIdent]
| IMinus PIdent [PIdent]
deriving (Eq,Ord,Show)
data Def =
@@ -106,38 +104,38 @@ data TopDef =
| DefPrintOld [PrintDef]
| DefLintype [Def]
| DefPattern [Def]
| DefPackage Ident [TopDef]
| DefPackage PIdent [TopDef]
| DefVars [Def]
| DefTokenizer Ident
| DefTokenizer PIdent
deriving (Eq,Ord,Show)
data CatDef =
SimpleCatDef Ident [DDecl]
| ListCatDef Ident [DDecl]
| ListSizeCatDef Ident [DDecl] Integer
SimpleCatDef PIdent [DDecl]
| ListCatDef PIdent [DDecl]
| ListSizeCatDef PIdent [DDecl] Integer
deriving (Eq,Ord,Show)
data FunDef =
FunDef [Ident] Exp
FunDef [PIdent] Exp
deriving (Eq,Ord,Show)
data DataDef =
DataDef Ident [DataConstr]
DataDef PIdent [DataConstr]
deriving (Eq,Ord,Show)
data DataConstr =
DataId Ident
| DataQId Ident Ident
DataId PIdent
| DataQId PIdent PIdent
deriving (Eq,Ord,Show)
data ParDef =
ParDefDir Ident [ParConstr]
| ParDefIndir Ident Ident
| ParDefAbs Ident
ParDefDir PIdent [ParConstr]
| ParDefIndir PIdent PIdent
| ParDefAbs PIdent
deriving (Eq,Ord,Show)
data ParConstr =
ParConstr Ident [DDecl]
ParConstr PIdent [DDecl]
deriving (Eq,Ord,Show)
data PrintDef =
@@ -145,24 +143,24 @@ data PrintDef =
deriving (Eq,Ord,Show)
data FlagDef =
FlagDef Ident Ident
FlagDef PIdent PIdent
deriving (Eq,Ord,Show)
data Name =
IdentName Ident
| ListName Ident
IdentName PIdent
| ListName PIdent
deriving (Eq,Ord,Show)
data LocDef =
LDDecl [Ident] Exp
| LDDef [Ident] Exp
| LDFull [Ident] Exp Exp
LDDecl [PIdent] Exp
| LDDef [PIdent] Exp
| LDFull [PIdent] Exp Exp
deriving (Eq,Ord,Show)
data Exp =
EIdent Ident
| EConstr Ident
| ECons Ident
EIdent PIdent
| EConstr PIdent
| ECons PIdent
| ESort Sort
| EString String
| EInt Integer
@@ -170,15 +168,15 @@ data Exp =
| EMeta
| EEmpty
| EData
| EList Ident Exps
| EList PIdent Exps
| EStrings String
| ERecord [LocDef]
| ETuple [TupleComp]
| EIndir Ident
| EIndir PIdent
| ETyped Exp Exp
| EProj Exp Label
| EQConstr Ident Ident
| EQCons Ident Ident
| EQConstr PIdent PIdent
| EQCons PIdent PIdent
| EApp Exp Exp
| ETable [Case]
| ETTable Exp [Case]
@@ -187,7 +185,9 @@ data Exp =
| EVariants [Exp]
| EPre Exp [Altern]
| EStrs [Exp]
| EConAt Ident Exp
| EConAt PIdent Exp
| EPatt Patt
| EPattType Exp
| ESelect Exp Exp
| ETupTyp Exp Exp
| EExtend Exp Exp
@@ -203,7 +203,7 @@ data Exp =
| EEqs [Equation]
| EExample Exp String
| ELString LString
| ELin Ident
| ELin PIdent
deriving (Eq,Ord,Show)
data Exps =
@@ -212,30 +212,34 @@ data Exps =
deriving (Eq,Ord,Show)
data Patt =
PW
| PV Ident
| PCon Ident
| PQ Ident Ident
PChar
| PChars String
| PMacro PIdent
| PM PIdent PIdent
| PW
| PV PIdent
| PCon PIdent
| PQ PIdent PIdent
| PInt Integer
| PFloat Double
| PStr String
| PR [PattAss]
| PTup [PattTupleComp]
| PC Ident [Patt]
| PQC Ident Ident [Patt]
| PC PIdent [Patt]
| PQC PIdent PIdent [Patt]
| PDisj Patt Patt
| PSeq Patt Patt
| PRep Patt
| PAs Ident Patt
| PAs PIdent Patt
| PNeg Patt
deriving (Eq,Ord,Show)
data PattAss =
PA [Ident] Patt
PA [PIdent] Patt
deriving (Eq,Ord,Show)
data Label =
LIdent Ident
LIdent PIdent
| LVar Integer
deriving (Eq,Ord,Show)
@@ -248,7 +252,7 @@ data Sort =
deriving (Eq,Ord,Show)
data Bind =
BIdent Ident
BIdent PIdent
| BWild
deriving (Eq,Ord,Show)
@@ -293,10 +297,10 @@ data Include =
data FileName =
FString String
| FIdent Ident
| FIdent PIdent
| FSlash FileName
| FDot FileName
| FMinus FileName
| FAddId Ident FileName
| FAddId PIdent FileName
deriving (Eq,Ord,Show)

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

@@ -21,12 +21,12 @@ _. ModDef ::= ModDef ";" ;
-- The $main$ multilingual grammar structure --%
MMain. ModDef ::= "grammar" Ident "=" "{" "abstract" "=" Ident ";" [ConcSpec] "}" ;--%
MMain. ModDef ::= "grammar" PIdent "=" "{" "abstract" "=" PIdent ";" [ConcSpec] "}" ;--%
ConcSpec. ConcSpec ::= Ident "=" ConcExp ;--%
ConcSpec. ConcSpec ::= PIdent "=" ConcExp ;--%
separator ConcSpec ";" ;--%
ConcExp. ConcExp ::= Ident [Transfer] ;--%
ConcExp. ConcExp ::= PIdent [Transfer] ;--%
separator Transfer "" ;--%
TransferIn. Transfer ::= "(" "transfer" "in" Open ")" ; --%
@@ -36,12 +36,12 @@ TransferOut. Transfer ::= "(" "transfer" "out" Open ")" ; --%
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 ;
MTAbstract. ModType ::= "abstract" PIdent ;
MTResource. ModType ::= "resource" PIdent ;
MTInterface. ModType ::= "interface" PIdent ;
MTConcrete. ModType ::= "concrete" PIdent "of" PIdent ;
MTInstance. ModType ::= "instance" PIdent "of" PIdent ;
MTTransfer. ModType ::= "transfer" PIdent ":" Open "->" Open ;
MBody. ModBody ::= Extend Opens "{" [TopDef] "}" ;
@@ -51,7 +51,7 @@ MWithBody. ModBody ::= Included "with" [Open] "**" Opens "{" [T
MWithE. ModBody ::= [Included] "**" Included "with" [Open] ;
MWithEBody. ModBody ::= [Included] "**" Included "with" [Open] "**" Opens "{" [TopDef] "}" ;
MReuse. ModBody ::= "reuse" Ident ; --%
MReuse. ModBody ::= "reuse" PIdent ; --%
MUnion. ModBody ::= "union" [Included] ;--%
separator TopDef "" ;
@@ -63,9 +63,9 @@ separator Open "," ;
NoOpens. Opens ::= ;
OpenIn. Opens ::= "open" [Open] "in" ;
OName. Open ::= Ident ;
OQualQO. Open ::= "(" QualOpen Ident ")" ;
OQual. Open ::= "(" QualOpen Ident "=" Ident ")" ;
OName. Open ::= PIdent ;
OQualQO. Open ::= "(" QualOpen PIdent ")" ;
OQual. Open ::= "(" QualOpen PIdent "=" PIdent ")" ;
CMCompl. ComplMod ::= ;
CMIncompl. ComplMod ::= "incomplete" ;
@@ -76,9 +76,9 @@ QOInterface. QualOpen ::= "interface" ;--%
separator Included "," ;
IAll. Included ::= Ident ;
ISome. Included ::= Ident "[" [Ident] "]" ;
IMinus. Included ::= Ident "-" "[" [Ident] "]" ;
IAll. Included ::= PIdent ;
ISome. Included ::= PIdent "[" [PIdent] "]" ;
IMinus. Included ::= PIdent "-" "[" [PIdent] "]" ;
-- definitions after the $oper$ keywords
@@ -108,27 +108,27 @@ DefPrintCat. TopDef ::= "printname" "cat" [PrintDef] ;
DefPrintFun. TopDef ::= "printname" "fun" [PrintDef] ;
DefFlag. TopDef ::= "flags" [FlagDef] ;
SimpleCatDef. CatDef ::= Ident [DDecl] ;
ListCatDef. CatDef ::= "[" Ident [DDecl] "]" ;
ListSizeCatDef. CatDef ::= "[" Ident [DDecl] "]" "{" Integer "}" ;
SimpleCatDef. CatDef ::= PIdent [DDecl] ;
ListCatDef. CatDef ::= "[" PIdent [DDecl] "]" ;
ListSizeCatDef. CatDef ::= "[" PIdent [DDecl] "]" "{" Integer "}" ;
FunDef. FunDef ::= [Ident] ":" Exp ;
FunDef. FunDef ::= [PIdent] ":" Exp ;
DataDef. DataDef ::= Ident "=" [DataConstr] ;
DataId. DataConstr ::= Ident ;
DataQId. DataConstr ::= Ident "." Ident ;
DataDef. DataDef ::= PIdent "=" [DataConstr] ;
DataId. DataConstr ::= PIdent ;
DataQId. DataConstr ::= PIdent "." PIdent ;
separator DataConstr "|" ;
ParDefDir. ParDef ::= Ident "=" [ParConstr] ;
ParDefIndir. ParDef ::= Ident "=" "(" "in" Ident ")" ;
ParDefAbs. ParDef ::= Ident ;
ParDefDir. ParDef ::= PIdent "=" [ParConstr] ;
ParDefIndir. ParDef ::= PIdent "=" "(" "in" PIdent ")" ;
ParDefAbs. ParDef ::= PIdent ;
ParConstr. ParConstr ::= Ident [DDecl] ;
ParConstr. ParConstr ::= PIdent [DDecl] ;
PrintDef. PrintDef ::= [Name] "=" Exp ;
FlagDef. FlagDef ::= Ident "=" Ident ;
FlagDef. FlagDef ::= PIdent "=" PIdent ;
terminator nonempty Def ";" ;
terminator nonempty CatDef ";" ;
@@ -141,28 +141,28 @@ terminator nonempty FlagDef ";" ;
separator ParConstr "|" ;
separator nonempty Ident "," ;
separator nonempty PIdent "," ;
-- names of categories and functions in definition LHS
IdentName. Name ::= Ident ;
ListName. Name ::= "[" Ident "]" ;
IdentName. Name ::= PIdent ;
ListName. Name ::= "[" PIdent "]" ;
separator nonempty Name "," ;
-- definitions in records and $let$ expressions
LDDecl. LocDef ::= [Ident] ":" Exp ;
LDDef. LocDef ::= [Ident] "=" Exp ;
LDFull. LocDef ::= [Ident] ":" Exp "=" Exp ;
LDDecl. LocDef ::= [PIdent] ":" Exp ;
LDDef. LocDef ::= [PIdent] "=" Exp ;
LDFull. LocDef ::= [PIdent] ":" Exp "=" Exp ;
separator LocDef ";" ;
-- terms and types
EIdent. Exp6 ::= Ident ;
EConstr. Exp6 ::= "{" Ident "}" ;--%
ECons. Exp6 ::= "%" Ident "%" ;--%
EIdent. Exp6 ::= PIdent ;
EConstr. Exp6 ::= "{" PIdent "}" ;--%
ECons. Exp6 ::= "%" PIdent "%" ;--%
ESort. Exp6 ::= Sort ;
EString. Exp6 ::= String ;
EInt. Exp6 ::= Integer ;
@@ -170,16 +170,16 @@ EFloat. Exp6 ::= Double ;
EMeta. Exp6 ::= "?" ;
EEmpty. Exp6 ::= "[" "]" ;
EData. Exp6 ::= "data" ;
EList. Exp6 ::= "[" Ident Exps "]" ;
EList. Exp6 ::= "[" PIdent Exps "]" ;
EStrings. Exp6 ::= "[" String "]" ;
ERecord. Exp6 ::= "{" [LocDef] "}" ; -- !
ETuple. Exp6 ::= "<" [TupleComp] ">" ; --- needed for separator ","
EIndir. Exp6 ::= "(" "in" Ident ")" ; -- indirection, used in judgements --%
EIndir. Exp6 ::= "(" "in" PIdent ")" ; -- indirection, used in judgements --%
ETyped. Exp6 ::= "<" Exp ":" Exp ">" ; -- typing, used for annotations
EProj. Exp5 ::= Exp5 "." Label ;
EQConstr. Exp5 ::= "{" Ident "." Ident "}" ; -- qualified constructor --%
EQCons. Exp5 ::= "%" Ident "." Ident ; -- qualified constant --%
EQConstr. Exp5 ::= "{" PIdent "." PIdent "}" ; -- qualified constructor --%
EQCons. Exp5 ::= "%" PIdent "." PIdent ; -- qualified constant --%
EApp. Exp4 ::= Exp4 Exp5 ;
ETable. Exp4 ::= "table" "{" [Case] "}" ;
@@ -187,9 +187,13 @@ ETTable. Exp4 ::= "table" Exp6 "{" [Case] "}" ;
EVTable. Exp4 ::= "table" Exp6 "[" [Exp] "]" ;
ECase. Exp4 ::= "case" Exp "of" "{" [Case] "}" ;
EVariants. Exp4 ::= "variants" "{" [Exp] "}" ;
--- EPreCase. Exp4 ::= "pre" "{" [Case] "}" ;
EPre. Exp4 ::= "pre" "{" Exp ";" [Altern] "}" ;
EStrs. Exp4 ::= "strs" "{" [Exp] "}" ;
EConAt. Exp4 ::= Ident "@" Exp6 ; --%
EConAt. Exp4 ::= PIdent "@" Exp6 ; --%
EPatt. Exp4 ::= "pattern" Patt2 ;
EPattType. Exp4 ::= "pattern" "type" Exp5 ;
ESelect. Exp3 ::= Exp3 "!" Exp4 ;
ETupTyp. Exp3 ::= Exp3 "*" Exp4 ;
@@ -220,30 +224,34 @@ ConsExp. Exps ::= Exp6 Exps ; -- Exp6 to force parantheses
-- patterns
PChar. Patt2 ::= "?" ;
PChars. Patt2 ::= "[" String "]" ;
PMacro. Patt2 ::= "#" PIdent ;
PM. Patt2 ::= "#" PIdent "." PIdent ;
PW. Patt2 ::= "_" ;
PV. Patt2 ::= Ident ;
PCon. Patt2 ::= "{" Ident "}" ; --%
PQ. Patt2 ::= Ident "." Ident ;
PV. Patt2 ::= PIdent ;
PCon. Patt2 ::= "{" PIdent "}" ; --%
PQ. Patt2 ::= PIdent "." PIdent ;
PInt. Patt2 ::= Integer ;
PFloat. Patt2 ::= Double ;
PStr. Patt2 ::= String ;
PR. Patt2 ::= "{" [PattAss] "}" ;
PTup. Patt2 ::= "<" [PattTupleComp] ">" ;
PC. Patt1 ::= Ident [Patt] ;
PQC. Patt1 ::= Ident "." Ident [Patt] ;
PC. Patt1 ::= PIdent [Patt] ;
PQC. Patt1 ::= PIdent "." PIdent [Patt] ;
PDisj. Patt ::= Patt "|" Patt1 ;
PSeq. Patt ::= Patt "+" Patt1 ;
PRep. Patt1 ::= Patt2 "*" ;
PAs. Patt1 ::= Ident "@" Patt2 ;
PAs. Patt1 ::= PIdent "@" Patt2 ;
PNeg. Patt1 ::= "-" Patt2 ;
coercions Patt 2 ;
PA. PattAss ::= [Ident] "=" Patt ;
PA. PattAss ::= [PIdent] "=" Patt ;
-- labels
LIdent. Label ::= Ident ;
LIdent. Label ::= PIdent ;
LVar. Label ::= "$" Integer ;
-- basic types
@@ -264,7 +272,7 @@ separator PattAss ";" ;
-- binds in lambdas and lin rules
BIdent. Bind ::= Ident ;
BIdent. Bind ::= PIdent ;
BWild. Bind ::= "_" ;
separator Bind "," ;
@@ -322,23 +330,27 @@ FString. FileName ::= String ; --%
terminator nonempty FileName ";" ; --%
FIdent. FileName ::= Ident ; --%
FIdent. FileName ::= PIdent ; --%
FSlash. FileName ::= "/" FileName ; --%
FDot. FileName ::= "." FileName ; --%
FMinus. FileName ::= "-" FileName ; --%
FAddId. FileName ::= Ident FileName ; --%
FAddId. FileName ::= PIdent FileName ; --%
token LString '\'' (char - '\'')* '\'' ; --%
ELString. Exp6 ::= LString ; --%
ELin. Exp4 ::= "Lin" Ident ; --%
ELin. Exp4 ::= "Lin" PIdent ; --%
DefPrintOld. TopDef ::= "printname" [PrintDef] ; --%
DefLintype. TopDef ::= "lintype" [Def] ; --%
DefPattern. TopDef ::= "pattern" [Def] ; --%
-- deprecated packages are attempted to be interpreted --%
DefPackage. TopDef ::= "package" Ident "=" "{" [TopDef] "}" ";" ; --%
DefPackage. TopDef ::= "package" PIdent "=" "{" [TopDef] "}" ";" ; --%
-- these two are just ignored after parsing --%
DefVars. TopDef ::= "var" [Def] ; --%
DefTokenizer. TopDef ::= "tokenizer" Ident ";" ; --%
DefTokenizer. TopDef ::= "tokenizer" PIdent ";" ; --%
-- identifiers
position token PIdent ('_' | letter) (letter | digit | '_' | '\'')* ;

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

@@ -96,17 +96,17 @@ trAnyDef (i,info) = let i' = tri i in case info of
ResOverload tysts ->
[P.DefOper [P.DDef [mkName i'] (
P.EApp (P.EIdent $ identC "overload")
P.EApp (P.EIdent $ tri $ identC "overload")
(P.ERecord [P.LDFull [i'] (trt ty) (trt fu) | (ty,fu) <- tysts]))]]
CncCat (Yes ty) Nope _ ->
[P.DefLincat [P.PrintDef [mkName i'] (trt ty)]]
CncCat pty ptr ppr ->
[P.DefLindef [trDef i' pty ptr]] ++
[P.DefPrintCat [P.PrintDef [mkName i] (trt pr)] | Yes pr <- [ppr]]
[P.DefPrintCat [P.PrintDef [mkName i'] (trt pr)] | Yes pr <- [ppr]]
CncFun _ ptr ppr ->
[P.DefLin [trDef i' nope ptr]] ++
[P.DefPrintFun [P.PrintDef [mkName i] (trt pr)] | Yes pr <- [ppr]]
[P.DefPrintFun [P.PrintDef [mkName i'] (trt pr)] | Yes pr <- [ppr]]
{-
---- encoding of AnyInd without changing syntax. AR 20/9/2007
AnyInd s b ->
@@ -116,7 +116,7 @@ trAnyDef (i,info) = let i' = tri i in case info of
_ -> []
trDef :: Ident -> Perh Type -> Perh Term -> P.Def
trDef :: P.PIdent -> Perh Type -> Perh Term -> P.Def
trDef i pty ptr = case (pty,ptr) of
(Nope, Nope) -> P.DDef [mkName i] (P.EMeta) ---
(_, Nope) -> P.DDecl [mkName i] (trPerh pty)
@@ -131,7 +131,7 @@ trPerh p = case p of
trFlag :: Option -> P.TopDef
trFlag o = case o of
Opt (f,[x]) -> P.DefFlag [P.FlagDef (identC f) (identC x)]
Opt (f,[x]) -> P.DefFlag [P.FlagDef (tri $ identC f) (tri $ identC x)]
_ -> P.DefFlag [] --- warning?
trt :: Term -> P.Exp
@@ -207,7 +207,7 @@ trp p = case p of
PC c a -> P.PC (tri c) (map trp a)
PP p c [] -> P.PQ (tri p) (tri c)
PP p c a -> P.PQC (tri p) (tri c) (map trp a)
PR r -> P.PR [P.PA [trLabelIdent l] (trp p) | (l,p) <- r]
PR r -> P.PR [P.PA [tri $ trLabelIdent l] (trp p) | (l,p) <- r]
PString s -> P.PStr s
PInt i -> P.PInt i
PFloat i -> P.PFloat i
@@ -219,36 +219,37 @@ trp p = case p of
PSeq p q -> P.PSeq (trp p) (trp q)
PRep p -> P.PRep (trp p)
PNeg p -> P.PNeg (trp p)
PChar -> P.PV (IC "C_") ---- temporary encoding
PChar -> P.PChar
PChars s -> P.PChars s
trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty
where
t' = trt t
x = [trLabelIdent lab]
x = [tri $ trLabelIdent lab]
trLabelling (lab,ty) = P.LDDecl [trLabelIdent lab] (trt ty)
trLabelling (lab,ty) = P.LDDecl [tri $ trLabelIdent lab] (trt ty)
trCase (patt, trm) = P.Case (trp patt) (trt trm)
trCases (patts,trm) = P.Case (foldl1 P.PDisj (map trp patts)) (trt trm)
trDecl (x,ty) = P.DDDec [trb x] (trt ty)
tri :: Ident -> Ident
tri i = case prIdent i of
s@('_':_:_) -> identC $ 'h':s ---- unsafe; needed since _3 etc are generated
s -> identC $ s
tri :: Ident -> P.PIdent
tri = ppIdent . prIdent
ppIdent i = P.PIdent ((0,0),i)
trb i = if isWildIdent i then P.BWild else P.BIdent (tri i)
trLabel :: Label -> P.Label
trLabel i = case i of
LIdent s -> P.LIdent $ identC s
LIdent s -> P.LIdent $ ppIdent s
LVar i -> P.LVar $ toInteger i
trLabelIdent i = identC $ case i of
LIdent s -> s
LVar i -> "v" ++ show i --- should not happen
mkName :: Ident -> P.Name
mkName :: P.PIdent -> P.Name
mkName = P.IdentName

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

File diff suppressed because one or more lines are too long

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

File diff suppressed because one or more lines are too long

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

@@ -1,10 +1,10 @@
module GF.Source.PrintGF where --H
{-# OPTIONS -fno-warn-incomplete-patterns #-}
module GF.Source.PrintGF where
-- pretty-printer generated by the BNF converter, except --H
-- pretty-printer generated by the BNF converter
import GF.Infra.Ident --H
import GF.Source.AbsGF --H
import Data.Char --H
import GF.Source.AbsGF
import Char
-- the top-level printing method
printTree :: Print a => a -> String
@@ -18,12 +18,6 @@ doc = (:)
render :: Doc -> String
render d = rend 0 (map ($ "") $ d []) "" where
rend i ss = case ss of
--H these four are hand-written
"{0" :ts -> showChar '{' . rend (i+1) ts
t :"}0" :ts -> showString t . space "}" . rend (i-1) ts
t : "." :ts -> showString t . showString "." . rend i ts
"\\" :ts -> showString "\\" . rend i ts
"[" :ts -> showChar '[' . rend i ts
"(" :ts -> showChar '(' . rend i ts
"{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts
@@ -83,17 +77,18 @@ instance Print Double where
prt _ x = doc (shows x)
instance Print Ident where
prt _ i = doc (showString $ prIdent i) --H
prtList es = case es of
[x] -> (concatD [prt 0 x])
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print LString where
prt _ (LString i) = doc (showString i)
instance Print PIdent where
prt _ (PIdent (_,i)) = doc (showString i)
prtList es = case es of
[x] -> (concatD [prt 0 x])
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print Grammar where
prt i e = case e of
@@ -102,7 +97,7 @@ instance Print Grammar where
instance Print ModDef where
prt i e = case e of
MMain id0 id concspecs -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 id0 , doc (showString "=") , doc (showString "{") , doc (showString "abstract") , doc (showString "=") , prt 0 id , doc (showString ";") , prt 0 concspecs , doc (showString "}")])
MMain pident0 pident concspecs -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 pident0 , doc (showString "=") , doc (showString "{") , doc (showString "abstract") , doc (showString "=") , prt 0 pident , doc (showString ";") , prt 0 concspecs , doc (showString "}")])
MModule complmod modtype modbody -> prPrec i 0 (concatD [prt 0 complmod , prt 0 modtype , doc (showString "=") , prt 0 modbody])
prtList es = case es of
@@ -111,7 +106,7 @@ instance Print ModDef where
instance Print ConcSpec where
prt i e = case e of
ConcSpec id concexp -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 concexp])
ConcSpec pident concexp -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 concexp])
prtList es = case es of
[] -> (concatD [])
@@ -120,7 +115,7 @@ instance Print ConcSpec where
instance Print ConcExp where
prt i e = case e of
ConcExp id transfers -> prPrec i 0 (concatD [prt 0 id , prt 0 transfers])
ConcExp pident transfers -> prPrec i 0 (concatD [prt 0 pident , prt 0 transfers])
instance Print Transfer where
@@ -134,25 +129,26 @@ instance Print Transfer where
instance Print ModType where
prt i e = case e of
MTAbstract id -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 id])
MTResource id -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 id])
MTInterface id -> prPrec i 0 (concatD [doc (showString "interface") , prt 0 id])
MTConcrete id0 id -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 id0 , doc (showString "of") , prt 0 id])
MTInstance id0 id -> prPrec i 0 (concatD [doc (showString "instance") , prt 0 id0 , doc (showString "of") , prt 0 id])
MTTransfer id open0 open -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 id , doc (showString ":") , prt 0 open0 , doc (showString "->") , prt 0 open])
MTAbstract pident -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 pident])
MTResource pident -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 pident])
MTInterface pident -> prPrec i 0 (concatD [doc (showString "interface") , prt 0 pident])
MTConcrete pident0 pident -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
MTInstance pident0 pident -> prPrec i 0 (concatD [doc (showString "instance") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
MTTransfer pident open0 open -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 pident , doc (showString ":") , prt 0 open0 , doc (showString "->") , prt 0 open])
instance Print ModBody where
prt i e = case e of
MNoBody includeds -> prPrec i 0 (concatD [prt 0 includeds])
MWithBody included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
MWithEBody includeds included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
MBody extend opens topdefs -> prPrec i 0 (concatD [prt 0 extend , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
MNoBody includeds -> prPrec i 0 (concatD [prt 0 includeds])
MWith included opens -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens])
MWithBody included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
MWithE includeds included opens -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens])
MReuse id -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 id])
MWithEBody includeds included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
MReuse pident -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 pident])
MUnion includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
instance Print Extend where
prt i e = case e of
Ext includeds -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**")])
@@ -167,9 +163,9 @@ instance Print Opens where
instance Print Open where
prt i e = case e of
OName id -> prPrec i 0 (concatD [prt 0 id])
OQualQO qualopen id -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 id , doc (showString ")")])
OQual qualopen id0 id -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 id0 , doc (showString "=") , prt 0 id , doc (showString ")")])
OName pident -> prPrec i 0 (concatD [prt 0 pident])
OQualQO qualopen pident -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 pident , doc (showString ")")])
OQual qualopen pident0 pident -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 pident0 , doc (showString "=") , prt 0 pident , doc (showString ")")])
prtList es = case es of
[] -> (concatD [])
@@ -191,9 +187,9 @@ instance Print QualOpen where
instance Print Included where
prt i e = case e of
IAll id -> prPrec i 0 (concatD [prt 0 id])
ISome id ids -> prPrec i 0 (concatD [prt 0 id , doc (showString "[") , prt 0 ids , doc (showString "]")])
IMinus id ids -> prPrec i 0 (concatD [prt 0 id , doc (showString "-") , doc (showString "[") , prt 0 ids , doc (showString "]")])
IAll pident -> prPrec i 0 (concatD [prt 0 pident])
ISome pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "[") , prt 0 pidents , doc (showString "]")])
IMinus pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "-") , doc (showString "[") , prt 0 pidents , doc (showString "]")])
prtList es = case es of
[] -> (concatD [])
@@ -230,9 +226,9 @@ instance Print TopDef where
DefPrintOld printdefs -> prPrec i 0 (concatD [doc (showString "printname") , prt 0 printdefs])
DefLintype defs -> prPrec i 0 (concatD [doc (showString "lintype") , prt 0 defs])
DefPattern defs -> prPrec i 0 (concatD [doc (showString "pattern") , prt 0 defs])
DefPackage id topdefs -> prPrec i 0 (concatD [doc (showString "package") , prt 0 id , doc (showString "=") , doc (showString "{") , prt 0 topdefs , doc (showString "}") , doc (showString ";")])
DefPackage pident topdefs -> prPrec i 0 (concatD [doc (showString "package") , prt 0 pident , doc (showString "=") , doc (showString "{") , prt 0 topdefs , doc (showString "}") , doc (showString ";")])
DefVars defs -> prPrec i 0 (concatD [doc (showString "var") , prt 0 defs])
DefTokenizer id -> prPrec i 0 (concatD [doc (showString "tokenizer") , prt 0 id , doc (showString ";")])
DefTokenizer pident -> prPrec i 0 (concatD [doc (showString "tokenizer") , prt 0 pident , doc (showString ";")])
prtList es = case es of
[] -> (concatD [])
@@ -240,9 +236,9 @@ instance Print TopDef where
instance Print CatDef where
prt i e = case e of
SimpleCatDef id ddecls -> prPrec i 0 (concatD [prt 0 id , prt 0 ddecls])
ListCatDef id ddecls -> prPrec i 0 (concatD [doc (showString "[") , prt 0 id , prt 0 ddecls , doc (showString "]")])
ListSizeCatDef id ddecls n -> prPrec i 0 (concatD [doc (showString "[") , prt 0 id , prt 0 ddecls , doc (showString "]") , doc (showString "{") , prt 0 n , doc (showString "}")])
SimpleCatDef pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
ListCatDef pident ddecls -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , prt 0 ddecls , doc (showString "]")])
ListSizeCatDef pident ddecls n -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , prt 0 ddecls , doc (showString "]") , doc (showString "{") , prt 0 n , doc (showString "}")])
prtList es = case es of
[x] -> (concatD [prt 0 x , doc (showString ";")])
@@ -250,7 +246,7 @@ instance Print CatDef where
instance Print FunDef where
prt i e = case e of
FunDef ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp])
FunDef pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp])
prtList es = case es of
[x] -> (concatD [prt 0 x , doc (showString ";")])
@@ -258,7 +254,7 @@ instance Print FunDef where
instance Print DataDef where
prt i e = case e of
DataDef id dataconstrs -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 dataconstrs])
DataDef pident dataconstrs -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 dataconstrs])
prtList es = case es of
[x] -> (concatD [prt 0 x , doc (showString ";")])
@@ -266,8 +262,8 @@ instance Print DataDef where
instance Print DataConstr where
prt i e = case e of
DataId id -> prPrec i 0 (concatD [prt 0 id])
DataQId id0 id -> prPrec i 0 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id])
DataId pident -> prPrec i 0 (concatD [prt 0 pident])
DataQId pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
prtList es = case es of
[] -> (concatD [])
@@ -276,9 +272,9 @@ instance Print DataConstr where
instance Print ParDef where
prt i e = case e of
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])
ParDefDir pident parconstrs -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 parconstrs])
ParDefIndir pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString "=") , doc (showString "(") , doc (showString "in") , prt 0 pident , doc (showString ")")])
ParDefAbs pident -> prPrec i 0 (concatD [prt 0 pident])
prtList es = case es of
[x] -> (concatD [prt 0 x , doc (showString ";")])
@@ -286,7 +282,7 @@ instance Print ParDef where
instance Print ParConstr where
prt i e = case e of
ParConstr id ddecls -> prPrec i 0 (concatD [prt 0 id , prt 0 ddecls])
ParConstr pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
prtList es = case es of
[] -> (concatD [])
@@ -303,7 +299,7 @@ instance Print PrintDef where
instance Print FlagDef where
prt i e = case e of
FlagDef id0 id -> prPrec i 0 (concatD [prt 0 id0 , doc (showString "=") , prt 0 id])
FlagDef pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString "=") , prt 0 pident])
prtList es = case es of
[x] -> (concatD [prt 0 x , doc (showString ";")])
@@ -311,8 +307,8 @@ instance Print FlagDef where
instance Print Name where
prt i e = case e of
IdentName id -> prPrec i 0 (concatD [prt 0 id])
ListName id -> prPrec i 0 (concatD [doc (showString "[") , prt 0 id , doc (showString "]")])
IdentName pident -> prPrec i 0 (concatD [prt 0 pident])
ListName pident -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , doc (showString "]")])
prtList es = case es of
[x] -> (concatD [prt 0 x])
@@ -320,9 +316,9 @@ instance Print Name where
instance Print LocDef where
prt i e = case e of
LDDecl ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp])
LDDef ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString "=") , prt 0 exp])
LDFull ids exp0 exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
LDDecl pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp])
LDDef pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString "=") , prt 0 exp])
LDFull pidents exp0 exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
prtList es = case es of
[] -> (concatD [])
@@ -331,9 +327,9 @@ instance Print LocDef where
instance Print Exp where
prt i e = case e of
EIdent id -> prPrec i 6 (concatD [prt 0 id])
EConstr id -> prPrec i 6 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) --H
ECons id -> prPrec i 6 (concatD [doc (showString "%") , prt 0 id , doc (showString "%")])
EIdent pident -> prPrec i 6 (concatD [prt 0 pident])
EConstr pident -> prPrec i 6 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
ECons pident -> prPrec i 6 (concatD [doc (showString "%") , prt 0 pident , doc (showString "%")])
ESort sort -> prPrec i 6 (concatD [prt 0 sort])
EString str -> prPrec i 6 (concatD [prt 0 str])
EInt n -> prPrec i 6 (concatD [prt 0 n])
@@ -341,15 +337,15 @@ instance Print Exp where
EMeta -> prPrec i 6 (concatD [doc (showString "?")])
EEmpty -> prPrec i 6 (concatD [doc (showString "[") , doc (showString "]")])
EData -> prPrec i 6 (concatD [doc (showString "data")])
EList id exps -> prPrec i 6 (concatD [doc (showString "[") , prt 0 id , prt 0 exps , doc (showString "]")])
EList pident exps -> prPrec i 6 (concatD [doc (showString "[") , prt 0 pident , prt 0 exps , doc (showString "]")])
EStrings str -> prPrec i 6 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
ERecord locdefs -> prPrec i 6 (concatD [doc (showString "{") , prt 0 locdefs , doc (showString "}")])
ETuple tuplecomps -> prPrec i 6 (concatD [doc (showString "<") , prt 0 tuplecomps , doc (showString ">")])
EIndir id -> prPrec i 6 (concatD [doc (showString "(") , doc (showString "in") , prt 0 id , doc (showString ")")])
EIndir pident -> prPrec i 6 (concatD [doc (showString "(") , doc (showString "in") , prt 0 pident , doc (showString ")")])
ETyped exp0 exp -> prPrec i 6 (concatD [doc (showString "<") , prt 0 exp0 , doc (showString ":") , prt 0 exp , doc (showString ">")])
EProj exp label -> prPrec i 5 (concatD [prt 5 exp , doc (showString ".") , prt 0 label])
EQConstr id0 id -> prPrec i 5 (concatD [doc (showString "{0") , prt 0 id0 , doc (showString ".") , prt 0 id , doc (showString "}0")]) --H
EQCons id0 id -> prPrec i 5 (concatD [doc (showString "%") , prt 0 id0 , doc (showString ".") , prt 0 id])
EQConstr pident0 pident -> prPrec i 5 (concatD [doc (showString "{") , prt 0 pident0 , doc (showString ".") , prt 0 pident , doc (showString "}")])
EQCons pident0 pident -> prPrec i 5 (concatD [doc (showString "%") , prt 0 pident0 , doc (showString ".") , prt 0 pident])
EApp exp0 exp -> prPrec i 4 (concatD [prt 4 exp0 , prt 5 exp])
ETable cases -> prPrec i 4 (concatD [doc (showString "table") , doc (showString "{") , prt 0 cases , doc (showString "}")])
ETTable exp cases -> prPrec i 4 (concatD [doc (showString "table") , prt 6 exp , doc (showString "{") , prt 0 cases , doc (showString "}")])
@@ -358,7 +354,9 @@ instance Print Exp where
EVariants exps -> prPrec i 4 (concatD [doc (showString "variants") , doc (showString "{") , prt 0 exps , doc (showString "}")])
EPre exp alterns -> prPrec i 4 (concatD [doc (showString "pre") , doc (showString "{") , prt 0 exp , doc (showString ";") , prt 0 alterns , doc (showString "}")])
EStrs exps -> prPrec i 4 (concatD [doc (showString "strs") , doc (showString "{") , prt 0 exps , doc (showString "}")])
EConAt id exp -> prPrec i 4 (concatD [prt 0 id , doc (showString "@") , prt 6 exp])
EConAt pident exp -> prPrec i 4 (concatD [prt 0 pident , doc (showString "@") , prt 6 exp])
EPatt patt -> prPrec i 4 (concatD [doc (showString "pattern") , prt 2 patt])
EPattType exp -> prPrec i 4 (concatD [doc (showString "pattern") , doc (showString "type") , prt 5 exp])
ESelect exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "!") , prt 4 exp])
ETupTyp exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "*") , prt 4 exp])
EExtend exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "**") , prt 4 exp])
@@ -374,7 +372,7 @@ instance Print Exp where
EEqs equations -> prPrec i 0 (concatD [doc (showString "fn") , doc (showString "{") , prt 0 equations , doc (showString "}")])
EExample exp str -> prPrec i 0 (concatD [doc (showString "in") , prt 5 exp , prt 0 str])
ELString lstring -> prPrec i 6 (concatD [prt 0 lstring])
ELin id -> prPrec i 4 (concatD [doc (showString "Lin") , prt 0 id])
ELin pident -> prPrec i 4 (concatD [doc (showString "Lin") , prt 0 pident])
prtList es = case es of
[] -> (concatD [])
@@ -389,21 +387,25 @@ instance Print Exps where
instance Print Patt where
prt i e = case e of
PChar -> prPrec i 2 (concatD [doc (showString "?")])
PChars str -> prPrec i 2 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
PMacro pident -> prPrec i 2 (concatD [doc (showString "#") , prt 0 pident])
PM pident0 pident -> prPrec i 2 (concatD [doc (showString "#") , prt 0 pident0 , doc (showString ".") , prt 0 pident])
PW -> prPrec i 2 (concatD [doc (showString "_")])
PV id -> prPrec i 2 (concatD [prt 0 id])
PCon id -> prPrec i 2 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) --H
PQ id0 id -> prPrec i 2 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id])
PV pident -> prPrec i 2 (concatD [prt 0 pident])
PCon pident -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
PQ pident0 pident -> prPrec i 2 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
PInt n -> prPrec i 2 (concatD [prt 0 n])
PFloat d -> prPrec i 2 (concatD [prt 0 d])
PStr str -> prPrec i 2 (concatD [prt 0 str])
PR pattasss -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pattasss , doc (showString "}")])
PTup patttuplecomps -> prPrec i 2 (concatD [doc (showString "<") , prt 0 patttuplecomps , doc (showString ">")])
PC id patts -> prPrec i 1 (concatD [prt 0 id , prt 0 patts])
PQC id0 id patts -> prPrec i 1 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id , prt 0 patts])
PC pident patts -> prPrec i 1 (concatD [prt 0 pident , prt 0 patts])
PQC pident0 pident patts -> prPrec i 1 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident , prt 0 patts])
PDisj patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "|") , prt 1 patt])
PSeq patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "+") , prt 1 patt])
PRep patt -> prPrec i 1 (concatD [prt 2 patt , doc (showString "*")])
PAs id patt -> prPrec i 1 (concatD [prt 0 id , doc (showString "@") , prt 2 patt])
PAs pident patt -> prPrec i 1 (concatD [prt 0 pident , doc (showString "@") , prt 2 patt])
PNeg patt -> prPrec i 1 (concatD [doc (showString "-") , prt 2 patt])
prtList es = case es of
@@ -412,7 +414,7 @@ instance Print Patt where
instance Print PattAss where
prt i e = case e of
PA ids patt -> prPrec i 0 (concatD [prt 0 ids , doc (showString "=") , prt 0 patt])
PA pidents patt -> prPrec i 0 (concatD [prt 0 pidents , doc (showString "=") , prt 0 patt])
prtList es = case es of
[] -> (concatD [])
@@ -421,7 +423,7 @@ instance Print PattAss where
instance Print Label where
prt i e = case e of
LIdent id -> prPrec i 0 (concatD [prt 0 id])
LIdent pident -> prPrec i 0 (concatD [prt 0 pident])
LVar n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
@@ -436,7 +438,7 @@ instance Print Sort where
instance Print Bind where
prt i e = case e of
BIdent id -> prPrec i 0 (concatD [prt 0 id])
BIdent pident -> prPrec i 0 (concatD [prt 0 pident])
BWild -> prPrec i 0 (concatD [doc (showString "_")])
prtList es = case es of
@@ -517,11 +519,11 @@ instance Print Include where
instance Print FileName where
prt i e = case e of
FString str -> prPrec i 0 (concatD [prt 0 str])
FIdent id -> prPrec i 0 (concatD [prt 0 id])
FIdent pident -> prPrec i 0 (concatD [prt 0 pident])
FSlash filename -> prPrec i 0 (concatD [doc (showString "/") , prt 0 filename])
FDot filename -> prPrec i 0 (concatD [doc (showString ".") , prt 0 filename])
FMinus filename -> prPrec i 0 (concatD [doc (showString "-") , prt 0 filename])
FAddId id filename -> prPrec i 0 (concatD [prt 0 id , prt 0 filename])
FAddId pident filename -> prPrec i 0 (concatD [prt 0 pident , prt 0 filename])
prtList es = case es of
[x] -> (concatD [prt 0 x , doc (showString ";")])

155
src/GF/Source/SkelGF.hs
View File

@@ -3,24 +3,22 @@ module GF.Source.SkelGF where
-- Haskell module generated by the BNF converter
import GF.Source.AbsGF
import GF.Infra.Ident
import GF.Data.ErrM
import GF.Source.ErrM
type Result = Err String
failure :: Show a => a -> Result
failure x = Bad $ "Undefined case: " ++ show x
transIdent :: Ident -> Result
transIdent x = case x of
IC str -> failure x
transLString :: LString -> Result
transLString x = case x of
LString str -> failure x
transPIdent :: PIdent -> Result
transPIdent x = case x of
PIdent str -> failure x
transGrammar :: Grammar -> Result
transGrammar x = case x of
Gr moddefs -> failure x
@@ -28,18 +26,18 @@ transGrammar x = case x of
transModDef :: ModDef -> Result
transModDef x = case x of
MMain id0 id concspecs -> failure x
MMain pident0 pident concspecs -> failure x
MModule complmod modtype modbody -> failure x
transConcSpec :: ConcSpec -> Result
transConcSpec x = case x of
ConcSpec id concexp -> failure x
ConcSpec pident concexp -> failure x
transConcExp :: ConcExp -> Result
transConcExp x = case x of
ConcExp id transfers -> failure x
ConcExp pident transfers -> failure x
transTransfer :: Transfer -> Result
@@ -50,26 +48,29 @@ transTransfer x = case x of
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
MTAbstract pident -> failure x
MTResource pident -> failure x
MTInterface pident -> failure x
MTConcrete pident0 pident -> failure x
MTInstance pident0 pident -> failure x
MTTransfer pident open0 open -> failure x
transModBody :: ModBody -> Result
transModBody x = case x of
MBody extend opens topdefs -> failure x
MWith id opens -> failure x
MWithE ids id opens -> failure x
MReuse id -> failure x
MNoBody includeds -> failure x
MWith included opens -> failure x
MWithBody included opens0 opens topdefs -> failure x
MWithE includeds included opens -> failure x
MWithEBody includeds included opens0 opens topdefs -> failure x
MReuse pident -> failure x
MUnion includeds -> failure x
transExtend :: Extend -> Result
transExtend x = case x of
Ext ids -> failure x
Ext includeds -> failure x
NoExt -> failure x
@@ -81,9 +82,9 @@ transOpens x = case x of
transOpen :: Open -> Result
transOpen x = case x of
OName id -> failure x
OQualQO qualopen id -> failure x
OQual qualopen id0 id -> failure x
OName pident -> failure x
OQualQO qualopen pident -> failure x
OQual qualopen pident0 pident -> failure x
transComplMod :: ComplMod -> Result
@@ -101,8 +102,9 @@ transQualOpen x = case x of
transIncluded :: Included -> Result
transIncluded x = case x of
IAll id -> failure x
ISome id ids -> failure x
IAll pident -> failure x
ISome pident pidents -> failure x
IMinus pident pidents -> failure x
transDef :: Def -> Result
@@ -132,44 +134,44 @@ transTopDef x = case x of
DefPrintOld printdefs -> failure x
DefLintype defs -> failure x
DefPattern defs -> failure x
DefPackage id topdefs -> failure x
DefPackage pident topdefs -> failure x
DefVars defs -> failure x
DefTokenizer id -> failure x
DefTokenizer pident -> failure x
transCatDef :: CatDef -> Result
transCatDef x = case x of
SimpleCatDef id ddecls -> failure x
ListCatDef id ddecls -> failure x
ListSizeCatDef id ddecls n -> failure x
SimpleCatDef pident ddecls -> failure x
ListCatDef pident ddecls -> failure x
ListSizeCatDef pident ddecls n -> failure x
transFunDef :: FunDef -> Result
transFunDef x = case x of
FunDef ids exp -> failure x
FunDef pidents exp -> failure x
transDataDef :: DataDef -> Result
transDataDef x = case x of
DataDef id dataconstrs -> failure x
DataDef pident dataconstrs -> failure x
transDataConstr :: DataConstr -> Result
transDataConstr x = case x of
DataId id -> failure x
DataQId id0 id -> failure x
DataId pident -> failure x
DataQId pident0 pident -> failure x
transParDef :: ParDef -> Result
transParDef x = case x of
ParDefDir id parconstrs -> failure x
ParDefIndir id0 id -> failure x
ParDefAbs id -> failure x
ParDefDir pident parconstrs -> failure x
ParDefIndir pident0 pident -> failure x
ParDefAbs pident -> failure x
transParConstr :: ParConstr -> Result
transParConstr x = case x of
ParConstr id ddecls -> failure x
ParConstr pident ddecls -> failure x
transPrintDef :: PrintDef -> Result
@@ -179,42 +181,43 @@ transPrintDef x = case x of
transFlagDef :: FlagDef -> Result
transFlagDef x = case x of
FlagDef id0 id -> failure x
FlagDef pident0 pident -> failure x
transName :: Name -> Result
transName x = case x of
IdentName id -> failure x
ListName id -> failure x
IdentName pident -> failure x
ListName pident -> failure x
transLocDef :: LocDef -> Result
transLocDef x = case x of
LDDecl ids exp -> failure x
LDDef ids exp -> failure x
LDFull ids exp0 exp -> failure x
LDDecl pidents exp -> failure x
LDDef pidents exp -> failure x
LDFull pidents exp0 exp -> failure x
transExp :: Exp -> Result
transExp x = case x of
EIdent id -> failure x
EConstr id -> failure x
ECons id -> failure x
EIdent pident -> failure x
EConstr pident -> failure x
ECons pident -> failure x
ESort sort -> failure x
EString str -> failure x
EInt n -> failure x
EFloat d -> failure x
EMeta -> failure x
EEmpty -> failure x
EData -> failure x
EList id exps -> failure x
EList pident exps -> failure x
EStrings str -> failure x
ERecord locdefs -> failure x
ETuple tuplecomps -> failure x
EIndir id -> failure x
EIndir pident -> failure x
ETyped exp0 exp -> failure x
EProj exp label -> failure x
EQConstr id0 id -> failure x
EQCons id0 id -> failure x
EQConstr pident0 pident -> failure x
EQCons pident0 pident -> failure x
EApp exp0 exp -> failure x
ETable cases -> failure x
ETTable exp cases -> failure x
@@ -223,22 +226,25 @@ transExp x = case x of
EVariants exps -> failure x
EPre exp alterns -> failure x
EStrs exps -> failure x
EConAt id exp -> failure x
EConAt pident exp -> failure x
EPatt patt -> failure x
EPattType exp -> failure x
ESelect exp0 exp -> failure x
ETupTyp exp0 exp -> failure x
EExtend exp0 exp -> failure x
EGlue exp0 exp -> failure x
EConcat exp0 exp -> failure x
EAbstr binds exp -> failure x
ECTable binds exp -> failure x
EProd decl exp -> failure x
ETType exp0 exp -> failure x
EConcat exp0 exp -> failure x
EGlue exp0 exp -> failure x
ELet locdefs exp -> failure x
ELetb locdefs exp -> failure x
EWhere exp locdefs -> failure x
EEqs equations -> failure x
EExample exp str -> failure x
ELString lstring -> failure x
ELin id -> failure x
ELin pident -> failure x
transExps :: Exps -> Result
@@ -249,26 +255,36 @@ transExps x = case x of
transPatt :: Patt -> Result
transPatt x = case x of
PChar -> failure x
PChars str -> failure x
PMacro pident -> failure x
PM pident0 pident -> failure x
PW -> failure x
PV id -> failure x
PCon id -> failure x
PQ id0 id -> failure x
PV pident -> failure x
PCon pident -> failure x
PQ pident0 pident -> failure x
PInt n -> failure x
PFloat d -> failure x
PStr str -> failure x
PR pattasss -> failure x
PTup patttuplecomps -> failure x
PC id patts -> failure x
PQC id0 id patts -> failure x
PC pident patts -> failure x
PQC pident0 pident patts -> failure x
PDisj patt0 patt -> failure x
PSeq patt0 patt -> failure x
PRep patt -> failure x
PAs pident patt -> failure x
PNeg patt -> failure x
transPattAss :: PattAss -> Result
transPattAss x = case x of
PA ids patt -> failure x
PA pidents patt -> failure x
transLabel :: Label -> Result
transLabel x = case x of
LIdent id -> failure x
LIdent pident -> failure x
LVar n -> failure x
@@ -281,14 +297,9 @@ transSort x = case x of
Sort_Strs -> failure x
transPattAlt :: PattAlt -> Result
transPattAlt x = case x of
AltP patt -> failure x
transBind :: Bind -> Result
transBind x = case x of
BIdent id -> failure x
BIdent pident -> failure x
BWild -> failure x
@@ -310,7 +321,7 @@ transPattTupleComp x = case x of
transCase :: Case -> Result
transCase x = case x of
Case pattalts exp -> failure x
Case patt exp -> failure x
transEquation :: Equation -> Result
@@ -343,11 +354,11 @@ transInclude x = case x of
transFileName :: FileName -> Result
transFileName x = case x of
FString str -> failure x
FIdent id -> failure x
FIdent pident -> failure x
FSlash filename -> failure x
FDot filename -> failure x
FMinus filename -> failure x
FAddId id filename -> failure x
FAddId pident filename -> failure x

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

@@ -45,14 +45,20 @@ type Result = Err String
failure :: Show a => a -> Err b
failure x = Bad $ "Undefined case: " ++ show x
transIdent :: Ident -> Err Ident
transIdent x = case x of
x -> return x
prPIdent :: PIdent -> String
prPIdent (PIdent (_,c)) = c
getIdentPos :: PIdent -> Err (Ident,Int)
getIdentPos x = case x of
PIdent ((line,_),c) -> return (IC c,line)
transIdent :: PIdent -> Err Ident
transIdent = liftM fst . getIdentPos
transName :: Name -> Err Ident
transName n = case n of
IdentName i -> transIdent i
ListName i -> transIdent (mkListId i)
ListName i -> liftM mkListId (transIdent i)
transGrammar :: Grammar -> Err G.SourceGrammar
transGrammar x = case x of
@@ -250,31 +256,34 @@ returnl = return . Left
transFlagDef :: FlagDef -> Err GO.Option
transFlagDef x = case x of
FlagDef f x -> return $ GO.Opt (prIdent f,[prIdent x])
FlagDef f x -> return $ GO.Opt (prPIdent f,[prPIdent x])
-- | Cat definitions can also return some fun defs
-- if it is a list category definition
transCatDef :: CatDef -> Err [(Ident, G.Info)]
transCatDef x = case x of
SimpleCatDef id ddecls -> liftM (:[]) $ cat id ddecls
SimpleCatDef id ddecls -> do
id' <- transIdent id
liftM (:[]) $ cat id' ddecls
ListCatDef id ddecls -> listCat id ddecls 0
ListSizeCatDef id ddecls size -> listCat id ddecls size
where
cat id ddecls = do
i <- transIdent id
cat i ddecls = do
-- i <- transIdent id
cont <- liftM concat $ mapM transDDecl ddecls
return (i, G.AbsCat (yes cont) nope)
listCat id ddecls size = do
id' <- transIdent id
let
li = mkListId id
baseId = mkBaseId id
consId = mkConsId id
li = mkListId id'
baseId = mkBaseId id'
consId = mkConsId id'
catd0@(c,G.AbsCat (Yes cont0) _) <- cat li ddecls
let
catd = (c,G.AbsCat (Yes cont0) (Yes [M.cn baseId,M.cn consId]))
cont = [(mkId x i,ty) | (i,(x,ty)) <- zip [0..] cont0]
xs = map (G.Vr . fst) cont
cd = M.mkDecl (M.mkApp (G.Vr id) xs)
cd = M.mkDecl (M.mkApp (G.Vr id') xs)
lc = M.mkApp (G.Vr li) xs
niltyp = M.mkProdSimple (cont ++ genericReplicate size cd) lc
nilfund = (baseId, G.AbsFun (yes niltyp) (yes G.EData))
@@ -431,7 +440,10 @@ transExp x = case x of
EMeta -> return $ M.meta $ M.int2meta 0
EEmpty -> return G.Empty
-- [ C x_1 ... x_n ] becomes (ListC x_1 ... x_n)
EList i es -> transExp $ foldl EApp (EIdent (mkListId i)) (exps2list es)
EList i es -> do
i' <- transIdent i
es' <- mapM transExp (exps2list es)
return $ foldl G.App (G.Vr (mkListId i')) es'
EStrings [] -> return G.Empty
EStrings str -> return $ foldr1 G.C $ map G.K $ words str
ERecord defs -> erecord2term defs
@@ -538,16 +550,17 @@ locdef2fields d = case d of
trLabel :: Label -> Err G.Label
trLabel x = case x of
-- this case is for bward compatibiity and should be removed
LIdent (IC ('v':ds@(_:_))) | all isDigit ds -> return $ G.LVar $ readIntArg ds
-- this case is for bward compatibility and should be removed
LIdent (PIdent (_,'v':ds@(_:_))) | all isDigit ds -> return $ G.LVar $ readIntArg ds
LIdent (IC s) -> return $ G.LIdent s
LIdent (PIdent (_, s)) -> return $ G.LIdent s
LVar x -> return $ G.LVar $ fromInteger x
transSort :: Sort -> Err String
transSort x = case x of
_ -> return $ printTree x
{-
--- no more used 7/1/2006 AR
transPatts :: Patt -> Err [G.Patt]
transPatts p = case p of
@@ -568,11 +581,11 @@ transPatts p = case p of
let ps' = combinations ps0
return $ map (G.PR . M.tuple2recordPatt) ps'
_ -> liftM singleton $ transPatt p
-}
transPatt :: Patt -> Err G.Patt
transPatt x = case x of
PW -> return G.wildPatt
PV (IC "C_") -> return G.PChar ---- temporary encoding
PV id -> liftM G.PV $ transIdent id
PC id patts -> liftM2 G.PC (transIdent id) (mapM transPatt patts)
PCon id -> liftM2 G.PC (transIdent id) (return [])
@@ -593,8 +606,8 @@ transPatt x = case x of
PRep p -> liftM G.PRep (transPatt p)
PNeg p -> liftM G.PNeg (transPatt p)
PAs x p -> liftM2 G.PAs (transIdent x) (transPatt p)
PChar -> return G.PChar
PChars s -> return $ G.PChars s
transBind :: Bind -> Err Ident
transBind x = case x of
@@ -681,9 +694,11 @@ transOldGrammar opts name0 x = case x of
q = CMCompl
name = maybe name0 (++ ".gf") $ getOptVal opts useName
absName = identC $ maybe topic id $ getOptVal opts useAbsName
resName = identC $ maybe ("Res" ++ lang) id $ getOptVal opts useResName
cncName = identC $ maybe lang id $ getOptVal opts useCncName
absName = identPI $ maybe topic id $ getOptVal opts useAbsName
resName = identPI $ maybe ("Res" ++ lang) id $ getOptVal opts useResName
cncName = identPI $ maybe lang id $ getOptVal opts useCncName
identPI s = PIdent ((0,0),s)
(beg,rest) = span (/='.') name
(topic,lang) = case rest of -- to avoid overwriting old files
@@ -700,11 +715,11 @@ transInclude x = case x of
where
trans f = case f of
FString s -> s
FIdent (IC s) -> modif s
FIdent (PIdent (_, s)) -> modif s
FSlash filename -> '/' : trans filename
FDot filename -> '.' : trans filename
FMinus filename -> '-' : trans filename
FAddId (IC s) filename -> modif s ++ trans filename
FAddId (PIdent (_, s)) filename -> modif s ++ trans filename
modif s = let s' = init s ++ [toLower (last s)] in
if elem s' newReservedWords then s' else s
--- unsafe hack ; cf. GetGrammar.oldLexer

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

@@ -2,7 +2,7 @@
module Main where
import System.IO ( stdin, hGetContents )
import IO ( stdin, hGetContents )
import System ( getArgs, getProgName )
import GF.Source.LexGF
@@ -14,7 +14,7 @@ import GF.Source.AbsGF
import GF.Data.ErrM
import GF.Source.ErrM
type ParseFun a = [Token] -> Err a