Converted GF/Source/*.hs to Unix line endings, to be able to see what happens when I regenerated the files.

This commit is contained in:
bjorn
2008-10-02 13:23:54 +00:00
parent 8fb068df6a
commit 86a30ef992
8 changed files with 9866 additions and 9866 deletions
+307 -307
View File
@@ -1,307 +1,307 @@
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)
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)
+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
+350 -350
View File
File diff suppressed because one or more lines are too long
+144 -144
View File
@@ -1,144 +1,144 @@
-- -*- 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
}
-- -*- 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
}
+7843 -7843
View File
File diff suppressed because it is too large Load Diff
+642 -642
View File
File diff suppressed because it is too large Load Diff
+534 -534
View File
File diff suppressed because it is too large Load Diff
+20 -20
View File
@@ -1,20 +1,20 @@
module GF.Source.SharedString (shareString) where
import Data.Map as M
import Data.IORef
import qualified Data.ByteString.Char8 as BS
import System.IO.Unsafe (unsafePerformIO)
{-# NOINLINE stringPoolRef #-}
stringPoolRef :: IORef (M.Map BS.ByteString BS.ByteString)
stringPoolRef = unsafePerformIO $ newIORef M.empty
{-# NOINLINE shareString #-}
shareString :: BS.ByteString -> BS.ByteString
shareString s = unsafePerformIO $ do
stringPool <- readIORef stringPoolRef
case M.lookup s stringPool of
Just s' -> return s'
Nothing -> do let s' = BS.copy s
writeIORef stringPoolRef $! M.insert s' s' stringPool
return s'
module GF.Source.SharedString (shareString) where
import Data.Map as M
import Data.IORef
import qualified Data.ByteString.Char8 as BS
import System.IO.Unsafe (unsafePerformIO)
{-# NOINLINE stringPoolRef #-}
stringPoolRef :: IORef (M.Map BS.ByteString BS.ByteString)
stringPoolRef = unsafePerformIO $ newIORef M.empty
{-# NOINLINE shareString #-}
shareString :: BS.ByteString -> BS.ByteString
shareString s = unsafePerformIO $ do
stringPool <- readIORef stringPoolRef
case M.lookup s stringPool of
Just s' -> return s'
Nothing -> do let s' = BS.copy s
writeIORef stringPoolRef $! M.insert s' s' stringPool
return s'