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

regex patterns for tokens

Browse Source
This commit is contained in:
aarne
2006-01-07 12:26:11 +00:00
parent 5e0dad4362
commit 16a4868efa
16 changed files with 358 additions and 199 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
doc/DocGF.pdf
View File

Binary file not shown.

22
src/GF/Compile/CheckGrammar.hs
View File

@@ -512,6 +512,10 @@ inferLType gr trm = case trm of
PString _ -> True
PInt _ -> True
PFloat _ -> True
PSeq p q -> isConstPatt p && isConstPatt q
PAlt p q -> isConstPatt p && isConstPatt q
PRep p -> isConstPatt p
PAs _ p -> isConstPatt p
_ -> False
inferPatt p = case p of
@@ -664,7 +668,7 @@ checkLType env trm typ0 = do
pattContext :: LTEnv -> Type -> Patt -> Check Context
pattContext env typ p = case p of
PV x -> return [(x,typ)]
PP q c ps | q /= cPredef || prt c == "CC" -> do ---- why this /=? AR 6/1/2006
PP q c ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006
t <- checkErr $ lookupResType cnc q c
(cont,v) <- checkErr $ typeFormCnc t
checkCond ("wrong number of arguments for constructor in" +++ prt p)
@@ -683,7 +687,21 @@ pattContext env typ p = case p of
checkEqLType env typ t (patt2term p')
pattContext env typ p'
_ -> return [] ----
PAs x p -> do
g <- pattContext env typ p
return $ (x,typ):g
PAlt p q -> do
g1 <- pattContext env typ p
g2 <- pattContext env typ q
return $ filter (flip elem g1) g2 -- must be in both
PSeq p q -> do
g1 <- pattContext env typ p
g2 <- pattContext env typ q
return $ g1 ++ g2
PRep p -> pattContext env typeStr p
_ -> return [] ---- check types!
where
cnc = env

18
src/GF/Compile/Rename.hs
View File

@@ -241,6 +241,24 @@ renamePattern env patt = case patt of
let (ps',vs') = unzip psvss
return (PR (zip ls ps'), concat vs')
PAlt p q -> do
(p',vs) <- renp p
(q',ws) <- renp q
return (PAlt p' q', vs ++ ws)
PSeq p q -> do
(p',vs) <- renp p
(q',ws) <- renp q
return (PSeq p' q', vs ++ ws)
PRep p -> do
(p',vs) <- renp p
return (PRep p', vs)
PAs x p -> do
(p',vs) <- renp p
return (PAs x p', x:vs)
_ -> return (patt,[])
where

7
src/GF/Grammar/Compute.hs
View File

@@ -304,6 +304,13 @@ computeTermOpt rec gr = comp where
PP _ _ ps -> concatMap contP ps
PT _ p -> contP p
PR rs -> concatMap (contP . snd) rs
PAs x p -> (x,Vr x) : contP p
PSeq p q -> concatMap contP [p,q]
PAlt p q -> concatMap contP [p,q]
PRep p -> contP p
_ -> []
prawitz g i f cs e = do

8
src/GF/Grammar/Grammar.hs
View File

@@ -171,6 +171,14 @@ data Patt =
| PInt Integer -- ^ integer literal pattern: @12@ -- only abstract
| PFloat Double -- ^ float literal pattern: @1.2@ -- only abstract
| PT Type Patt -- ^ type-annotated pattern
| PAs Ident Patt -- ^ as-pattern: x@p
-- regular expression patterns
| PAlt Patt Patt -- ^ disjunctive pattern: p1 | p2
| PSeq Patt Patt -- ^ sequence of token parts
| PRep Patt -- ^ repetition of token part
deriving (Read, Show, Eq, Ord)
-- | to guide computation and type checking of tables

26
src/GF/Grammar/Macros.hs
View File

@@ -504,6 +504,24 @@ term2patt trm = case termForm trm of
Ok ([],EInt i,[]) -> return $ PInt i
Ok ([],EFloat i,[]) -> return $ PFloat i
Ok ([],K s, []) -> return $ PString s
--- encodings due to excessive use of term-patt convs. AR 7/1/2005
Ok ([], Cn (IC "@"), [Vr a,b]) -> do
b' <- term2patt b
return (PAs a b')
Ok ([], Cn (IC "*"), [a]) -> do
a' <- term2patt a
return (PRep a')
Ok ([], Cn (IC "+"), [a,b]) -> do
a' <- term2patt a
b' <- term2patt b
return (PSeq a' b')
Ok ([], Cn (IC "|"), [a,b]) -> do
a' <- term2patt a
b' <- term2patt b
return (PAlt a' b')
_ -> prtBad "no pattern corresponds to term" trm
patt2term :: Patt -> Term
@@ -513,11 +531,17 @@ patt2term pt = case pt of
PC c pp -> mkApp (Con c) (map patt2term pp)
PP p c pp -> mkApp (QC p c) (map patt2term pp)
PR r -> R [assign l (patt2term p) | (l,p) <- r]
PT _ p -> patt2term p
PT _ p -> patt2term p
PInt i -> EInt i
PFloat i -> EFloat i
PString s -> K s
PAs x p -> appc "@" [Vr x, patt2term p] --- an encoding
PSeq a b -> appc "+" [(patt2term a), (patt2term b)] --- an encoding
PAlt a b -> appc "|" [(patt2term a), (patt2term b)] --- an encoding
PRep a -> appc "*" [(patt2term a)] --- an encoding
redirectTerm :: Ident -> Term -> Term
redirectTerm n t = case t of
QC _ f -> QC n f

23
src/GF/Grammar/PatternMatch.hs
View File

@@ -67,11 +67,6 @@ tryMatch (p,t) = do
do matches <- mapM tryMatch (zip pp tt)
return (concat matches)
(PP (IC "Predef") (IC "CC") [p1,p2], ([],K s, [])) -> do
let cuts = [splitAt n s | n <- [0 .. length s]]
matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]
return (concat matches)
(PP q p pp, ([], QC r f, tt)) |
-- q `eqStrIdent` r && --- not for inherited AR 10/10/2005
p `eqStrIdent` f && length pp == length tt ->
@@ -91,6 +86,24 @@ tryMatch (p,t) = do
return (concat matches)
(PT _ p',_) -> trym p' t'
(_, ([],Alias _ _ d,[])) -> tryMatch (p,d)
-- (PP (IC "Predef") (IC "CC") [p1,p2], ([],K s, [])) -> do
(PAs x p',_) -> do
subst <- trym p' t'
return $ (x,t) : subst
(PAlt p1 p2,_) -> checks [trym p1 t', trym p2 t']
(PSeq p1 p2, ([],K s, [])) -> do
let cuts = [splitAt n s | n <- [0 .. length s]]
matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]
return (concat matches)
(PRep p1, ([],K s, [])) -> checks [
trym (foldr (const (PSeq p1)) (PString "") [0..n]) t' | n <- [1 .. length s]
]
_ -> prtBad "no match in case expr for" t
isInConstantForm :: Term -> Bool

7
src/GF/Grammar/Refresh.hs
View File

@@ -71,6 +71,13 @@ refreshPatt p = case p of
PP q c ps -> liftM (PP q c) (mapM refreshPatt ps)
PR r -> liftM PR (mapPairsM refreshPatt r)
PT t p' -> liftM2 PT (refresh t) (refreshPatt p')
PAs x p' -> liftM2 PAs (refVar x) (refreshPatt p')
PSeq p' q' -> liftM2 PSeq (refreshPatt p') (refreshPatt q')
PAlt p' q' -> liftM2 PAlt (refreshPatt p') (refreshPatt q')
PRep p' -> liftM PRep (refreshPatt p')
_ -> return p
refreshRecord r = case r of

3
src/GF/Source/AbsGF.hs
View File

@@ -221,6 +221,9 @@ data Patt =
| PC Ident [Patt]
| PQC Ident Ident [Patt]
| PDisj Patt Patt
| PSeq Patt Patt
| PRep Patt
| PAs Ident Patt
deriving (Eq,Ord,Show)
data PattAss =

5
src/GF/Source/GF.cf
View File

@@ -200,7 +200,7 @@ EEqs. Exp ::= "fn" "{" [Equation] "}" ;
EExample. Exp ::= "in" Exp5 String ;
coercions Exp 4 ;
coercions Exp 6 ;
separator Exp ";" ; -- in variants
@@ -222,6 +222,9 @@ PTup. Patt2 ::= "<" [PattTupleComp] ">" ;
PC. Patt1 ::= Ident [Patt] ;
PQC. Patt1 ::= Ident "." Ident [Patt] ;
PDisj. Patt ::= Patt "|" Patt1 ;
PSeq. Patt ::= Patt "+" Patt1 ;
PRep. Patt1 ::= Patt2 "*" ;
PAs. Patt1 ::= Ident "@" Patt2 ;
coercions Patt 2 ;

6
src/GF/Source/GrammarToSource.hs
View File

@@ -197,6 +197,12 @@ trp p = case p of
PFloat i -> P.PFloat i
PT t p -> trp p ---- prParenth (prt p +++ ":" +++ prt t)
PAs x p -> P.PAs (tri x) (trp p)
PAlt p q -> P.PDisj (trp p) (trp q)
PSeq p q -> P.PSeq (trp p) (trp q)
PRep p -> P.PRep (trp p)
trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty
where

10
src/GF/Source/LexGF.x
View File

@@ -1,10 +1,10 @@
-- -*- haskell -*-
-- This Alex file was machine-generated by the BNF converter
{
module GF.Source.LexGF where -- H
module LexGF where
import GF.Data.ErrM -- H
import GF.Data.SharedString -- H
import ErrM
import SharedString
}
@@ -16,7 +16,7 @@ $i = [$l $d _ '] -- identifier character
$u = [\0-\255] -- universal: any character
@rsyms = -- reserved words consisting of special symbols
\; | \= | \{ | \} | \( | \) | \: | \- \> | \* \* | \, | \[ | \] | \. | \| | \% | \? | \< | \> | \@ | \! | \* | \\ | \= \> | \+ \+ | \+ | \_ | \$ | \/ | \-
\; | \= | \{ | \} | \( | \) | \: | \- \> | \* \* | \, | \[ | \] | \- | \. | \| | \% | \? | \< | \> | \@ | \! | \* | \+ | \+ \+ | \\ | \= \> | \_ | \$ | \/
:-
"--" [.]* ; -- Toss single line comments
@@ -30,7 +30,7 @@ $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)) }
{

291
src/GF/Source/ParGF.hs
View File

File diff suppressed because one or more lines are too long

112
src/GF/Source/ParGF.y
View File

@@ -1,10 +1,9 @@
-- This Happy file was machine-generated by the BNF converter
{
module GF.Source.ParGF where -- H
import GF.Source.AbsGF -- H
import GF.Source.LexGF -- H
import GF.Infra.Ident -- H
import GF.Data.ErrM -- H
module ParGF where
import AbsGF
import LexGF
import ErrM
}
%name pGrammar Grammar
@@ -29,6 +28,7 @@ import GF.Data.ErrM -- H
',' { PT _ (TS ",") }
'[' { PT _ (TS "[") }
']' { PT _ (TS "]") }
'-' { PT _ (TS "-") }
'.' { PT _ (TS ".") }
'|' { PT _ (TS "|") }
'%' { PT _ (TS "%") }
@@ -38,14 +38,13 @@ import GF.Data.ErrM -- H
'@' { PT _ (TS "@") }
'!' { PT _ (TS "!") }
'*' { PT _ (TS "*") }
'+' { PT _ (TS "+") }
'++' { PT _ (TS "++") }
'\\' { PT _ (TS "\\") }
'=>' { PT _ (TS "=>") }
'++' { PT _ (TS "++") }
'+' { PT _ (TS "+") }
'_' { PT _ (TS "_") }
'$' { PT _ (TS "$") }
'/' { PT _ (TS "/") }
'-' { PT _ (TS "-") }
'Lin' { PT _ (TS "Lin") }
'PType' { PT _ (TS "PType") }
'Str' { PT _ (TS "Str") }
@@ -96,15 +95,17 @@ import GF.Data.ErrM -- H
L_ident { PT _ (TV $$) }
L_integ { PT _ (TI $$) }
L_quoted { PT _ (TL $$) }
L_doubl { PT _ (TD $$) }
L_LString { PT _ (T_LString $$) }
L_err { _ }
%%
Ident :: { Ident } : L_ident { identC $1 } -- H
Ident :: { Ident } : L_ident { Ident $1 }
Integer :: { Integer } : L_integ { (read $1) :: Integer }
String :: { String } : L_quoted { $1 }
Double :: { Double } : L_doubl { (read $1) :: Double }
LString :: { LString} : L_LString { LString ($1)}
Grammar :: { Grammar }
@@ -158,7 +159,7 @@ ModType : 'abstract' Ident { MTAbstract $2 }
ModBody :: { ModBody }
ModBody : Extend Opens '{' ListTopDef '}' { MBody $1 $2 (reverse $4) }
| Ident 'with' ListOpen { MWith $1 $3 }
| ListIdent '**' Ident 'with' ListOpen { MWithE $1 $3 $5 }
| ListIncluded '**' Ident 'with' ListOpen { MWithE $1 $3 $5 }
| 'reuse' Ident { MReuse $2 }
| 'union' ListIncluded { MUnion $2 }
@@ -169,7 +170,7 @@ ListTopDef : {- empty -} { [] }
Extend :: { Extend }
Extend : ListIdent '**' { Ext $1 }
Extend : ListIncluded '**' { Ext $1 }
| {- empty -} { NoExt }
@@ -210,6 +211,7 @@ ListIncluded : {- empty -} { [] }
Included :: { Included }
Included : Ident { IAll $1 }
| Ident '[' ListIdent ']' { ISome $1 $3 }
| Ident '-' '[' ListIdent ']' { IMinus $1 $4 }
Def :: { Def }
@@ -353,13 +355,14 @@ ListLocDef : {- empty -} { [] }
| LocDef ';' ListLocDef { (:) $1 $3 }
Exp4 :: { Exp }
Exp4 : Ident { EIdent $1 }
Exp6 :: { Exp }
Exp6 : Ident { EIdent $1 }
| '{' Ident '}' { EConstr $2 }
| '%' Ident '%' { ECons $2 }
| Sort { ESort $1 }
| String { EString $1 }
| Integer { EInt $1 }
| Double { EFloat $1 }
| '?' { EMeta }
| '[' ']' { EEmpty }
| 'data' { EData }
@@ -373,48 +376,57 @@ Exp4 : Ident { EIdent $1 }
| LString { ELString $1 }
Exp3 :: { Exp }
Exp3 : Exp3 '.' Label { EProj $1 $3 }
Exp5 :: { Exp }
Exp5 : Exp5 '.' Label { EProj $1 $3 }
| '{' Ident '.' Ident '}' { EQConstr $2 $4 }
| '%' Ident '.' Ident '%' { EQCons $2 $4 }
| Exp4 { $1 }
| '%' Ident '.' Ident { EQCons $2 $4 }
| Exp6 { $1 }
Exp2 :: { Exp }
Exp2 : Exp2 Exp3 { EApp $1 $2 }
Exp4 :: { Exp }
Exp4 : Exp4 Exp5 { EApp $1 $2 }
| 'table' '{' ListCase '}' { ETable $3 }
| 'table' Exp4 '{' ListCase '}' { ETTable $2 $4 }
| 'table' Exp4 '[' ListExp ']' { EVTable $2 $4 }
| 'table' Exp6 '{' ListCase '}' { ETTable $2 $4 }
| 'table' Exp6 '[' ListExp ']' { EVTable $2 $4 }
| 'case' Exp 'of' '{' ListCase '}' { ECase $2 $5 }
| 'variants' '{' ListExp '}' { EVariants $3 }
| 'pre' '{' Exp ';' ListAltern '}' { EPre $3 $5 }
| 'strs' '{' ListExp '}' { EStrs $3 }
| Ident '@' Exp4 { EConAt $1 $3 }
| Exp3 { $1 }
| Ident '@' Exp6 { EConAt $1 $3 }
| Exp5 { $1 }
| 'Lin' Ident { ELin $2 }
Exp3 :: { Exp }
Exp3 : Exp3 '!' Exp4 { ESelect $1 $3 }
| Exp3 '*' Exp4 { ETupTyp $1 $3 }
| Exp3 '**' Exp4 { EExtend $1 $3 }
| Exp4 { $1 }
Exp1 :: { Exp }
Exp1 : Exp1 '!' Exp2 { ESelect $1 $3 }
| Exp1 '*' Exp2 { ETupTyp $1 $3 }
| Exp1 '**' Exp2 { EExtend $1 $3 }
Exp1 : Exp2 '+' Exp1 { EGlue $1 $3 }
| Exp2 { $1 }
Exp :: { Exp }
Exp : '\\' ListBind '->' Exp { EAbstr $2 $4 }
Exp : Exp1 '++' Exp { EConcat $1 $3 }
| '\\' ListBind '->' Exp { EAbstr $2 $4 }
| '\\' '\\' ListBind '=>' Exp { ECTable $3 $5 }
| Decl '->' Exp { EProd $1 $3 }
| Exp1 '=>' Exp { ETType $1 $3 }
| Exp1 '++' Exp { EConcat $1 $3 }
| Exp1 '+' Exp { EGlue $1 $3 }
| Exp3 '=>' Exp { ETType $1 $3 }
| 'let' '{' ListLocDef '}' 'in' Exp { ELet $3 $6 }
| 'let' ListLocDef 'in' Exp { ELetb $2 $4 }
| Exp1 'where' '{' ListLocDef '}' { EWhere $1 $4 }
| Exp3 'where' '{' ListLocDef '}' { EWhere $1 $4 }
| 'fn' '{' ListEquation '}' { EEqs $3 }
| 'in' Exp5 String { EExample $2 $3 }
| Exp1 { $1 }
Exp2 :: { Exp }
Exp2 : Exp3 { $1 }
ListExp :: { [Exp] }
ListExp : {- empty -} { [] }
| Exp { (:[]) $1 }
@@ -423,24 +435,33 @@ ListExp : {- empty -} { [] }
Exps :: { Exps }
Exps : {- empty -} { NilExp }
| Exp4 Exps { ConsExp $1 $2 }
| Exp6 Exps { ConsExp $1 $2 }
Patt1 :: { Patt }
Patt1 : '_' { PW }
Patt2 :: { Patt }
Patt2 : '_' { PW }
| Ident { PV $1 }
| '{' Ident '}' { PCon $2 }
| Ident '.' Ident { PQ $1 $3 }
| Integer { PInt $1 }
| Double { PFloat $1 }
| String { PStr $1 }
| '{' ListPattAss '}' { PR $2 }
| '<' ListPattTupleComp '>' { PTup $2 }
| '(' Patt ')' { $2 }
Patt :: { Patt }
Patt : Ident ListPatt { PC $1 $2 }
Patt1 :: { Patt }
Patt1 : Ident ListPatt { PC $1 $2 }
| Ident '.' Ident ListPatt { PQC $1 $3 $4 }
| Patt2 '*' { PRep $1 }
| Ident '@' Patt2 { PAs $1 $3 }
| Patt2 { $1 }
Patt :: { Patt }
Patt : Patt '|' Patt1 { PDisj $1 $3 }
| Patt '+' Patt1 { PSeq $1 $3 }
| Patt1 { $1 }
@@ -467,18 +488,9 @@ ListPattAss : {- empty -} { [] }
| PattAss ';' ListPattAss { (:) $1 $3 }
PattAlt :: { PattAlt }
PattAlt : Patt { AltP $1 }
ListPatt :: { [Patt] }
ListPatt : Patt1 { (:[]) $1 }
| Patt1 ListPatt { (:) $1 $2 }
ListPattAlt :: { [PattAlt] }
ListPattAlt : PattAlt { (:[]) $1 }
| PattAlt '|' ListPattAlt { (:) $1 $3 }
ListPatt : Patt2 { (:[]) $1 }
| Patt2 ListPatt { (:) $1 $2 }
Bind :: { Bind }
@@ -494,7 +506,7 @@ ListBind : {- empty -} { [] }
Decl :: { Decl }
Decl : '(' ListBind ':' Exp ')' { DDec $2 $4 }
| Exp2 { DExp $1 }
| Exp4 { DExp $1 }
TupleComp :: { TupleComp }
@@ -518,7 +530,7 @@ ListPattTupleComp : {- empty -} { [] }
Case :: { Case }
Case : ListPattAlt '=>' Exp { Case $1 $3 }
Case : Patt '=>' Exp { Case $1 $3 }
ListCase :: { [Case] }
@@ -548,7 +560,7 @@ ListAltern : {- empty -} { [] }
DDecl :: { DDecl }
DDecl : '(' ListBind ':' Exp ')' { DDDec $2 $4 }
| Exp4 { DDExp $1 }
| Exp6 { DDExp $1 }
ListDDecl :: { [DDecl] }

3
src/GF/Source/PrintGF.hs
View File

@@ -399,6 +399,9 @@ instance Print Patt where
PC id patts -> prPrec i 1 (concatD [prt 0 id , prt 0 patts])
PQC id0 id patts -> prPrec i 1 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id , prt 0 patts])
PDisj patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "|") , prt 1 patt])
PSeq patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "+") , prt 1 patt])
PRep patt -> prPrec i 1 (concatD [prt 2 patt , doc (showString "*")])
PAs id patt -> prPrec i 1 (concatD [prt 0 id , doc (showString "@") , prt 2 patt])
prtList es = case es of
[x] -> (concatD [prt 2 x])

