GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-08-19 10:46:22 -06:00
Code Issues Packages Projects Releases Wiki Activity

deprecate PW in favour of PV identW

Browse Source
This commit is contained in:
Krasimir Angelov
2026-02-08 09:41:41 +01:00
parent b547e39857
commit 880d3aa76c
11 changed files with 28 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/compiler/api/GF/Compile/Compute.hs
+4 -2
View File
@@ -361,6 +361,7 @@ evalAbsDef g@(Gl gr pds _) c q args =
case splitAt' arity args of
Nothing -> VPAP c q args
Just (_,_) -> patternMatch g c (VConst q args) (map (\(ps,t) -> ([],ps,args,t)) eqs)
Ok (_,Nothing) -> VConst q args
Bad msg -> error msg
apply g (VMeta i vs0) vs = VMeta i (vs0++vs)
@@ -550,9 +551,10 @@ patternMatch g s v0 ((env0,ps,args0,t):eqs) = match env0 ps eqs args0
Bad msg -> error msg
where
Gl gr _ _ = g
match env (PV v :ps) eqs (arg:args) = match ((v,arg):env) ps eqs args
match env (PV v :ps) eqs (arg:args)
| v == identW = match env ps eqs args
| otherwise = match ((v,arg):env) ps eqs args
match env (PAs v p :ps) eqs (arg:args) = match ((v,arg):env) (p:ps) eqs (arg:args)
match env (PW :ps) eqs (arg:args) = match env ps eqs args
match env (PTilde _ :ps) eqs (arg:args) = match env ps eqs args
match env (p :ps) eqs (arg:args) = match' env p ps eqs arg args
src/compiler/api/GF/Compile/ConcreteToHaskell.hs
+3 -2
View File
@@ -170,8 +170,9 @@ concrete2haskell opts abstr@(absname,_) concr@(cncname,mi) =
convertPatt (PC c ps) = ConP (gId c) (map convertPatt ps)
convertPatt (PP (_,c) ps) = ConP (gId c) (map convertPatt ps)
convertPatt (PV v) = VarP v
convertPatt PW = WildP
convertPatt (PV v)
| v == identW = WildP
| otherwise = VarP v
convertPatt (PR lbls) = ConP (rcon' ls) (map convertPatt ps)
where (ls,ps) = unzip $ sortOn fst lbls
convertPatt (PString s) = Lit s
src/compiler/api/GF/Compile/GenerateBC.hs
+3 -2
View File
@@ -50,8 +50,9 @@ compileEquations gr arity st (i:is) eqs fl bs = whilePP eqs Map.empty
in (bs3,[PUSH_FRAME, EVAL (shiftIVal (st+2) i) RecCall] ++ instrs1)
whilePV [] vrs = compileEquations gr arity st is vrs fl bs
whilePV ((vs, PV x : ps, t):eqs) vrs = whilePV eqs (((x,i):vs,ps,t) : vrs)
whilePV ((vs, PW : ps, t):eqs) vrs = whilePV eqs (( vs,ps,t) : vrs)
whilePV ((vs, PV x : ps, t):eqs) vrs
| x == identW = whilePV eqs (( vs,ps,t) : vrs)
| otherwise = whilePV eqs (((x,i):vs,ps,t) : vrs)
whilePV ((vs, PTilde _ : ps, t):eqs) vrs = whilePV eqs (( vs,ps,t) : vrs)
whilePV ((vs, PImplArg p:ps, t):eqs) vrs = whilePV ((vs,p:ps,t):eqs) vrs
whilePV ((vs, PT _ p : ps, t):eqs) vrs = whilePV ((vs,p:ps,t):eqs) vrs
src/compiler/api/GF/Compile/GeneratePMCFG.hs
+1 -1
View File
@@ -169,7 +169,7 @@ type2metaTerm gr d ms s r rs (RecType lbls) params =
in (ms',s',r',R ass,params')
type2metaTerm gr d ms s r rs (Table p q) params
| count == 1 = let (ms',s',r',t,params') = type2metaTerm gr d ms s r rs q params
in (ms',s',r+(r'-r),T (TTyped p) [(PW,t)],params')
in (ms',s',r+(r'-r),T (TTyped p) [(PV identW,t)],params')
| otherwise = let pv = varX (length rs+1)
(ms',s',r',t,params') = type2metaTerm gr d ms s r ((delta,(pv,p)):rs) q params
delta = r'-r
src/compiler/api/GF/Compile/GrammarToPGF.hs
-1
View File
@@ -153,7 +153,6 @@ mkPatt scope p =
A.PV x -> (x:scope,C.PVar (i2i x))
A.PAs x p -> let (scope',p') = mkPatt scope p
in (x:scope',C.PAs (i2i x) p')
A.PW -> ( scope,C.PWild)
A.PInt i -> ( scope,C.PLit (C.LInt (fromIntegral i)))
A.PFloat f -> ( scope,C.PLit (C.LFlt f))
A.PString s -> ( scope,C.PLit (C.LStr s))
src/compiler/api/GF/Compile/TypeCheck.hs
+15 -13
View File
@@ -98,7 +98,6 @@ checkDef g q ty (ps,t) = do
(scope,arg_ty) <- tcPatt scope c1 p (Just arg_ty)
go scope c2 res_ty ps
-- tcPatt scope c PW Nothing = do
inferSigma :: Scope -> Choice -> Term -> EvalM (Term,Sigma)
inferSigma scope s t = do -- GEN1
@@ -766,17 +765,16 @@ reapply2 scope c fun fun_ty ((arg,arg_v,arg_ty):args) mb_ty = do -- Explicit arg
res_ty <- evalCodomain x arg_v res_ty
reapply2 scope c (App fun arg) res_ty args mb_ty
tcPatt scope c PW Nothing = do
i <- newResiduation scope
return (scope,VMeta i [])
tcPatt scope c PW (Just ty0) =
return (scope,ty0)
tcPatt scope c (PV x) Nothing = do
i <- newResiduation scope
let ty = VMeta i []
return ((x,ty):scope,ty)
if x == identW
then return (scope,VMeta i [])
else let ty = VMeta i []
in return ((x,ty):scope,ty)
tcPatt scope c (PV x) (Just ty) =
return ((x,ty):scope,ty)
if x == identW
then return (scope,ty)
else return ((x,ty):scope,ty)
tcPatt scope c (PP q ps) mb_ty = do
g@(Gl gr _ isAbstract) <- globals
ty <- case (if isAbstract then lookupFunType else lookupResType) gr q of
@@ -923,7 +921,8 @@ measurePatt p =
return (min,max,PT t p')
PAs x p -> do (min,max,p) <- measurePatt p
case p of
PW -> return (0,Nothing,PV x)
PV y | y == identW
-> return (0,Nothing,PV x)
_ -> return (min,max,PAs x p)
PImplArg p -> do (min,max,p') <- measurePatt p
return (min,max,PImplArg p')
@@ -941,13 +940,16 @@ measurePatt p =
-> do (min1,max1,p1) <- measurePatt p1
(min2,max2,p2) <- measurePatt p2
case (p1,p2) of
(PW, PW ) -> return (0,Nothing,PW)
(PV x, PV y )
| x == identW && y == identW
-> return (0,Nothing,PV identW)
(PString s1,PString s2) -> return (min1+min2,liftM2 (+) max1 max2,PString (s1++s2))
_ -> return (min1+min2,liftM2 (+) max1 max2,PSeq min1 max1 p1 min2 max2 p2)
PRep _ _ p -> do (minp,maxp,p) <- measurePatt p
case p of
PW -> return (0,Nothing,PW)
PChar -> return (0,Nothing,PW)
PV x | x == identW
-> return (0,Nothing,PV x)
PChar -> return (0,Nothing,PV identW)
_ -> return (0,Nothing,PRep minp maxp p)
PChar -> return (1,Just 1,p)
PChars _ -> return (1,Just 1,p)
src/compiler/api/GF/Grammar/Binary.hs
-2
View File
@@ -224,7 +224,6 @@ instance Binary Patt where
put (PC x y) = putWord8 0 >> put (x,y)
put (PP x y) = putWord8 1 >> put (x,y)
put (PV x) = putWord8 2 >> put x
put (PW) = putWord8 3
put (PR x) = putWord8 4 >> put x
put (PString x) = putWord8 5 >> put x
put (PInt x) = putWord8 6 >> put x
@@ -246,7 +245,6 @@ instance Binary Patt where
0 -> get >>= \(x,y) -> return (PC x y)
1 -> get >>= \(x,y) -> return (PP x y)
2 -> get >>= \x -> return (PV x)
3 -> return (PW)
4 -> get >>= \x -> return (PR x)
5 -> get >>= \x -> return (PString x)
6 -> get >>= \x -> return (PInt x)
src/compiler/api/GF/Grammar/Grammar.hs
+1 -2
View File
@@ -410,8 +410,7 @@ data Term =
data Patt =
PC Ident [Patt] -- ^ constructor pattern: @C p1 ... pn@ @C@
| PP QIdent [Patt] -- ^ package constructor pattern: @P.C p1 ... pn@ @P.C@
| PV Ident -- ^ variable pattern: @x@
| PW -- ^ wild card pattern: @_@
| PV Ident -- ^ variable pattern: @x@ or wild card @_@
| PR [(Label,Patt)] -- ^ record pattern: @{r = p ; ...}@ -- only concrete
| PString String -- ^ string literal pattern: @\"foo\"@ -- only abstract
| PInt Integer -- ^ integer literal pattern: @12@ -- only abstract
src/compiler/api/GF/Grammar/JSON.hs
-2
View File
@@ -198,7 +198,6 @@ json2term o = Vr <$> o!:"vr"
patt2json (PC id ps) = makeObj [("pc",showJSON id),("args",showJSON (map patt2json ps))]
patt2json (PP (mn,id) ps) = makeObj [("mod",showJSON mn),("pc",showJSON id),("args",showJSON (map patt2json ps))]
patt2json (PV id) = makeObj [("pv",showJSON id)]
patt2json PW = makeObj [("wildcard",showJSON True)]
patt2json (PR lbls) = makeObj (("record", showJSON True) : map toRow lbls)
where toRow (l,t) = (showLabel l, patt2json t)
patt2json (PString s) = showJSON s
@@ -231,7 +230,6 @@ json2patt :: JSValue -> Result Patt
json2patt o = PP <$> (liftM2 (\mn id -> (mn,id)) (o!:"mod") (o!:"pc")) <*> (o!:"args" >>= mapM json2patt)
<|> PC <$> (o!:"pc") <*> (o!:"args" >>= mapM json2patt)
<|> PV <$> (o!:"pv")
<|> (o!:"wildcard" >>= guard >> return PW)
<|> (const PR) <$> (o!:"record" >>= guard) <*> mapM fromRow (assocsJSObject o)
<|> PString <$> readJSON o
<|> PInt <$> readJSON o
src/compiler/api/GF/Grammar/Parser.y
+1 -1
View File
@@ -536,7 +536,7 @@ Patt3
| '[' String ']' { PChars $2 }
| '#' Ident { PMacro $2 }
| '#' ModuleName '.' Ident { PM ($2,$4) }
| '_' { PW }
| '_' { PV identW }
| Ident { PV $1 }
| ModuleName '.' Ident { PP ($1,$3) [] }
| Integer { PInt $1 }
src/compiler/api/GF/Grammar/Printer.hs
-3
View File
@@ -293,7 +293,6 @@ ppPatt q d (PChar) = pp '?'
ppPatt q d (PChars s) = brackets (str s)
ppPatt q d (PMacro id) = '#' <> id
ppPatt q d (PM id) = '#' <> ppQIdent q id
ppPatt q d PW = pp '_'
ppPatt q d (PV id) = pp id
ppPatt q d (PInt n) = pp n
ppPatt q d (PFloat f) = pp f
@@ -369,8 +368,6 @@ getAbs e = ([],e)
getCTable :: Term -> ([Ident], Term)
getCTable (T TRaw [(PV v,e)]) = let (vs,e') = getCTable e
in (v:vs,e')
getCTable (T TRaw [(PW, e)]) = let (vs,e') = getCTable e
in (identW:vs,e')
getCTable e = ([],e)
getLet :: Term -> ([LocalDef], Term)