GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 03:32:51 -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 ) where
import GF.Data.Operations import GF.Data.Operations
import qualified GF.Data.ErrM as E ---- import qualified GF.Source.ErrM as E
import GF.Infra.UseIO import GF.Infra.UseIO
import GF.Grammar.Grammar import GF.Grammar.Grammar
@@ -62,14 +62,14 @@ getSourceModule opts file0 = do
Just "utf8" -> decodeUTF8 string0 Just "utf8" -> decodeUTF8 string0
_ -> string0 _ -> string0
let tokens = myLexer string let tokens = myLexer string
mo1 <- ioeErr $ {- err2err $ -} pModDef tokens mo1 <- ioeErr $ err2err $ pModDef tokens
ioeErr $ transModDef mo1 ioeErr $ transModDef mo1
getSourceGrammar :: Options -> FilePath -> IOE SourceGrammar getSourceGrammar :: Options -> FilePath -> IOE SourceGrammar
getSourceGrammar opts file = do getSourceGrammar opts file = do
string <- readFileIOE file string <- readFileIOE file
let tokens = myLexer string let tokens = myLexer string
gr1 <- ioeErr $ {- err2err $ -} pGrammar tokens gr1 <- ioeErr $ err2err $ pGrammar tokens
ioeErr $ transGrammar gr1 ioeErr $ transGrammar gr1
@@ -101,7 +101,7 @@ parseOldGrammar :: FilePath -> IOE ([FilePath],[A.TopDef])
parseOldGrammar file = do parseOldGrammar file = do
putStrLnE $ "reading old file" +++ file putStrLnE $ "reading old file" +++ file
s <- ioeIO $ readFileIf 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 includes <- ioeErr $ transInclude incl
return (includes, topdefs) return (includes, topdefs)

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

@@ -32,7 +32,7 @@ import GF.Data.Operations
pTerm :: String -> Err Term pTerm :: String -> Err Term
pTerm s = do pTerm s = do
e <- {- err2err $ -} pExp $ myLexer s e <- err2err $ pExp $ myLexer s
transExp e transExp e
pTrm :: String -> Term 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 | PSeq Patt Patt -- ^ sequence of token parts: p + q
| PRep Patt -- ^ repetition of token part: p* | PRep Patt -- ^ repetition of token part: p*
| PChar -- ^ string of length one | PChar -- ^ string of length one
| PChars [Char] -- ^ character list
deriving (Read, Show, Eq, Ord) 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.Infra.Ident
import GF.Data.Str import GF.Data.Str
import GF.Infra.CompactPrint
import Data.List (intersperse) import Data.List (intersperse)
class Print a where class Print a where
@@ -71,24 +73,27 @@ class Print a where
prtBad :: Print a => String -> a -> Err b prtBad :: Print a => String -> a -> Err b
prtBad s a = Bad (s +++ prt a) prtBad s a = Bad (s +++ prt a)
pprintTree :: P.Print a => a -> String
pprintTree = compactPrint . P.printTree
prGrammar :: SourceGrammar -> String prGrammar :: SourceGrammar -> String
prGrammar = P.printTree . trGrammar prGrammar = pprintTree . trGrammar
prModule :: (Ident, SourceModInfo) -> String prModule :: (Ident, SourceModInfo) -> String
prModule = P.printTree . trModule prModule = pprintTree . trModule
instance Print Term where instance Print Term where
prt = P.printTree . trt prt = pprintTree . trt
prt_ = prExp prt_ = prExp
instance Print Ident where instance Print Ident where
prt = P.printTree . tri prt = pprintTree . tri
instance Print Patt where instance Print Patt where
prt = P.printTree . trp prt = pprintTree . trp
instance Print Label where instance Print Label where
prt = P.printTree . trLabel prt = pprintTree . trLabel
instance Print MetaSymb where instance Print MetaSymb where
prt (MetaSymb i) = "?" ++ show i 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 LString = LString String deriving (Eq,Ord,Show)
newtype PIdent = PIdent ((Int,Int),String) deriving (Eq,Ord,Show)
data Grammar = data Grammar =
Gr [ModDef] Gr [ModDef]
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data ModDef = data ModDef =
MMain Ident Ident [ConcSpec] MMain PIdent PIdent [ConcSpec]
| MModule ComplMod ModType ModBody | MModule ComplMod ModType ModBody
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data ConcSpec = data ConcSpec =
ConcSpec Ident ConcExp ConcSpec PIdent ConcExp
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data ConcExp = data ConcExp =
ConcExp Ident [Transfer] ConcExp PIdent [Transfer]
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Transfer = data Transfer =
@@ -29,22 +27,22 @@ data Transfer =
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data ModType = data ModType =
MTAbstract Ident MTAbstract PIdent
| MTResource Ident | MTResource PIdent
| MTInterface Ident | MTInterface PIdent
| MTConcrete Ident Ident | MTConcrete PIdent PIdent
| MTInstance Ident Ident | MTInstance PIdent PIdent
| MTTransfer Ident Open Open | MTTransfer PIdent Open Open
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data ModBody = data ModBody =
MNoBody [Included] MBody Extend Opens [TopDef]
| MWithBody Included [Open] Opens [TopDef] | MNoBody [Included]
| MWithEBody [Included] Included [Open] Opens [TopDef]
| MBody Extend Opens [TopDef]
| MWith Included [Open] | MWith Included [Open]
| MWithBody Included [Open] Opens [TopDef]
| MWithE [Included] Included [Open] | MWithE [Included] Included [Open]
| MReuse Ident | MWithEBody [Included] Included [Open] Opens [TopDef]
| MReuse PIdent
| MUnion [Included] | MUnion [Included]
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
@@ -59,9 +57,9 @@ data Opens =
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Open = data Open =
OName Ident OName PIdent
| OQualQO QualOpen Ident | OQualQO QualOpen PIdent
| OQual QualOpen Ident Ident | OQual QualOpen PIdent PIdent
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data ComplMod = data ComplMod =
@@ -76,9 +74,9 @@ data QualOpen =
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Included = data Included =
IAll Ident IAll PIdent
| ISome Ident [Ident] | ISome PIdent [PIdent]
| IMinus Ident [Ident] | IMinus PIdent [PIdent]
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Def = data Def =
@@ -106,38 +104,38 @@ data TopDef =
| DefPrintOld [PrintDef] | DefPrintOld [PrintDef]
| DefLintype [Def] | DefLintype [Def]
| DefPattern [Def] | DefPattern [Def]
| DefPackage Ident [TopDef] | DefPackage PIdent [TopDef]
| DefVars [Def] | DefVars [Def]
| DefTokenizer Ident | DefTokenizer PIdent
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data CatDef = data CatDef =
SimpleCatDef Ident [DDecl] SimpleCatDef PIdent [DDecl]
| ListCatDef Ident [DDecl] | ListCatDef PIdent [DDecl]
| ListSizeCatDef Ident [DDecl] Integer | ListSizeCatDef PIdent [DDecl] Integer
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data FunDef = data FunDef =
FunDef [Ident] Exp FunDef [PIdent] Exp
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data DataDef = data DataDef =
DataDef Ident [DataConstr] DataDef PIdent [DataConstr]
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data DataConstr = data DataConstr =
DataId Ident DataId PIdent
| DataQId Ident Ident | DataQId PIdent PIdent
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data ParDef = data ParDef =
ParDefDir Ident [ParConstr] ParDefDir PIdent [ParConstr]
| ParDefIndir Ident Ident | ParDefIndir PIdent PIdent
| ParDefAbs Ident | ParDefAbs PIdent
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data ParConstr = data ParConstr =
ParConstr Ident [DDecl] ParConstr PIdent [DDecl]
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data PrintDef = data PrintDef =
@@ -145,24 +143,24 @@ data PrintDef =
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data FlagDef = data FlagDef =
FlagDef Ident Ident FlagDef PIdent PIdent
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Name = data Name =
IdentName Ident IdentName PIdent
| ListName Ident | ListName PIdent
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data LocDef = data LocDef =
LDDecl [Ident] Exp LDDecl [PIdent] Exp
| LDDef [Ident] Exp | LDDef [PIdent] Exp
| LDFull [Ident] Exp Exp | LDFull [PIdent] Exp Exp
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Exp = data Exp =
EIdent Ident EIdent PIdent
| EConstr Ident | EConstr PIdent
| ECons Ident | ECons PIdent
| ESort Sort | ESort Sort
| EString String | EString String
| EInt Integer | EInt Integer
@@ -170,15 +168,15 @@ data Exp =
| EMeta | EMeta
| EEmpty | EEmpty
| EData | EData
| EList Ident Exps | EList PIdent Exps
| EStrings String | EStrings String
| ERecord [LocDef] | ERecord [LocDef]
| ETuple [TupleComp] | ETuple [TupleComp]
| EIndir Ident | EIndir PIdent
| ETyped Exp Exp | ETyped Exp Exp
| EProj Exp Label | EProj Exp Label
| EQConstr Ident Ident | EQConstr PIdent PIdent
| EQCons Ident Ident | EQCons PIdent PIdent
| EApp Exp Exp | EApp Exp Exp
| ETable [Case] | ETable [Case]
| ETTable Exp [Case] | ETTable Exp [Case]
@@ -187,7 +185,9 @@ data Exp =
| EVariants [Exp] | EVariants [Exp]
| EPre Exp [Altern] | EPre Exp [Altern]
| EStrs [Exp] | EStrs [Exp]
| EConAt Ident Exp | EConAt PIdent Exp
| EPatt Patt
| EPattType Exp
| ESelect Exp Exp | ESelect Exp Exp
| ETupTyp Exp Exp | ETupTyp Exp Exp
| EExtend Exp Exp | EExtend Exp Exp
@@ -203,7 +203,7 @@ data Exp =
| EEqs [Equation] | EEqs [Equation]
| EExample Exp String | EExample Exp String
| ELString LString | ELString LString
| ELin Ident | ELin PIdent
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Exps = data Exps =
@@ -212,30 +212,34 @@ data Exps =
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Patt = data Patt =
PW PChar
| PV Ident | PChars String
| PCon Ident | PMacro PIdent
| PQ Ident Ident | PM PIdent PIdent
| PW
| PV PIdent
| PCon PIdent
| PQ PIdent PIdent
| PInt Integer | PInt Integer
| PFloat Double | PFloat Double
| PStr String | PStr String
| PR [PattAss] | PR [PattAss]
| PTup [PattTupleComp] | PTup [PattTupleComp]
| PC Ident [Patt] | PC PIdent [Patt]
| PQC Ident Ident [Patt] | PQC PIdent PIdent [Patt]
| PDisj Patt Patt | PDisj Patt Patt
| PSeq Patt Patt | PSeq Patt Patt
| PRep Patt | PRep Patt
| PAs Ident Patt | PAs PIdent Patt
| PNeg Patt | PNeg Patt
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data PattAss = data PattAss =
PA [Ident] Patt PA [PIdent] Patt
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Label = data Label =
LIdent Ident LIdent PIdent
| LVar Integer | LVar Integer
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
@@ -248,7 +252,7 @@ data Sort =
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data Bind = data Bind =
BIdent Ident BIdent PIdent
| BWild | BWild
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
@@ -293,10 +297,10 @@ data Include =
data FileName = data FileName =
FString String FString String
| FIdent Ident | FIdent PIdent
| FSlash FileName | FSlash FileName
| FDot FileName | FDot FileName
| FMinus FileName | FMinus FileName
| FAddId Ident FileName | FAddId PIdent FileName
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)

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

