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

WIP params

Browse Source
This commit is contained in:
John J. Camilleri
2021-02-26 17:18:21 +01:00
parent 9785f8351d
commit 4771d9c356
6 changed files with 99 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

76
src/compiler/GF/Compile/GrammarToLPGF.hs
View File

@@ -52,7 +52,8 @@ mkCanon2lpgf opts gr am = do
(C.Abstract _ _ _ funs) = ab
paramMap = mkParamMap params
paramTuples = mkParamTuples params
-- mapM_ (putStrLn . T.unpack . L.render . L.pp) paramTuples
let
-- filter out record fields from defn which don't appear in lincat
-- this seems to be an inconsistency in the canonical representation
lindefs' =
@@ -100,9 +101,9 @@ mkCanon2lpgf opts gr am = do
C.ErrorValue err -> return (L.LFError err, Nothing)
-- when param value can be known at compile time
-- this case is actually covered below and can be omitted, but it will result in smaller LPGF
-- and should thus be seen as an optimisation
-- when param value is known at compile time
-- this case is actually covered below and can be omitted,
-- but will result in smaller LPGF and is thus an optimisation
C.ParamConstant _ | isParamConstant lv -> do
(gix,ix) <- [ (gix,ix) | (gix,lvs) <- zip [0..] paramMap, Just ix <- [elemIndex lv lvs] ]
`headOrLeft` printf "Cannot find param value: %s" (show lv)
@@ -110,20 +111,46 @@ mkCanon2lpgf opts gr am = do
return (L.LFInt (ix+1), Just $ C.ParamType (C.ParamTypeId tpid))
-- when param value is dynamic
C.ParamConstant (C.Param pid pids) -> do
C.ParamConstant (C.Param pid lvs) -> do
-- get param group index and defn for this constructor
(gix,def) <- [ (gix,d) | (gix,d@(C.ParamDef _ ps)) <- zip [0..] params, any (\(C.Param p _) -> p == pid) ps ]
`headOrLeft` printf "Cannot find param group: %s" (show pid)
let (C.ParamDef tpid defpids) = def
pidIx <- eitherElemIndex pid [ p | C.Param p _ <- defpids ]
pids' <- mapM val2lin pids
let
tuple = paramTuples !! gix
term = foldl L.LFProjection tuple (L.LFInt (pidIx+1):map fst pids')
collectProjections :: C.LinValue -> Either String [L.LinFun]
collectProjections (C.ParamConstant (C.Param pid lvs)) = do
def <- [ d | d@(C.ParamDef _ ps) <- params, any (\(C.Param p _) -> p == pid) ps ]
`headOrLeft` printf "Cannot find param group: %s" (show pid)
let (C.ParamDef tpid defpids) = def
pidIx <- eitherElemIndex pid [ p | C.Param p _ <- defpids ]
rest <- mapM collectProjections lvs
return $ L.LFInt (pidIx+1) : concat rest
collectProjections lv = do
(lf ,_) <- val2lin lv
return [lf]
let tuple = paramTuples !! gix
lfs <- collectProjections lv
let term = foldl L.LFProjection tuple lfs
-- term <- case lvs of
-- [] -> return $ L.LFProjection tuple (L.LFInt (pidIx+1))
-- [lv0] -> do
-- (lf0,lt0) <- val2lin lv0
-- return $ L.LFProjection (L.LFProjection tuple (L.LFInt (pidIx+1))) lf0
-- [lv1,lv2] -> do
-- (lf1,lt1) <- val2lin lv1
-- (lf2,lt2) <- val2lin lv2
-- return $ L.LFProjection (L.LFProjection (L.LFProjection tuple (L.LFInt (pidIx+1))) lf1) lf2
-- lvs' <- mapM val2lin lvs
-- let term = foldl L.LFProjection tuple (L.LFInt (pidIx+1):map fst lvs')
-- term = L.LFProjection (L.LFProjection (L.LFProjection (L.LFProjection tuple (L.LFInt 2 {- AMod -})) (L.LFInt 1 {- GSg -})) (L.LFInt 3 {- Neutr -})) (L.LFInt 1 {- True -})
return (term, Just $ C.ParamType (C.ParamTypeId tpid))
-- https://www.aclweb.org/anthology/W15-3305.pdf
C.PredefValue (C.PredefId pid) -> case pid of
"BIND" -> return (L.LFBind, Nothing)
"SOFT_BIND" -> return (L.LFBind, Nothing)
@@ -219,7 +246,8 @@ inlineParamAliases defs = if null aliases then defs else map rp' pdefs
Just (C.ParamAliasDef _ (C.ParamType (C.ParamTypeId p))) -> p
_ -> pid
-- | Enumerate all paramvalue combinations for looking up index numbers
-- | Enumerate all param value combinations for looking up index numbers.
-- Used when param value is static (known at compile time)
mkParamMap :: [C.ParamDef] -> [[C.LinValue]]
mkParamMap defs = map mk' pdefs
where
@@ -240,7 +268,8 @@ mkParamMap defs = map mk' pdefs
, let Just def = L.find (\(C.ParamDef pid _) -> pid == p) pdefs
] :: [[C.LinValue]]
-- | Build LPGF tuple of param values, needed when param index is looked up dynamically
-- | Build nested tuple of param values.
-- Needed when param value is dynamic (known only at run time)
mkParamTuples :: [C.ParamDef] -> [L.LinFun]
mkParamTuples defs = map (\def -> CMS.evalState (mk' def) 1) pdefs
where
@@ -257,15 +286,24 @@ mkParamTuples defs = map (\def -> CMS.evalState (mk' def) 1) pdefs
ix <- CMS.get
CMS.modify (+1)
return $ L.LFInt ix
mk'' x@(C.Param p0 [pid]) = do
let Just def = L.find (\(C.ParamDef p _) -> pid == p) pdefs
mk' def
-- mk'' x@(C.Param p0 [pid1,pid2]) = do
-- let Just def1 = L.find (\(C.ParamDef p _) -> pid1 == p) pdefs
-- let Just def2 = L.find (\(C.ParamDef p _) -> pid2 == p) pdefs
-- let m1 = CMS.evalState (mk' def1) 1 -- get shape without affecting our counter
-- -- m2 <- mk' def2
-- let LFTuple m1' = m1
-- -- let LFTuple m2' = m2
-- L.LFTuple <$> sequence [ mk' def2 | _ <- m1' ]
mk'' (C.Param p0 (pid:pids)) = do
let Just def = L.find (\(C.ParamDef p _) -> pid == p) pdefs
let ms = CMS.evalState (mk' def) 1
let L.LFTuple ms' = ms
ns <- sequence
[ mk'' (C.Param p0 pids)
| m <- ms'
]
return $ L.LFTuple ns
let L.LFTuple ms = CMS.evalState (mk' def) 1 -- get shape without affecting our counter
L.LFTuple <$> sequence [ mk'' (C.Param p0 pids) | _ <- ms ]
-- | Always put 's' reocord field first, then sort alphabetically
-- This seems to be done inconsistently in the canonical format

11
src/runtime/haskell/LPGF.hs
View File

@@ -272,9 +272,14 @@ instance PP LinFun where
CMW.tell [ T.replicate (n+1) " " `T.append` T.pack (show p) | p <- ps ]
pp' (n+1) d
c@(LFConcat l1 l2) | isDeep l1 || isDeep l2 -> do
p "LFConcat"
mapM_ (pp' (n+1)) (unConcat c)
c@(LFConcat l1 l2) -> do
let ts = unConcat c
if any isDeep ts
then do
p "LFConcat"
mapM_ (pp' (n+1)) ts
else
ps $ "LFConcat " ++ show ts
LFTuple ls | any isDeep ls -> do
p "LFTuple"
mapM_ (pp' (n+1)) ls

4
testsuite/lpgf/unittests/Params.treebank
View File

@@ -1,5 +1,5 @@
Params: FtoS f1
ParamsCnc: PR R1 Q1
ParamsCnc: PRQ _ Q3
Params: FtoS f2
ParamsCnc: PR R2 _
ParamsCnc: PRQ (RT _) Q1

2
testsuite/lpgf/unittests/Params2.treebank
View File

@@ -1,2 +1,2 @@
Params2: SuchMassKind Good
Params2Cnc: gutes
Params2Cnc: mod sg neutr t

18
testsuite/lpgf/unittests/Params2Cnc.gf
View File

@@ -1,8 +1,9 @@
concrete Params2Cnc of Params2 = {
param
Boolean = True | False;
AForm = APred | AMod GenNum;
GenNum = GSg Gender | GPl;
GenNum = GSg Gender Boolean | GPl;
Gender = Masc | Fem | Neutr;
lincat
@@ -11,16 +12,19 @@ concrete Params2Cnc of Params2 = {
lin
SuchMassKind qual = {
s = qual.s ! AMod (GSg qual.g)
s = qual.s ! AMod (GSg qual.g True)
};
Good = {
s =
table {APred => "gut";
AMod (GSg Masc) => "guter";
AMod (GSg Fem) => "gute";
AMod (GSg Neutr) => "gutes";
AMod GPl => "gute"} ;
table {APred => "pred";
AMod (GSg Masc True) => "mod sg masc t";
AMod (GSg Fem True) => "mod sg fem t";
AMod (GSg Neutr True) => "mod sg neutr t";
AMod (GSg Masc False) => "mod sg masc f";
AMod (GSg Fem False) => "mod sg fem f";
AMod (GSg Neutr False) => "mod sg neutr f";
AMod GPl => "mod pl"} ;
g = Neutr
};
}

31
testsuite/lpgf/unittests/ParamsCnc.gf
View File

@@ -1,21 +1,30 @@
concrete ParamsCnc of Params = {
param
R = R1 | R2 ;
P = PR R Q | PP ;
P = Px | PRQ R Q | Py ;
R = R0 | RT T ;
T = T0 | T1 ;
Q = Q3 | Q2 | Q1 ;
lincat
S = Str ;
F = { r : R } ;
F = { r : R; q : Q } ;
lin
f1 = { r = R1 } ;
f2 = { r = R2 } ;
FtoS f = tbl ! PR f.r Q1 ;
f1 = { r = R0 ; q = Q3 } ;
f2 = { r = RT T1 ; q = Q1 } ;
FtoS f = tbl ! PRQ f.r f.q ;
oper
tbl = table {
PR R1 Q2 => "PR R1 Q2" ;
PR R1 Q1 => "PR R1 Q1" ;
PR R1 Q3 => "PR R1 Q3" ;
PR R2 _ => "PR R2 _" ;
PP => "PP"
Px => "Px" ;
Py => "Py" ;
PRQ R0 Q1 => "PRQ R0 Q1" ;
PRQ R0 Q2 => "PRQ R0 Q2" ;
-- PRQ R0 Q3 => "PRQ R0 Q3" ;
PRQ (RT _) Q1 => "PRQ (RT _) Q1" ;
-- PRQ (RT T0) Q1 => "PRQ (RT T0) Q1" ;
PRQ (RT T0) Q2 => "PRQ (RT T0) Q2" ;
-- PRQ (RT T0) Q3 => "PRQ (RT T0) Q3" ;
-- PRQ (RT T1) Q1 => "PRQ (RT T1) Q1" ;
PRQ (RT T1) Q2 => "PRQ (RT T1) Q2" ;
-- PRQ (RT T1) Q3 => "PRQ (RT T1) Q3" ;
PRQ _ Q3 => "PRQ _ Q3"
} ;
}