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

Add more complex param/table unit tests and pass them. Still fails on Phrasebook though.

Browse Source
This commit is contained in:
John J. Camilleri
2021-03-04 12:37:12 +01:00
parent 0ba0438dc7
commit f5886bf447
9 changed files with 364 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -157,10 +157,23 @@ mkCanon2lpgf opts gr am = do
go :: [C.TableRowValue] -> Either String (L.LinFun, Maybe C.LinType)
go [C.TableRow _ lv] = val2lin lv
go trvs = do
let grps = L.groupBy (\(C.TableRow (C.RecordPattern rps1) _) (C.TableRow (C.RecordPattern rps2) _) -> head rps1 == head rps2) trvs
-- ts <- mapM (go . map (\(C.TableRow (C.RecordPattern rps) lv) -> C.TableRow (C.RecordPattern (tail rps)) lv)) grps
let grps = flip L.groupBy trvs $ \tr1 tr2 ->
let
C.TableRow (C.RecordPattern (C.RecordRow lid1 (C.ParamPattern (C.Param pid1 _)):_)) _ = tr1
C.TableRow (C.RecordPattern (C.RecordRow lid2 (C.ParamPattern (C.Param pid2 _)):_)) _ = tr2
in lid1 == lid2 && pid1 == pid2
ts <- forM grps $ \grp ->
go $ map (\(C.TableRow (C.RecordPattern rps) lv) -> C.TableRow (C.RecordPattern (tail rps)) lv) grp
go =<< forM grp (\row ->
case row of
C.TableRow (C.RecordPattern []) lv -> return row
C.TableRow (C.RecordPattern (C.RecordRow _ (C.ParamPattern (C.Param _ [])):rrs)) lv -> return $ C.TableRow (C.RecordPattern rrs) lv
C.TableRow (C.RecordPattern rrs) lv -> return $ C.TableRow (C.RecordPattern rrs') lv
where
C.RecordRow lid (C.ParamPattern (C.Param pid patts)) = head rrs
C.ParamPattern (C.Param pid2 patts2) = head patts
rrs' = C.RecordRow lid (C.ParamPattern (C.Param pid2 (patts2 ++ tail patts))) : tail rrs
_ -> Left $ printf "Unhandled table row: %s" (show row)
)
let typ = case ts of
(_, Just tst):_ -> Just $ C.TableType lt tst
_ -> Nothing
@@ -231,7 +244,7 @@ mkCanon2lpgf opts gr am = do
-- C.CommentedValue cmnt lv -> val2lin lv
C.CommentedValue cmnt lv -> case cmnt of
"impossible" -> val2lin lv >>= \(_, typ) -> return (L.Empty, typ) -- TODO untested optimisation
"impossible" -> val2lin lv >>= \(_, typ) -> return (L.Empty, typ)
_ -> val2lin lv
v -> Left $ printf "val2lin not implemented for: %s" (show v)

59
testsuite/lpgf/README.md
View File

@@ -17,6 +17,10 @@ stack test gf:test:lpgf --test-arguments="unittests/Params" # specific grammar
stack test gf:test:lpgf --test-arguments="foods/Foods Fre Ger" # specific grammar and languages
```
```
stack build --test --bench --no-run-tests --no-run-benchmarks && DEBUG=1 stack test gf:test:lpgf --test-arguments="foods/Foods Fre Ger"
```
Set environment variable `DEBUG=1` to enable dumping of intermediate formats.
## Benchmark
@@ -55,15 +59,16 @@ stack bench --benchmark-arguments "run lpgf Foods.lpgf testsuite/lpgf/foods/Food
# Notes on compilation
## 1
## 1 (see unittests/Params4)
param defns
P = P1 | P2
Q = Q1 | Q2
R = RP P | RPQ P Q | R0
X = XPQ P Q
**param defns**
P = P1 | P2
Q = Q1 | Q2
R = RP P | RPQ P Q | R0
X = XPQ P Q
translation (NB: tuples may be listed, but will be concatted at runtime)
**translation**
NB: tuples may be nested, but will be concatted at runtime
P1 = <1>
P2 = <2>
@@ -110,14 +115,15 @@ X => Str
{p=P2 ; r1=RP P1 ; r2=RPQ P1 Q2 ; r3=R0 }
< <2> , <1, 1> , <2, 1, 2> , <3>>
## 2
## 2 (see unittests/Params5)
param defns
P = P1 | PQ Q
Q = Q1 | QR R
R = R1 | R2
**param defns**
translation
P = P1 | PQ Q
Q = Q1 | QR R
R = R1 | R2
**translation**
P1 = <1>
PQ Q1 = <2,1>
@@ -156,3 +162,30 @@ P => Str
{q=QR R2 ; p=PQ Q1} = <<2,2>,<2,1>>
{q=QR R2 ; p=PQ (QR R1)} = <<2,2>,<2,2,1>>
{q=QR R2 ; p=PQ (QR R2)} = <<2,2>,<2,2,2>>
**NOTE**: GF will swap q and p in record, as part of record field sorting, resulting in the following:
{p:P ; q:Q} => Str
< <"P1;Q1", <"P1;QR R1","P1;QR R2">>,
< <"PQ Q1;Q1", <"PQ Q1;QR R1","PQ Q1;QR R2">>,
< <"PQ (QR R1);Q1", <"PQ (QR R1);QR R1","PQ (QR R1);QR R2">>,
<"PQ (QR R2);Q1", <"PQ (QR R2);QR R1","PQ (QR R2);QR R2">>
>
>
>
{p=P1 ; q=Q1} = <<1>,<1>>
{p=P1 ; q=QR R1} = <<1>,<2,1>>
{p=P1 ; q=QR R2} = <<1>,<2,2>>
{p=PQ Q1 ; q=Q1} = <<2,1>,<1>>
{p=PQ Q1 ; q=QR R1} = <<2,1>,<2,1>>
{p=PQ Q1 ; q=QR R2} = <<2,1>,<2,2>>
{p=PQ (QR R1) ; q=Q1} = <<2,2,1>,<1>>
{p=PQ (QR R1) ; q=QR R1} = <<2,2,1>,<2,1>>
{p=PQ (QR R1) ; q=QR R2} = <<2,2,1>,<2,2>>
{p=PQ (QR R2) ; q=Q1} = <<2,2,2>,<1>>
{p=PQ (QR R2) ; q=QR R1} = <<2,2,2>,<2,1>>
{p=PQ (QR R2) ; q=QR R2} = <<2,2,2>,<2,2>>

2
testsuite/lpgf/test.hs
View File

@@ -28,6 +28,8 @@ main = do
doGrammar "unittests" "Params1"
doGrammar "unittests" "Params2"
doGrammar "unittests" "Params3"
doGrammar "unittests" "Params4"
doGrammar "unittests" "Params5"
doGrammar "unittests" "Pre"
doGrammar "unittests" "Projection"
doGrammar "unittests" "Tables"

20
testsuite/lpgf/unittests/Params4.gf Normal file
View File

@@ -0,0 +1,20 @@
abstract Params4 = {
cat
P_ ;
Q_ ;
S ;
fun
p1 : P_ ;
p2 : P_ ;
q1 : Q_ ;
q2 : Q_ ;
pqrec : P_ -> Q_ -> S ;
rp : P_ -> S ;
rpq : P_ -> Q_ -> S ;
r0 : S ;
xpq : P_ -> Q_ -> S ;
}

44
testsuite/lpgf/unittests/Params4.treebank Normal file
View File

@@ -0,0 +1,44 @@
Params4: pqrec p1 q1
Params4Cnc: P1 ; Q1
Params4: pqrec p1 q2
Params4Cnc: P1 ; Q2
Params4: pqrec p2 q1
Params4Cnc: P2 ; Q1
Params4: pqrec p2 q2
Params4Cnc: P2 ; Q2
Params4: r0
Params4Cnc: R0
Params4: rp p1
Params4Cnc: RP P1
Params4: rp p2
Params4Cnc: RP P2
Params4: rpq p1 q1
Params4Cnc: RPQ P1 Q1
Params4: rpq p1 q2
Params4Cnc: RPQ P1 Q2
Params4: rpq p2 q1
Params4Cnc: RPQ P2 Q1
Params4: rpq p2 q2
Params4Cnc: RPQ P2 Q2
Params4: xpq p1 q1
Params4Cnc: XPQ P1 Q1
Params4: xpq p1 q2
Params4Cnc: XPQ P1 Q2
Params4: xpq p2 q1
Params4Cnc: XPQ P2 Q1
Params4: xpq p2 q2
Params4Cnc: XPQ P2 Q2

61
testsuite/lpgf/unittests/Params4Cnc.gf Normal file
View File

@@ -0,0 +1,61 @@
concrete Params4Cnc of Params4 = {
param
P = P1 | P2 ;
Q = Q1 | Q2 ;
R = RP P | RPQ P Q | R0 ;
X = XPQ P Q ;
lincat
P_ = P ;
Q_ = Q ;
S = Str ;
lin
p1 = P1 ;
p2 = P2 ;
q1 = Q1 ;
q2 = Q2 ;
pqrec p q = tblPQRec ! { p = p ; q = q } ;
rp p = tblR ! RP p ;
rpq p q = tblR ! RPQ p q ;
r0 = tblR ! R0 ;
xpq p q = tblX ! XPQ p q ;
oper
tblP : P => Str ;
tblP = table {
P1 => "P1";
P2 => "P2"
} ;
tblPQRec : {p:P; q:Q} => Str ;
tblPQRec = table {
{p=P1; q=Q1} => "P1 ; Q1";
{p=P1; q=Q2} => "P1 ; Q2";
{p=P2; q=Q1} => "P2 ; Q1";
{p=P2; q=Q2} => "P2 ; Q2"
} ;
tblR : R => Str ;
tblR = table {
RP P1 => "RP P1";
RP P2 => "RP P2";
RPQ P1 Q1 => "RPQ P1 Q1";
RPQ P1 Q2 => "RPQ P1 Q2";
RPQ P2 Q1 => "RPQ P2 Q1";
RPQ P2 Q2 => "RPQ P2 Q2";
R0 => "R0"
} ;
tblX : X => Str ;
tblX = table {
XPQ P1 Q1 => "XPQ P1 Q1";
XPQ P1 Q2 => "XPQ P1 Q2";
XPQ P2 Q1 => "XPQ P2 Q1";
XPQ P2 Q2 => "XPQ P2 Q2"
} ;
}

19
testsuite/lpgf/unittests/Params5.gf Normal file
View File

@@ -0,0 +1,19 @@
abstract Params5 = {
cat
P_ ;
Q_ ;
R_ ;
S ;
fun
p1 : P_ ;
pq : Q_ -> P_ ;
q1 : Q_ ;
qr : R_ -> Q_ ;
r1 : R_ ;
r2 : R_ ;
showP : P_ -> S ;
showPQ : P_ -> Q_ -> S ;
showQP : Q_ -> P_ -> S ;
}

83
testsuite/lpgf/unittests/Params5.treebank Normal file
View File

@@ -0,0 +1,83 @@
Params5: showP p1
Params5Cnc: P1
Params5: showP (pq q1)
Params5Cnc: PQ Q1
Params5: showP (pq (qr r1))
Params5Cnc: PQ (QR R1)
Params5: showP (pq (qr r2))
Params5Cnc: PQ (QR R2)
Params5: showPQ p1 q1
Params5Cnc: P1 ; Q1
Params5: showPQ p1 (qr r1)
Params5Cnc: P1 ; QR R1
Params5: showPQ p1 (qr r2)
Params5Cnc: P1 ; QR R2
Params5: showPQ (pq q1) q1
Params5Cnc: PQ Q1 ; Q1
Params5: showPQ (pq q1) (qr r1)
Params5Cnc: PQ Q1 ; QR R1
Params5: showPQ (pq q1) (qr r2)
Params5Cnc: PQ Q1 ; QR R2
Params5: showPQ (pq (qr r1)) q1
Params5Cnc: PQ (QR R1) ; Q1
Params5: showPQ (pq (qr r1)) (qr r1)
Params5Cnc: PQ (QR R1) ; QR R1
Params5: showPQ (pq (qr r1)) (qr r2)
Params5Cnc: PQ (QR R1) ; QR R2
Params5: showPQ (pq (qr r2)) q1
Params5Cnc: PQ (QR R2) ; Q1
Params5: showPQ (pq (qr r2)) (qr r1)
Params5Cnc: PQ (QR R2) ; QR R1
Params5: showPQ (pq (qr r2)) (qr r2)
Params5Cnc: PQ (QR R2) ; QR R2
Params5: showQP q1 p1
Params5Cnc: Q1 ; P1
Params5: showQP q1 (pq q1)
Params5Cnc: Q1 ; PQ Q1
Params5: showQP q1 (pq (qr r1))
Params5Cnc: Q1 ; PQ (QR R1)
Params5: showQP q1 (pq (qr r2))
Params5Cnc: Q1 ; PQ (QR R2)
Params5: showQP (qr r1) p1
Params5Cnc: QR R1 ; P1
Params5: showQP (qr r1) (pq q1)
Params5Cnc: QR R1 ; PQ Q1
Params5: showQP (qr r1) (pq (qr r1))
Params5Cnc: QR R1 ; PQ (QR R1)
Params5: showQP (qr r1) (pq (qr r2))
Params5Cnc: QR R1 ; PQ (QR R2)
Params5: showQP (qr r2) p1
Params5Cnc: QR R2 ; P1
Params5: showQP (qr r2) (pq q1)
Params5Cnc: QR R2 ; PQ Q1
Params5: showQP (qr r2) (pq (qr r1))
Params5Cnc: QR R2 ; PQ (QR R1)
Params5: showQP (qr r2) (pq (qr r2))
Params5Cnc: QR R2 ; PQ (QR R2)

72
testsuite/lpgf/unittests/Params5Cnc.gf Normal file
View File

@@ -0,0 +1,72 @@
concrete Params5Cnc of Params5 = {
param
P = P1 | PQ Q ;
Q = Q1 | QR R ;
R = R1 | R2 ;
lincat
P_ = P ;
Q_ = Q ;
R_ = R ;
S = Str ;
lin
p1 = P1 ;
pq q = PQ q ;
q1 = Q1 ;
qr r = QR r ;
r1 = R1 ;
r2 = R2 ;
showP p = tblP ! p ;
showPQ p q = tblPQRec ! { p = p ; q = q } ;
showQP q p = tblQPRec ! { q = q ; p = p } ;
oper
tblP : P => Str ;
tblP = table {
P1 => "P1";
PQ Q1 => "PQ Q1";
PQ (QR R1) => "PQ (QR R1)";
PQ (QR R2) => "PQ (QR R2)"
} ;
tblQPRec : {q:Q ; p:P} => Str ;
tblQPRec = table {
{q=Q1 ; p=P1} => "Q1 ; P1";
{q=Q1 ; p=PQ Q1} => "Q1 ; PQ Q1";
{q=Q1 ; p=PQ (QR R1)} => "Q1 ; PQ (QR R1)";
{q=Q1 ; p=PQ (QR R2)} => "Q1 ; PQ (QR R2)";
{q=QR R1 ; p=P1} => "QR R1 ; P1";
{q=QR R1 ; p=PQ Q1} => "QR R1 ; PQ Q1";
{q=QR R1 ; p=PQ (QR R1)} => "QR R1 ; PQ (QR R1)";
{q=QR R1 ; p=PQ (QR R2)} => "QR R1 ; PQ (QR R2)";
{q=QR R2 ; p=P1} => "QR R2 ; P1";
{q=QR R2 ; p=PQ Q1} => "QR R2 ; PQ Q1";
{q=QR R2 ; p=PQ (QR R1)} => "QR R2 ; PQ (QR R1)";
{q=QR R2 ; p=PQ (QR R2)} => "QR R2 ; PQ (QR R2)"
} ;
tblPQRec : {p:P ; q:Q} => Str ;
tblPQRec = table {
{p=P1 ; q=Q1} => "P1 ; Q1";
{p=P1 ; q=QR R1} => "P1 ; QR R1";
{p=P1 ; q=QR R2} => "P1 ; QR R2";
{p=PQ Q1 ; q=Q1} => "PQ Q1 ; Q1";
{p=PQ Q1 ; q=QR R1} => "PQ Q1 ; QR R1";
{p=PQ Q1 ; q=QR R2} => "PQ Q1 ; QR R2";
{p=PQ (QR R1) ; q=Q1} => "PQ (QR R1) ; Q1";
{p=PQ (QR R1) ; q=QR R1} => "PQ (QR R1) ; QR R1";
{p=PQ (QR R1) ; q=QR R2} => "PQ (QR R1) ; QR R2";
{p=PQ (QR R2) ; q=Q1} => "PQ (QR R2) ; Q1";
{p=PQ (QR R2) ; q=QR R1} => "PQ (QR R2) ; QR R1";
{p=PQ (QR R2) ; q=QR R2} => "PQ (QR R2) ; QR R2"
} ;
}