GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-19 16:12:52 -06:00
Code Issues Packages Projects Releases Wiki Activity

implemented pattern macros

Browse Source
This commit is contained in:
krangelov
2021-09-29 17:38:53 +02:00
parent 6efb878c43
commit 0229329d7c
14 changed files with 71 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/compiler/GF/Grammar/Binary.hs
View File

@@ -182,7 +182,7 @@ instance Binary Term where
put (QC x) = putWord8 25 >> put x
put (C x y) = putWord8 26 >> put (x,y)
put (Glue x y) = putWord8 27 >> put (x,y)
put (EPatt x) = putWord8 28 >> put x
put (EPatt x y z) = putWord8 28 >> put (x,y,z)
put (EPattType x) = putWord8 29 >> put x
put (ELincat x y) = putWord8 30 >> put (x,y)
put (ELin x y) = putWord8 31 >> put (x,y)
@@ -221,7 +221,7 @@ instance Binary Term where
25 -> get >>= \x -> return (QC x)
26 -> get >>= \(x,y) -> return (C x y)
27 -> get >>= \(x,y) -> return (Glue x y)
28 -> get >>= \x -> return (EPatt x)
28 -> get >>= \(x,y,z) -> return (EPatt x y z)
29 -> get >>= \x -> return (EPattType x)
30 -> get >>= \(x,y) -> return (ELincat x y)
31 -> get >>= \(x,y) -> return (ELin x y)

6
src/compiler/GF/Grammar/Grammar.hs
View File

