forked from GitHub/gf-core
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
+307
-307
@@ -1,307 +1,307 @@
|
|||||||
module GF.Source.AbsGF where
|
module GF.Source.AbsGF where
|
||||||
|
|
||||||
-- Haskell module generated by the BNF converter
|
-- Haskell module generated by the BNF converter
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
newtype LString = LString BS.ByteString deriving (Eq,Ord,Show)
|
newtype LString = LString BS.ByteString deriving (Eq,Ord,Show)
|
||||||
newtype PIdent = PIdent ((Int,Int),BS.ByteString) deriving (Eq,Ord,Show)
|
newtype PIdent = PIdent ((Int,Int),BS.ByteString) deriving (Eq,Ord,Show)
|
||||||
data Grammar =
|
data Grammar =
|
||||||
Gr [ModDef]
|
Gr [ModDef]
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data ModDef =
|
data ModDef =
|
||||||
MMain PIdent PIdent [ConcSpec]
|
MMain PIdent PIdent [ConcSpec]
|
||||||
| MModule ComplMod ModType ModBody
|
| MModule ComplMod ModType ModBody
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data ConcSpec =
|
data ConcSpec =
|
||||||
ConcSpec PIdent ConcExp
|
ConcSpec PIdent ConcExp
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data ConcExp =
|
data ConcExp =
|
||||||
ConcExp PIdent [Transfer]
|
ConcExp PIdent [Transfer]
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Transfer =
|
data Transfer =
|
||||||
TransferIn Open
|
TransferIn Open
|
||||||
| TransferOut Open
|
| TransferOut Open
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data ModType =
|
data ModType =
|
||||||
MTAbstract PIdent
|
MTAbstract PIdent
|
||||||
| MTResource PIdent
|
| MTResource PIdent
|
||||||
| MTInterface PIdent
|
| MTInterface PIdent
|
||||||
| MTConcrete PIdent PIdent
|
| MTConcrete PIdent PIdent
|
||||||
| MTInstance PIdent PIdent
|
| MTInstance PIdent PIdent
|
||||||
| MTTransfer PIdent Open Open
|
| MTTransfer PIdent Open Open
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data ModBody =
|
data ModBody =
|
||||||
MBody Extend Opens [TopDef]
|
MBody Extend Opens [TopDef]
|
||||||
| MNoBody [Included]
|
| MNoBody [Included]
|
||||||
| MWith Included [Open]
|
| MWith Included [Open]
|
||||||
| MWithBody Included [Open] Opens [TopDef]
|
| MWithBody Included [Open] Opens [TopDef]
|
||||||
| MWithE [Included] Included [Open]
|
| MWithE [Included] Included [Open]
|
||||||
| MWithEBody [Included] Included [Open] Opens [TopDef]
|
| MWithEBody [Included] Included [Open] Opens [TopDef]
|
||||||
| MReuse PIdent
|
| MReuse PIdent
|
||||||
| MUnion [Included]
|
| MUnion [Included]
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Extend =
|
data Extend =
|
||||||
Ext [Included]
|
Ext [Included]
|
||||||
| NoExt
|
| NoExt
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Opens =
|
data Opens =
|
||||||
NoOpens
|
NoOpens
|
||||||
| OpenIn [Open]
|
| OpenIn [Open]
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Open =
|
data Open =
|
||||||
OName PIdent
|
OName PIdent
|
||||||
| OQualQO QualOpen PIdent
|
| OQualQO QualOpen PIdent
|
||||||
| OQual QualOpen PIdent PIdent
|
| OQual QualOpen PIdent PIdent
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data ComplMod =
|
data ComplMod =
|
||||||
CMCompl
|
CMCompl
|
||||||
| CMIncompl
|
| CMIncompl
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data QualOpen =
|
data QualOpen =
|
||||||
QOCompl
|
QOCompl
|
||||||
| QOIncompl
|
| QOIncompl
|
||||||
| QOInterface
|
| QOInterface
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Included =
|
data Included =
|
||||||
IAll PIdent
|
IAll PIdent
|
||||||
| ISome PIdent [PIdent]
|
| ISome PIdent [PIdent]
|
||||||
| IMinus PIdent [PIdent]
|
| IMinus PIdent [PIdent]
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Def =
|
data Def =
|
||||||
DDecl [Name] Exp
|
DDecl [Name] Exp
|
||||||
| DDef [Name] Exp
|
| DDef [Name] Exp
|
||||||
| DPatt Name [Patt] Exp
|
| DPatt Name [Patt] Exp
|
||||||
| DFull [Name] Exp Exp
|
| DFull [Name] Exp Exp
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data TopDef =
|
data TopDef =
|
||||||
DefCat [CatDef]
|
DefCat [CatDef]
|
||||||
| DefFun [FunDef]
|
| DefFun [FunDef]
|
||||||
| DefFunData [FunDef]
|
| DefFunData [FunDef]
|
||||||
| DefDef [Def]
|
| DefDef [Def]
|
||||||
| DefData [DataDef]
|
| DefData [DataDef]
|
||||||
| DefTrans [Def]
|
| DefTrans [Def]
|
||||||
| DefPar [ParDef]
|
| DefPar [ParDef]
|
||||||
| DefOper [Def]
|
| DefOper [Def]
|
||||||
| DefLincat [PrintDef]
|
| DefLincat [PrintDef]
|
||||||
| DefLindef [Def]
|
| DefLindef [Def]
|
||||||
| DefLin [Def]
|
| DefLin [Def]
|
||||||
| DefPrintCat [PrintDef]
|
| DefPrintCat [PrintDef]
|
||||||
| DefPrintFun [PrintDef]
|
| DefPrintFun [PrintDef]
|
||||||
| DefFlag [FlagDef]
|
| DefFlag [FlagDef]
|
||||||
| DefPrintOld [PrintDef]
|
| DefPrintOld [PrintDef]
|
||||||
| DefLintype [Def]
|
| DefLintype [Def]
|
||||||
| DefPattern [Def]
|
| DefPattern [Def]
|
||||||
| DefPackage PIdent [TopDef]
|
| DefPackage PIdent [TopDef]
|
||||||
| DefVars [Def]
|
| DefVars [Def]
|
||||||
| DefTokenizer PIdent
|
| DefTokenizer PIdent
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data CatDef =
|
data CatDef =
|
||||||
SimpleCatDef PIdent [DDecl]
|
SimpleCatDef PIdent [DDecl]
|
||||||
| ListCatDef PIdent [DDecl]
|
| ListCatDef PIdent [DDecl]
|
||||||
| ListSizeCatDef PIdent [DDecl] Integer
|
| ListSizeCatDef PIdent [DDecl] Integer
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data FunDef =
|
data FunDef =
|
||||||
FunDef [PIdent] Exp
|
FunDef [PIdent] Exp
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data DataDef =
|
data DataDef =
|
||||||
DataDef PIdent [DataConstr]
|
DataDef PIdent [DataConstr]
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data DataConstr =
|
data DataConstr =
|
||||||
DataId PIdent
|
DataId PIdent
|
||||||
| DataQId PIdent PIdent
|
| DataQId PIdent PIdent
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data ParDef =
|
data ParDef =
|
||||||
ParDefDir PIdent [ParConstr]
|
ParDefDir PIdent [ParConstr]
|
||||||
| ParDefIndir PIdent PIdent
|
| ParDefIndir PIdent PIdent
|
||||||
| ParDefAbs PIdent
|
| ParDefAbs PIdent
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data ParConstr =
|
data ParConstr =
|
||||||
ParConstr PIdent [DDecl]
|
ParConstr PIdent [DDecl]
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data PrintDef =
|
data PrintDef =
|
||||||
PrintDef [Name] Exp
|
PrintDef [Name] Exp
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data FlagDef =
|
data FlagDef =
|
||||||
FlagDef PIdent PIdent
|
FlagDef PIdent PIdent
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Name =
|
data Name =
|
||||||
IdentName PIdent
|
IdentName PIdent
|
||||||
| ListName PIdent
|
| ListName PIdent
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data LocDef =
|
data LocDef =
|
||||||
LDDecl [PIdent] Exp
|
LDDecl [PIdent] Exp
|
||||||
| LDDef [PIdent] Exp
|
| LDDef [PIdent] Exp
|
||||||
| LDFull [PIdent] Exp Exp
|
| LDFull [PIdent] Exp Exp
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Exp =
|
data Exp =
|
||||||
EIdent PIdent
|
EIdent PIdent
|
||||||
| EConstr PIdent
|
| EConstr PIdent
|
||||||
| ECons PIdent
|
| ECons PIdent
|
||||||
| ESort Sort
|
| ESort Sort
|
||||||
| EString String
|
| EString String
|
||||||
| EInt Integer
|
| EInt Integer
|
||||||
| EFloat Double
|
| EFloat Double
|
||||||
| EMeta
|
| EMeta
|
||||||
| EEmpty
|
| EEmpty
|
||||||
| EData
|
| EData
|
||||||
| EList PIdent Exps
|
| EList PIdent Exps
|
||||||
| EStrings String
|
| EStrings String
|
||||||
| ERecord [LocDef]
|
| ERecord [LocDef]
|
||||||
| ETuple [TupleComp]
|
| ETuple [TupleComp]
|
||||||
| EIndir PIdent
|
| EIndir PIdent
|
||||||
| ETyped Exp Exp
|
| ETyped Exp Exp
|
||||||
| EProj Exp Label
|
| EProj Exp Label
|
||||||
| EQConstr PIdent PIdent
|
| EQConstr PIdent PIdent
|
||||||
| EQCons PIdent PIdent
|
| EQCons PIdent PIdent
|
||||||
| EApp Exp Exp
|
| EApp Exp Exp
|
||||||
| ETable [Case]
|
| ETable [Case]
|
||||||
| ETTable Exp [Case]
|
| ETTable Exp [Case]
|
||||||
| EVTable Exp [Exp]
|
| EVTable Exp [Exp]
|
||||||
| ECase Exp [Case]
|
| ECase Exp [Case]
|
||||||
| EVariants [Exp]
|
| EVariants [Exp]
|
||||||
| EPre Exp [Altern]
|
| EPre Exp [Altern]
|
||||||
| EStrs [Exp]
|
| EStrs [Exp]
|
||||||
| EConAt PIdent Exp
|
| EConAt PIdent Exp
|
||||||
| EPatt Patt
|
| EPatt Patt
|
||||||
| EPattType Exp
|
| EPattType Exp
|
||||||
| ESelect Exp Exp
|
| ESelect Exp Exp
|
||||||
| ETupTyp Exp Exp
|
| ETupTyp Exp Exp
|
||||||
| EExtend Exp Exp
|
| EExtend Exp Exp
|
||||||
| EGlue Exp Exp
|
| EGlue Exp Exp
|
||||||
| EConcat Exp Exp
|
| EConcat Exp Exp
|
||||||
| EAbstr [Bind] Exp
|
| EAbstr [Bind] Exp
|
||||||
| ECTable [Bind] Exp
|
| ECTable [Bind] Exp
|
||||||
| EProd Decl Exp
|
| EProd Decl Exp
|
||||||
| ETType Exp Exp
|
| ETType Exp Exp
|
||||||
| ELet [LocDef] Exp
|
| ELet [LocDef] Exp
|
||||||
| ELetb [LocDef] Exp
|
| ELetb [LocDef] Exp
|
||||||
| EWhere Exp [LocDef]
|
| EWhere Exp [LocDef]
|
||||||
| EEqs [Equation]
|
| EEqs [Equation]
|
||||||
| EExample Exp String
|
| EExample Exp String
|
||||||
| ELString LString
|
| ELString LString
|
||||||
| ELin PIdent
|
| ELin PIdent
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Exps =
|
data Exps =
|
||||||
NilExp
|
NilExp
|
||||||
| ConsExp Exp Exps
|
| ConsExp Exp Exps
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Patt =
|
data Patt =
|
||||||
PChar
|
PChar
|
||||||
| PChars String
|
| PChars String
|
||||||
| PMacro PIdent
|
| PMacro PIdent
|
||||||
| PM PIdent PIdent
|
| PM PIdent PIdent
|
||||||
| PW
|
| PW
|
||||||
| PV PIdent
|
| PV PIdent
|
||||||
| PCon PIdent
|
| PCon PIdent
|
||||||
| PQ PIdent PIdent
|
| PQ PIdent PIdent
|
||||||
| PInt Integer
|
| PInt Integer
|
||||||
| PFloat Double
|
| PFloat Double
|
||||||
| PStr String
|
| PStr String
|
||||||
| PR [PattAss]
|
| PR [PattAss]
|
||||||
| PTup [PattTupleComp]
|
| PTup [PattTupleComp]
|
||||||
| PC PIdent [Patt]
|
| PC PIdent [Patt]
|
||||||
| PQC PIdent PIdent [Patt]
|
| PQC PIdent PIdent [Patt]
|
||||||
| PDisj Patt Patt
|
| PDisj Patt Patt
|
||||||
| PSeq Patt Patt
|
| PSeq Patt Patt
|
||||||
| PRep Patt
|
| PRep Patt
|
||||||
| PAs PIdent Patt
|
| PAs PIdent Patt
|
||||||
| PNeg Patt
|
| PNeg Patt
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data PattAss =
|
data PattAss =
|
||||||
PA [PIdent] Patt
|
PA [PIdent] Patt
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Label =
|
data Label =
|
||||||
LIdent PIdent
|
LIdent PIdent
|
||||||
| LVar Integer
|
| LVar Integer
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Sort =
|
data Sort =
|
||||||
Sort_Type
|
Sort_Type
|
||||||
| Sort_PType
|
| Sort_PType
|
||||||
| Sort_Tok
|
| Sort_Tok
|
||||||
| Sort_Str
|
| Sort_Str
|
||||||
| Sort_Strs
|
| Sort_Strs
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Bind =
|
data Bind =
|
||||||
BIdent PIdent
|
BIdent PIdent
|
||||||
| BWild
|
| BWild
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Decl =
|
data Decl =
|
||||||
DDec [Bind] Exp
|
DDec [Bind] Exp
|
||||||
| DExp Exp
|
| DExp Exp
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data TupleComp =
|
data TupleComp =
|
||||||
TComp Exp
|
TComp Exp
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data PattTupleComp =
|
data PattTupleComp =
|
||||||
PTComp Patt
|
PTComp Patt
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Case =
|
data Case =
|
||||||
Case Patt Exp
|
Case Patt Exp
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Equation =
|
data Equation =
|
||||||
Equ [Patt] Exp
|
Equ [Patt] Exp
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Altern =
|
data Altern =
|
||||||
Alt Exp Exp
|
Alt Exp Exp
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data DDecl =
|
data DDecl =
|
||||||
DDDec [Bind] Exp
|
DDDec [Bind] Exp
|
||||||
| DDExp Exp
|
| DDExp Exp
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data OldGrammar =
|
data OldGrammar =
|
||||||
OldGr Include [TopDef]
|
OldGr Include [TopDef]
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Include =
|
data Include =
|
||||||
NoIncl
|
NoIncl
|
||||||
| Incl [FileName]
|
| Incl [FileName]
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data FileName =
|
data FileName =
|
||||||
FString String
|
FString String
|
||||||
| FIdent PIdent
|
| FIdent PIdent
|
||||||
| FSlash FileName
|
| FSlash FileName
|
||||||
| FDot FileName
|
| FDot FileName
|
||||||
| FMinus FileName
|
| FMinus FileName
|
||||||
| FAddId PIdent FileName
|
| FAddId PIdent FileName
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
|
|||||||
+26
-26
@@ -1,26 +1,26 @@
|
|||||||
-- BNF Converter: Error Monad
|
-- BNF Converter: Error Monad
|
||||||
-- Copyright (C) 2004 Author: Aarne Ranta
|
-- Copyright (C) 2004 Author: Aarne Ranta
|
||||||
|
|
||||||
-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.
|
-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.
|
||||||
module GF.Source.ErrM where
|
module GF.Source.ErrM where
|
||||||
|
|
||||||
-- the Error monad: like Maybe type with error msgs
|
-- the Error monad: like Maybe type with error msgs
|
||||||
|
|
||||||
import Control.Monad (MonadPlus(..), liftM)
|
import Control.Monad (MonadPlus(..), liftM)
|
||||||
|
|
||||||
data Err a = Ok a | Bad String
|
data Err a = Ok a | Bad String
|
||||||
deriving (Read, Show, Eq, Ord)
|
deriving (Read, Show, Eq, Ord)
|
||||||
|
|
||||||
instance Monad Err where
|
instance Monad Err where
|
||||||
return = Ok
|
return = Ok
|
||||||
fail = Bad
|
fail = Bad
|
||||||
Ok a >>= f = f a
|
Ok a >>= f = f a
|
||||||
Bad s >>= f = Bad s
|
Bad s >>= f = Bad s
|
||||||
|
|
||||||
instance Functor Err where
|
instance Functor Err where
|
||||||
fmap = liftM
|
fmap = liftM
|
||||||
|
|
||||||
instance MonadPlus Err where
|
instance MonadPlus Err where
|
||||||
mzero = Bad "Err.mzero"
|
mzero = Bad "Err.mzero"
|
||||||
mplus (Bad _) y = y
|
mplus (Bad _) y = y
|
||||||
mplus x _ = x
|
mplus x _ = x
|
||||||
|
|||||||
+350
-350
File diff suppressed because one or more lines are too long
+144
-144
@@ -1,144 +1,144 @@
|
|||||||
-- -*- haskell -*-
|
-- -*- haskell -*-
|
||||||
-- This Alex file was machine-generated by the BNF converter
|
-- This Alex file was machine-generated by the BNF converter
|
||||||
{
|
{
|
||||||
{-# OPTIONS -fno-warn-incomplete-patterns #-}
|
{-# OPTIONS -fno-warn-incomplete-patterns #-}
|
||||||
module GF.Source.LexGF where
|
module GF.Source.LexGF where
|
||||||
|
|
||||||
import GF.Source.SharedString
|
import GF.Source.SharedString
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME
|
$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME
|
||||||
$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME
|
$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME
|
||||||
$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME
|
$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME
|
||||||
$d = [0-9] -- digit
|
$d = [0-9] -- digit
|
||||||
$i = [$l $d _ '] -- identifier character
|
$i = [$l $d _ '] -- identifier character
|
||||||
$u = [\0-\255] -- universal: any character
|
$u = [\0-\255] -- universal: any character
|
||||||
|
|
||||||
@rsyms = -- symbols and non-identifier-like reserved words
|
@rsyms = -- symbols and non-identifier-like reserved words
|
||||||
\; | \= | \{ | \} | \( | \) | \* \* | \: | \- \> | \, | \[ | \] | \- | \. | \| | \% | \? | \< | \> | \@ | \# | \! | \* | \+ | \+ \+ | \\ | \= \> | \_ | \$ | \/
|
\; | \= | \{ | \} | \( | \) | \* \* | \: | \- \> | \, | \[ | \] | \- | \. | \| | \% | \? | \< | \> | \@ | \# | \! | \* | \+ | \+ \+ | \\ | \= \> | \_ | \$ | \/
|
||||||
|
|
||||||
:-
|
:-
|
||||||
"--" [.]* ; -- Toss single line comments
|
"--" [.]* ; -- Toss single line comments
|
||||||
"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
|
"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
|
||||||
|
|
||||||
$white+ ;
|
$white+ ;
|
||||||
@rsyms { tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) }
|
@rsyms { tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) }
|
||||||
\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent (T_LString . 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)($l | $d | \_ | \')* { tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) }
|
||||||
|
|
||||||
$l $i* { tok (\p s -> PT p (eitherResIdent (TV . 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)) }
|
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
|
||||||
|
|
||||||
$d+ { tok (\p s -> PT p (TI $ share s)) }
|
$d+ { tok (\p s -> PT p (TI $ share s)) }
|
||||||
$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }
|
$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }
|
||||||
|
|
||||||
{
|
{
|
||||||
|
|
||||||
tok f p s = f p s
|
tok f p s = f p s
|
||||||
|
|
||||||
share :: BS.ByteString -> BS.ByteString
|
share :: BS.ByteString -> BS.ByteString
|
||||||
share = shareString
|
share = shareString
|
||||||
|
|
||||||
data Tok =
|
data Tok =
|
||||||
TS !BS.ByteString !Int -- reserved words and symbols
|
TS !BS.ByteString !Int -- reserved words and symbols
|
||||||
| TL !BS.ByteString -- string literals
|
| TL !BS.ByteString -- string literals
|
||||||
| TI !BS.ByteString -- integer literals
|
| TI !BS.ByteString -- integer literals
|
||||||
| TV !BS.ByteString -- identifiers
|
| TV !BS.ByteString -- identifiers
|
||||||
| TD !BS.ByteString -- double precision float literals
|
| TD !BS.ByteString -- double precision float literals
|
||||||
| TC !BS.ByteString -- character literals
|
| TC !BS.ByteString -- character literals
|
||||||
| T_LString !BS.ByteString
|
| T_LString !BS.ByteString
|
||||||
| T_PIdent !BS.ByteString
|
| T_PIdent !BS.ByteString
|
||||||
|
|
||||||
deriving (Eq,Show,Ord)
|
deriving (Eq,Show,Ord)
|
||||||
|
|
||||||
data Token =
|
data Token =
|
||||||
PT Posn Tok
|
PT Posn Tok
|
||||||
| Err Posn
|
| Err Posn
|
||||||
deriving (Eq,Show,Ord)
|
deriving (Eq,Show,Ord)
|
||||||
|
|
||||||
tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
|
tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
|
||||||
tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
|
tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
|
||||||
tokenPos _ = "end of file"
|
tokenPos _ = "end of file"
|
||||||
|
|
||||||
posLineCol (Pn _ l c) = (l,c)
|
posLineCol (Pn _ l c) = (l,c)
|
||||||
mkPosToken t@(PT p _) = (posLineCol p, prToken t)
|
mkPosToken t@(PT p _) = (posLineCol p, prToken t)
|
||||||
|
|
||||||
prToken t = case t of
|
prToken t = case t of
|
||||||
PT _ (TS s _) -> s
|
PT _ (TS s _) -> s
|
||||||
PT _ (TL s) -> s
|
PT _ (TL s) -> s
|
||||||
PT _ (TI s) -> s
|
PT _ (TI s) -> s
|
||||||
PT _ (TV s) -> s
|
PT _ (TV s) -> s
|
||||||
PT _ (TD s) -> s
|
PT _ (TD s) -> s
|
||||||
PT _ (TC s) -> s
|
PT _ (TC s) -> s
|
||||||
PT _ (T_LString s) -> s
|
PT _ (T_LString s) -> s
|
||||||
PT _ (T_PIdent s) -> s
|
PT _ (T_PIdent s) -> s
|
||||||
|
|
||||||
|
|
||||||
data BTree = N | B BS.ByteString Tok BTree BTree deriving (Show)
|
data BTree = N | B BS.ByteString Tok BTree BTree deriving (Show)
|
||||||
|
|
||||||
eitherResIdent :: (BS.ByteString -> Tok) -> BS.ByteString -> Tok
|
eitherResIdent :: (BS.ByteString -> Tok) -> BS.ByteString -> Tok
|
||||||
eitherResIdent tv s = treeFind resWords
|
eitherResIdent tv s = treeFind resWords
|
||||||
where
|
where
|
||||||
treeFind N = tv s
|
treeFind N = tv s
|
||||||
treeFind (B a t left right) | s < a = treeFind left
|
treeFind (B a t left right) | s < a = treeFind left
|
||||||
| s > a = treeFind right
|
| s > a = treeFind right
|
||||||
| s == a = t
|
| 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)))))
|
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
|
where b s n = let bs = BS.pack s
|
||||||
in B bs (TS bs n)
|
in B bs (TS bs n)
|
||||||
|
|
||||||
unescapeInitTail :: BS.ByteString -> BS.ByteString
|
unescapeInitTail :: BS.ByteString -> BS.ByteString
|
||||||
unescapeInitTail = BS.pack . unesc . tail . BS.unpack where
|
unescapeInitTail = BS.pack . unesc . tail . BS.unpack where
|
||||||
unesc s = case s of
|
unesc s = case s of
|
||||||
'\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
|
'\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
|
||||||
'\\':'n':cs -> '\n' : unesc cs
|
'\\':'n':cs -> '\n' : unesc cs
|
||||||
'\\':'t':cs -> '\t' : unesc cs
|
'\\':'t':cs -> '\t' : unesc cs
|
||||||
'"':[] -> []
|
'"':[] -> []
|
||||||
c:cs -> c : unesc cs
|
c:cs -> c : unesc cs
|
||||||
_ -> []
|
_ -> []
|
||||||
|
|
||||||
-------------------------------------------------------------------
|
-------------------------------------------------------------------
|
||||||
-- Alex wrapper code.
|
-- Alex wrapper code.
|
||||||
-- A modified "posn" wrapper.
|
-- A modified "posn" wrapper.
|
||||||
-------------------------------------------------------------------
|
-------------------------------------------------------------------
|
||||||
|
|
||||||
data Posn = Pn !Int !Int !Int
|
data Posn = Pn !Int !Int !Int
|
||||||
deriving (Eq, Show,Ord)
|
deriving (Eq, Show,Ord)
|
||||||
|
|
||||||
alexStartPos :: Posn
|
alexStartPos :: Posn
|
||||||
alexStartPos = Pn 0 1 1
|
alexStartPos = Pn 0 1 1
|
||||||
|
|
||||||
alexMove :: Posn -> Char -> Posn
|
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) '\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) '\n' = Pn (a+1) (l+1) 1
|
||||||
alexMove (Pn a l c) _ = Pn (a+1) l (c+1)
|
alexMove (Pn a l c) _ = Pn (a+1) l (c+1)
|
||||||
|
|
||||||
type AlexInput = (Posn, -- current position,
|
type AlexInput = (Posn, -- current position,
|
||||||
Char, -- previous char
|
Char, -- previous char
|
||||||
BS.ByteString) -- current input string
|
BS.ByteString) -- current input string
|
||||||
|
|
||||||
tokens :: BS.ByteString -> [Token]
|
tokens :: BS.ByteString -> [Token]
|
||||||
tokens str = go (alexStartPos, '\n', str)
|
tokens str = go (alexStartPos, '\n', str)
|
||||||
where
|
where
|
||||||
go :: AlexInput -> [Token]
|
go :: AlexInput -> [Token]
|
||||||
go inp@(pos, _, str) =
|
go inp@(pos, _, str) =
|
||||||
case alexScan inp 0 of
|
case alexScan inp 0 of
|
||||||
AlexEOF -> []
|
AlexEOF -> []
|
||||||
AlexError (pos, _, _) -> [Err pos]
|
AlexError (pos, _, _) -> [Err pos]
|
||||||
AlexSkip inp' len -> go inp'
|
AlexSkip inp' len -> go inp'
|
||||||
AlexToken inp' len act -> act pos (BS.take len str) : (go inp')
|
AlexToken inp' len act -> act pos (BS.take len str) : (go inp')
|
||||||
|
|
||||||
alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
|
alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
|
||||||
alexGetChar (p, _, s) =
|
alexGetChar (p, _, s) =
|
||||||
case BS.uncons s of
|
case BS.uncons s of
|
||||||
Nothing -> Nothing
|
Nothing -> Nothing
|
||||||
Just (c,s) ->
|
Just (c,s) ->
|
||||||
let p' = alexMove p c
|
let p' = alexMove p c
|
||||||
in p' `seq` Just (c, (p', c, s))
|
in p' `seq` Just (c, (p', c, s))
|
||||||
|
|
||||||
alexInputPrevChar :: AlexInput -> Char
|
alexInputPrevChar :: AlexInput -> Char
|
||||||
alexInputPrevChar (p, c, s) = c
|
alexInputPrevChar (p, c, s) = c
|
||||||
}
|
}
|
||||||
|
|||||||
+7843
-7843
File diff suppressed because it is too large
Load Diff
+642
-642
File diff suppressed because it is too large
Load Diff
+534
-534
File diff suppressed because it is too large
Load Diff
@@ -1,20 +1,20 @@
|
|||||||
module GF.Source.SharedString (shareString) where
|
module GF.Source.SharedString (shareString) where
|
||||||
|
|
||||||
import Data.Map as M
|
import Data.Map as M
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
|
|
||||||
{-# NOINLINE stringPoolRef #-}
|
{-# NOINLINE stringPoolRef #-}
|
||||||
stringPoolRef :: IORef (M.Map BS.ByteString BS.ByteString)
|
stringPoolRef :: IORef (M.Map BS.ByteString BS.ByteString)
|
||||||
stringPoolRef = unsafePerformIO $ newIORef M.empty
|
stringPoolRef = unsafePerformIO $ newIORef M.empty
|
||||||
|
|
||||||
{-# NOINLINE shareString #-}
|
{-# NOINLINE shareString #-}
|
||||||
shareString :: BS.ByteString -> BS.ByteString
|
shareString :: BS.ByteString -> BS.ByteString
|
||||||
shareString s = unsafePerformIO $ do
|
shareString s = unsafePerformIO $ do
|
||||||
stringPool <- readIORef stringPoolRef
|
stringPool <- readIORef stringPoolRef
|
||||||
case M.lookup s stringPool of
|
case M.lookup s stringPool of
|
||||||
Just s' -> return s'
|
Just s' -> return s'
|
||||||
Nothing -> do let s' = BS.copy s
|
Nothing -> do let s' = BS.copy s
|
||||||
writeIORef stringPoolRef $! M.insert s' s' stringPool
|
writeIORef stringPoolRef $! M.insert s' s' stringPool
|
||||||
return s'
|
return s'
|
||||||
|
|||||||
Reference in New Issue
Block a user