@@ -21,12 +21,12 @@ _. ModDef ::= ModDef ";" ;
-- The $main$ multilingual grammar structure --% -- 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 ";" ;--% separator ConcSpec ";" ;--%
ConcExp. ConcExp ::= Ident [Transfer] ;--% ConcExp. ConcExp ::= PIdent [Transfer] ;--%
separator Transfer "" ;--% separator Transfer "" ;--%
TransferIn. Transfer ::= "(" "transfer" "in" Open ")" ; --% TransferIn. Transfer ::= "(" "transfer" "in" Open ")" ; --%
@@ -36,12 +36,12 @@ TransferOut. Transfer ::= "(" "transfer" "out" Open ")" ; --%
MModule. ModDef ::= ComplMod ModType "=" ModBody ; MModule. ModDef ::= ComplMod ModType "=" ModBody ;
MTAbstract. ModType ::= "abstract" Ident ; MTAbstract. ModType ::= "abstract" PIdent ;
MTResource. ModType ::= "resource" Ident ; MTResource. ModType ::= "resource" PIdent ;
MTInterface. ModType ::= "interface" Ident ; MTInterface. ModType ::= "interface" PIdent ;
MTConcrete. ModType ::= "concrete" Ident "of" Ident ; MTConcrete. ModType ::= "concrete" PIdent "of" PIdent ;
MTInstance. ModType ::= "instance" Ident "of" Ident ; MTInstance. ModType ::= "instance" PIdent "of" PIdent ;
MTTransfer. ModType ::= "transfer" Ident ":" Open "->" Open ; MTTransfer. ModType ::= "transfer" PIdent ":" Open "->" Open ;
MBody. ModBody ::= Extend Opens "{" [TopDef] "}" ; MBody. ModBody ::= Extend Opens "{" [TopDef] "}" ;
@@ -51,7 +51,7 @@ MWithBody. ModBody ::= Included "with" [Open] "**" Opens "{" [T
MWithE. ModBody ::= [Included] "**" Included "with" [Open] ; MWithE. ModBody ::= [Included] "**" Included "with" [Open] ;
MWithEBody. ModBody ::= [Included] "**" Included "with" [Open] "**" Opens "{" [TopDef] "}" ; MWithEBody. ModBody ::= [Included] "**" Included "with" [Open] "**" Opens "{" [TopDef] "}" ;
MReuse. ModBody ::= "reuse" Ident ; --% MReuse. ModBody ::= "reuse" PIdent ; --%
MUnion. ModBody ::= "union" [Included] ;--% MUnion. ModBody ::= "union" [Included] ;--%
separator TopDef "" ; separator TopDef "" ;
@@ -63,9 +63,9 @@ separator Open "," ;
NoOpens. Opens ::= ; NoOpens. Opens ::= ;
OpenIn. Opens ::= "open" [Open] "in" ; OpenIn. Opens ::= "open" [Open] "in" ;
OName. Open ::= Ident ; OName. Open ::= PIdent ;
OQualQO. Open ::= "(" QualOpen Ident ")" ; OQualQO. Open ::= "(" QualOpen PIdent ")" ;
OQual. Open ::= "(" QualOpen Ident "=" Ident ")" ; OQual. Open ::= "(" QualOpen PIdent "=" PIdent ")" ;
CMCompl. ComplMod ::= ; CMCompl. ComplMod ::= ;
CMIncompl. ComplMod ::= "incomplete" ; CMIncompl. ComplMod ::= "incomplete" ;
@@ -76,9 +76,9 @@ QOInterface. QualOpen ::= "interface" ;--%
separator Included "," ; separator Included "," ;
IAll. Included ::= Ident ; IAll. Included ::= PIdent ;
ISome. Included ::= Ident "[" [Ident] "]" ; ISome. Included ::= PIdent "[" [PIdent] "]" ;
IMinus. Included ::= Ident "-" "[" [Ident] "]" ; IMinus. Included ::= PIdent "-" "[" [PIdent] "]" ;
-- definitions after the $oper$ keywords -- definitions after the $oper$ keywords
@@ -108,27 +108,27 @@ DefPrintCat. TopDef ::= "printname" "cat" [PrintDef] ;
DefPrintFun. TopDef ::= "printname" "fun" [PrintDef] ; DefPrintFun. TopDef ::= "printname" "fun" [PrintDef] ;
DefFlag. TopDef ::= "flags" [FlagDef] ; DefFlag. TopDef ::= "flags" [FlagDef] ;
SimpleCatDef. CatDef ::= Ident [DDecl] ; SimpleCatDef. CatDef ::= PIdent [DDecl] ;
ListCatDef. CatDef ::= "[" Ident [DDecl] "]" ; ListCatDef. CatDef ::= "[" PIdent [DDecl] "]" ;
ListSizeCatDef. CatDef ::= "[" Ident [DDecl] "]" "{" Integer "}" ; ListSizeCatDef. CatDef ::= "[" PIdent [DDecl] "]" "{" Integer "}" ;
FunDef. FunDef ::= [Ident] ":" Exp ; FunDef. FunDef ::= [PIdent] ":" Exp ;
DataDef. DataDef ::= Ident "=" [DataConstr] ; DataDef. DataDef ::= PIdent "=" [DataConstr] ;
DataId. DataConstr ::= Ident ; DataId. DataConstr ::= PIdent ;
DataQId. DataConstr ::= Ident "." Ident ; DataQId. DataConstr ::= PIdent "." PIdent ;
separator DataConstr "|" ; separator DataConstr "|" ;
ParDefDir. ParDef ::= Ident "=" [ParConstr] ; ParDefDir. ParDef ::= PIdent "=" [ParConstr] ;
ParDefIndir. ParDef ::= Ident "=" "(" "in" Ident ")" ; ParDefIndir. ParDef ::= PIdent "=" "(" "in" PIdent ")" ;
ParDefAbs. ParDef ::= Ident ; ParDefAbs. ParDef ::= PIdent ;
ParConstr. ParConstr ::= Ident [DDecl] ; ParConstr. ParConstr ::= PIdent [DDecl] ;
PrintDef. PrintDef ::= [Name] "=" Exp ; PrintDef. PrintDef ::= [Name] "=" Exp ;
FlagDef. FlagDef ::= Ident "=" Ident ; FlagDef. FlagDef ::= PIdent "=" PIdent ;
terminator nonempty Def ";" ; terminator nonempty Def ";" ;
terminator nonempty CatDef ";" ; terminator nonempty CatDef ";" ;
@@ -141,28 +141,28 @@ terminator nonempty FlagDef ";" ;
separator ParConstr "|" ; separator ParConstr "|" ;
separator nonempty Ident "," ; separator nonempty PIdent "," ;
-- names of categories and functions in definition LHS -- names of categories and functions in definition LHS
IdentName. Name ::= Ident ; IdentName. Name ::= PIdent ;
ListName. Name ::= "[" Ident "]" ; ListName. Name ::= "[" PIdent "]" ;
separator nonempty Name "," ; separator nonempty Name "," ;
-- definitions in records and $let$ expressions -- definitions in records and $let$ expressions
LDDecl. LocDef ::= [Ident] ":" Exp ; LDDecl. LocDef ::= [PIdent] ":" Exp ;
LDDef. LocDef ::= [Ident] "=" Exp ; LDDef. LocDef ::= [PIdent] "=" Exp ;
LDFull. LocDef ::= [Ident] ":" Exp "=" Exp ; LDFull. LocDef ::= [PIdent] ":" Exp "=" Exp ;
separator LocDef ";" ; separator LocDef ";" ;
-- terms and types -- terms and types
EIdent. Exp6 ::= Ident ; EIdent. Exp6 ::= PIdent ;
EConstr. Exp6 ::= "{" Ident "}" ;--% EConstr. Exp6 ::= "{" PIdent "}" ;--%
ECons. Exp6 ::= "%" Ident "%" ;--% ECons. Exp6 ::= "%" PIdent "%" ;--%
ESort. Exp6 ::= Sort ; ESort. Exp6 ::= Sort ;
EString. Exp6 ::= String ; EString. Exp6 ::= String ;
EInt. Exp6 ::= Integer ; EInt. Exp6 ::= Integer ;
@@ -170,16 +170,16 @@ EFloat. Exp6 ::= Double ;
EMeta. Exp6 ::= "?" ; EMeta. Exp6 ::= "?" ;
EEmpty. Exp6 ::= "[" "]" ; EEmpty. Exp6 ::= "[" "]" ;
EData. Exp6 ::= "data" ; EData. Exp6 ::= "data" ;
EList. Exp6 ::= "[" Ident Exps "]" ; EList. Exp6 ::= "[" PIdent Exps "]" ;
EStrings. Exp6 ::= "[" String "]" ; EStrings. Exp6 ::= "[" String "]" ;
ERecord. Exp6 ::= "{" [LocDef] "}" ; -- ! ERecord. Exp6 ::= "{" [LocDef] "}" ; -- !
ETuple. Exp6 ::= "<" [TupleComp] ">" ; --- needed for separator "," 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 ETyped. Exp6 ::= "<" Exp ":" Exp ">" ; -- typing, used for annotations
EProj. Exp5 ::= Exp5 "." Label ; EProj. Exp5 ::= Exp5 "." Label ;
EQConstr. Exp5 ::= "{" Ident "." Ident "}" ; -- qualified constructor --% EQConstr. Exp5 ::= "{" PIdent "." PIdent "}" ; -- qualified constructor --%
EQCons. Exp5 ::= "%" Ident "." Ident ; -- qualified constant --% EQCons. Exp5 ::= "%" PIdent "." PIdent ; -- qualified constant --%
EApp. Exp4 ::= Exp4 Exp5 ; EApp. Exp4 ::= Exp4 Exp5 ;
ETable. Exp4 ::= "table" "{" [Case] "}" ; ETable. Exp4 ::= "table" "{" [Case] "}" ;
@@ -187,9 +187,13 @@ ETTable. Exp4 ::= "table" Exp6 "{" [Case] "}" ;
EVTable. Exp4 ::= "table" Exp6 "[" [Exp] "]" ; EVTable. Exp4 ::= "table" Exp6 "[" [Exp] "]" ;
ECase. Exp4 ::= "case" Exp "of" "{" [Case] "}" ; ECase. Exp4 ::= "case" Exp "of" "{" [Case] "}" ;
EVariants. Exp4 ::= "variants" "{" [Exp] "}" ; EVariants. Exp4 ::= "variants" "{" [Exp] "}" ;
--- EPreCase. Exp4 ::= "pre" "{" [Case] "}" ;
EPre. Exp4 ::= "pre" "{" Exp ";" [Altern] "}" ; EPre. Exp4 ::= "pre" "{" Exp ";" [Altern] "}" ;
EStrs. Exp4 ::= "strs" "{" [Exp] "}" ; 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 ; ESelect. Exp3 ::= Exp3 "!" Exp4 ;
ETupTyp. Exp3 ::= Exp3 "*" Exp4 ; ETupTyp. Exp3 ::= Exp3 "*" Exp4 ;
@@ -220,30 +224,34 @@ ConsExp. Exps ::= Exp6 Exps ; -- Exp6 to force parantheses
-- patterns -- patterns
PChar. Patt2 ::= "?" ;
PChars. Patt2 ::= "[" String "]" ;
PMacro. Patt2 ::= "#" PIdent ;
PM. Patt2 ::= "#" PIdent "." PIdent ;
PW. Patt2 ::= "_" ; PW. Patt2 ::= "_" ;
PV. Patt2 ::= Ident ; PV. Patt2 ::= PIdent ;
PCon. Patt2 ::= "{" Ident "}" ; --% PCon. Patt2 ::= "{" PIdent "}" ; --%
PQ. Patt2 ::= Ident "." Ident ; PQ. Patt2 ::= PIdent "." PIdent ;
PInt. Patt2 ::= Integer ; PInt. Patt2 ::= Integer ;
PFloat. Patt2 ::= Double ; PFloat. Patt2 ::= Double ;
PStr. Patt2 ::= String ; PStr. Patt2 ::= String ;
PR. Patt2 ::= "{" [PattAss] "}" ; PR. Patt2 ::= "{" [PattAss] "}" ;
PTup. Patt2 ::= "<" [PattTupleComp] ">" ; PTup. Patt2 ::= "<" [PattTupleComp] ">" ;
PC. Patt1 ::= Ident [Patt] ; PC. Patt1 ::= PIdent [Patt] ;
PQC. Patt1 ::= Ident "." Ident [Patt] ; PQC. Patt1 ::= PIdent "." PIdent [Patt] ;
PDisj. Patt ::= Patt "|" Patt1 ; PDisj. Patt ::= Patt "|" Patt1 ;
PSeq. Patt ::= Patt "+" Patt1 ; PSeq. Patt ::= Patt "+" Patt1 ;
PRep. Patt1 ::= Patt2 "*" ; PRep. Patt1 ::= Patt2 "*" ;
PAs. Patt1 ::= Ident "@" Patt2 ; PAs. Patt1 ::= PIdent "@" Patt2 ;
PNeg. Patt1 ::= "-" Patt2 ; PNeg. Patt1 ::= "-" Patt2 ;
coercions Patt 2 ; coercions Patt 2 ;
PA. PattAss ::= [Ident] "=" Patt ; PA. PattAss ::= [PIdent] "=" Patt ;
-- labels -- labels
LIdent. Label ::= Ident ; LIdent. Label ::= PIdent ;
LVar. Label ::= "$" Integer ; LVar. Label ::= "$" Integer ;
-- basic types -- basic types
@@ -264,7 +272,7 @@ separator PattAss ";" ;
-- binds in lambdas and lin rules -- binds in lambdas and lin rules
BIdent. Bind ::= Ident ; BIdent. Bind ::= PIdent ;
BWild. Bind ::= "_" ; BWild. Bind ::= "_" ;
separator Bind "," ; separator Bind "," ;
@@ -322,23 +330,27 @@ FString. FileName ::= String ; --%
terminator nonempty FileName ";" ; --% terminator nonempty FileName ";" ; --%
FIdent. FileName ::= Ident ; --% FIdent. FileName ::= PIdent ; --%
FSlash. FileName ::= "/" FileName ; --% FSlash. FileName ::= "/" FileName ; --%
FDot. FileName ::= "." FileName ; --% FDot. FileName ::= "." FileName ; --%
FMinus. FileName ::= "-" FileName ; --% FMinus. FileName ::= "-" FileName ; --%
FAddId. FileName ::= Ident FileName ; --% FAddId. FileName ::= PIdent FileName ; --%
token LString '\'' (char - '\'')* '\'' ; --% token LString '\'' (char - '\'')* '\'' ; --%
ELString. Exp6 ::= LString ; --% ELString. Exp6 ::= LString ; --%
ELin. Exp4 ::= "Lin" Ident ; --% ELin. Exp4 ::= "Lin" PIdent ; --%
DefPrintOld. TopDef ::= "printname" [PrintDef] ; --% DefPrintOld. TopDef ::= "printname" [PrintDef] ; --%
DefLintype. TopDef ::= "lintype" [Def] ; --% DefLintype. TopDef ::= "lintype" [Def] ; --%
DefPattern. TopDef ::= "pattern" [Def] ; --% DefPattern. TopDef ::= "pattern" [Def] ; --%
-- deprecated packages are attempted to be interpreted --% -- deprecated packages are attempted to be interpreted --%
DefPackage. TopDef ::= "package" Ident "=" "{" [TopDef] "}" ";" ; --% DefPackage. TopDef ::= "package" PIdent "=" "{" [TopDef] "}" ";" ; --%
-- these two are just ignored after parsing --% -- these two are just ignored after parsing --%
DefVars. TopDef ::= "var" [Def] ; --% 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 -> ResOverload tysts ->
[P.DefOper [P.DDef [mkName i'] ( [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]))]] (P.ERecord [P.LDFull [i'] (trt ty) (trt fu) | (ty,fu) <- tysts]))]]
CncCat (Yes ty) Nope _ -> CncCat (Yes ty) Nope _ ->
[P.DefLincat [P.PrintDef [mkName i'] (trt ty)]] [P.DefLincat [P.PrintDef [mkName i'] (trt ty)]]
CncCat pty ptr ppr -> CncCat pty ptr ppr ->
[P.DefLindef [trDef i' pty ptr]] ++ [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 -> CncFun _ ptr ppr ->
[P.DefLin [trDef i' nope ptr]] ++ [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 ---- encoding of AnyInd without changing syntax. AR 20/9/2007
AnyInd s b -> 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 trDef i pty ptr = case (pty,ptr) of
(Nope, Nope) -> P.DDef [mkName i] (P.EMeta) --- (Nope, Nope) -> P.DDef [mkName i] (P.EMeta) ---
(_, Nope) -> P.DDecl [mkName i] (trPerh pty) (_, Nope) -> P.DDecl [mkName i] (trPerh pty)
@@ -131,7 +131,7 @@ trPerh p = case p of
trFlag :: Option -> P.TopDef trFlag :: Option -> P.TopDef
trFlag o = case o of 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? _ -> P.DefFlag [] --- warning?
trt :: Term -> P.Exp trt :: Term -> P.Exp
@@ -207,7 +207,7 @@ trp p = case p of
PC c a -> P.PC (tri c) (map trp a) PC c a -> P.PC (tri c) (map trp a)
PP p c [] -> P.PQ (tri p) (tri c) PP p c [] -> P.PQ (tri p) (tri c)
PP p c a -> P.PQC (tri p) (tri c) (map trp a) 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 PString s -> P.PStr s
PInt i -> P.PInt i PInt i -> P.PInt i
PFloat i -> P.PFloat i PFloat i -> P.PFloat i
@@ -219,36 +219,37 @@ trp p = case p of
PSeq p q -> P.PSeq (trp p) (trp q) PSeq p q -> P.PSeq (trp p) (trp q)
PRep p -> P.PRep (trp p) PRep p -> P.PRep (trp p)
PNeg p -> P.PNeg (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 trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty
where where
t' = trt t 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) trCase (patt, trm) = P.Case (trp patt) (trt trm)
trCases (patts,trm) = P.Case (foldl1 P.PDisj (map trp patts)) (trt trm) trCases (patts,trm) = P.Case (foldl1 P.PDisj (map trp patts)) (trt trm)
trDecl (x,ty) = P.DDDec [trb x] (trt ty) trDecl (x,ty) = P.DDDec [trb x] (trt ty)
tri :: Ident -> Ident tri :: Ident -> P.PIdent
tri i = case prIdent i of tri = ppIdent . prIdent
s@('_':_:_) -> identC $ 'h':s ---- unsafe; needed since _3 etc are generated
s -> identC $ s ppIdent i = P.PIdent ((0,0),i)
trb i = if isWildIdent i then P.BWild else P.BIdent (tri i) trb i = if isWildIdent i then P.BWild else P.BIdent (tri i)
trLabel :: Label -> P.Label trLabel :: Label -> P.Label
trLabel i = case i of trLabel i = case i of
LIdent s -> P.LIdent $ identC s LIdent s -> P.LIdent $ ppIdent s
LVar i -> P.LVar $ toInteger i LVar i -> P.LVar $ toInteger i
trLabelIdent i = identC $ case i of trLabelIdent i = identC $ case i of
LIdent s -> s LIdent s -> s
LVar i -> "v" ++ show i --- should not happen LVar i -> "v" ++ show i --- should not happen
mkName :: Ident -> P.Name mkName :: P.PIdent -> P.Name
mkName = P.IdentName 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
import GF.Source.AbsGF --H import Char
import Data.Char --H
-- the top-level printing method -- the top-level printing method
printTree :: Print a => a -> String printTree :: Print a => a -> String
@@ -18,12 +18,6 @@ doc = (:)
render :: Doc -> String render :: Doc -> String
render d = rend 0 (map ($ "") $ d []) "" where render d = rend 0 (map ($ "") $ d []) "" where
rend i ss = case ss of 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 '(' . rend i ts "(" :ts -> showChar '(' . rend i ts
"{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts "{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts
@@ -83,17 +77,18 @@ instance Print Double where
prt _ x = doc (shows x) 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 instance Print LString where
prt _ (LString i) = doc (showString i) 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 instance Print Grammar where
prt i e = case e of prt i e = case e of
@@ -102,7 +97,7 @@ instance Print Grammar where
instance Print ModDef where instance Print ModDef where
prt i e = case e of 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]) MModule complmod modtype modbody -> prPrec i 0 (concatD [prt 0 complmod , prt 0 modtype , doc (showString "=") , prt 0 modbody])
prtList es = case es of prtList es = case es of
@@ -111,7 +106,7 @@ instance Print ModDef where
instance Print ConcSpec where instance Print ConcSpec where
prt i e = case e of 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 prtList es = case es of
[] -> (concatD []) [] -> (concatD [])
@@ -120,7 +115,7 @@ instance Print ConcSpec where
instance Print ConcExp where instance Print ConcExp where
prt i e = case e of 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 instance Print Transfer where
@@ -134,25 +129,26 @@ instance Print Transfer where
instance Print ModType where instance Print ModType where
prt i e = case e of prt i e = case e of
MTAbstract id -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 id]) MTAbstract pident -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 pident])
MTResource id -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 id]) MTResource pident -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 pident])
MTInterface id -> prPrec i 0 (concatD [doc (showString "interface") , prt 0 id]) MTInterface pident -> prPrec i 0 (concatD [doc (showString "interface") , prt 0 pident])
MTConcrete id0 id -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 id0 , doc (showString "of") , prt 0 id]) MTConcrete pident0 pident -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
MTInstance id0 id -> prPrec i 0 (concatD [doc (showString "instance") , prt 0 id0 , doc (showString "of") , prt 0 id]) MTInstance pident0 pident -> prPrec i 0 (concatD [doc (showString "instance") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
MTTransfer id open0 open -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 id , doc (showString ":") , prt 0 open0 , doc (showString "->") , prt 0 open]) 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 instance Print ModBody where
prt i e = case e of 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 "}")]) 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]) 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]) 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]) MUnion includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
instance Print Extend where instance Print Extend where
prt i e = case e of prt i e = case e of
Ext includeds -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**")]) Ext includeds -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**")])
@@ -167,9 +163,9 @@ instance Print Opens where
instance Print Open where instance Print Open where
prt i e = case e of prt i e = case e of
OName id -> prPrec i 0 (concatD [prt 0 id]) OName pident -> prPrec i 0 (concatD [prt 0 pident])
OQualQO qualopen id -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 id , doc (showString ")")]) OQualQO qualopen pident -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 pident , 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 ")")]) 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 prtList es = case es of
[] -> (concatD []) [] -> (concatD [])
@@ -191,9 +187,9 @@ instance Print QualOpen where
instance Print Included where instance Print Included where
prt i e = case e of prt i e = case e of
IAll id -> prPrec i 0 (concatD [prt 0 id]) IAll pident -> prPrec i 0 (concatD [prt 0 pident])
ISome id ids -> prPrec i 0 (concatD [prt 0 id , doc (showString "[") , prt 0 ids , doc (showString "]")]) ISome pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "[") , prt 0 pidents , doc (showString "]")])
IMinus id ids -> prPrec i 0 (concatD [prt 0 id , doc (showString "-") , doc (showString "[") , prt 0 ids , 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 prtList es = case es of
[] -> (concatD []) [] -> (concatD [])
@@ -230,9 +226,9 @@ instance Print TopDef where
DefPrintOld printdefs -> prPrec i 0 (concatD [doc (showString "printname") , prt 0 printdefs]) DefPrintOld printdefs -> prPrec i 0 (concatD [doc (showString "printname") , prt 0 printdefs])
DefLintype defs -> prPrec i 0 (concatD [doc (showString "lintype") , prt 0 defs]) DefLintype defs -> prPrec i 0 (concatD [doc (showString "lintype") , prt 0 defs])
DefPattern defs -> prPrec i 0 (concatD [doc (showString "pattern") , 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]) 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 prtList es = case es of
[] -> (concatD []) [] -> (concatD [])
@@ -240,9 +236,9 @@ instance Print TopDef where
instance Print CatDef where instance Print CatDef where
prt i e = case e of prt i e = case e of
SimpleCatDef id ddecls -> prPrec i 0 (concatD [prt 0 id , prt 0 ddecls]) SimpleCatDef pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
ListCatDef id ddecls -> prPrec i 0 (concatD [doc (showString "[") , prt 0 id , prt 0 ddecls , doc (showString "]")]) ListCatDef pident ddecls -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , 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 "}")]) 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 prtList es = case es of
[x] -> (concatD [prt 0 x , doc (showString ";")]) [x] -> (concatD [prt 0 x , doc (showString ";")])
@@ -250,7 +246,7 @@ instance Print CatDef where
instance Print FunDef where instance Print FunDef where
prt i e = case e of 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 prtList es = case es of
[x] -> (concatD [prt 0 x , doc (showString ";")]) [x] -> (concatD [prt 0 x , doc (showString ";")])
@@ -258,7 +254,7 @@ instance Print FunDef where
instance Print DataDef where instance Print DataDef where
prt i e = case e of 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 prtList es = case es of
[x] -> (concatD [prt 0 x , doc (showString ";")]) [x] -> (concatD [prt 0 x , doc (showString ";")])
@@ -266,8 +262,8 @@ instance Print DataDef where
instance Print DataConstr where instance Print DataConstr where
prt i e = case e of prt i e = case e of
DataId id -> prPrec i 0 (concatD [prt 0 id]) DataId pident -> prPrec i 0 (concatD [prt 0 pident])
DataQId id0 id -> prPrec i 0 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id]) DataQId pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
prtList es = case es of prtList es = case es of
[] -> (concatD []) [] -> (concatD [])
@@ -276,9 +272,9 @@ instance Print DataConstr where
instance Print ParDef where instance Print ParDef where
prt i e = case e of prt i e = case e of
ParDefDir id parconstrs -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 parconstrs]) ParDefDir pident parconstrs -> prPrec i 0 (concatD [prt 0 pident , 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 ")")]) ParDefIndir pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString "=") , doc (showString "(") , doc (showString "in") , prt 0 pident , doc (showString ")")])
ParDefAbs id -> prPrec i 0 (concatD [prt 0 id]) ParDefAbs pident -> prPrec i 0 (concatD [prt 0 pident])
prtList es = case es of prtList es = case es of
[x] -> (concatD [prt 0 x , doc (showString ";")]) [x] -> (concatD [prt 0 x , doc (showString ";")])
@@ -286,7 +282,7 @@ instance Print ParDef where
instance Print ParConstr where instance Print ParConstr where
prt i e = case e of 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 prtList es = case es of
[] -> (concatD []) [] -> (concatD [])
@@ -303,7 +299,7 @@ instance Print PrintDef where
instance Print FlagDef where instance Print FlagDef where
prt i e = case e of 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 prtList es = case es of
[x] -> (concatD [prt 0 x , doc (showString ";")]) [x] -> (concatD [prt 0 x , doc (showString ";")])
@@ -311,8 +307,8 @@ instance Print FlagDef where
instance Print Name where instance Print Name where
prt i e = case e of prt i e = case e of
IdentName id -> prPrec i 0 (concatD [prt 0 id]) IdentName pident -> prPrec i 0 (concatD [prt 0 pident])
ListName id -> prPrec i 0 (concatD [doc (showString "[") , prt 0 id , doc (showString "]")]) ListName pident -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , doc (showString "]")])
prtList es = case es of prtList es = case es of
[x] -> (concatD [prt 0 x]) [x] -> (concatD [prt 0 x])
@@ -320,9 +316,9 @@ instance Print Name where
instance Print LocDef where instance Print LocDef where
prt i e = case e of prt i e = case e of
LDDecl ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp]) LDDecl pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp])
LDDef ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString "=") , prt 0 exp]) LDDef pidents exp -> prPrec i 0 (concatD [prt 0 pidents , 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]) 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 prtList es = case es of
[] -> (concatD []) [] -> (concatD [])
@@ -331,9 +327,9 @@ instance Print LocDef where
instance Print Exp where instance Print Exp where
prt i e = case e of prt i e = case e of
EIdent id -> prPrec i 6 (concatD [prt 0 id]) EIdent pident -> prPrec i 6 (concatD [prt 0 pident])
EConstr id -> prPrec i 6 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) --H EConstr pident -> prPrec i 6 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
ECons id -> prPrec i 6 (concatD [doc (showString "%") , prt 0 id , doc (showString "%")]) ECons pident -> prPrec i 6 (concatD [doc (showString "%") , prt 0 pident , doc (showString "%")])
ESort sort -> prPrec i 6 (concatD [prt 0 sort]) ESort sort -> prPrec i 6 (concatD [prt 0 sort])
EString str -> prPrec i 6 (concatD [prt 0 str]) EString str -> prPrec i 6 (concatD [prt 0 str])
EInt n -> prPrec i 6 (concatD [prt 0 n]) EInt n -> prPrec i 6 (concatD [prt 0 n])
@@ -341,15 +337,15 @@ instance Print Exp where
EMeta -> prPrec i 6 (concatD [doc (showString "?")]) EMeta -> prPrec i 6 (concatD [doc (showString "?")])
EEmpty -> prPrec i 6 (concatD [doc (showString "[") , doc (showString "]")]) EEmpty -> prPrec i 6 (concatD [doc (showString "[") , doc (showString "]")])
EData -> prPrec i 6 (concatD [doc (showString "data")]) 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 "]")]) 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 "}")]) 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 ">")]) 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 ">")]) 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]) 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 EQConstr pident0 pident -> prPrec i 5 (concatD [doc (showString "{") , prt 0 pident0 , doc (showString ".") , prt 0 pident , doc (showString "}")])
EQCons id0 id -> prPrec i 5 (concatD [doc (showString "%") , prt 0 id0 , doc (showString ".") , prt 0 id]) 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]) 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 "}")]) 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 "}")]) 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 "}")]) 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 "}")]) 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 "}")]) 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]) 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]) 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]) 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 "}")]) 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]) 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]) 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 prtList es = case es of
[] -> (concatD []) [] -> (concatD [])
@@ -389,21 +387,25 @@ instance Print Exps where
instance Print Patt where instance Print Patt where
prt i e = case e of 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 "_")]) PW -> prPrec i 2 (concatD [doc (showString "_")])
PV id -> prPrec i 2 (concatD [prt 0 id]) PV pident -> prPrec i 2 (concatD [prt 0 pident])
PCon id -> prPrec i 2 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) --H PCon pident -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
PQ id0 id -> prPrec i 2 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id]) PQ pident0 pident -> prPrec i 2 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
PInt n -> prPrec i 2 (concatD [prt 0 n]) PInt n -> prPrec i 2 (concatD [prt 0 n])
PFloat d -> prPrec i 2 (concatD [prt 0 d]) PFloat d -> prPrec i 2 (concatD [prt 0 d])
PStr str -> prPrec i 2 (concatD [prt 0 str]) PStr str -> prPrec i 2 (concatD [prt 0 str])
PR pattasss -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pattasss , doc (showString "}")]) 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 ">")]) 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]) PC pident patts -> prPrec i 1 (concatD [prt 0 pident , prt 0 patts])
PQC id0 id patts -> prPrec i 1 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id , 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]) 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]) 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 "*")]) 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]) PNeg patt -> prPrec i 1 (concatD [doc (showString "-") , prt 2 patt])
prtList es = case es of prtList es = case es of
@@ -412,7 +414,7 @@ instance Print Patt where
instance Print PattAss where instance Print PattAss where
prt i e = case e of 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 prtList es = case es of
[] -> (concatD []) [] -> (concatD [])
@@ -421,7 +423,7 @@ instance Print PattAss where
instance Print Label where instance Print Label where
prt i e = case e of 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]) LVar n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
@@ -436,7 +438,7 @@ instance Print Sort where
instance Print Bind where instance Print Bind where
prt i e = case e of 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 "_")]) BWild -> prPrec i 0 (concatD [doc (showString "_")])
prtList es = case es of prtList es = case es of
@@ -517,11 +519,11 @@ instance Print Include where
instance Print FileName where instance Print FileName where
prt i e = case e of prt i e = case e of
FString str -> prPrec i 0 (concatD [prt 0 str]) 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]) FSlash filename -> prPrec i 0 (concatD [doc (showString "/") , prt 0 filename])
FDot 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]) 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 prtList es = case es of
[x] -> (concatD [prt 0 x , doc (showString ";")]) [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 -- Haskell module generated by the BNF converter
import GF.Source.AbsGF import GF.Source.AbsGF
import GF.Infra.Ident import GF.Source.ErrM
import GF.Data.ErrM
type Result = Err String type Result = Err String
failure :: Show a => a -> Result failure :: Show a => a -> Result
failure x = Bad $ "Undefined case: " ++ show x failure x = Bad $ "Undefined case: " ++ show x
transIdent :: Ident -> Result
transIdent x = case x of
IC str -> failure x
transLString :: LString -> Result transLString :: LString -> Result
transLString x = case x of transLString x = case x of
LString str -> failure x LString str -> failure x
transPIdent :: PIdent -> Result
transPIdent x = case x of
PIdent str -> failure x
transGrammar :: Grammar -> Result transGrammar :: Grammar -> Result
transGrammar x = case x of transGrammar x = case x of
Gr moddefs -> failure x Gr moddefs -> failure x
@@ -28,18 +26,18 @@ transGrammar x = case x of
transModDef :: ModDef -> Result transModDef :: ModDef -> Result
transModDef x = case x of transModDef x = case x of
MMain id0 id concspecs -> failure x MMain pident0 pident concspecs -> failure x
MModule complmod modtype modbody -> failure x MModule complmod modtype modbody -> failure x
transConcSpec :: ConcSpec -> Result transConcSpec :: ConcSpec -> Result
transConcSpec x = case x of transConcSpec x = case x of
ConcSpec id concexp -> failure x ConcSpec pident concexp -> failure x
transConcExp :: ConcExp -> Result transConcExp :: ConcExp -> Result
transConcExp x = case x of transConcExp x = case x of
ConcExp id transfers -> failure x ConcExp pident transfers -> failure x
transTransfer :: Transfer -> Result transTransfer :: Transfer -> Result
@@ -50,26 +48,29 @@ transTransfer x = case x of
transModType :: ModType -> Result transModType :: ModType -> Result
transModType x = case x of transModType x = case x of
MTAbstract id -> failure x MTAbstract pident -> failure x
MTResource id -> failure x MTResource pident -> failure x
MTInterface id -> failure x MTInterface pident -> failure x
MTConcrete id0 id -> failure x MTConcrete pident0 pident -> failure x
MTInstance id0 id -> failure x MTInstance pident0 pident -> failure x
MTTransfer id open0 open -> failure x MTTransfer pident open0 open -> failure x
transModBody :: ModBody -> Result transModBody :: ModBody -> Result
transModBody x = case x of transModBody x = case x of
MBody extend opens topdefs -> failure x MBody extend opens topdefs -> failure x
MWith id opens -> failure x MNoBody includeds -> failure x
MWithE ids id opens -> failure x MWith included opens -> failure x
MReuse id -> 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 MUnion includeds -> failure x
transExtend :: Extend -> Result transExtend :: Extend -> Result
transExtend x = case x of transExtend x = case x of
Ext ids -> failure x Ext includeds -> failure x
NoExt -> failure x NoExt -> failure x
@@ -81,9 +82,9 @@ transOpens x = case x of
transOpen :: Open -> Result transOpen :: Open -> Result
transOpen x = case x of transOpen x = case x of
OName id -> failure x OName pident -> failure x
OQualQO qualopen id -> failure x OQualQO qualopen pident -> failure x
OQual qualopen id0 id -> failure x OQual qualopen pident0 pident -> failure x
transComplMod :: ComplMod -> Result transComplMod :: ComplMod -> Result
@@ -101,8 +102,9 @@ transQualOpen x = case x of
transIncluded :: Included -> Result transIncluded :: Included -> Result
transIncluded x = case x of transIncluded x = case x of
IAll id -> failure x IAll pident -> failure x
ISome id ids -> failure x ISome pident pidents -> failure x
IMinus pident pidents -> failure x
transDef :: Def -> Result transDef :: Def -> Result
@@ -132,44 +134,44 @@ transTopDef x = case x of
DefPrintOld printdefs -> failure x DefPrintOld printdefs -> failure x
DefLintype defs -> failure x DefLintype defs -> failure x
DefPattern defs -> failure x DefPattern defs -> failure x
DefPackage id topdefs -> failure x DefPackage pident topdefs -> failure x
DefVars defs -> failure x DefVars defs -> failure x
DefTokenizer id -> failure x DefTokenizer pident -> failure x
transCatDef :: CatDef -> Result transCatDef :: CatDef -> Result
transCatDef x = case x of transCatDef x = case x of
SimpleCatDef id ddecls -> failure x SimpleCatDef pident ddecls -> failure x
ListCatDef id ddecls -> failure x ListCatDef pident ddecls -> failure x
ListSizeCatDef id ddecls n -> failure x ListSizeCatDef pident ddecls n -> failure x
transFunDef :: FunDef -> Result transFunDef :: FunDef -> Result
transFunDef x = case x of transFunDef x = case x of
FunDef ids exp -> failure x FunDef pidents exp -> failure x
transDataDef :: DataDef -> Result transDataDef :: DataDef -> Result
transDataDef x = case x of transDataDef x = case x of
DataDef id dataconstrs -> failure x DataDef pident dataconstrs -> failure x
transDataConstr :: DataConstr -> Result transDataConstr :: DataConstr -> Result
transDataConstr x = case x of transDataConstr x = case x of
DataId id -> failure x DataId pident -> failure x
DataQId id0 id -> failure x DataQId pident0 pident -> failure x
transParDef :: ParDef -> Result transParDef :: ParDef -> Result
transParDef x = case x of transParDef x = case x of
ParDefDir id parconstrs -> failure x ParDefDir pident parconstrs -> failure x
ParDefIndir id0 id -> failure x ParDefIndir pident0 pident -> failure x
ParDefAbs id -> failure x ParDefAbs pident -> failure x
transParConstr :: ParConstr -> Result transParConstr :: ParConstr -> Result
transParConstr x = case x of transParConstr x = case x of
ParConstr id ddecls -> failure x ParConstr pident ddecls -> failure x
transPrintDef :: PrintDef -> Result transPrintDef :: PrintDef -> Result
@@ -179,42 +181,43 @@ transPrintDef x = case x of
transFlagDef :: FlagDef -> Result transFlagDef :: FlagDef -> Result
transFlagDef x = case x of transFlagDef x = case x of
FlagDef id0 id -> failure x FlagDef pident0 pident -> failure x
transName :: Name -> Result transName :: Name -> Result
transName x = case x of transName x = case x of
IdentName id -> failure x IdentName pident -> failure x
ListName id -> failure x ListName pident -> failure x
transLocDef :: LocDef -> Result transLocDef :: LocDef -> Result
transLocDef x = case x of transLocDef x = case x of
LDDecl ids exp -> failure x LDDecl pidents exp -> failure x
LDDef ids exp -> failure x LDDef pidents exp -> failure x
LDFull ids exp0 exp -> failure x LDFull pidents exp0 exp -> failure x
transExp :: Exp -> Result transExp :: Exp -> Result
transExp x = case x of transExp x = case x of
EIdent id -> failure x EIdent pident -> failure x
EConstr id -> failure x EConstr pident -> failure x
ECons id -> failure x ECons pident -> failure x
ESort sort -> failure x ESort sort -> failure x
EString str -> failure x EString str -> failure x
EInt n -> failure x EInt n -> failure x
EFloat d -> failure x
EMeta -> failure x EMeta -> failure x
EEmpty -> failure x EEmpty -> failure x
EData -> failure x EData -> failure x
EList id exps -> failure x EList pident exps -> failure x
EStrings str -> failure x EStrings str -> failure x
ERecord locdefs -> failure x ERecord locdefs -> failure x
ETuple tuplecomps -> failure x ETuple tuplecomps -> failure x
EIndir id -> failure x EIndir pident -> failure x
ETyped exp0 exp -> failure x ETyped exp0 exp -> failure x
EProj exp label -> failure x EProj exp label -> failure x
EQConstr id0 id -> failure x EQConstr pident0 pident -> failure x
EQCons id0 id -> failure x EQCons pident0 pident -> failure x
EApp exp0 exp -> failure x EApp exp0 exp -> failure x
ETable cases -> failure x ETable cases -> failure x
ETTable exp cases -> failure x ETTable exp cases -> failure x
@@ -223,22 +226,25 @@ transExp x = case x of
EVariants exps -> failure x EVariants exps -> failure x
EPre exp alterns -> failure x EPre exp alterns -> failure x
EStrs exps -> 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 ESelect exp0 exp -> failure x
ETupTyp exp0 exp -> failure x ETupTyp exp0 exp -> failure x
EExtend exp0 exp -> failure x EExtend exp0 exp -> failure x
EGlue exp0 exp -> failure x
EConcat exp0 exp -> failure x
EAbstr binds exp -> failure x EAbstr binds exp -> failure x
ECTable binds exp -> failure x ECTable binds exp -> failure x
EProd decl exp -> failure x EProd decl exp -> failure x
ETType exp0 exp -> failure x ETType exp0 exp -> failure x
EConcat exp0 exp -> failure x
EGlue exp0 exp -> failure x
ELet locdefs exp -> failure x ELet locdefs exp -> failure x
ELetb locdefs exp -> failure x ELetb locdefs exp -> failure x
EWhere exp locdefs -> failure x EWhere exp locdefs -> failure x
EEqs equations -> failure x EEqs equations -> failure x
EExample exp str -> failure x
ELString lstring -> failure x ELString lstring -> failure x
ELin id -> failure x ELin pident -> failure x
transExps :: Exps -> Result transExps :: Exps -> Result
@@ -249,26 +255,36 @@ transExps x = case x of
transPatt :: Patt -> Result transPatt :: Patt -> Result
transPatt x = case x of transPatt x = case x of
PChar -> failure x
PChars str -> failure x
PMacro pident -> failure x
PM pident0 pident -> failure x
PW -> failure x PW -> failure x
PV id -> failure x PV pident -> failure x
PCon id -> failure x PCon pident -> failure x
PQ id0 id -> failure x PQ pident0 pident -> failure x
PInt n -> failure x PInt n -> failure x
PFloat d -> failure x
PStr str -> failure x PStr str -> failure x
PR pattasss -> failure x PR pattasss -> failure x
PTup patttuplecomps -> failure x PTup patttuplecomps -> failure x
PC id patts -> failure x PC pident patts -> failure x
PQC id0 id 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 :: PattAss -> Result
transPattAss x = case x of transPattAss x = case x of
PA ids patt -> failure x PA pidents patt -> failure x
transLabel :: Label -> Result transLabel :: Label -> Result
transLabel x = case x of transLabel x = case x of
LIdent id -> failure x LIdent pident -> failure x
LVar n -> failure x LVar n -> failure x
@@ -281,14 +297,9 @@ transSort x = case x of
Sort_Strs -> failure x Sort_Strs -> failure x
transPattAlt :: PattAlt -> Result
transPattAlt x = case x of
AltP patt -> failure x
transBind :: Bind -> Result transBind :: Bind -> Result
transBind x = case x of transBind x = case x of
BIdent id -> failure x BIdent pident -> failure x
BWild -> failure x BWild -> failure x
@@ -310,7 +321,7 @@ transPattTupleComp x = case x of
transCase :: Case -> Result transCase :: Case -> Result
transCase x = case x of transCase x = case x of
Case pattalts exp -> failure x Case patt exp -> failure x
transEquation :: Equation -> Result transEquation :: Equation -> Result
@@ -343,11 +354,11 @@ transInclude x = case x of
transFileName :: FileName -> Result transFileName :: FileName -> Result
transFileName x = case x of transFileName x = case x of
FString str -> failure x FString str -> failure x
FIdent id -> failure x FIdent pident -> failure x
FSlash filename -> failure x FSlash filename -> failure x
FDot filename -> failure x FDot filename -> failure x
FMinus 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 :: Show a => a -> Err b
failure x = Bad $ "Undefined case: " ++ show x failure x = Bad $ "Undefined case: " ++ show x
transIdent :: Ident -> Err Ident prPIdent :: PIdent -> String
transIdent x = case x of prPIdent (PIdent (_,c)) = c
x -> return x
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 :: Name -> Err Ident
transName n = case n of transName n = case n of
IdentName i -> transIdent i IdentName i -> transIdent i
ListName i -> transIdent (mkListId i) ListName i -> liftM mkListId (transIdent i)
transGrammar :: Grammar -> Err G.SourceGrammar transGrammar :: Grammar -> Err G.SourceGrammar
transGrammar x = case x of transGrammar x = case x of
@@ -250,31 +256,34 @@ returnl = return . Left
transFlagDef :: FlagDef -> Err GO.Option transFlagDef :: FlagDef -> Err GO.Option
transFlagDef x = case x of 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 -- | Cat definitions can also return some fun defs
-- if it is a list category definition -- if it is a list category definition
transCatDef :: CatDef -> Err [(Ident, G.Info)] transCatDef :: CatDef -> Err [(Ident, G.Info)]
transCatDef x = case x of 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 ListCatDef id ddecls -> listCat id ddecls 0
ListSizeCatDef id ddecls size -> listCat id ddecls size ListSizeCatDef id ddecls size -> listCat id ddecls size
where where
cat id ddecls = do cat i ddecls = do
i <- transIdent id -- i <- transIdent id
cont <- liftM concat $ mapM transDDecl ddecls cont <- liftM concat $ mapM transDDecl ddecls
return (i, G.AbsCat (yes cont) nope) return (i, G.AbsCat (yes cont) nope)
listCat id ddecls size = do listCat id ddecls size = do
id' <- transIdent id
let let
li = mkListId id li = mkListId id'
baseId = mkBaseId id baseId = mkBaseId id'
consId = mkConsId id consId = mkConsId id'
catd0@(c,G.AbsCat (Yes cont0) _) <- cat li ddecls catd0@(c,G.AbsCat (Yes cont0) _) <- cat li ddecls
let let
catd = (c,G.AbsCat (Yes cont0) (Yes [M.cn baseId,M.cn consId])) catd = (c,G.AbsCat (Yes cont0) (Yes [M.cn baseId,M.cn consId]))
cont = [(mkId x i,ty) | (i,(x,ty)) <- zip [0..] cont0] cont = [(mkId x i,ty) | (i,(x,ty)) <- zip [0..] cont0]
xs = map (G.Vr . fst) cont 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 lc = M.mkApp (G.Vr li) xs
niltyp = M.mkProdSimple (cont ++ genericReplicate size cd) lc niltyp = M.mkProdSimple (cont ++ genericReplicate size cd) lc
nilfund = (baseId, G.AbsFun (yes niltyp) (yes G.EData)) 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 EMeta -> return $ M.meta $ M.int2meta 0
EEmpty -> return G.Empty EEmpty -> return G.Empty
-- [ C x_1 ... x_n ] becomes (ListC x_1 ... x_n) -- [ 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 [] -> return G.Empty
EStrings str -> return $ foldr1 G.C $ map G.K $ words str EStrings str -> return $ foldr1 G.C $ map G.K $ words str
ERecord defs -> erecord2term defs ERecord defs -> erecord2term defs
@@ -538,16 +550,17 @@ locdef2fields d = case d of
trLabel :: Label -> Err G.Label trLabel :: Label -> Err G.Label
trLabel x = case x of trLabel x = case x of
-- this case is for bward compatibiity and should be removed -- this case is for bward compatibility and should be removed
LIdent (IC ('v':ds@(_:_))) | all isDigit ds -> return $ G.LVar $ readIntArg ds 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 LVar x -> return $ G.LVar $ fromInteger x
transSort :: Sort -> Err String transSort :: Sort -> Err String
transSort x = case x of transSort x = case x of
_ -> return $ printTree x _ -> return $ printTree x
{-
--- no more used 7/1/2006 AR --- no more used 7/1/2006 AR
transPatts :: Patt -> Err [G.Patt] transPatts :: Patt -> Err [G.Patt]
transPatts p = case p of transPatts p = case p of
@@ -568,11 +581,11 @@ transPatts p = case p of
let ps' = combinations ps0 let ps' = combinations ps0
return $ map (G.PR . M.tuple2recordPatt) ps' return $ map (G.PR . M.tuple2recordPatt) ps'
_ -> liftM singleton $ transPatt p _ -> liftM singleton $ transPatt p
-}
transPatt :: Patt -> Err G.Patt transPatt :: Patt -> Err G.Patt
transPatt x = case x of transPatt x = case x of
PW -> return G.wildPatt PW -> return G.wildPatt
PV (IC "C_") -> return G.PChar ---- temporary encoding
PV id -> liftM G.PV $ transIdent id PV id -> liftM G.PV $ transIdent id
PC id patts -> liftM2 G.PC (transIdent id) (mapM transPatt patts) PC id patts -> liftM2 G.PC (transIdent id) (mapM transPatt patts)
PCon id -> liftM2 G.PC (transIdent id) (return []) PCon id -> liftM2 G.PC (transIdent id) (return [])
@@ -593,8 +606,8 @@ transPatt x = case x of
PRep p -> liftM G.PRep (transPatt p) PRep p -> liftM G.PRep (transPatt p)
PNeg p -> liftM G.PNeg (transPatt p) PNeg p -> liftM G.PNeg (transPatt p)
PAs x p -> liftM2 G.PAs (transIdent x) (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 :: Bind -> Err Ident
transBind x = case x of transBind x = case x of
@@ -681,9 +694,11 @@ transOldGrammar opts name0 x = case x of
q = CMCompl q = CMCompl
name = maybe name0 (++ ".gf") $ getOptVal opts useName name = maybe name0 (++ ".gf") $ getOptVal opts useName
absName = identC $ maybe topic id $ getOptVal opts useAbsName absName = identPI $ maybe topic id $ getOptVal opts useAbsName
resName = identC $ maybe ("Res" ++ lang) id $ getOptVal opts useResName resName = identPI $ maybe ("Res" ++ lang) id $ getOptVal opts useResName
cncName = identC $ maybe lang id $ getOptVal opts useCncName cncName = identPI $ maybe lang id $ getOptVal opts useCncName
identPI s = PIdent ((0,0),s)
(beg,rest) = span (/='.') name (beg,rest) = span (/='.') name
(topic,lang) = case rest of -- to avoid overwriting old files (topic,lang) = case rest of -- to avoid overwriting old files
@@ -700,11 +715,11 @@ transInclude x = case x of
where where
trans f = case f of trans f = case f of
FString s -> s FString s -> s
FIdent (IC s) -> modif s FIdent (PIdent (_, s)) -> modif s
FSlash filename -> '/' : trans filename FSlash filename -> '/' : trans filename
FDot filename -> '.' : trans filename FDot filename -> '.' : trans filename
FMinus 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 modif s = let s' = init s ++ [toLower (last s)] in
if elem s' newReservedWords then s' else s if elem s' newReservedWords then s' else s
--- unsafe hack ; cf. GetGrammar.oldLexer --- unsafe hack ; cf. GetGrammar.oldLexer

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

@@ -2,7 +2,7 @@
module Main where module Main where
import System.IO ( stdin, hGetContents ) import IO ( stdin, hGetContents )
import System ( getArgs, getProgName ) import System ( getArgs, getProgName )
import GF.Source.LexGF 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 type ParseFun a = [Token] -> Err a