msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

use ByteString internally in Ident, CId and Label

Browse Source
This commit is contained in:
kr.angelov
2008-05-21 13:10:54 +00:00
parent e8bbd458cb
commit 314f5cc5e7
65 changed files with 6275 additions and 6432 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src-3.0/GF/Source/AbsGF.hs
+307 -306
View File
@@ -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)
src-3.0/GF/Source/ErrM.hs
+26 -26
View File
@@ -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
src-3.0/GF/Source/GF.cf
+1
View File
@@ -5,6 +5,7 @@
entrypoints Grammar, ModDef,
OldGrammar, --%
ModHeader,
Exp ; -- let's see if more are needed
comment "--" ;
src-3.0/GF/Source/GrammarToSource.hs
+14 -18
View File
@@ -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
src-3.0/GF/Source/LexGF.hs
+350 -345
View File
File diff suppressed because one or more lines are too long
src-3.0/GF/Source/LexGF.x
+144 -137
View File
@@ -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
}
src-3.0/GF/Source/ParGF.hs
+3297 -3299
View File
File diff suppressed because it is too large Load Diff
src-3.0/GF/Source/ParGF.y
+642 -642
View File
File diff suppressed because it is too large Load Diff
src-3.0/GF/Source/PrintGF.hs
+534 -532
View File
File diff suppressed because it is too large Load Diff
src-3.0/GF/Source/SkelGF.hs
+381 -364
View File
@@ -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
src-3.0/GF/Source/SourceToGrammar.hs
+30 -28
View File
@@ -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))
src-3.0/GF/Source/TestGF.hs
+58 -58
View File
@@ -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