16
src/GF/Source/SourceToGrammar.hs
View File

@@ -517,6 +517,7 @@ transSort :: Sort -> Err String
transSort x = case x of
_ -> return $ printTree x
--- no more used 7/1/2006 AR
transPatts :: Patt -> Err [G.Patt]
transPatts p = case p of
PDisj p1 p2 -> liftM2 (++) (transPatts p1) (transPatts p2)
@@ -555,7 +556,12 @@ transPatt x = case x of
PQ id0 id -> liftM3 G.PP (transIdent id0) (transIdent id) (return [])
PQC id0 id patts ->
liftM3 G.PP (transIdent id0) (transIdent id) (mapM transPatt patts)
PDisj _ _ -> Bad $ "not allowed pattern" +++ printTree x
PDisj p1 p2 -> liftM2 G.PAlt (transPatt p1) (transPatt p2)
PSeq p1 p2 -> liftM2 G.PSeq (transPatt p1) (transPatt p2)
PRep p -> liftM G.PRep (transPatt p)
PAs x p -> liftM2 G.PAs (transIdent x) (transPatt p)
transBind :: Bind -> Err Ident
transBind x = case x of
@@ -571,13 +577,13 @@ transDecl x = case x of
DExp exp -> liftM (return . M.mkDecl) $ transExp exp
transCases :: [Case] -> Err [G.Case]
transCases = liftM concat . mapM transCase
transCases = mapM transCase
transCase :: Case -> Err [G.Case]
transCase :: Case -> Err G.Case
transCase (Case p exp) = do
patts <- transPatts p
patt <- transPatt p
exp' <- transExp exp
return [(p,exp') | p <- patts]
return (patt,exp')
transEquation :: Equation -> Err G.Equation
transEquation x = case x of