forked from GitHub/gf-core
gfcm header
This commit is contained in:
aarne
@@ -3,9 +3,10 @@ abstract Arithm = Logic ** {
|
||||
-- arithmetic
|
||||
fun
|
||||
Nat, Real : Dom ;
|
||||
data
|
||||
zero : Elem Nat ;
|
||||
succ : Elem Nat -> Elem Nat ;
|
||||
|
||||
fun
|
||||
trunc : Elem Real -> Elem Nat ;
|
||||
|
||||
EqNat : (m,n : Elem Nat) -> Prop ;
|
||||
@@ -19,13 +20,13 @@ fun
|
||||
two : Elem Nat ;
|
||||
sum : (m,n : Elem Nat) -> Elem Nat ;
|
||||
prod : (m,n : Elem Nat) -> Elem Nat ;
|
||||
|
||||
data
|
||||
evax1 : Proof (Even zero) ;
|
||||
evax2 : (n : Elem Nat) -> Proof (Even n) -> Proof (Odd (succ n)) ;
|
||||
evax3 : (n : Elem Nat) -> Proof (Odd n) -> Proof (Even (succ n)) ;
|
||||
eqax1 : Proof (EqNat zero zero) ;
|
||||
eqax2 : (m,n : Elem Nat) -> Proof (EqNat m n) -> Proof (EqNat (succ m) (succ n)) ;
|
||||
|
||||
fun
|
||||
IndNat : (C : Elem Nat -> Prop) ->
|
||||
Proof (C zero) ->
|
||||
((x : Elem Nat) -> Proof (C x) -> Proof (C (succ x))) ->
|
||||
@@ -45,7 +46,6 @@ def
|
||||
(Univ Nat (\x -> Impl (Conj (LtNat one x) (Div n x)) (EqNat x n))) ;
|
||||
|
||||
Abs = Abs ;
|
||||
--- data Elem = zero | succ ;
|
||||
|
||||
fun ex1 : Text ;
|
||||
def ex1 =
|
||||
|
||||
@@ -32,25 +32,36 @@ fun
|
||||
ImplP : (A : Prop) -> (Proof A -> Prop) -> Prop ;
|
||||
|
||||
-- inference rules
|
||||
data
|
||||
ConjI : (A,B : Prop) -> Proof A -> Proof B -> Proof (Conj A B) ;
|
||||
fun
|
||||
ConjEl : (A,B : Prop) -> Proof (Conj A B) -> Proof A ;
|
||||
ConjEr : (A,B : Prop) -> Proof (Conj A B) -> Proof B ;
|
||||
data
|
||||
DisjIl : (A,B : Prop) -> Proof A -> Proof (Disj A B) ;
|
||||
DisjIr : (A,B : Prop) -> Proof B -> Proof (Disj A B) ;
|
||||
fun
|
||||
DisjE : (A,B,C : Prop) -> Proof (Disj A B) ->
|
||||
(Proof A -> Proof C) -> (Proof B -> Proof C) -> Proof C ;
|
||||
data
|
||||
ImplI : (A,B : Prop) -> (Proof A -> Proof B) -> Proof (Impl A B) ;
|
||||
fun
|
||||
ImplE : (A,B : Prop) -> Proof (Impl A B) -> Proof A -> Proof B ;
|
||||
data
|
||||
NegI : (A : Prop) -> (Proof A -> Proof Abs) -> Proof (Neg A) ;
|
||||
fun
|
||||
NegE : (A : Prop) -> Proof (Neg A) -> Proof A -> Proof Abs ;
|
||||
AbsE : (C : Prop) -> Proof Abs -> Proof C ;
|
||||
|
||||
data
|
||||
UnivI : (A : Dom) -> (B : Elem A -> Prop) ->
|
||||
((x : Elem A) -> Proof (B x)) -> Proof (Univ A B) ;
|
||||
fun
|
||||
UnivE : (A : Dom) -> (B : Elem A -> Prop) ->
|
||||
Proof (Univ A B) -> (a : Elem A) -> Proof (B a) ;
|
||||
data
|
||||
ExistI : (A : Dom) -> (B : Elem A -> Prop) ->
|
||||
(a : Elem A) -> Proof (B a) -> Proof (Exist A B) ;
|
||||
fun
|
||||
ExistE : (A : Dom) -> (B : Elem A -> Prop) -> (C : Prop) ->
|
||||
Proof (Exist A B) -> ((x : Elem A) -> Proof (B x) -> Proof C) ->
|
||||
Proof C ;
|
||||
@@ -61,9 +72,6 @@ fun
|
||||
-- pronoun
|
||||
Pron : (A : Dom) -> Elem A -> Elem A ;
|
||||
|
||||
data
|
||||
Proof = ConjI | DisjIl | DisjIr ;
|
||||
|
||||
def
|
||||
-- proof normalization
|
||||
ConjEl _ _ (ConjI _ _ a _) = a ;
|
||||
|
||||
@@ -26,6 +26,8 @@ resource ParadigmsEng = open (Predef=Predef), Prelude, SyntaxEng, ResourceEng in
|
||||
-- To abstract over gender names, we define the following identifiers.
|
||||
|
||||
oper
|
||||
Gender : Type = SyntaxEng.Gender ;
|
||||
|
||||
human : Gender ;
|
||||
nonhuman : Gender ;
|
||||
|
||||
|
||||
@@ -7,7 +7,8 @@ import Ident --H
|
||||
-- newtype Ident = Ident String deriving (Eq,Ord,Show) --H
|
||||
|
||||
data Canon =
|
||||
Gr [Module]
|
||||
MGr [Ident] Ident [Module]
|
||||
| Gr [Module]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Module =
|
||||
@@ -27,8 +28,8 @@ data Extend =
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Open =
|
||||
NoOpens
|
||||
| Opens [Ident]
|
||||
Opens [Ident]
|
||||
| NoOpens
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Flag =
|
||||
|
||||
@@ -4,7 +4,8 @@
|
||||
|
||||
entrypoints Canon ;
|
||||
|
||||
Gr. Canon ::= [Module] ;
|
||||
MGr. Canon ::= "grammar" [Ident] "of" Ident ";" [Module] ;
|
||||
Gr. Canon ::= [Module] ;
|
||||
|
||||
Mod. Module ::= ModType "=" Extend Open "{" [Flag] [Def] "}" ;
|
||||
|
||||
|
||||
@@ -1,17 +1,33 @@
|
||||
|
||||
{-# OPTIONS -cpp #-}
|
||||
{-# LINE 3 "LexGFC.x" #-}
|
||||
module LexGFC where
|
||||
|
||||
import Alex
|
||||
import ErrM
|
||||
|
||||
pTSpec p = PT p . TS
|
||||
#if __GLASGOW_HASKELL__ >= 503
|
||||
import Data.Array
|
||||
import Data.Char (ord)
|
||||
import Data.Array.Base (unsafeAt)
|
||||
#else
|
||||
import Array
|
||||
import Char (ord)
|
||||
#endif
|
||||
alex_base :: Array Int Int
|
||||
alex_base = listArray (0,14) [1,57,66,0,9,29,11,32,154,362,0,277,485,211,51]
|
||||
|
||||
ident p = PT p . eitherResIdent TV
|
||||
alex_table :: Array Int Int
|
||||
alex_table = listArray (0,740) [0,-1,-1,-1,-1,-1,-1,-1,-1,-1,2,2,2,2,2,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,2,3,11,-1,3,-1,-1,-1,3,3,7,5,3,6,3,3,14,14,14,14,14,14,14,14,14,14,3,3,3,4,3,3,3,2,2,2,2,2,3,3,3,3,2,2,2,2,2,0,0,0,0,0,0,0,0,0,2,0,0,3,3,3,-1,3,-1,2,14,14,14,14,14,14,14,14,14,14,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3,3,3,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,9,0,0,0,0,0,0,0,0,9,9,9,9,9,9,9,9,9,9,0,0,0,0,-1,0,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,12,0,0,-1,9,12,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,12,0,0,0,0,0,0,0,10,0,0,0,0,0,0,0,0,0,12,0,0,0,0,0,12,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,13,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,9,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,10,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,13,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
|
||||
|
||||
string p = PT p . TL . unescapeInitTail
|
||||
alex_check :: Array Int Int
|
||||
alex_check = listArray (0,740) [-1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,9,10,11,12,13,62,43,62,42,9,10,11,12,13,-1,-1,-1,-1,-1,-1,-1,-1,-1,32,-1,-1,91,92,93,94,95,96,32,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,39,-1,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,215,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,34,-1,-1,247,95,39,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,10,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,92,-1,-1,-1,-1,-1,-1,-1,34,-1,-1,-1,-1,-1,-1,-1,-1,-1,110,-1,-1,-1,-1,-1,116,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,92,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,39,248,249,250,251,252,253,254,255,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,10,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,34,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,92,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,-1,248,249,250,251,252,253,254,255,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1]
|
||||
|
||||
int p = PT p . TI
|
||||
alex_deflt :: Array Int Int
|
||||
alex_deflt = listArray (0,14) [8,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,12,12,-1,-1]
|
||||
|
||||
alex_accept = listArray (0::Int,14) [[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_1))],[],[],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_3))],[],[],[],[(AlexAcc (alex_action_4))]]
|
||||
{-# LINE 31 "LexGFC.x" #-}
|
||||
|
||||
tok f p s = f p s
|
||||
|
||||
data Tok =
|
||||
TS String -- reserved words
|
||||
@@ -32,27 +48,21 @@ 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
|
||||
_ -> show t
|
||||
|
||||
tokens:: String -> [Token]
|
||||
tokens inp = scan tokens_scan inp
|
||||
|
||||
tokens_scan:: Scan Token
|
||||
tokens_scan = load_scan (tokens_acts,stop_act) tokens_lx
|
||||
where
|
||||
stop_act p "" = []
|
||||
stop_act p inp = [Err p]
|
||||
|
||||
eitherResIdent :: (String -> Tok) -> String -> Tok
|
||||
eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
|
||||
isResWord s = isInTree s $
|
||||
B "lincat" (B "data" (B "abstract" (B "Type" (B "Str" N N) N) (B "concrete" (B "cat" N N) N)) (B "in" (B "fun" (B "flags" N N) N) (B "lin" N N))) (B "pre" (B "oper" (B "open" (B "of" N N) N) (B "param" N N)) (B "transfer" (B "table" (B "resource" N N) N) (B "variants" N N)))
|
||||
B "lin" (B "data" (B "abstract" (B "Type" (B "Str" N N) N) (B "concrete" (B "cat" N N) N)) (B "grammar" (B "fun" (B "flags" N N) N) (B "in" N N))) (B "pre" (B "open" (B "of" (B "lincat" N N) N) (B "param" (B "oper" N N) N)) (B "transfer" (B "table" (B "resource" N N) N) (B "variants" N N)))
|
||||
|
||||
data BTree = N | B String BTree BTree deriving (Show)
|
||||
|
||||
@@ -74,32 +84,207 @@ unescapeInitTail = unesc . tail where
|
||||
c:cs -> c : unesc cs
|
||||
_ -> []
|
||||
|
||||
tokens_acts = [("ident",ident),("int",int),("pTSpec",pTSpec),("string",string)]
|
||||
-------------------------------------------------------------------
|
||||
-- Alex wrapper code.
|
||||
-- A modified "posn" wrapper.
|
||||
-------------------------------------------------------------------
|
||||
|
||||
tokens_lx :: [(Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))]
|
||||
tokens_lx = [lx__0_0,lx__1_0,lx__2_0,lx__3_0,lx__4_0,lx__5_0,lx__6_0,lx__7_0,lx__8_0,lx__9_0,lx__10_0,lx__11_0]
|
||||
lx__0_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__0_0 = (False,[],-1,(('\t','\255'),[('\t',1),('\n',1),('\v',1),('\f',1),('\r',1),(' ',1),('!',6),('"',8),('$',6),('(',6),(')',6),('*',3),('+',5),(',',6),('-',2),('.',6),('/',6),('0',11),('1',11),('2',11),('3',11),('4',11),('5',11),('6',11),('7',11),('8',11),('9',11),(':',6),(';',6),('<',6),('=',4),('>',6),('?',6),('@',6),('A',7),('B',7),('C',7),('D',7),('E',7),('F',7),('G',7),('H',7),('I',7),('J',7),('K',7),('L',7),('M',7),('N',7),('O',7),('P',7),('Q',7),('R',7),('S',7),('T',7),('U',7),('V',7),('W',7),('X',7),('Y',7),('Z',7),('[',6),('\\',6),(']',6),('_',6),('a',7),('b',7),('c',7),('d',7),('e',7),('f',7),('g',7),('h',7),('i',7),('j',7),('k',7),('l',7),('m',7),('n',7),('o',7),('p',7),('q',7),('r',7),('s',7),('t',7),('u',7),('v',7),('w',7),('x',7),('y',7),('z',7),('{',6),('|',6),('}',6),('\192',7),('\193',7),('\194',7),('\195',7),('\196',7),('\197',7),('\198',7),('\199',7),('\200',7),('\201',7),('\202',7),('\203',7),('\204',7),('\205',7),('\206',7),('\207',7),('\208',7),('\209',7),('\210',7),('\211',7),('\212',7),('\213',7),('\214',7),('\216',7),('\217',7),('\218',7),('\219',7),('\220',7),('\221',7),('\222',7),('\223',7),('\224',7),('\225',7),('\226',7),('\227',7),('\228',7),('\229',7),('\230',7),('\231',7),('\232',7),('\233',7),('\234',7),('\235',7),('\236',7),('\237',7),('\238',7),('\239',7),('\240',7),('\241',7),('\242',7),('\243',7),('\244',7),('\245',7),('\246',7),('\248',7),('\249',7),('\250',7),('\251',7),('\252',7),('\253',7),('\254',7),('\255',7)]))
|
||||
lx__1_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__1_0 = (True,[(0,"",[],Nothing,Nothing)],-1,(('\t',' '),[('\t',1),('\n',1),('\v',1),('\f',1),('\r',1),(' ',1)]))
|
||||
lx__2_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__2_0 = (False,[],-1,(('>','>'),[('>',6)]))
|
||||
lx__3_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__3_0 = (False,[],-1,(('*','*'),[('*',6)]))
|
||||
lx__4_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__4_0 = (True,[(1,"pTSpec",[],Nothing,Nothing)],-1,(('>','>'),[('>',6)]))
|
||||
lx__5_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__5_0 = (True,[(1,"pTSpec",[],Nothing,Nothing)],-1,(('+','+'),[('+',6)]))
|
||||
lx__6_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__6_0 = (True,[(1,"pTSpec",[],Nothing,Nothing)],-1,(('0','0'),[]))
|
||||
lx__7_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__7_0 = (True,[(2,"ident",[],Nothing,Nothing)],-1,(('\'','\255'),[('\'',7),('0',7),('1',7),('2',7),('3',7),('4',7),('5',7),('6',7),('7',7),('8',7),('9',7),('A',7),('B',7),('C',7),('D',7),('E',7),('F',7),('G',7),('H',7),('I',7),('J',7),('K',7),('L',7),('M',7),('N',7),('O',7),('P',7),('Q',7),('R',7),('S',7),('T',7),('U',7),('V',7),('W',7),('X',7),('Y',7),('Z',7),('_',7),('a',7),('b',7),('c',7),('d',7),('e',7),('f',7),('g',7),('h',7),('i',7),('j',7),('k',7),('l',7),('m',7),('n',7),('o',7),('p',7),('q',7),('r',7),('s',7),('t',7),('u',7),('v',7),('w',7),('x',7),('y',7),('z',7),('\192',7),('\193',7),('\194',7),('\195',7),('\196',7),('\197',7),('\198',7),('\199',7),('\200',7),('\201',7),('\202',7),('\203',7),('\204',7),('\205',7),('\206',7),('\207',7),('\208',7),('\209',7),('\210',7),('\211',7),('\212',7),('\213',7),('\214',7),('\216',7),('\217',7),('\218',7),('\219',7),('\220',7),('\221',7),('\222',7),('\223',7),('\224',7),('\225',7),('\226',7),('\227',7),('\228',7),('\229',7),('\230',7),('\231',7),('\232',7),('\233',7),('\234',7),('\235',7),('\236',7),('\237',7),('\238',7),('\239',7),('\240',7),('\241',7),('\242',7),('\243',7),('\244',7),('\245',7),('\246',7),('\248',7),('\249',7),('\250',7),('\251',7),('\252',7),('\253',7),('\254',7),('\255',7)]))
|
||||
lx__8_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__8_0 = (False,[],8,(('\n','\\'),[('\n',-1),('"',10),('\\',9)]))
|
||||
lx__9_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__9_0 = (False,[],-1,(('"','t'),[('"',8),('\'',8),('\\',8),('n',8),('t',8)]))
|
||||
lx__10_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__10_0 = (True,[(3,"string",[],Nothing,Nothing)],-1,(('0','0'),[]))
|
||||
lx__11_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__11_0 = (True,[(4,"int",[],Nothing,Nothing)],-1,(('0','9'),[('0',11),('1',11),('2',11),('3',11),('4',11),('5',11),('6',11),('7',11),('8',11),('9',11)]))
|
||||
data Posn = Pn !Int !Int !Int
|
||||
deriving (Eq, Show)
|
||||
|
||||
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
|
||||
|
||||
alex_action_1 = tok (\p s -> PT p (TS s))
|
||||
alex_action_2 = tok (\p s -> PT p (eitherResIdent TV s))
|
||||
alex_action_3 = tok (\p s -> PT p (TL $ unescapeInitTail s))
|
||||
alex_action_4 = tok (\p s -> PT p (TI s))
|
||||
{-# LINE 1 "GenericTemplate.hs" #-}
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- ALEX TEMPLATE
|
||||
--
|
||||
-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
|
||||
-- it for any purpose whatsoever.
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- INTERNALS and main scanner engine
|
||||
|
||||
{-# LINE 22 "GenericTemplate.hs" #-}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
{-# LINE 66 "GenericTemplate.hs" #-}
|
||||
|
||||
alexIndexShortOffAddr arr off = arr ! off
|
||||
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- Main lexing routines
|
||||
|
||||
data AlexReturn a
|
||||
= AlexEOF
|
||||
| AlexError !AlexInput
|
||||
| AlexSkip !AlexInput !Int
|
||||
| AlexToken !AlexInput !Int a
|
||||
|
||||
-- alexScan :: AlexInput -> StartCode -> Maybe (AlexInput,Int,act)
|
||||
alexScan input (sc)
|
||||
= alexScanUser undefined input (sc)
|
||||
|
||||
alexScanUser user input (sc)
|
||||
= case alex_scan_tkn user input (0) input sc AlexNone of
|
||||
(AlexNone, input') ->
|
||||
case alexGetChar input of
|
||||
Nothing ->
|
||||
|
||||
|
||||
|
||||
AlexEOF
|
||||
Just _ ->
|
||||
|
||||
|
||||
|
||||
AlexError input
|
||||
|
||||
(AlexLastSkip input len, _) ->
|
||||
|
||||
|
||||
|
||||
AlexSkip input len
|
||||
|
||||
(AlexLastAcc k input len, _) ->
|
||||
|
||||
|
||||
|
||||
AlexToken input len k
|
||||
|
||||
|
||||
-- Push the input through the DFA, remembering the most recent accepting
|
||||
-- state it encountered.
|
||||
|
||||
alex_scan_tkn user orig_input len input s last_acc =
|
||||
input `seq` -- strict in the input
|
||||
case s of
|
||||
(-1) -> (last_acc, input)
|
||||
_ -> alex_scan_tkn' user orig_input len input s last_acc
|
||||
|
||||
alex_scan_tkn' user orig_input len input s last_acc =
|
||||
let
|
||||
new_acc = check_accs (alex_accept `unsafeAt` (s))
|
||||
in
|
||||
new_acc `seq`
|
||||
case alexGetChar input of
|
||||
Nothing -> (new_acc, input)
|
||||
Just (c, new_input) ->
|
||||
|
||||
|
||||
|
||||
let
|
||||
base = alexIndexShortOffAddr alex_base s
|
||||
(ord_c) = ord c
|
||||
offset = (base + ord_c)
|
||||
check = alexIndexShortOffAddr alex_check offset
|
||||
|
||||
new_s = if (offset >= (0)) && (check == ord_c)
|
||||
then alexIndexShortOffAddr alex_table offset
|
||||
else alexIndexShortOffAddr alex_deflt s
|
||||
in
|
||||
alex_scan_tkn user orig_input (len + (1)) new_input new_s new_acc
|
||||
|
||||
where
|
||||
check_accs [] = last_acc
|
||||
check_accs (AlexAcc a : _) = AlexLastAcc a input (len)
|
||||
check_accs (AlexAccSkip : _) = AlexLastSkip input (len)
|
||||
check_accs (AlexAccPred a pred : rest)
|
||||
| pred user orig_input (len) input
|
||||
= AlexLastAcc a input (len)
|
||||
check_accs (AlexAccSkipPred pred : rest)
|
||||
| pred user orig_input (len) input
|
||||
= AlexLastSkip input (len)
|
||||
check_accs (_ : rest) = check_accs rest
|
||||
|
||||
data AlexLastAcc a
|
||||
= AlexNone
|
||||
| AlexLastAcc a !AlexInput !Int
|
||||
| AlexLastSkip !AlexInput !Int
|
||||
|
||||
data AlexAcc a user
|
||||
= AlexAcc a
|
||||
| AlexAccSkip
|
||||
| AlexAccPred a (AlexAccPred user)
|
||||
| AlexAccSkipPred (AlexAccPred user)
|
||||
|
||||
type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- Predicates on a rule
|
||||
|
||||
alexAndPred p1 p2 user in1 len in2
|
||||
= p1 user in1 len in2 && p2 user in1 len in2
|
||||
|
||||
--alexPrevCharIsPred :: Char -> AlexAccPred _
|
||||
alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input
|
||||
|
||||
--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _
|
||||
alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input
|
||||
|
||||
--alexRightContext :: Int -> AlexAccPred _
|
||||
alexRightContext (sc) user _ _ input =
|
||||
case alex_scan_tkn user input (0) input sc AlexNone of
|
||||
(AlexNone, _) -> False
|
||||
_ -> True
|
||||
-- TODO: there's no need to find the longest
|
||||
-- match when checking the right context, just
|
||||
-- the first match will do.
|
||||
|
||||
-- used by wrappers
|
||||
iUnbox (i) = i
|
||||
|
||||
@@ -15,7 +15,14 @@ prCanonModInfo = prt . info2mod
|
||||
prCanon :: CanonGrammar -> String
|
||||
prCanon = unlines . map prCanonModInfo . M.modules
|
||||
|
||||
prCanonMGr :: CanonGrammar -> String
|
||||
prCanonMGr g = header ++++ prCanon g where
|
||||
header = case M.greatestAbstract g of
|
||||
Just a -> prt (MGr (M.allConcretes g a) a [])
|
||||
_ -> []
|
||||
|
||||
canon2grammar :: Canon -> CanonGrammar
|
||||
canon2grammar (MGr _ _ modules) = canon2grammar (Gr modules) ---- ignoring the header
|
||||
canon2grammar (Gr modules) = M.MGrammar $ map mod2info modules where
|
||||
mod2info m = case m of
|
||||
Mod mt e os flags defs ->
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -95,6 +95,7 @@ instance Print Ident where
|
||||
|
||||
instance Print Canon where
|
||||
prt i e = case e of
|
||||
MGr ids id modules -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 ids , doc (showString "of") , prt 0 id , doc (showString ";") , prt 0 modules])
|
||||
Gr modules -> prPrec i 0 (concatD [prt 0 modules])
|
||||
|
||||
|
||||
|
||||
@@ -16,6 +16,7 @@ transIdent x = case x of
|
||||
|
||||
transCanon :: Canon -> Result
|
||||
transCanon x = case x of
|
||||
MGr ids id modules -> failure x
|
||||
Gr modules -> failure x
|
||||
|
||||
|
||||
@@ -40,8 +41,8 @@ transExtend x = case x of
|
||||
|
||||
transOpen :: Open -> Result
|
||||
transOpen x = case x of
|
||||
NoOpens -> failure x
|
||||
Opens ids -> failure x
|
||||
NoOpens -> failure x
|
||||
|
||||
|
||||
transFlag :: Flag -> Result
|
||||
|
||||
@@ -1,5 +1,9 @@
|
||||
-- automatically generated by BNF Converter
|
||||
module TestGFC where
|
||||
module Main where
|
||||
|
||||
|
||||
import IO ( stdin, hGetContents )
|
||||
import System ( getArgs, getProgName )
|
||||
|
||||
import LexGFC
|
||||
import ParGFC
|
||||
@@ -7,19 +11,29 @@ import SkelGFC
|
||||
import PrintGFC
|
||||
import AbsGFC
|
||||
|
||||
|
||||
import ErrM
|
||||
|
||||
type ParseFun a = [Token] -> Err a
|
||||
|
||||
myLLexer = myLexer
|
||||
|
||||
runFile :: (Print a, Show a) => ParseFun a -> FilePath -> IO()
|
||||
runFile :: (Print a, Show a) => ParseFun a -> FilePath -> IO ()
|
||||
runFile p f = readFile f >>= run p
|
||||
|
||||
run :: (Print a, Show a) => ParseFun a -> String -> IO()
|
||||
run :: (Print a, Show a) => ParseFun a -> String -> IO ()
|
||||
run p s = case (p (myLLexer s)) of
|
||||
Bad s -> do putStrLn "\nParse Failed...\n"
|
||||
putStrLn s
|
||||
Ok tree -> do putStrLn "\nParse Successful!"
|
||||
putStrLn $ "\n[Abstract Syntax]\n\n" ++ show tree
|
||||
putStrLn $ "\n[Linearized tree]\n\n" ++ printTree tree
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do args <- getArgs
|
||||
case args of
|
||||
[] -> hGetContents stdin >>= run pCanon
|
||||
[f] -> runFile pCanon f
|
||||
_ -> do progName <- getProgName
|
||||
putStrLn $ progName ++ ": excess arguments."
|
||||
|
||||
@@ -80,8 +80,8 @@ redInfo am (c,info) = errIn ("translating definition of" +++ prt c) $ do
|
||||
returns c' $ C.AbsCat cont fs
|
||||
AbsFun (Yes typ) pdf -> do
|
||||
let df = case pdf of
|
||||
Yes t -> t
|
||||
_ -> EData --- data vs. primitive
|
||||
Yes t -> t -- definition or "data"
|
||||
_ -> Eqs [] -- primitive notion
|
||||
returns c' $ C.AbsFun typ df
|
||||
AbsTrans t ->
|
||||
returns c' $ C.AbsTrans t
|
||||
|
||||
@@ -119,7 +119,7 @@ updateShellState :: Options -> ShellState ->
|
||||
Err ShellState
|
||||
updateShellState opts sh ((_,sgr,gr),rts) = do
|
||||
let cgr0 = M.updateMGrammar (canModules sh) gr
|
||||
a' = ifNull Nothing (return . head) $ allAbstracts cgr0
|
||||
a' = M.greatestAbstract cgr0
|
||||
abstr0 <- case abstract sh of
|
||||
Just a -> do
|
||||
-- test that abstract is compatible --- unsafe exception for old?
|
||||
@@ -128,7 +128,7 @@ updateShellState opts sh ((_,sgr,gr),rts) = do
|
||||
return $ Just a
|
||||
_ -> return a'
|
||||
let cgr = filterAbstracts abstr0 cgr0
|
||||
let concrs = maybe [] (allConcretes cgr) abstr0
|
||||
let concrs = maybe [] (M.allConcretes cgr) abstr0
|
||||
concr0 = ifNull Nothing (return . head) concrs
|
||||
notInrts f = notElem f $ map fst rts
|
||||
cfs <- mapM (canon2cf opts cgr) concrs --- would not need to update all...
|
||||
@@ -217,37 +217,12 @@ grammar2stateGrammar opts gr = do
|
||||
concr <- maybeErr "no concrete syntax" $ concrete st
|
||||
return $ stateGrammarOfLang st concr
|
||||
|
||||
-- all abstract modules
|
||||
allAbstracts :: CanonGrammar -> [Ident]
|
||||
allAbstracts gr = [i | (i,M.ModMod m) <- M.modules gr, M.mtype m == M.MTAbstract]
|
||||
|
||||
-- the last abstract in dependency order (head of list)
|
||||
greatestAbstract :: CanonGrammar -> Maybe Ident
|
||||
greatestAbstract gr = case allAbstracts gr of
|
||||
[] -> Nothing
|
||||
a -> return $ head a
|
||||
|
||||
-- all resource modules
|
||||
allResources :: G.SourceGrammar -> [Ident]
|
||||
allResources gr = [i | (i,M.ModMod m) <- M.modules gr, M.isModRes m]
|
||||
|
||||
|
||||
-- the greatest resource in dependency order
|
||||
greatestResource :: G.SourceGrammar -> Maybe Ident
|
||||
greatestResource gr = case allResources gr of
|
||||
[] -> Nothing
|
||||
a -> return $ head a
|
||||
|
||||
resourceOfShellState :: ShellState -> Maybe Ident
|
||||
resourceOfShellState = greatestResource . srcModules
|
||||
resourceOfShellState = M.greatestResource . srcModules
|
||||
|
||||
qualifTop :: StateGrammar -> G.QIdent -> G.QIdent
|
||||
qualifTop gr (_,c) = (absId gr,c)
|
||||
|
||||
-- all concretes for a given abstract
|
||||
allConcretes :: CanonGrammar -> Ident -> [Ident]
|
||||
allConcretes gr a = [i | (i,M.ModMod m) <- M.modules gr, M.mtype m== M.MTConcrete a]
|
||||
|
||||
stateGrammarOfLang :: ShellState -> Language -> StateGrammar
|
||||
stateGrammarOfLang st l = StGr {
|
||||
absId = maybe (identC "Abs") id (abstract st), ---
|
||||
|
||||
@@ -71,6 +71,7 @@ instance Print A.Case where prt = C.printTree
|
||||
instance Print A.CType where prt = C.printTree
|
||||
instance Print A.Label where prt = C.printTree
|
||||
instance Print A.Module where prt = C.printTree
|
||||
instance Print A.Canon where prt = C.printTree
|
||||
instance Print A.Sort where prt = C.printTree
|
||||
|
||||
instance Print A.Atom where
|
||||
|
||||
@@ -296,3 +296,28 @@ isCompilableModule m = case m of
|
||||
-- interface and "incomplete M" are not complete
|
||||
isCompleteModule :: (Eq i) => Module i f a -> Bool
|
||||
isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
|
||||
|
||||
|
||||
-- all abstract modules
|
||||
allAbstracts :: Eq i => MGrammar i f a -> [i]
|
||||
allAbstracts gr = [i | (i,ModMod m) <- modules gr, mtype m == MTAbstract]
|
||||
|
||||
-- the last abstract in dependency order (head of list)
|
||||
greatestAbstract :: Eq i => MGrammar i f a -> Maybe i
|
||||
greatestAbstract gr = case allAbstracts gr of
|
||||
[] -> Nothing
|
||||
a:_ -> return a
|
||||
|
||||
-- all resource modules
|
||||
allResources :: MGrammar i f a -> [i]
|
||||
allResources gr = [i | (i,ModMod m) <- modules gr, isModRes m]
|
||||
|
||||
-- the greatest resource in dependency order
|
||||
greatestResource :: MGrammar i f a -> Maybe i
|
||||
greatestResource gr = case allResources gr of
|
||||
[] -> Nothing
|
||||
a -> return $ head a
|
||||
|
||||
-- all concretes for a given abstract
|
||||
allConcretes :: Eq i => MGrammar i f a -> i -> [i]
|
||||
allConcretes gr a = [i | (i, ModMod m) <- modules gr, mtype m == MTConcrete a]
|
||||
|
||||
@@ -7,6 +7,7 @@ import PrGrammar
|
||||
|
||||
import Option
|
||||
import Operations
|
||||
import Modules
|
||||
|
||||
import Char (isDigit)
|
||||
|
||||
@@ -177,7 +178,6 @@ optionsOfCommand co = case co of
|
||||
CPrintGlobalOptions
|
||||
CPrintLanguages
|
||||
CPrintInformation I.Ident
|
||||
CPrintMultiGrammar
|
||||
CPrintGramlet
|
||||
CPrintCanonXML
|
||||
CPrintCanonXMLStruct
|
||||
|
||||
@@ -45,7 +45,7 @@ data ModBody =
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Extend =
|
||||
Ext Ident
|
||||
Ext [Ident]
|
||||
| NoExt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
@@ -86,6 +86,7 @@ data Def =
|
||||
data TopDef =
|
||||
DefCat [CatDef]
|
||||
| DefFun [FunDef]
|
||||
| DefFunData [FunDef]
|
||||
| DefDef [Def]
|
||||
| DefData [DataDef]
|
||||
| DefTrans [Def]
|
||||
@@ -155,6 +156,7 @@ data Exp =
|
||||
| EInt Integer
|
||||
| EMeta
|
||||
| EEmpty
|
||||
| EData
|
||||
| EStrings String
|
||||
| ERecord [LocDef]
|
||||
| ETuple [TupleComp]
|
||||
|
||||
@@ -45,7 +45,7 @@ MUnion. ModBody ::= "union" [Included] ;
|
||||
|
||||
separator TopDef "" ;
|
||||
|
||||
Ext. Extend ::= Ident "**" ;
|
||||
Ext. Extend ::= [Ident] "**" ;
|
||||
NoExt. Extend ::= ;
|
||||
|
||||
separator Open "," ;
|
||||
@@ -79,6 +79,7 @@ DFull. Def ::= [Ident] ":" Exp "=" Exp ;
|
||||
|
||||
DefCat. TopDef ::= "cat" [CatDef] ;
|
||||
DefFun. TopDef ::= "fun" [FunDef] ;
|
||||
DefFunData.TopDef ::= "data" [FunDef] ;
|
||||
DefDef. TopDef ::= "def" [Def] ;
|
||||
DefData. TopDef ::= "data" [DataDef] ;
|
||||
|
||||
@@ -145,6 +146,7 @@ EString. Exp4 ::= String ;
|
||||
EInt. Exp4 ::= Integer ;
|
||||
EMeta. Exp4 ::= "?" ;
|
||||
EEmpty. Exp4 ::= "[" "]" ;
|
||||
EData. Exp4 ::= "data" ;
|
||||
EStrings. Exp4 ::= "[" String "]" ;
|
||||
ERecord. Exp4 ::= "{" [LocDef] "}" ; -- !
|
||||
ETuple. Exp4 ::= "<" [TupleComp] ">" ; --- needed for separator ","
|
||||
|
||||
@@ -31,7 +31,7 @@ trModule (i,mo) = case mo of
|
||||
(mkTopDefs (concatMap trAnyDef (tree2list (jments m)) ++ map trFlag (flags m)))
|
||||
|
||||
trExtend :: Maybe Ident -> P.Extend
|
||||
trExtend i = maybe P.NoExt (P.Ext . tri) i
|
||||
trExtend i = maybe P.NoExt (P.Ext . singleton . tri) i
|
||||
|
||||
---- this has to be completed with other mtys
|
||||
forName (MTConcrete a) = tri a
|
||||
|
||||
@@ -1,19 +1,33 @@
|
||||
|
||||
{-# OPTIONS -cpp #-}
|
||||
{-# LINE 3 "LexGF.x" #-}
|
||||
module LexGF where
|
||||
|
||||
import Alex
|
||||
import ErrM
|
||||
|
||||
pTSpec p = PT p . TS
|
||||
#if __GLASGOW_HASKELL__ >= 503
|
||||
import Data.Array
|
||||
import Data.Char (ord)
|
||||
import Data.Array.Base (unsafeAt)
|
||||
#else
|
||||
import Array
|
||||
import Char (ord)
|
||||
#endif
|
||||
alex_base :: Array Int Int
|
||||
alex_base = listArray (0,27) [1,21,57,58,24,25,26,0,68,69,27,28,29,66,0,38,19,39,0,44,45,156,364,0,279,487,213,51]
|
||||
|
||||
mk_LString p = PT p . eitherResIdent T_LString
|
||||
alex_table :: Array Int Int
|
||||
alex_table = listArray (0,742) [0,-1,-1,-1,-1,-1,-1,-1,-1,-1,13,13,13,13,13,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,13,14,24,-1,14,-1,-1,19,14,14,15,17,14,5,14,14,27,27,27,27,27,27,27,27,27,27,14,14,14,16,14,14,14,4,-1,-1,2,2,9,9,9,10,13,13,13,13,13,14,14,14,18,18,0,0,14,0,0,0,0,14,14,14,-1,14,-1,13,27,27,27,27,27,27,27,27,27,27,0,0,0,0,9,8,0,0,0,0,0,0,0,0,0,12,14,14,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,6,7,22,0,0,0,0,0,0,0,0,22,22,22,22,22,22,22,22,22,22,0,0,-1,0,0,0,0,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,25,-1,0,0,22,25,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,25,0,0,0,0,0,0,0,23,0,0,0,0,0,0,0,0,0,25,0,0,0,0,0,25,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,26,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,0,0,0,0,0,0,0,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,0,0,0,0,22,0,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,23,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,26,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,0,22,22,22,22,22,22,22,22,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
|
||||
|
||||
ident p = PT p . eitherResIdent TV
|
||||
alex_check :: Array Int Int
|
||||
alex_check = listArray (0,742) [-1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,45,10,10,45,45,45,45,45,45,9,10,11,12,13,42,62,43,39,39,-1,-1,62,-1,-1,-1,-1,91,92,93,94,95,96,32,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,45,45,-1,-1,-1,-1,-1,-1,-1,-1,-1,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,125,125,39,-1,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,215,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,34,247,-1,-1,95,39,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,10,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,92,-1,-1,-1,-1,-1,-1,-1,34,-1,-1,-1,-1,-1,-1,-1,-1,-1,110,-1,-1,-1,-1,-1,116,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,92,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,39,248,249,250,251,252,253,254,255,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,10,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,34,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,92,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,-1,248,249,250,251,252,253,254,255,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1]
|
||||
|
||||
string p = PT p . TL . unescapeInitTail
|
||||
alex_deflt :: Array Int Int
|
||||
alex_deflt = listArray (0,27) [21,-1,3,3,-1,-1,11,-1,11,11,11,11,-1,-1,-1,-1,-1,-1,-1,20,20,-1,-1,-1,25,25,-1,-1]
|
||||
|
||||
int p = PT p . TI
|
||||
alex_accept = listArray (0::Int,27) [[],[],[(AlexAccSkip)],[(AlexAccSkip)],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAccSkip)],[],[],[],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[],[],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_6))],[],[],[],[(AlexAcc (alex_action_7))]]
|
||||
{-# LINE 34 "LexGF.x" #-}
|
||||
|
||||
tok f p s = f p s
|
||||
|
||||
data Tok =
|
||||
TS String -- reserved words
|
||||
@@ -47,15 +61,6 @@ prToken t = case t of
|
||||
PT _ (T_LString s) -> s
|
||||
|
||||
|
||||
tokens:: String -> [Token]
|
||||
tokens inp = scan tokens_scan inp
|
||||
|
||||
tokens_scan:: Scan Token
|
||||
tokens_scan = load_scan (tokens_acts,stop_act) tokens_lx
|
||||
where
|
||||
stop_act p "" = []
|
||||
stop_act p inp = [Err p]
|
||||
|
||||
eitherResIdent :: (String -> Tok) -> String -> Tok
|
||||
eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
|
||||
isResWord s = isInTree s $
|
||||
@@ -81,52 +86,208 @@ unescapeInitTail = unesc . tail where
|
||||
c:cs -> c : unesc cs
|
||||
_ -> []
|
||||
|
||||
tokens_acts = [("ident",ident),("int",int),("mk_LString",mk_LString),("pTSpec",pTSpec),("string",string)]
|
||||
-------------------------------------------------------------------
|
||||
-- Alex wrapper code.
|
||||
-- A modified "posn" wrapper.
|
||||
-------------------------------------------------------------------
|
||||
|
||||
tokens_lx :: [(Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))]
|
||||
tokens_lx = [lx__0_0,lx__1_0,lx__2_0,lx__3_0,lx__4_0,lx__5_0,lx__6_0,lx__7_0,lx__8_0,lx__9_0,lx__10_0,lx__11_0,lx__12_0,lx__13_0,lx__14_0,lx__15_0,lx__16_0,lx__17_0,lx__18_0,lx__19_0,lx__20_0,lx__21_0]
|
||||
lx__0_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__0_0 = (False,[],-1,(('\t','\255'),[('\t',10),('\n',10),('\v',10),('\f',10),('\r',10),(' ',10),('!',14),('"',18),('$',14),('\'',15),('(',14),(')',14),('*',11),('+',13),(',',14),('-',1),('.',14),('/',14),('0',21),('1',21),('2',21),('3',21),('4',21),('5',21),('6',21),('7',21),('8',21),('9',21),(':',14),(';',14),('<',14),('=',12),('>',14),('?',14),('@',14),('A',17),('B',17),('C',17),('D',17),('E',17),('F',17),('G',17),('H',17),('I',17),('J',17),('K',17),('L',17),('M',17),('N',17),('O',17),('P',17),('Q',17),('R',17),('S',17),('T',17),('U',17),('V',17),('W',17),('X',17),('Y',17),('Z',17),('[',14),('\\',14),(']',14),('_',14),('a',17),('b',17),('c',17),('d',17),('e',17),('f',17),('g',17),('h',17),('i',17),('j',17),('k',17),('l',17),('m',17),('n',17),('o',17),('p',17),('q',17),('r',17),('s',17),('t',17),('u',17),('v',17),('w',17),('x',17),('y',17),('z',17),('{',4),('|',14),('}',14),('\192',17),('\193',17),('\194',17),('\195',17),('\196',17),('\197',17),('\198',17),('\199',17),('\200',17),('\201',17),('\202',17),('\203',17),('\204',17),('\205',17),('\206',17),('\207',17),('\208',17),('\209',17),('\210',17),('\211',17),('\212',17),('\213',17),('\214',17),('\216',17),('\217',17),('\218',17),('\219',17),('\220',17),('\221',17),('\222',17),('\223',17),('\224',17),('\225',17),('\226',17),('\227',17),('\228',17),('\229',17),('\230',17),('\231',17),('\232',17),('\233',17),('\234',17),('\235',17),('\236',17),('\237',17),('\238',17),('\239',17),('\240',17),('\241',17),('\242',17),('\243',17),('\244',17),('\245',17),('\246',17),('\248',17),('\249',17),('\250',17),('\251',17),('\252',17),('\253',17),('\254',17),('\255',17)]))
|
||||
lx__1_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__1_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('-','>'),[('-',2),('>',14)]))
|
||||
lx__2_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__2_0 = (False,[],2,(('\n','\n'),[('\n',3)]))
|
||||
lx__3_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__3_0 = (True,[(0,"",[],Nothing,Nothing)],-1,(('0','0'),[]))
|
||||
lx__4_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__4_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('-','-'),[('-',5)]))
|
||||
lx__5_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__5_0 = (False,[],5,(('-','-'),[('-',8)]))
|
||||
lx__6_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__6_0 = (False,[],5,(('-','}'),[('-',8),('}',7)]))
|
||||
lx__7_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__7_0 = (True,[(1,"",[],Nothing,Nothing)],5,(('-','-'),[('-',8)]))
|
||||
lx__8_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__8_0 = (False,[],5,(('-','}'),[('-',6),('}',9)]))
|
||||
lx__9_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__9_0 = (True,[(1,"",[],Nothing,Nothing)],-1,(('0','0'),[]))
|
||||
lx__10_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__10_0 = (True,[(2,"",[],Nothing,Nothing)],-1,(('\t',' '),[('\t',10),('\n',10),('\v',10),('\f',10),('\r',10),(' ',10)]))
|
||||
lx__11_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__11_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('*','*'),[('*',14)]))
|
||||
lx__12_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__12_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('>','>'),[('>',14)]))
|
||||
lx__13_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__13_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('+','+'),[('+',14)]))
|
||||
lx__14_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__14_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('0','0'),[]))
|
||||
lx__15_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__15_0 = (False,[],15,(('\'','\''),[('\'',16)]))
|
||||
lx__16_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__16_0 = (True,[(4,"mk_LString",[],Nothing,Nothing)],-1,(('0','0'),[]))
|
||||
lx__17_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__17_0 = (True,[(5,"ident",[],Nothing,Nothing)],-1,(('\'','\255'),[('\'',17),('0',17),('1',17),('2',17),('3',17),('4',17),('5',17),('6',17),('7',17),('8',17),('9',17),('A',17),('B',17),('C',17),('D',17),('E',17),('F',17),('G',17),('H',17),('I',17),('J',17),('K',17),('L',17),('M',17),('N',17),('O',17),('P',17),('Q',17),('R',17),('S',17),('T',17),('U',17),('V',17),('W',17),('X',17),('Y',17),('Z',17),('_',17),('a',17),('b',17),('c',17),('d',17),('e',17),('f',17),('g',17),('h',17),('i',17),('j',17),('k',17),('l',17),('m',17),('n',17),('o',17),('p',17),('q',17),('r',17),('s',17),('t',17),('u',17),('v',17),('w',17),('x',17),('y',17),('z',17),('\192',17),('\193',17),('\194',17),('\195',17),('\196',17),('\197',17),('\198',17),('\199',17),('\200',17),('\201',17),('\202',17),('\203',17),('\204',17),('\205',17),('\206',17),('\207',17),('\208',17),('\209',17),('\210',17),('\211',17),('\212',17),('\213',17),('\214',17),('\216',17),('\217',17),('\218',17),('\219',17),('\220',17),('\221',17),('\222',17),('\223',17),('\224',17),('\225',17),('\226',17),('\227',17),('\228',17),('\229',17),('\230',17),('\231',17),('\232',17),('\233',17),('\234',17),('\235',17),('\236',17),('\237',17),('\238',17),('\239',17),('\240',17),('\241',17),('\242',17),('\243',17),('\244',17),('\245',17),('\246',17),('\248',17),('\249',17),('\250',17),('\251',17),('\252',17),('\253',17),('\254',17),('\255',17)]))
|
||||
lx__18_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__18_0 = (False,[],18,(('\n','\\'),[('\n',-1),('"',20),('\\',19)]))
|
||||
lx__19_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__19_0 = (False,[],-1,(('"','t'),[('"',18),('\'',18),('\\',18),('n',18),('t',18)]))
|
||||
lx__20_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__20_0 = (True,[(6,"string",[],Nothing,Nothing)],-1,(('0','0'),[]))
|
||||
lx__21_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
|
||||
lx__21_0 = (True,[(7,"int",[],Nothing,Nothing)],-1,(('0','9'),[('0',21),('1',21),('2',21),('3',21),('4',21),('5',21),('6',21),('7',21),('8',21),('9',21)]))
|
||||
data Posn = Pn !Int !Int !Int
|
||||
deriving (Eq, Show)
|
||||
|
||||
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
|
||||
|
||||
alex_action_3 = tok (\p s -> PT p (TS s))
|
||||
alex_action_4 = tok (\p s -> PT p (eitherResIdent T_LString s))
|
||||
alex_action_5 = tok (\p s -> PT p (eitherResIdent TV s))
|
||||
alex_action_6 = tok (\p s -> PT p (TL $ unescapeInitTail s))
|
||||
alex_action_7 = tok (\p s -> PT p (TI s))
|
||||
{-# LINE 1 "GenericTemplate.hs" #-}
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- ALEX TEMPLATE
|
||||
--
|
||||
-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
|
||||
-- it for any purpose whatsoever.
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- INTERNALS and main scanner engine
|
||||
|
||||
{-# LINE 22 "GenericTemplate.hs" #-}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
{-# LINE 66 "GenericTemplate.hs" #-}
|
||||
|
||||
alexIndexShortOffAddr arr off = arr ! off
|
||||
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- Main lexing routines
|
||||
|
||||
data AlexReturn a
|
||||
= AlexEOF
|
||||
| AlexError !AlexInput
|
||||
| AlexSkip !AlexInput !Int
|
||||
| AlexToken !AlexInput !Int a
|
||||
|
||||
-- alexScan :: AlexInput -> StartCode -> Maybe (AlexInput,Int,act)
|
||||
alexScan input (sc)
|
||||
= alexScanUser undefined input (sc)
|
||||
|
||||
alexScanUser user input (sc)
|
||||
= case alex_scan_tkn user input (0) input sc AlexNone of
|
||||
(AlexNone, input') ->
|
||||
case alexGetChar input of
|
||||
Nothing ->
|
||||
|
||||
|
||||
|
||||
AlexEOF
|
||||
Just _ ->
|
||||
|
||||
|
||||
|
||||
AlexError input
|
||||
|
||||
(AlexLastSkip input len, _) ->
|
||||
|
||||
|
||||
|
||||
AlexSkip input len
|
||||
|
||||
(AlexLastAcc k input len, _) ->
|
||||
|
||||
|
||||
|
||||
AlexToken input len k
|
||||
|
||||
|
||||
-- Push the input through the DFA, remembering the most recent accepting
|
||||
-- state it encountered.
|
||||
|
||||
alex_scan_tkn user orig_input len input s last_acc =
|
||||
input `seq` -- strict in the input
|
||||
case s of
|
||||
(-1) -> (last_acc, input)
|
||||
_ -> alex_scan_tkn' user orig_input len input s last_acc
|
||||
|
||||
alex_scan_tkn' user orig_input len input s last_acc =
|
||||
let
|
||||
new_acc = check_accs (alex_accept `unsafeAt` (s))
|
||||
in
|
||||
new_acc `seq`
|
||||
case alexGetChar input of
|
||||
Nothing -> (new_acc, input)
|
||||
Just (c, new_input) ->
|
||||
|
||||
|
||||
|
||||
let
|
||||
base = alexIndexShortOffAddr alex_base s
|
||||
(ord_c) = ord c
|
||||
offset = (base + ord_c)
|
||||
check = alexIndexShortOffAddr alex_check offset
|
||||
|
||||
new_s = if (offset >= (0)) && (check == ord_c)
|
||||
then alexIndexShortOffAddr alex_table offset
|
||||
else alexIndexShortOffAddr alex_deflt s
|
||||
in
|
||||
alex_scan_tkn user orig_input (len + (1)) new_input new_s new_acc
|
||||
|
||||
where
|
||||
check_accs [] = last_acc
|
||||
check_accs (AlexAcc a : _) = AlexLastAcc a input (len)
|
||||
check_accs (AlexAccSkip : _) = AlexLastSkip input (len)
|
||||
check_accs (AlexAccPred a pred : rest)
|
||||
| pred user orig_input (len) input
|
||||
= AlexLastAcc a input (len)
|
||||
check_accs (AlexAccSkipPred pred : rest)
|
||||
| pred user orig_input (len) input
|
||||
= AlexLastSkip input (len)
|
||||
check_accs (_ : rest) = check_accs rest
|
||||
|
||||
data AlexLastAcc a
|
||||
= AlexNone
|
||||
| AlexLastAcc a !AlexInput !Int
|
||||
| AlexLastSkip !AlexInput !Int
|
||||
|
||||
data AlexAcc a user
|
||||
= AlexAcc a
|
||||
| AlexAccSkip
|
||||
| AlexAccPred a (AlexAccPred user)
|
||||
| AlexAccSkipPred (AlexAccPred user)
|
||||
|
||||
type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool
|
||||
|
||||
-- -----------------------------------------------------------------------------
|
||||
-- Predicates on a rule
|
||||
|
||||
alexAndPred p1 p2 user in1 len in2
|
||||
= p1 user in1 len in2 && p2 user in1 len in2
|
||||
|
||||
--alexPrevCharIsPred :: Char -> AlexAccPred _
|
||||
alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input
|
||||
|
||||
--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _
|
||||
alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input
|
||||
|
||||
--alexRightContext :: Int -> AlexAccPred _
|
||||
alexRightContext (sc) user _ _ input =
|
||||
case alex_scan_tkn user input (0) input sc AlexNone of
|
||||
(AlexNone, _) -> False
|
||||
_ -> True
|
||||
-- TODO: there's no need to find the longest
|
||||
-- match when checking the right context, just
|
||||
-- the first match will do.
|
||||
|
||||
-- used by wrappers
|
||||
iUnbox (i) = i
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -150,7 +150,7 @@ instance Print ModBody where
|
||||
|
||||
instance Print Extend where
|
||||
prt i e = case e of
|
||||
Ext id -> prPrec i 0 (concatD [prt 0 id , doc (showString "**")])
|
||||
Ext ids -> prPrec i 0 (concatD [prt 0 ids , doc (showString "**")])
|
||||
NoExt -> prPrec i 0 (concatD [])
|
||||
|
||||
|
||||
@@ -209,6 +209,7 @@ instance Print TopDef where
|
||||
prt i e = case e of
|
||||
DefCat catdefs -> prPrec i 0 (concatD [doc (showString "cat") , prt 0 catdefs])
|
||||
DefFun fundefs -> prPrec i 0 (concatD [doc (showString "fun") , prt 0 fundefs])
|
||||
DefFunData fundefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 fundefs])
|
||||
DefDef defs -> prPrec i 0 (concatD [doc (showString "def") , prt 0 defs])
|
||||
DefData datadefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 datadefs])
|
||||
DefTrans defs -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 defs])
|
||||
@@ -321,6 +322,7 @@ instance Print Exp where
|
||||
EInt n -> prPrec i 4 (concatD [prt 0 n])
|
||||
EMeta -> prPrec i 4 (concatD [doc (showString "?")])
|
||||
EEmpty -> prPrec i 4 (concatD [doc (showString "[") , doc (showString "]")])
|
||||
EData -> prPrec i 4 (concatD [doc (showString "data")])
|
||||
EStrings str -> prPrec i 4 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
|
||||
ERecord locdefs -> prPrec i 4 (concatD [doc (showString "{") , prt 0 locdefs , doc (showString "}")])
|
||||
ETuple tuplecomps -> prPrec i 4 (concatD [doc (showString "<") , prt 0 tuplecomps , doc (showString ">")])
|
||||
|
||||
@@ -66,7 +66,7 @@ transModBody x = case x of
|
||||
|
||||
transExtend :: Extend -> Result
|
||||
transExtend x = case x of
|
||||
Ext id -> failure x
|
||||
Ext ids -> failure x
|
||||
NoExt -> failure x
|
||||
|
||||
|
||||
@@ -114,6 +114,7 @@ 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
|
||||
@@ -193,6 +194,7 @@ transExp x = case x of
|
||||
EInt n -> failure x
|
||||
EMeta -> failure x
|
||||
EEmpty -> failure x
|
||||
EData -> failure x
|
||||
EStrings str -> failure x
|
||||
ERecord locdefs -> failure x
|
||||
ETuple tuplecomps -> failure x
|
||||
|
||||
@@ -139,7 +139,8 @@ transTransfer x = case x of
|
||||
|
||||
transExtend :: Extend -> Err (Maybe Ident)
|
||||
transExtend x = case x of
|
||||
Ext id -> transIdent id >>= return . Just
|
||||
Ext [id] -> transIdent id >>= return . Just
|
||||
Ext ids -> Bad "sorry, no support for multiple inheritance yet"
|
||||
NoExt -> return Nothing
|
||||
|
||||
transOpens :: Opens -> Err [GM.OpenSpec Ident]
|
||||
@@ -173,6 +174,9 @@ transAbsDef x = case x of
|
||||
DefFun fundefs -> do
|
||||
fundefs' <- mapM transFunDef fundefs
|
||||
returnl [(fun, G.AbsFun (yes typ) nope) | (funs,typ) <- fundefs', fun <- funs]
|
||||
DefFunData fundefs -> do
|
||||
fundefs' <- mapM transFunDef fundefs
|
||||
returnl [(fun, G.AbsFun (yes typ) (yes G.EData)) | (funs,typ) <- fundefs', fun <- funs]
|
||||
DefDef defs -> do
|
||||
defs' <- liftM concat $ mapM getDefsGen defs
|
||||
returnl [(c, G.AbsFun nope pe) | (c,(_,pe)) <- defs']
|
||||
|
||||
@@ -11,6 +11,7 @@ import SkelGF
|
||||
import PrintGF
|
||||
import AbsGF
|
||||
|
||||
|
||||
import ErrM
|
||||
|
||||
type ParseFun a = [Token] -> Err a
|
||||
@@ -28,6 +29,7 @@ run p s = case (p (myLLexer s)) of
|
||||
putStrLn $ "\n[Abstract Syntax]\n\n" ++ show tree
|
||||
putStrLn $ "\n[Linearized tree]\n\n" ++ printTree tree
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do args <- getArgs
|
||||
case args of
|
||||
|
||||
@@ -221,6 +221,7 @@ customMultiGrammarPrinter =
|
||||
customData "Printers for multiple grammars, selected by option -printer=x" $
|
||||
[
|
||||
(strCI "gfcm", MC.prCanon)
|
||||
,(strCI "header", MC.prCanonMGr)
|
||||
,(strCI "cfgm", prCanonAsCFGM)
|
||||
]
|
||||
++ moreCustomMultiGrammarPrinter
|
||||
|
||||
@@ -17,8 +17,9 @@ htmls :: FilePath -> IO ()
|
||||
htmls file = do
|
||||
s <- readFile file
|
||||
let ss = allPages s
|
||||
mapM (uncurry writeFile) (map (mkFile file (length ss)) ss)
|
||||
return ()
|
||||
lg = length ss
|
||||
putStrLn $ show lg ++ " slides"
|
||||
mapM_ (uncurry writeFile . mkFile file lg) ss
|
||||
|
||||
allPages :: String -> [(Int,String)]
|
||||
allPages = zip [1..] . map unlines . chop . lines where
|
||||
|
||||
Reference in New Issue
Block a user