@@ -386,7 +386,7 @@ data Term =
| C Term Term -- ^ concatenation: @s ++ t@
| Glue Term Term -- ^ agglutination: @s + t@
| EPatt Patt -- ^ pattern (in macro definition): # p
| EPatt Int (Maybe Int) Patt -- ^ pattern (in macro definition): # p
| EPattType Term -- ^ pattern type: pattern T
| ELincat Ident Term -- ^ boxed linearization type of Ident
@@ -421,12 +421,12 @@ data Patt =
-- regular expression patterns
| PNeg Patt -- ^ negated pattern: -p
| PAlt Patt Patt -- ^ disjunctive pattern: p1 | p2
| PSeq {-# UNPACK #-} !Int {-# UNPACK #-} !Int Patt {-# UNPACK #-} !Int {-# UNPACK #-} !Int Patt
| PSeq Int (Maybe Int) Patt Int (Maybe Int) Patt
-- ^ sequence of token parts: p + q
-- In the constructor PSeq minp maxp p minq maxq q,
-- minp/maxp and minq/maxq are the minimal/maximal
-- length of a matching string for p/q.
| PRep {-# UNPACK #-} !Int {-# UNPACK #-} !Int Patt
| PRep Int (Maybe Int) Patt
-- ^ repetition of token part: p*
-- In the constructor PRep minp maxp p,
-- minp/maxp is the minimal/maximal length of

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

@@ -384,7 +384,7 @@ term2patt trm = case termForm trm of
return (PNeg a')
Ok ([], Cn id, [a]) | id == cRep -> do
a' <- term2patt a
return (PRep 0 maxBound a')
return (PRep 0 Nothing a')
Ok ([], Cn id, []) | id == cRep -> do
return PChar
Ok ([], Cn id,[K s]) | id == cChars -> do
@@ -392,7 +392,7 @@ term2patt trm = case termForm trm of
Ok ([], Cn id, [a,b]) | id == cSeq -> do
a' <- term2patt a
b' <- term2patt b
return (PSeq 0 maxBound a' 0 maxBound b')
return (PSeq 0 Nothing a' 0 Nothing b')
Ok ([], Cn id, [a,b]) | id == cAlt -> do
a' <- term2patt a
b' <- term2patt b
@@ -475,8 +475,8 @@ composPattOp op patt =
PImplArg p -> liftM PImplArg (op p)
PNeg p -> liftM PNeg (op p)
PAlt p1 p2 -> liftM2 PAlt (op p1) (op p2)
PSeq _ _ p1 _ _ p2 -> liftM2 (\p1 p2 -> PSeq 0 maxBound p1 0 maxBound p2) (op p1) (op p2)
PRep _ _ p -> liftM (PRep 0 maxBound) (op p)
PSeq _ _ p1 _ _ p2 -> liftM2 (\p1 p2 -> PSeq 0 Nothing p1 0 Nothing p2) (op p1) (op p2)
PRep _ _ p -> liftM (PRep 0 Nothing) (op p)
_ -> return patt -- covers cases without subpatterns
collectOp :: Monoid m => (Term -> m) -> Term -> m

6
src/compiler/GF/Grammar/Parser.y
View File

@@ -444,7 +444,7 @@ Exp4
| 'pre' '{' String ';' ListAltern '}' { Alts (K $3) $5 }
| 'pre' '{' Ident ';' ListAltern '}' { Alts (Vr $3) $5 }
| 'strs' '{' ListExp '}' { Strs $3 }
| '#' Patt3 { EPatt $2 }
| '#' Patt3 { EPatt 0 Nothing $2 }
| 'pattern' Exp5 { EPattType $2 }
| 'lincat' Ident Exp5 { ELincat $2 $3 }
| 'lin' Ident Exp5 { ELin $2 $3 }
@@ -485,14 +485,14 @@ Exps
Patt :: { Patt }
Patt
: Patt '|' Patt1 { PAlt $1 $3 }
| Patt '+' Patt1 { PSeq 0 maxBound $1 0 maxBound $3 }
| Patt '+' Patt1 { PSeq 0 Nothing $1 0 Nothing $3 }
| Patt1 { $1 }
Patt1 :: { Patt }
Patt1
: Ident ListPatt { PC $1 $2 }
| ModuleName '.' Ident ListPatt { PP ($1,$3) $4 }
| Patt3 '*' { PRep 0 maxBound $1 }
| Patt3 '*' { PRep 0 Nothing $1 }
| Patt2 { $1 }
Patt2 :: { Patt }

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

@@ -24,7 +24,7 @@ import GF.Infra.Ident
import GF.Grammar.Macros
--import GF.Grammar.Printer
--import Data.List
import Data.Maybe(fromMaybe)
import Control.Monad
import GF.Text.Pretty
--import Debug.Trace
@@ -124,7 +124,7 @@ tryMatch (p,t) = do
(PSeq min1 max1 p1 min2 max2 p2, ([],K s, [])) -> matchPSeq min1 max1 p1 min2 max2 p2 s
(PRep _ _ p1, ([],K s, [])) -> checks [
trym (foldr (const (PSeq 0 maxBound p1 0 maxBound)) (PString "")
trym (foldr (const (PSeq 0 Nothing p1 0 Nothing)) (PString "")
[1..n]) t' | n <- [0 .. length s]
] >>
return []
@@ -140,8 +140,8 @@ tryMatch (p,t) = do
matchPSeq min1 max1 p1 min2 max2 p2 s =
do let n = length s
lo = min1 `max` (n-max2)
hi = (n-min2) `min` max1
lo = min1 `max` (n-fromMaybe n max2)
hi = (n-min2) `min` (fromMaybe n max1)
cuts = [splitAt i s | i <- [lo..hi]]
matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]
return (concat matches)

2
src/compiler/GF/Grammar/Printer.hs
View File

@@ -213,7 +213,7 @@ ppTerm q d (FV es) = prec d 4 ("variants" <+> braces (fsep (punctuate ';' (m
ppTerm q d (AdHocOverload es) = "overload" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es)))
ppTerm q d (Alts e xs) = prec d 4 ("pre" <+> braces (ppTerm q 0 e <> ';' <+> fsep (punctuate ';' (map (ppAltern q) xs))))
ppTerm q d (Strs es) = "strs" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es)))
ppTerm q d (EPatt p) = prec d 4 ('#' <+> ppPatt q 2 p)
ppTerm q d (EPatt _ _ p)=prec d 4 ('#' <+> ppPatt q 2 p)
ppTerm q d (EPattType t)=prec d 4 ("pattern" <+> ppTerm q 0 t)
ppTerm q d (P t l) = prec d 5 (ppTerm q 5 t <> '.' <> l)
ppTerm q d (Cn id) = pp id