mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 19:22:50 -06:00
use ByteString internally in Ident, CId and Label
This commit is contained in:
kr.angelov
@@ -1,306 +1,307 @@
|
||||
module GF.Source.AbsGF where
|
||||
|
||||
-- Haskell module generated by the BNF converter
|
||||
|
||||
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 PIdent PIdent [ConcSpec]
|
||||
| MModule ComplMod ModType ModBody
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ConcSpec =
|
||||
ConcSpec PIdent ConcExp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ConcExp =
|
||||
ConcExp PIdent [Transfer]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Transfer =
|
||||
TransferIn Open
|
||||
| TransferOut Open
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ModType =
|
||||
MTAbstract PIdent
|
||||
| MTResource PIdent
|
||||
| MTInterface PIdent
|
||||
| MTConcrete PIdent PIdent
|
||||
| MTInstance PIdent PIdent
|
||||
| MTTransfer PIdent Open Open
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ModBody =
|
||||
MBody Extend Opens [TopDef]
|
||||
| MNoBody [Included]
|
||||
| MWith Included [Open]
|
||||
| MWithBody Included [Open] Opens [TopDef]
|
||||
| MWithE [Included] Included [Open]
|
||||
| MWithEBody [Included] Included [Open] Opens [TopDef]
|
||||
| MReuse PIdent
|
||||
| MUnion [Included]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Extend =
|
||||
Ext [Included]
|
||||
| NoExt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Opens =
|
||||
NoOpens
|
||||
| OpenIn [Open]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Open =
|
||||
OName PIdent
|
||||
| OQualQO QualOpen PIdent
|
||||
| OQual QualOpen PIdent PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ComplMod =
|
||||
CMCompl
|
||||
| CMIncompl
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data QualOpen =
|
||||
QOCompl
|
||||
| QOIncompl
|
||||
| QOInterface
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Included =
|
||||
IAll PIdent
|
||||
| ISome PIdent [PIdent]
|
||||
| IMinus PIdent [PIdent]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Def =
|
||||
DDecl [Name] Exp
|
||||
| DDef [Name] Exp
|
||||
| DPatt Name [Patt] Exp
|
||||
| DFull [Name] Exp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data TopDef =
|
||||
DefCat [CatDef]
|
||||
| DefFun [FunDef]
|
||||
| DefFunData [FunDef]
|
||||
| DefDef [Def]
|
||||
| DefData [DataDef]
|
||||
| DefTrans [Def]
|
||||
| DefPar [ParDef]
|
||||
| DefOper [Def]
|
||||
| DefLincat [PrintDef]
|
||||
| DefLindef [Def]
|
||||
| DefLin [Def]
|
||||
| DefPrintCat [PrintDef]
|
||||
| DefPrintFun [PrintDef]
|
||||
| DefFlag [FlagDef]
|
||||
| DefPrintOld [PrintDef]
|
||||
| DefLintype [Def]
|
||||
| DefPattern [Def]
|
||||
| DefPackage PIdent [TopDef]
|
||||
| DefVars [Def]
|
||||
| DefTokenizer PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data CatDef =
|
||||
SimpleCatDef PIdent [DDecl]
|
||||
| ListCatDef PIdent [DDecl]
|
||||
| ListSizeCatDef PIdent [DDecl] Integer
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data FunDef =
|
||||
FunDef [PIdent] Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DataDef =
|
||||
DataDef PIdent [DataConstr]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DataConstr =
|
||||
DataId PIdent
|
||||
| DataQId PIdent PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ParDef =
|
||||
ParDefDir PIdent [ParConstr]
|
||||
| ParDefIndir PIdent PIdent
|
||||
| ParDefAbs PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ParConstr =
|
||||
ParConstr PIdent [DDecl]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data PrintDef =
|
||||
PrintDef [Name] Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data FlagDef =
|
||||
FlagDef PIdent PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Name =
|
||||
IdentName PIdent
|
||||
| ListName PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data LocDef =
|
||||
LDDecl [PIdent] Exp
|
||||
| LDDef [PIdent] Exp
|
||||
| LDFull [PIdent] Exp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Exp =
|
||||
EIdent PIdent
|
||||
| EConstr PIdent
|
||||
| ECons PIdent
|
||||
| ESort Sort
|
||||
| EString String
|
||||
| EInt Integer
|
||||
| EFloat Double
|
||||
| EMeta
|
||||
| EEmpty
|
||||
| EData
|
||||
| EList PIdent Exps
|
||||
| EStrings String
|
||||
| ERecord [LocDef]
|
||||
| ETuple [TupleComp]
|
||||
| EIndir PIdent
|
||||
| ETyped Exp Exp
|
||||
| EProj Exp Label
|
||||
| EQConstr PIdent PIdent
|
||||
| EQCons PIdent PIdent
|
||||
| EApp Exp Exp
|
||||
| ETable [Case]
|
||||
| ETTable Exp [Case]
|
||||
| EVTable Exp [Exp]
|
||||
| ECase Exp [Case]
|
||||
| EVariants [Exp]
|
||||
| EPre Exp [Altern]
|
||||
| EStrs [Exp]
|
||||
| EConAt PIdent Exp
|
||||
| EPatt Patt
|
||||
| EPattType Exp
|
||||
| ESelect Exp Exp
|
||||
| ETupTyp Exp Exp
|
||||
| EExtend Exp Exp
|
||||
| EGlue Exp Exp
|
||||
| EConcat Exp Exp
|
||||
| EAbstr [Bind] Exp
|
||||
| ECTable [Bind] Exp
|
||||
| EProd Decl Exp
|
||||
| ETType Exp Exp
|
||||
| ELet [LocDef] Exp
|
||||
| ELetb [LocDef] Exp
|
||||
| EWhere Exp [LocDef]
|
||||
| EEqs [Equation]
|
||||
| EExample Exp String
|
||||
| ELString LString
|
||||
| ELin PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Exps =
|
||||
NilExp
|
||||
| ConsExp Exp Exps
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Patt =
|
||||
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 PIdent [Patt]
|
||||
| PQC PIdent PIdent [Patt]
|
||||
| PDisj Patt Patt
|
||||
| PSeq Patt Patt
|
||||
| PRep Patt
|
||||
| PAs PIdent Patt
|
||||
| PNeg Patt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data PattAss =
|
||||
PA [PIdent] Patt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Label =
|
||||
LIdent PIdent
|
||||
| LVar Integer
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Sort =
|
||||
Sort_Type
|
||||
| Sort_PType
|
||||
| Sort_Tok
|
||||
| Sort_Str
|
||||
| Sort_Strs
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Bind =
|
||||
BIdent PIdent
|
||||
| BWild
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Decl =
|
||||
DDec [Bind] Exp
|
||||
| DExp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data TupleComp =
|
||||
TComp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data PattTupleComp =
|
||||
PTComp Patt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Case =
|
||||
Case Patt Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Equation =
|
||||
Equ [Patt] Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Altern =
|
||||
Alt Exp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DDecl =
|
||||
DDDec [Bind] Exp
|
||||
| DDExp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data OldGrammar =
|
||||
OldGr Include [TopDef]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Include =
|
||||
NoIncl
|
||||
| Incl [FileName]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data FileName =
|
||||
FString String
|
||||
| FIdent PIdent
|
||||
| FSlash FileName
|
||||
| FDot FileName
|
||||
| FMinus FileName
|
||||
| FAddId PIdent FileName
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
module GF.Source.AbsGF where
|
||||
|
||||
-- Haskell module generated by the BNF converter
|
||||
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
newtype LString = LString BS.ByteString deriving (Eq,Ord,Show)
|
||||
newtype PIdent = PIdent ((Int,Int),BS.ByteString) deriving (Eq,Ord,Show)
|
||||
data Grammar =
|
||||
Gr [ModDef]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ModDef =
|
||||
MMain PIdent PIdent [ConcSpec]
|
||||
| MModule ComplMod ModType ModBody
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ConcSpec =
|
||||
ConcSpec PIdent ConcExp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ConcExp =
|
||||
ConcExp PIdent [Transfer]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Transfer =
|
||||
TransferIn Open
|
||||
| TransferOut Open
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ModType =
|
||||
MTAbstract PIdent
|
||||
| MTResource PIdent
|
||||
| MTInterface PIdent
|
||||
| MTConcrete PIdent PIdent
|
||||
| MTInstance PIdent PIdent
|
||||
| MTTransfer PIdent Open Open
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ModBody =
|
||||
MBody Extend Opens [TopDef]
|
||||
| MNoBody [Included]
|
||||
| MWith Included [Open]
|
||||
| MWithBody Included [Open] Opens [TopDef]
|
||||
| MWithE [Included] Included [Open]
|
||||
| MWithEBody [Included] Included [Open] Opens [TopDef]
|
||||
| MReuse PIdent
|
||||
| MUnion [Included]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Extend =
|
||||
Ext [Included]
|
||||
| NoExt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Opens =
|
||||
NoOpens
|
||||
| OpenIn [Open]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Open =
|
||||
OName PIdent
|
||||
| OQualQO QualOpen PIdent
|
||||
| OQual QualOpen PIdent PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ComplMod =
|
||||
CMCompl
|
||||
| CMIncompl
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data QualOpen =
|
||||
QOCompl
|
||||
| QOIncompl
|
||||
| QOInterface
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Included =
|
||||
IAll PIdent
|
||||
| ISome PIdent [PIdent]
|
||||
| IMinus PIdent [PIdent]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Def =
|
||||
DDecl [Name] Exp
|
||||
| DDef [Name] Exp
|
||||
| DPatt Name [Patt] Exp
|
||||
| DFull [Name] Exp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data TopDef =
|
||||
DefCat [CatDef]
|
||||
| DefFun [FunDef]
|
||||
| DefFunData [FunDef]
|
||||
| DefDef [Def]
|
||||
| DefData [DataDef]
|
||||
| DefTrans [Def]
|
||||
| DefPar [ParDef]
|
||||
| DefOper [Def]
|
||||
| DefLincat [PrintDef]
|
||||
| DefLindef [Def]
|
||||
| DefLin [Def]
|
||||
| DefPrintCat [PrintDef]
|
||||
| DefPrintFun [PrintDef]
|
||||
| DefFlag [FlagDef]
|
||||
| DefPrintOld [PrintDef]
|
||||
| DefLintype [Def]
|
||||
| DefPattern [Def]
|
||||
| DefPackage PIdent [TopDef]
|
||||
| DefVars [Def]
|
||||
| DefTokenizer PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data CatDef =
|
||||
SimpleCatDef PIdent [DDecl]
|
||||
| ListCatDef PIdent [DDecl]
|
||||
| ListSizeCatDef PIdent [DDecl] Integer
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data FunDef =
|
||||
FunDef [PIdent] Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DataDef =
|
||||
DataDef PIdent [DataConstr]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DataConstr =
|
||||
DataId PIdent
|
||||
| DataQId PIdent PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ParDef =
|
||||
ParDefDir PIdent [ParConstr]
|
||||
| ParDefIndir PIdent PIdent
|
||||
| ParDefAbs PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data ParConstr =
|
||||
ParConstr PIdent [DDecl]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data PrintDef =
|
||||
PrintDef [Name] Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data FlagDef =
|
||||
FlagDef PIdent PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Name =
|
||||
IdentName PIdent
|
||||
| ListName PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data LocDef =
|
||||
LDDecl [PIdent] Exp
|
||||
| LDDef [PIdent] Exp
|
||||
| LDFull [PIdent] Exp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Exp =
|
||||
EIdent PIdent
|
||||
| EConstr PIdent
|
||||
| ECons PIdent
|
||||
| ESort Sort
|
||||
| EString String
|
||||
| EInt Integer
|
||||
| EFloat Double
|
||||
| EMeta
|
||||
| EEmpty
|
||||
| EData
|
||||
| EList PIdent Exps
|
||||
| EStrings String
|
||||
| ERecord [LocDef]
|
||||
| ETuple [TupleComp]
|
||||
| EIndir PIdent
|
||||
| ETyped Exp Exp
|
||||
| EProj Exp Label
|
||||
| EQConstr PIdent PIdent
|
||||
| EQCons PIdent PIdent
|
||||
| EApp Exp Exp
|
||||
| ETable [Case]
|
||||
| ETTable Exp [Case]
|
||||
| EVTable Exp [Exp]
|
||||
| ECase Exp [Case]
|
||||
| EVariants [Exp]
|
||||
| EPre Exp [Altern]
|
||||
| EStrs [Exp]
|
||||
| EConAt PIdent Exp
|
||||
| EPatt Patt
|
||||
| EPattType Exp
|
||||
| ESelect Exp Exp
|
||||
| ETupTyp Exp Exp
|
||||
| EExtend Exp Exp
|
||||
| EGlue Exp Exp
|
||||
| EConcat Exp Exp
|
||||
| EAbstr [Bind] Exp
|
||||
| ECTable [Bind] Exp
|
||||
| EProd Decl Exp
|
||||
| ETType Exp Exp
|
||||
| ELet [LocDef] Exp
|
||||
| ELetb [LocDef] Exp
|
||||
| EWhere Exp [LocDef]
|
||||
| EEqs [Equation]
|
||||
| EExample Exp String
|
||||
| ELString LString
|
||||
| ELin PIdent
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Exps =
|
||||
NilExp
|
||||
| ConsExp Exp Exps
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Patt =
|
||||
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 PIdent [Patt]
|
||||
| PQC PIdent PIdent [Patt]
|
||||
| PDisj Patt Patt
|
||||
| PSeq Patt Patt
|
||||
| PRep Patt
|
||||
| PAs PIdent Patt
|
||||
| PNeg Patt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data PattAss =
|
||||
PA [PIdent] Patt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Label =
|
||||
LIdent PIdent
|
||||
| LVar Integer
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Sort =
|
||||
Sort_Type
|
||||
| Sort_PType
|
||||
| Sort_Tok
|
||||
| Sort_Str
|
||||
| Sort_Strs
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Bind =
|
||||
BIdent PIdent
|
||||
| BWild
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Decl =
|
||||
DDec [Bind] Exp
|
||||
| DExp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data TupleComp =
|
||||
TComp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data PattTupleComp =
|
||||
PTComp Patt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Case =
|
||||
Case Patt Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Equation =
|
||||
Equ [Patt] Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Altern =
|
||||
Alt Exp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DDecl =
|
||||
DDDec [Bind] Exp
|
||||
| DDExp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data OldGrammar =
|
||||
OldGr Include [TopDef]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Include =
|
||||
NoIncl
|
||||
| Incl [FileName]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data FileName =
|
||||
FString String
|
||||
| FIdent PIdent
|
||||
| FSlash FileName
|
||||
| FDot FileName
|
||||
| FMinus FileName
|
||||
| FAddId PIdent FileName
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
|
||||
@@ -1,26 +1,26 @@
|
||||
-- BNF Converter: Error Monad
|
||||
-- Copyright (C) 2004 Author: Aarne Ranta
|
||||
|
||||
-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.
|
||||
module GF.Source.ErrM where
|
||||
|
||||
-- the Error monad: like Maybe type with error msgs
|
||||
|
||||
import Control.Monad (MonadPlus(..), liftM)
|
||||
|
||||
data Err a = Ok a | Bad String
|
||||
deriving (Read, Show, Eq, Ord)
|
||||
|
||||
instance Monad Err where
|
||||
return = Ok
|
||||
fail = Bad
|
||||
Ok a >>= f = f a
|
||||
Bad s >>= f = Bad s
|
||||
|
||||
instance Functor Err where
|
||||
fmap = liftM
|
||||
|
||||
instance MonadPlus Err where
|
||||
mzero = Bad "Err.mzero"
|
||||
mplus (Bad _) y = y
|
||||
mplus x _ = x
|
||||
-- BNF Converter: Error Monad
|
||||
-- Copyright (C) 2004 Author: Aarne Ranta
|
||||
|
||||
-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.
|
||||
module GF.Source.ErrM where
|
||||
|
||||
-- the Error monad: like Maybe type with error msgs
|
||||
|
||||
import Control.Monad (MonadPlus(..), liftM)
|
||||
|
||||
data Err a = Ok a | Bad String
|
||||
deriving (Read, Show, Eq, Ord)
|
||||
|
||||
instance Monad Err where
|
||||
return = Ok
|
||||
fail = Bad
|
||||
Ok a >>= f = f a
|
||||
Bad s >>= f = Bad s
|
||||
|
||||
instance Functor Err where
|
||||
fmap = liftM
|
||||
|
||||
instance MonadPlus Err where
|
||||
mzero = Bad "Err.mzero"
|
||||
mplus (Bad _) y = y
|
||||
mplus x _ = x
|
||||
|
||||
@@ -5,6 +5,7 @@
|
||||
|
||||
entrypoints Grammar, ModDef,
|
||||
OldGrammar, --%
|
||||
ModHeader,
|
||||
Exp ; -- let's see if more are needed
|
||||
|
||||
comment "--" ;
|
||||
|
||||
@@ -21,10 +21,12 @@ module GF.Source.GrammarToSource ( trGrammar,
|
||||
|
||||
import GF.Data.Operations
|
||||
import GF.Grammar.Grammar
|
||||
import GF.Grammar.Predef
|
||||
import GF.Infra.Modules
|
||||
import GF.Infra.Option
|
||||
import qualified GF.Source.AbsGF as P
|
||||
import GF.Infra.Ident
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
|
||||
-- | AR 13\/5\/2003
|
||||
--
|
||||
@@ -96,7 +98,7 @@ trAnyDef (i,info) = let i' = tri i in case info of
|
||||
|
||||
ResOverload tysts ->
|
||||
[P.DefOper [P.DDef [mkName i'] (
|
||||
P.EApp (P.EIdent $ tri $ identC "overload")
|
||||
P.EApp (P.EIdent $ tri $ cOverload)
|
||||
(P.ERecord [P.LDFull [i'] (trt ty) (trt fu) | (ty,fu) <- tysts]))]]
|
||||
|
||||
CncCat (Yes ty) Nope _ ->
|
||||
@@ -131,7 +133,7 @@ trPerh p = case p of
|
||||
|
||||
trFlag :: Option -> P.TopDef
|
||||
trFlag o = case o of
|
||||
Opt (f,[x]) -> P.DefFlag [P.FlagDef (tri $ identC f) (tri $ identC x)]
|
||||
Opt (f,[x]) -> P.DefFlag [P.FlagDef (tri $ identC (BS.pack f)) (tri $ identC (BS.pack x))]
|
||||
_ -> P.DefFlag [] --- warning?
|
||||
|
||||
trt :: Term -> P.Exp
|
||||
@@ -139,14 +141,12 @@ trt trm = case trm of
|
||||
Vr s -> P.EIdent $ tri s
|
||||
Cn s -> P.ECons $ tri s
|
||||
Con s -> P.EConstr $ tri s
|
||||
Sort s -> P.ESort $ case s of
|
||||
"Type" -> P.Sort_Type
|
||||
"PType" -> P.Sort_PType
|
||||
"Tok" -> P.Sort_Tok
|
||||
"Str" -> P.Sort_Str
|
||||
"Strs" -> P.Sort_Strs
|
||||
_ -> error $ "not yet sort " +++ show trm ----
|
||||
|
||||
Sort s -> P.ESort $! if s == cType then P.Sort_Type else
|
||||
if s == cPType then P.Sort_PType else
|
||||
if s == cTok then P.Sort_Tok else
|
||||
if s == cStr then P.Sort_Str else
|
||||
if s == cStrs then P.Sort_Strs else
|
||||
error $ "not yet sort " +++ show trm
|
||||
App c a -> P.EApp (trt c) (trt a)
|
||||
Abs x b -> P.EAbstr [trb x] (trt b)
|
||||
Eqs pts -> P.EEqs [P.Equ (map trp ps) (trt t) | (ps,t) <- pts]
|
||||
@@ -210,7 +210,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 [tri $ trLabelIdent l] (trp p) | (l,p) <- r]
|
||||
PR r -> P.PR [P.PA [tri $ label2ident l] (trp p) | (l,p) <- r]
|
||||
PString s -> P.PStr s
|
||||
PInt i -> P.PInt i
|
||||
PFloat i -> P.PFloat i
|
||||
@@ -230,9 +230,9 @@ trp p = case p of
|
||||
trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty
|
||||
where
|
||||
t' = trt t
|
||||
x = [tri $ trLabelIdent lab]
|
||||
x = [tri $ label2ident lab]
|
||||
|
||||
trLabelling (lab,ty) = P.LDDecl [tri $ trLabelIdent lab] (trt ty)
|
||||
trLabelling (lab,ty) = P.LDDecl [tri $ label2ident 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)
|
||||
@@ -240,7 +240,7 @@ trCases (patts,trm) = P.Case (foldl1 P.PDisj (map trp patts)) (trt trm)
|
||||
trDecl (x,ty) = P.DDDec [trb x] (trt ty)
|
||||
|
||||
tri :: Ident -> P.PIdent
|
||||
tri = ppIdent . prIdent
|
||||
tri = ppIdent . ident2bs
|
||||
|
||||
ppIdent i = P.PIdent ((0,0),i)
|
||||
|
||||
@@ -251,9 +251,5 @@ trLabel i = case i of
|
||||
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 :: P.PIdent -> P.Name
|
||||
mkName = P.IdentName
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -1,137 +1,144 @@
|
||||
-- -*- haskell -*-
|
||||
-- This Alex file was machine-generated by the BNF converter
|
||||
{
|
||||
module LexGF where
|
||||
|
||||
import ErrM
|
||||
import SharedString
|
||||
}
|
||||
|
||||
|
||||
$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME
|
||||
$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME
|
||||
$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME
|
||||
$d = [0-9] -- digit
|
||||
$i = [$l $d _ '] -- identifier character
|
||||
$u = [\0-\255] -- universal: any character
|
||||
|
||||
@rsyms = -- reserved words consisting of special symbols
|
||||
\; | \= | \{ | \} | \( | \) | \: | \- \> | \* \* | \, | \[ | \] | \- | \. | \| | \% | \? | \< | \> | \@ | \! | \* | \+ | \+ \+ | \\ | \= \> | \_ | \$ | \/
|
||||
|
||||
:-
|
||||
"--" [.]* ; -- Toss single line comments
|
||||
"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
|
||||
|
||||
$white+ ;
|
||||
@rsyms { tok (\p s -> PT p (TS $ share s)) }
|
||||
\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent (T_LString . share) s)) }
|
||||
|
||||
$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
|
||||
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
|
||||
|
||||
$d+ { tok (\p s -> PT p (TI $ share s)) }
|
||||
$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }
|
||||
|
||||
{
|
||||
|
||||
tok f p s = f p s
|
||||
|
||||
share :: String -> String
|
||||
share = shareString
|
||||
|
||||
data Tok =
|
||||
TS !String -- reserved words
|
||||
| TL !String -- string literals
|
||||
| TI !String -- integer literals
|
||||
| TV !String -- identifiers
|
||||
| TD !String -- double precision float literals
|
||||
| TC !String -- character literals
|
||||
| T_LString !String
|
||||
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
data Token =
|
||||
PT Posn Tok
|
||||
| Err Posn
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
|
||||
tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
|
||||
tokenPos _ = "end of file"
|
||||
|
||||
posLineCol (Pn _ l c) = (l,c)
|
||||
mkPosToken t@(PT p _) = (posLineCol p, prToken t)
|
||||
|
||||
prToken t = case t of
|
||||
PT _ (TS s) -> s
|
||||
PT _ (TI s) -> s
|
||||
PT _ (TV s) -> s
|
||||
PT _ (TD s) -> s
|
||||
PT _ (TC s) -> s
|
||||
PT _ (T_LString s) -> s
|
||||
|
||||
_ -> show t
|
||||
|
||||
data BTree = N | B String Tok BTree BTree deriving (Show)
|
||||
|
||||
eitherResIdent :: (String -> Tok) -> String -> Tok
|
||||
eitherResIdent tv s = treeFind resWords
|
||||
where
|
||||
treeFind N = tv s
|
||||
treeFind (B a t left right) | s < a = treeFind left
|
||||
| s > a = treeFind right
|
||||
| s == a = t
|
||||
|
||||
resWords = b "lincat" (b "def" (b "Type" (b "Str" (b "PType" (b "Lin" N N) N) (b "Tok" (b "Strs" N N) N)) (b "cat" (b "case" (b "abstract" N N) N) (b "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "lin" (b "let" N N) N)))) (b "resource" (b "out" (b "of" (b "lintype" (b "lindef" N N) N) (b "oper" (b "open" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "union" (b "table" (b "strs" (b "reuse" N N) N) (b "transfer" (b "tokenizer" N N) N)) (b "where" (b "variants" (b "var" N N) N) (b "with" N N))))
|
||||
where b s = B s (TS s)
|
||||
|
||||
unescapeInitTail :: String -> String
|
||||
unescapeInitTail = unesc . tail where
|
||||
unesc s = case s of
|
||||
'\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
|
||||
'\\':'n':cs -> '\n' : unesc cs
|
||||
'\\':'t':cs -> '\t' : unesc cs
|
||||
'"':[] -> []
|
||||
c:cs -> c : unesc cs
|
||||
_ -> []
|
||||
|
||||
-------------------------------------------------------------------
|
||||
-- Alex wrapper code.
|
||||
-- A modified "posn" wrapper.
|
||||
-------------------------------------------------------------------
|
||||
|
||||
data Posn = Pn !Int !Int !Int
|
||||
deriving (Eq, Show,Ord)
|
||||
|
||||
alexStartPos :: Posn
|
||||
alexStartPos = Pn 0 1 1
|
||||
|
||||
alexMove :: Posn -> Char -> Posn
|
||||
alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)
|
||||
alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1
|
||||
alexMove (Pn a l c) _ = Pn (a+1) l (c+1)
|
||||
|
||||
type AlexInput = (Posn, -- current position,
|
||||
Char, -- previous char
|
||||
String) -- current input string
|
||||
|
||||
tokens :: String -> [Token]
|
||||
tokens str = go (alexStartPos, '\n', str)
|
||||
where
|
||||
go :: (Posn, Char, String) -> [Token]
|
||||
go inp@(pos, _, str) =
|
||||
case alexScan inp 0 of
|
||||
AlexEOF -> []
|
||||
AlexError (pos, _, _) -> fail $ show pos ++ ": lexical error"
|
||||
AlexSkip inp' len -> go inp'
|
||||
AlexToken inp' len act -> act pos (take len str) : (go inp')
|
||||
|
||||
alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
|
||||
alexGetChar (p, c, []) = Nothing
|
||||
alexGetChar (p, _, (c:s)) =
|
||||
let p' = alexMove p c
|
||||
in p' `seq` Just (c, (p', c, s))
|
||||
|
||||
alexInputPrevChar :: AlexInput -> Char
|
||||
alexInputPrevChar (p, c, s) = c
|
||||
}
|
||||
-- -*- haskell -*-
|
||||
-- This Alex file was machine-generated by the BNF converter
|
||||
{
|
||||
{-# OPTIONS -fno-warn-incomplete-patterns #-}
|
||||
module GF.Source.LexGF where
|
||||
|
||||
import GF.Source.SharedString
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
}
|
||||
|
||||
|
||||
$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME
|
||||
$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME
|
||||
$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME
|
||||
$d = [0-9] -- digit
|
||||
$i = [$l $d _ '] -- identifier character
|
||||
$u = [\0-\255] -- universal: any character
|
||||
|
||||
@rsyms = -- symbols and non-identifier-like reserved words
|
||||
\; | \= | \{ | \} | \( | \) | \* \* | \: | \- \> | \, | \[ | \] | \- | \. | \| | \% | \? | \< | \> | \@ | \# | \! | \* | \+ | \+ \+ | \\ | \= \> | \_ | \$ | \/
|
||||
|
||||
:-
|
||||
"--" [.]* ; -- Toss single line comments
|
||||
"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
|
||||
|
||||
$white+ ;
|
||||
@rsyms { tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) }
|
||||
\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent (T_LString . share) s)) }
|
||||
(\_ | $l)($l | $d | \_ | \')* { tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) }
|
||||
|
||||
$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
|
||||
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
|
||||
|
||||
$d+ { tok (\p s -> PT p (TI $ share s)) }
|
||||
$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }
|
||||
|
||||
{
|
||||
|
||||
tok f p s = f p s
|
||||
|
||||
share :: BS.ByteString -> BS.ByteString
|
||||
share = shareString
|
||||
|
||||
data Tok =
|
||||
TS !BS.ByteString !Int -- reserved words and symbols
|
||||
| TL !BS.ByteString -- string literals
|
||||
| TI !BS.ByteString -- integer literals
|
||||
| TV !BS.ByteString -- identifiers
|
||||
| TD !BS.ByteString -- double precision float literals
|
||||
| TC !BS.ByteString -- character literals
|
||||
| T_LString !BS.ByteString
|
||||
| T_PIdent !BS.ByteString
|
||||
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
data Token =
|
||||
PT Posn Tok
|
||||
| Err Posn
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
|
||||
tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
|
||||
tokenPos _ = "end of file"
|
||||
|
||||
posLineCol (Pn _ l c) = (l,c)
|
||||
mkPosToken t@(PT p _) = (posLineCol p, prToken t)
|
||||
|
||||
prToken t = case t of
|
||||
PT _ (TS s _) -> s
|
||||
PT _ (TL s) -> s
|
||||
PT _ (TI s) -> s
|
||||
PT _ (TV s) -> s
|
||||
PT _ (TD s) -> s
|
||||
PT _ (TC s) -> s
|
||||
PT _ (T_LString s) -> s
|
||||
PT _ (T_PIdent s) -> s
|
||||
|
||||
|
||||
data BTree = N | B BS.ByteString Tok BTree BTree deriving (Show)
|
||||
|
||||
eitherResIdent :: (BS.ByteString -> Tok) -> BS.ByteString -> Tok
|
||||
eitherResIdent tv s = treeFind resWords
|
||||
where
|
||||
treeFind N = tv s
|
||||
treeFind (B a t left right) | s < a = treeFind left
|
||||
| s > a = treeFind right
|
||||
| s == a = t
|
||||
|
||||
resWords = b "def" 39 (b "=>" 20 (b "++" 10 (b "(" 5 (b "$" 3 (b "#" 2 (b "!" 1 N N) N) (b "%" 4 N N)) (b "**" 8 (b "*" 7 (b ")" 6 N N) N) (b "+" 9 N N))) (b "/" 15 (b "->" 13 (b "-" 12 (b "," 11 N N) N) (b "." 14 N N)) (b "<" 18 (b ";" 17 (b ":" 16 N N) N) (b "=" 19 N N)))) (b "[" 30 (b "PType" 25 (b "@" 23 (b "?" 22 (b ">" 21 N N) N) (b "Lin" 24 N N)) (b "Tok" 28 (b "Strs" 27 (b "Str" 26 N N) N) (b "Type" 29 N N))) (b "case" 35 (b "_" 33 (b "]" 32 (b "\\" 31 N N) N) (b "abstract" 34 N N)) (b "concrete" 37 (b "cat" 36 N N) (b "data" 38 N N))))) (b "package" 58 (b "let" 49 (b "in" 44 (b "fun" 42 (b "fn" 41 (b "flags" 40 N N) N) (b "grammar" 43 N N)) (b "instance" 47 (b "incomplete" 46 (b "include" 45 N N) N) (b "interface" 48 N N))) (b "of" 54 (b "lindef" 52 (b "lincat" 51 (b "lin" 50 N N) N) (b "lintype" 53 N N)) (b "oper" 56 (b "open" 55 N N) (b "out" 57 N N)))) (b "transfer" 68 (b "resource" 63 (b "pre" 61 (b "pattern" 60 (b "param" 59 N N) N) (b "printname" 62 N N)) (b "table" 66 (b "strs" 65 (b "reuse" 64 N N) N) (b "tokenizer" 67 N N))) (b "with" 73 (b "variants" 71 (b "var" 70 (b "union" 69 N N) N) (b "where" 72 N N)) (b "|" 75 (b "{" 74 N N) (b "}" 76 N N)))))
|
||||
where b s n = let bs = BS.pack s
|
||||
in B bs (TS bs n)
|
||||
|
||||
unescapeInitTail :: BS.ByteString -> BS.ByteString
|
||||
unescapeInitTail = BS.pack . unesc . tail . BS.unpack where
|
||||
unesc s = case s of
|
||||
'\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
|
||||
'\\':'n':cs -> '\n' : unesc cs
|
||||
'\\':'t':cs -> '\t' : unesc cs
|
||||
'"':[] -> []
|
||||
c:cs -> c : unesc cs
|
||||
_ -> []
|
||||
|
||||
-------------------------------------------------------------------
|
||||
-- Alex wrapper code.
|
||||
-- A modified "posn" wrapper.
|
||||
-------------------------------------------------------------------
|
||||
|
||||
data Posn = Pn !Int !Int !Int
|
||||
deriving (Eq, Show,Ord)
|
||||
|
||||
alexStartPos :: Posn
|
||||
alexStartPos = Pn 0 1 1
|
||||
|
||||
alexMove :: Posn -> Char -> Posn
|
||||
alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)
|
||||
alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1
|
||||
alexMove (Pn a l c) _ = Pn (a+1) l (c+1)
|
||||
|
||||
type AlexInput = (Posn, -- current position,
|
||||
Char, -- previous char
|
||||
BS.ByteString) -- current input string
|
||||
|
||||
tokens :: BS.ByteString -> [Token]
|
||||
tokens str = go (alexStartPos, '\n', str)
|
||||
where
|
||||
go :: AlexInput -> [Token]
|
||||
go inp@(pos, _, str) =
|
||||
case alexScan inp 0 of
|
||||
AlexEOF -> []
|
||||
AlexError (pos, _, _) -> [Err pos]
|
||||
AlexSkip inp' len -> go inp'
|
||||
AlexToken inp' len act -> act pos (BS.take len str) : (go inp')
|
||||
|
||||
alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
|
||||
alexGetChar (p, _, s) =
|
||||
case BS.uncons s of
|
||||
Nothing -> Nothing
|
||||
Just (c,s) ->
|
||||
let p' = alexMove p c
|
||||
in p' `seq` Just (c, (p', c, s))
|
||||
|
||||
alexInputPrevChar :: AlexInput -> Char
|
||||
alexInputPrevChar (p, c, s) = c
|
||||
}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -1,364 +1,381 @@
|
||||
module GF.Source.SkelGF where
|
||||
|
||||
-- Haskell module generated by the BNF converter
|
||||
|
||||
import GF.Source.AbsGF
|
||||
import GF.Source.ErrM
|
||||
type Result = Err String
|
||||
|
||||
failure :: Show a => a -> Result
|
||||
failure x = Bad $ "Undefined case: " ++ show 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
|
||||
|
||||
|
||||
transModDef :: ModDef -> Result
|
||||
transModDef x = case x of
|
||||
MMain pident0 pident concspecs -> failure x
|
||||
MModule complmod modtype modbody -> failure x
|
||||
|
||||
|
||||
transConcSpec :: ConcSpec -> Result
|
||||
transConcSpec x = case x of
|
||||
ConcSpec pident concexp -> failure x
|
||||
|
||||
|
||||
transConcExp :: ConcExp -> Result
|
||||
transConcExp x = case x of
|
||||
ConcExp pident transfers -> failure x
|
||||
|
||||
|
||||
transTransfer :: Transfer -> Result
|
||||
transTransfer x = case x of
|
||||
TransferIn open -> failure x
|
||||
TransferOut open -> failure x
|
||||
|
||||
|
||||
transModType :: ModType -> Result
|
||||
transModType x = case x of
|
||||
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
|
||||
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 includeds -> failure x
|
||||
NoExt -> failure x
|
||||
|
||||
|
||||
transOpens :: Opens -> Result
|
||||
transOpens x = case x of
|
||||
NoOpens -> failure x
|
||||
OpenIn opens -> failure x
|
||||
|
||||
|
||||
transOpen :: Open -> Result
|
||||
transOpen x = case x of
|
||||
OName pident -> failure x
|
||||
OQualQO qualopen pident -> failure x
|
||||
OQual qualopen pident0 pident -> failure x
|
||||
|
||||
|
||||
transComplMod :: ComplMod -> Result
|
||||
transComplMod x = case x of
|
||||
CMCompl -> failure x
|
||||
CMIncompl -> failure x
|
||||
|
||||
|
||||
transQualOpen :: QualOpen -> Result
|
||||
transQualOpen x = case x of
|
||||
QOCompl -> failure x
|
||||
QOIncompl -> failure x
|
||||
QOInterface -> failure x
|
||||
|
||||
|
||||
transIncluded :: Included -> Result
|
||||
transIncluded x = case x of
|
||||
IAll pident -> failure x
|
||||
ISome pident pidents -> failure x
|
||||
IMinus pident pidents -> failure x
|
||||
|
||||
|
||||
transDef :: Def -> Result
|
||||
transDef x = case x of
|
||||
DDecl names exp -> failure x
|
||||
DDef names exp -> failure x
|
||||
DPatt name patts exp -> failure x
|
||||
DFull names exp0 exp -> failure x
|
||||
|
||||
|
||||
transTopDef :: TopDef -> Result
|
||||
transTopDef x = case x of
|
||||
DefCat catdefs -> failure x
|
||||
DefFun fundefs -> failure x
|
||||
DefFunData fundefs -> failure x
|
||||
DefDef defs -> failure x
|
||||
DefData datadefs -> failure x
|
||||
DefTrans defs -> failure x
|
||||
DefPar pardefs -> failure x
|
||||
DefOper defs -> failure x
|
||||
DefLincat printdefs -> failure x
|
||||
DefLindef defs -> failure x
|
||||
DefLin defs -> failure x
|
||||
DefPrintCat printdefs -> failure x
|
||||
DefPrintFun printdefs -> failure x
|
||||
DefFlag flagdefs -> failure x
|
||||
DefPrintOld printdefs -> failure x
|
||||
DefLintype defs -> failure x
|
||||
DefPattern defs -> failure x
|
||||
DefPackage pident topdefs -> failure x
|
||||
DefVars defs -> failure x
|
||||
DefTokenizer pident -> failure x
|
||||
|
||||
|
||||
transCatDef :: CatDef -> Result
|
||||
transCatDef x = case x of
|
||||
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 pidents exp -> failure x
|
||||
|
||||
|
||||
transDataDef :: DataDef -> Result
|
||||
transDataDef x = case x of
|
||||
DataDef pident dataconstrs -> failure x
|
||||
|
||||
|
||||
transDataConstr :: DataConstr -> Result
|
||||
transDataConstr x = case x of
|
||||
DataId pident -> failure x
|
||||
DataQId pident0 pident -> failure x
|
||||
|
||||
|
||||
transParDef :: ParDef -> Result
|
||||
transParDef x = case x of
|
||||
ParDefDir pident parconstrs -> failure x
|
||||
ParDefIndir pident0 pident -> failure x
|
||||
ParDefAbs pident -> failure x
|
||||
|
||||
|
||||
transParConstr :: ParConstr -> Result
|
||||
transParConstr x = case x of
|
||||
ParConstr pident ddecls -> failure x
|
||||
|
||||
|
||||
transPrintDef :: PrintDef -> Result
|
||||
transPrintDef x = case x of
|
||||
PrintDef names exp -> failure x
|
||||
|
||||
|
||||
transFlagDef :: FlagDef -> Result
|
||||
transFlagDef x = case x of
|
||||
FlagDef pident0 pident -> failure x
|
||||
|
||||
|
||||
transName :: Name -> Result
|
||||
transName x = case x of
|
||||
IdentName pident -> failure x
|
||||
ListName pident -> failure x
|
||||
|
||||
|
||||
transLocDef :: LocDef -> Result
|
||||
transLocDef x = case x of
|
||||
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 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 pident exps -> failure x
|
||||
EStrings str -> failure x
|
||||
ERecord locdefs -> failure x
|
||||
ETuple tuplecomps -> failure x
|
||||
EIndir pident -> failure x
|
||||
ETyped exp0 exp -> failure x
|
||||
EProj exp label -> 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
|
||||
EVTable exp exps -> failure x
|
||||
ECase exp cases -> failure x
|
||||
EVariants exps -> failure x
|
||||
EPre exp alterns -> failure x
|
||||
EStrs exps -> 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
|
||||
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 pident -> failure x
|
||||
|
||||
|
||||
transExps :: Exps -> Result
|
||||
transExps x = case x of
|
||||
NilExp -> failure x
|
||||
ConsExp exp exps -> failure x
|
||||
|
||||
|
||||
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 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 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 pidents patt -> failure x
|
||||
|
||||
|
||||
transLabel :: Label -> Result
|
||||
transLabel x = case x of
|
||||
LIdent pident -> failure x
|
||||
LVar n -> failure x
|
||||
|
||||
|
||||
transSort :: Sort -> Result
|
||||
transSort x = case x of
|
||||
Sort_Type -> failure x
|
||||
Sort_PType -> failure x
|
||||
Sort_Tok -> failure x
|
||||
Sort_Str -> failure x
|
||||
Sort_Strs -> failure x
|
||||
|
||||
|
||||
transBind :: Bind -> Result
|
||||
transBind x = case x of
|
||||
BIdent pident -> failure x
|
||||
BWild -> failure x
|
||||
|
||||
|
||||
transDecl :: Decl -> Result
|
||||
transDecl x = case x of
|
||||
DDec binds exp -> failure x
|
||||
DExp exp -> failure x
|
||||
|
||||
|
||||
transTupleComp :: TupleComp -> Result
|
||||
transTupleComp x = case x of
|
||||
TComp exp -> failure x
|
||||
|
||||
|
||||
transPattTupleComp :: PattTupleComp -> Result
|
||||
transPattTupleComp x = case x of
|
||||
PTComp patt -> failure x
|
||||
|
||||
|
||||
transCase :: Case -> Result
|
||||
transCase x = case x of
|
||||
Case patt exp -> failure x
|
||||
|
||||
|
||||
transEquation :: Equation -> Result
|
||||
transEquation x = case x of
|
||||
Equ patts exp -> failure x
|
||||
|
||||
|
||||
transAltern :: Altern -> Result
|
||||
transAltern x = case x of
|
||||
Alt exp0 exp -> failure x
|
||||
|
||||
|
||||
transDDecl :: DDecl -> Result
|
||||
transDDecl x = case x of
|
||||
DDDec binds exp -> failure x
|
||||
DDExp exp -> failure x
|
||||
|
||||
|
||||
transOldGrammar :: OldGrammar -> Result
|
||||
transOldGrammar x = case x of
|
||||
OldGr include topdefs -> failure x
|
||||
|
||||
|
||||
transInclude :: Include -> Result
|
||||
transInclude x = case x of
|
||||
NoIncl -> failure x
|
||||
Incl filenames -> failure x
|
||||
|
||||
|
||||
transFileName :: FileName -> Result
|
||||
transFileName x = case x of
|
||||
FString str -> failure x
|
||||
FIdent pident -> failure x
|
||||
FSlash filename -> failure x
|
||||
FDot filename -> failure x
|
||||
FMinus filename -> failure x
|
||||
FAddId pident filename -> failure x
|
||||
|
||||
|
||||
|
||||
module GF.Source.SkelGF where
|
||||
|
||||
-- Haskell module generated by the BNF converter
|
||||
|
||||
import GF.Source.AbsGF
|
||||
import GF.Source.ErrM
|
||||
type Result = Err String
|
||||
|
||||
failure :: Show a => a -> Result
|
||||
failure x = Bad $ "Undefined case: " ++ show 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
|
||||
|
||||
|
||||
transModDef :: ModDef -> Result
|
||||
transModDef x = case x of
|
||||
MMain pident0 pident concspecs -> failure x
|
||||
MModule complmod modtype modbody -> failure x
|
||||
|
||||
|
||||
transConcSpec :: ConcSpec -> Result
|
||||
transConcSpec x = case x of
|
||||
ConcSpec pident concexp -> failure x
|
||||
|
||||
|
||||
transConcExp :: ConcExp -> Result
|
||||
transConcExp x = case x of
|
||||
ConcExp pident transfers -> failure x
|
||||
|
||||
|
||||
transTransfer :: Transfer -> Result
|
||||
transTransfer x = case x of
|
||||
TransferIn open -> failure x
|
||||
TransferOut open -> failure x
|
||||
|
||||
|
||||
transModHeader :: ModHeader -> Result
|
||||
transModHeader x = case x of
|
||||
MModule2 complmod modtype modheaderbody -> failure x
|
||||
|
||||
|
||||
transModHeaderBody :: ModHeaderBody -> Result
|
||||
transModHeaderBody x = case x of
|
||||
MBody2 extend opens -> failure x
|
||||
MNoBody2 includeds -> failure x
|
||||
MWith2 included opens -> failure x
|
||||
MWithBody2 included opens0 opens -> failure x
|
||||
MWithE2 includeds included opens -> failure x
|
||||
MWithEBody2 includeds included opens0 opens -> failure x
|
||||
MReuse2 pident -> failure x
|
||||
MUnion2 includeds -> failure x
|
||||
|
||||
|
||||
transModType :: ModType -> Result
|
||||
transModType x = case x of
|
||||
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
|
||||
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 includeds -> failure x
|
||||
NoExt -> failure x
|
||||
|
||||
|
||||
transOpens :: Opens -> Result
|
||||
transOpens x = case x of
|
||||
NoOpens -> failure x
|
||||
OpenIn opens -> failure x
|
||||
|
||||
|
||||
transOpen :: Open -> Result
|
||||
transOpen x = case x of
|
||||
OName pident -> failure x
|
||||
OQualQO qualopen pident -> failure x
|
||||
OQual qualopen pident0 pident -> failure x
|
||||
|
||||
|
||||
transComplMod :: ComplMod -> Result
|
||||
transComplMod x = case x of
|
||||
CMCompl -> failure x
|
||||
CMIncompl -> failure x
|
||||
|
||||
|
||||
transQualOpen :: QualOpen -> Result
|
||||
transQualOpen x = case x of
|
||||
QOCompl -> failure x
|
||||
QOIncompl -> failure x
|
||||
QOInterface -> failure x
|
||||
|
||||
|
||||
transIncluded :: Included -> Result
|
||||
transIncluded x = case x of
|
||||
IAll pident -> failure x
|
||||
ISome pident pidents -> failure x
|
||||
IMinus pident pidents -> failure x
|
||||
|
||||
|
||||
transDef :: Def -> Result
|
||||
transDef x = case x of
|
||||
DDecl names exp -> failure x
|
||||
DDef names exp -> failure x
|
||||
DPatt name patts exp -> failure x
|
||||
DFull names exp0 exp -> failure x
|
||||
|
||||
|
||||
transTopDef :: TopDef -> Result
|
||||
transTopDef x = case x of
|
||||
DefCat catdefs -> failure x
|
||||
DefFun fundefs -> failure x
|
||||
DefFunData fundefs -> failure x
|
||||
DefDef defs -> failure x
|
||||
DefData datadefs -> failure x
|
||||
DefTrans defs -> failure x
|
||||
DefPar pardefs -> failure x
|
||||
DefOper defs -> failure x
|
||||
DefLincat printdefs -> failure x
|
||||
DefLindef defs -> failure x
|
||||
DefLin defs -> failure x
|
||||
DefPrintCat printdefs -> failure x
|
||||
DefPrintFun printdefs -> failure x
|
||||
DefFlag flagdefs -> failure x
|
||||
DefPrintOld printdefs -> failure x
|
||||
DefLintype defs -> failure x
|
||||
DefPattern defs -> failure x
|
||||
DefPackage pident topdefs -> failure x
|
||||
DefVars defs -> failure x
|
||||
DefTokenizer pident -> failure x
|
||||
|
||||
|
||||
transCatDef :: CatDef -> Result
|
||||
transCatDef x = case x of
|
||||
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 pidents exp -> failure x
|
||||
|
||||
|
||||
transDataDef :: DataDef -> Result
|
||||
transDataDef x = case x of
|
||||
DataDef pident dataconstrs -> failure x
|
||||
|
||||
|
||||
transDataConstr :: DataConstr -> Result
|
||||
transDataConstr x = case x of
|
||||
DataId pident -> failure x
|
||||
DataQId pident0 pident -> failure x
|
||||
|
||||
|
||||
transParDef :: ParDef -> Result
|
||||
transParDef x = case x of
|
||||
ParDefDir pident parconstrs -> failure x
|
||||
ParDefIndir pident0 pident -> failure x
|
||||
ParDefAbs pident -> failure x
|
||||
|
||||
|
||||
transParConstr :: ParConstr -> Result
|
||||
transParConstr x = case x of
|
||||
ParConstr pident ddecls -> failure x
|
||||
|
||||
|
||||
transPrintDef :: PrintDef -> Result
|
||||
transPrintDef x = case x of
|
||||
PrintDef names exp -> failure x
|
||||
|
||||
|
||||
transFlagDef :: FlagDef -> Result
|
||||
transFlagDef x = case x of
|
||||
FlagDef pident0 pident -> failure x
|
||||
|
||||
|
||||
transName :: Name -> Result
|
||||
transName x = case x of
|
||||
IdentName pident -> failure x
|
||||
ListName pident -> failure x
|
||||
|
||||
|
||||
transLocDef :: LocDef -> Result
|
||||
transLocDef x = case x of
|
||||
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 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 pident exps -> failure x
|
||||
EStrings str -> failure x
|
||||
ERecord locdefs -> failure x
|
||||
ETuple tuplecomps -> failure x
|
||||
EIndir pident -> failure x
|
||||
ETyped exp0 exp -> failure x
|
||||
EProj exp label -> 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
|
||||
EVTable exp exps -> failure x
|
||||
ECase exp cases -> failure x
|
||||
EVariants exps -> failure x
|
||||
EPre exp alterns -> failure x
|
||||
EStrs exps -> 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
|
||||
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 pident -> failure x
|
||||
|
||||
|
||||
transExps :: Exps -> Result
|
||||
transExps x = case x of
|
||||
NilExp -> failure x
|
||||
ConsExp exp exps -> failure x
|
||||
|
||||
|
||||
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 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 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 pidents patt -> failure x
|
||||
|
||||
|
||||
transLabel :: Label -> Result
|
||||
transLabel x = case x of
|
||||
LIdent pident -> failure x
|
||||
LVar n -> failure x
|
||||
|
||||
|
||||
transSort :: Sort -> Result
|
||||
transSort x = case x of
|
||||
Sort_Type -> failure x
|
||||
Sort_PType -> failure x
|
||||
Sort_Tok -> failure x
|
||||
Sort_Str -> failure x
|
||||
Sort_Strs -> failure x
|
||||
|
||||
|
||||
transBind :: Bind -> Result
|
||||
transBind x = case x of
|
||||
BIdent pident -> failure x
|
||||
BWild -> failure x
|
||||
|
||||
|
||||
transDecl :: Decl -> Result
|
||||
transDecl x = case x of
|
||||
DDec binds exp -> failure x
|
||||
DExp exp -> failure x
|
||||
|
||||
|
||||
transTupleComp :: TupleComp -> Result
|
||||
transTupleComp x = case x of
|
||||
TComp exp -> failure x
|
||||
|
||||
|
||||
transPattTupleComp :: PattTupleComp -> Result
|
||||
transPattTupleComp x = case x of
|
||||
PTComp patt -> failure x
|
||||
|
||||
|
||||
transCase :: Case -> Result
|
||||
transCase x = case x of
|
||||
Case patt exp -> failure x
|
||||
|
||||
|
||||
transEquation :: Equation -> Result
|
||||
transEquation x = case x of
|
||||
Equ patts exp -> failure x
|
||||
|
||||
|
||||
transAltern :: Altern -> Result
|
||||
transAltern x = case x of
|
||||
Alt exp0 exp -> failure x
|
||||
|
||||
|
||||
transDDecl :: DDecl -> Result
|
||||
transDDecl x = case x of
|
||||
DDDec binds exp -> failure x
|
||||
DDExp exp -> failure x
|
||||
|
||||
|
||||
transOldGrammar :: OldGrammar -> Result
|
||||
transOldGrammar x = case x of
|
||||
OldGr include topdefs -> failure x
|
||||
|
||||
|
||||
transInclude :: Include -> Result
|
||||
transInclude x = case x of
|
||||
NoIncl -> failure x
|
||||
Incl filenames -> failure x
|
||||
|
||||
|
||||
transFileName :: FileName -> Result
|
||||
transFileName x = case x of
|
||||
FString str -> failure x
|
||||
FIdent pident -> failure x
|
||||
FSlash filename -> failure x
|
||||
FDot filename -> failure x
|
||||
FMinus filename -> failure x
|
||||
FAddId pident filename -> failure x
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -27,6 +27,7 @@ import qualified GF.Grammar.Macros as M
|
||||
import qualified GF.Compile.Update as U
|
||||
import qualified GF.Infra.Option as GO
|
||||
import qualified GF.Compile.ModDeps as GD
|
||||
import GF.Grammar.Predef
|
||||
import GF.Infra.Ident
|
||||
import GF.Source.AbsGF
|
||||
import GF.Source.PrintGF
|
||||
@@ -37,6 +38,7 @@ import GF.Infra.Option
|
||||
import Control.Monad
|
||||
import Data.Char
|
||||
import Data.List (genericReplicate)
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
|
||||
-- based on the skeleton Haskell module generated by the BNF converter
|
||||
|
||||
@@ -45,9 +47,6 @@ type Result = Err String
|
||||
failure :: Show a => a -> Err b
|
||||
failure x = Bad $ "Undefined case: " ++ show 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)
|
||||
@@ -225,7 +224,7 @@ transAbsDef x = case x of
|
||||
DefFunData fundefs -> do
|
||||
fundefs' <- mapM transFunDef fundefs
|
||||
returnl $
|
||||
[(cat, G.AbsCat nope (yes [M.cn fun])) | (funs,typ) <- fundefs',
|
||||
[(cat, G.AbsCat nope (yes [G.Cn fun])) | (funs,typ) <- fundefs',
|
||||
fun <- funs,
|
||||
Ok (_,cat) <- [M.valCat typ]
|
||||
] ++
|
||||
@@ -257,6 +256,9 @@ returnl = return . Left
|
||||
transFlagDef :: FlagDef -> Err GO.Option
|
||||
transFlagDef x = case x of
|
||||
FlagDef f x -> return $ GO.Opt (prPIdent f,[prPIdent x])
|
||||
where
|
||||
prPIdent (PIdent (_,c)) = BS.unpack c
|
||||
|
||||
|
||||
-- | Cat definitions can also return some fun defs
|
||||
-- if it is a list category definition
|
||||
@@ -280,7 +282,7 @@ transCatDef x = case x of
|
||||
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]))
|
||||
catd = (c,G.AbsCat (Yes cont0) (Yes [G.Cn baseId,G.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)
|
||||
@@ -290,7 +292,7 @@ transCatDef x = case x of
|
||||
constyp = M.mkProdSimple (cont ++ [cd, M.mkDecl lc]) lc
|
||||
consfund = (consId, G.AbsFun (yes constyp) (yes G.EData))
|
||||
return [catd,nilfund,consfund]
|
||||
mkId x i = if isWildIdent x then (mkIdent "x" i) else x
|
||||
mkId x i = if isWildIdent x then (varX i) else x
|
||||
|
||||
transFunDef :: FunDef -> Err ([Ident], G.Type)
|
||||
transFunDef x = case x of
|
||||
@@ -434,10 +436,10 @@ transExp x = case x of
|
||||
EQConstr m c -> liftM2 G.QC (transIdent m) (transIdent c)
|
||||
EQCons m c -> liftM2 G.Q (transIdent m) (transIdent c)
|
||||
EString str -> return $ G.K str
|
||||
ESort sort -> liftM G.Sort $ transSort sort
|
||||
ESort sort -> return $ G.Sort $ transSort sort
|
||||
EInt n -> return $ G.EInt n
|
||||
EFloat n -> return $ G.EFloat n
|
||||
EMeta -> return $ M.meta $ M.int2meta 0
|
||||
EMeta -> return $ G.Meta $ M.int2meta 0
|
||||
EEmpty -> return G.Empty
|
||||
-- [ C x_1 ... x_n ] becomes (ListC x_1 ... x_n)
|
||||
EList i es -> do
|
||||
@@ -499,7 +501,7 @@ transExp x = case x of
|
||||
EPattType typ -> liftM G.EPattType (transExp typ)
|
||||
EPatt patt -> liftM G.EPatt (transPatt patt)
|
||||
|
||||
ELString (LString str) -> return $ G.K str
|
||||
ELString (LString str) -> return $ G.K (BS.unpack str) -- use the grammar encoding here
|
||||
ELin id -> liftM G.LiT $ transIdent id
|
||||
|
||||
EEqs eqs -> liftM G.Eqs $ mapM transEquation eqs
|
||||
@@ -527,10 +529,10 @@ erecord2term ds = do
|
||||
(lab,(Just ty,Nothing)) -> mapM tryRT fs >>= return . Left
|
||||
_ -> mapM tryR fs >>= return . Right
|
||||
tryRT f = case f of
|
||||
(lab,(Just ty,Nothing)) -> return (M.ident2label lab,ty)
|
||||
(lab,(Just ty,Nothing)) -> return (G.ident2label lab,ty)
|
||||
_ -> Bad $ "illegal record type field" +++ GP.prt (fst f) --- manifest fields ?!
|
||||
tryR f = case f of
|
||||
(lab,(mty, Just t)) -> return (M.ident2label lab,(mty,t))
|
||||
(lab,(mty, Just t)) -> return (G.ident2label lab,(mty,t))
|
||||
_ -> Bad $ "illegal record field" +++ GP.prt (fst f)
|
||||
|
||||
|
||||
@@ -552,16 +554,16 @@ locdef2fields d = case d of
|
||||
|
||||
trLabel :: Label -> Err G.Label
|
||||
trLabel x = case x of
|
||||
|
||||
-- this case is for bward compatibility and should be removed
|
||||
LIdent (PIdent (_,'v':ds@(_:_))) | all isDigit ds -> return $ G.LVar $ readIntArg ds
|
||||
|
||||
LIdent (PIdent (_, s)) -> return $ G.LIdent s
|
||||
LVar x -> return $ G.LVar $ fromInteger x
|
||||
LVar x -> return $ G.LVar $ fromInteger x
|
||||
|
||||
transSort :: Sort -> Ident
|
||||
transSort Sort_Type = cType
|
||||
transSort Sort_PType = cPType
|
||||
transSort Sort_Tok = cTok
|
||||
transSort Sort_Str = cStr
|
||||
transSort Sort_Strs = cStrs
|
||||
|
||||
transSort :: Sort -> Err String
|
||||
transSort x = case x of
|
||||
_ -> return $ printTree x
|
||||
|
||||
{-
|
||||
--- no more used 7/1/2006 AR
|
||||
@@ -703,7 +705,7 @@ transOldGrammar opts name0 x = case x of
|
||||
resName = identPI $ maybe ("Res" ++ lang) id $ getOptVal opts useResName
|
||||
cncName = identPI $ maybe lang id $ getOptVal opts useCncName
|
||||
|
||||
identPI s = PIdent ((0,0),s)
|
||||
identPI s = PIdent ((0,0),BS.pack s)
|
||||
|
||||
(beg,rest) = span (/='.') name
|
||||
(topic,lang) = case rest of -- to avoid overwriting old files
|
||||
@@ -725,8 +727,8 @@ transInclude x = case x of
|
||||
FDot filename -> '.' : trans filename
|
||||
FMinus filename -> '-' : 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
|
||||
modif s = let s' = BS.snoc (BS.init s) (toLower (BS.last s)) in
|
||||
BS.unpack (if elem (BS.unpack s') newReservedWords then s' else s)
|
||||
--- unsafe hack ; cf. GetGrammar.oldLexer
|
||||
|
||||
|
||||
@@ -740,16 +742,16 @@ termInPattern t = M.mkAbs xx $ G.R [(s, (Nothing, toP body))] where
|
||||
toP t = case t of
|
||||
G.Vr x -> G.P t s
|
||||
_ -> M.composSafeOp toP t
|
||||
s = G.LIdent "s"
|
||||
s = G.LIdent (BS.pack "s")
|
||||
(xx,body) = abss [] t
|
||||
abss xs t = case t of
|
||||
G.Abs x b -> abss (x:xs) b
|
||||
_ -> (reverse xs,t)
|
||||
|
||||
mkListId,mkConsId,mkBaseId :: Ident -> Ident
|
||||
mkListId = prefixId "List"
|
||||
mkConsId = prefixId "Cons"
|
||||
mkBaseId = prefixId "Base"
|
||||
mkListId = prefixId (BS.pack "List")
|
||||
mkConsId = prefixId (BS.pack "Cons")
|
||||
mkBaseId = prefixId (BS.pack "Base")
|
||||
|
||||
prefixId :: String -> Ident -> Ident
|
||||
prefixId pref id = IC (pref ++ prIdent id)
|
||||
prefixId :: BS.ByteString -> Ident -> Ident
|
||||
prefixId pref id = identC (BS.append pref (ident2bs id))
|
||||
|
||||
@@ -1,58 +1,58 @@
|
||||
-- automatically generated by BNF Converter
|
||||
module Main where
|
||||
|
||||
|
||||
import IO ( stdin, hGetContents )
|
||||
import System ( getArgs, getProgName )
|
||||
|
||||
import GF.Source.LexGF
|
||||
import GF.Source.ParGF
|
||||
import GF.Source.SkelGF
|
||||
import GF.Source.PrintGF
|
||||
import GF.Source.AbsGF
|
||||
|
||||
|
||||
|
||||
|
||||
import GF.Source.ErrM
|
||||
|
||||
type ParseFun a = [Token] -> Err a
|
||||
|
||||
myLLexer = myLexer
|
||||
|
||||
type Verbosity = Int
|
||||
|
||||
putStrV :: Verbosity -> String -> IO ()
|
||||
putStrV v s = if v > 1 then putStrLn s else return ()
|
||||
|
||||
runFile :: (Print a, Show a) => Verbosity -> ParseFun a -> FilePath -> IO ()
|
||||
runFile v p f = putStrLn f >> readFile f >>= run v p
|
||||
|
||||
run :: (Print a, Show a) => Verbosity -> ParseFun a -> String -> IO ()
|
||||
run v p s = let ts = myLLexer s in case p ts of
|
||||
Bad s -> do putStrLn "\nParse Failed...\n"
|
||||
putStrV v "Tokens:"
|
||||
putStrV v $ show ts
|
||||
putStrLn s
|
||||
Ok tree -> do putStrLn "\nParse Successful!"
|
||||
showTree v tree
|
||||
|
||||
|
||||
|
||||
showTree :: (Show a, Print a) => Int -> a -> IO ()
|
||||
showTree v tree
|
||||
= do
|
||||
putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree
|
||||
putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree
|
||||
|
||||
main :: IO ()
|
||||
main = do args <- getArgs
|
||||
case args of
|
||||
[] -> hGetContents stdin >>= run 2 pGrammar
|
||||
"-s":fs -> mapM_ (runFile 0 pGrammar) fs
|
||||
fs -> mapM_ (runFile 2 pGrammar) fs
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
-- automatically generated by BNF Converter
|
||||
module Main where
|
||||
|
||||
|
||||
import IO ( stdin, hGetContents )
|
||||
import System ( getArgs, getProgName )
|
||||
|
||||
import GF.Source.LexGF
|
||||
import GF.Source.ParGF
|
||||
import GF.Source.SkelGF
|
||||
import GF.Source.PrintGF
|
||||
import GF.Source.AbsGF
|
||||
|
||||
|
||||
|
||||
|
||||
import GF.Source.ErrM
|
||||
|
||||
type ParseFun a = [Token] -> Err a
|
||||
|
||||
myLLexer = myLexer
|
||||
|
||||
type Verbosity = Int
|
||||
|
||||
putStrV :: Verbosity -> String -> IO ()
|
||||
putStrV v s = if v > 1 then putStrLn s else return ()
|
||||
|
||||
runFile :: (Print a, Show a) => Verbosity -> ParseFun a -> FilePath -> IO ()
|
||||
runFile v p f = putStrLn f >> readFile f >>= run v p
|
||||
|
||||
run :: (Print a, Show a) => Verbosity -> ParseFun a -> String -> IO ()
|
||||
run v p s = let ts = myLLexer s in case p ts of
|
||||
Bad s -> do putStrLn "\nParse Failed...\n"
|
||||
putStrV v "Tokens:"
|
||||
putStrV v $ show ts
|
||||
putStrLn s
|
||||
Ok tree -> do putStrLn "\nParse Successful!"
|
||||
showTree v tree
|
||||
|
||||
|
||||
|
||||
showTree :: (Show a, Print a) => Int -> a -> IO ()
|
||||
showTree v tree
|
||||
= do
|
||||
putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree
|
||||
putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree
|
||||
|
||||
main :: IO ()
|
||||
main = do args <- getArgs
|
||||
case args of
|
||||
[] -> hGetContents stdin >>= run 2 pGrammar
|
||||
"-s":fs -> mapM_ (runFile 0 pGrammar) fs
|
||||
fs -> mapM_ (runFile 2 pGrammar) fs
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user