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

Replace list comprehension lookups with maps. Halfway through transitioning to new strategy for tables/params, see testsuite/lpgf/README.md.

Browse Source
This commit is contained in:
John J. Camilleri
2021-03-03 13:26:03 +01:00
parent a8e3dc8855
commit 3beed2c49e
4 changed files with 195 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files

105
testsuite/lpgf/README.md
View File

@@ -47,3 +47,108 @@ stack bench --benchmark-arguments "run pgf Foods.pgf testsuite/lpgf/foods/Food
stack bench --benchmark-arguments "run pgf2 Foods.pgf testsuite/lpgf/foods/Foods-all.trees +RTS -T -RTS"
stack bench --benchmark-arguments "run lpgf Foods.lpgf testsuite/lpgf/foods/Foods-all.trees +RTS -T -RTS"
```
# Notes on compilation
## 1
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)
P1 = <1>
P2 = <2>
Q1 = <1>
Q2 = <2>
R P1 = <1,1>
R P2 = <1,2>
RPQ P1 Q1 = <2,1,1>
RPQ P1 Q2 = <2,1,2>
RPQ P2 Q1 = <2,2,1>
RPQ P2 Q2 = <2,2,2>
R0 = <3>
XPQ P1 Q1 = <1,1,1>
XPQ P1 Q2 = <1,1,2>
XPQ P2 Q1 = <1,2,1>
XPQ P2 Q2 = <1,2,2>
P => Str
<"P1","P2">
{p:P ; q:Q} => Str
<<"P1;Q1","P1;Q2">,<"P2;Q1","P2;Q2">>
{p=P2; q=Q1}
<<2>,<1>>
R => Str
< <"RP P1","RP P2">,
< <"RPQ P1 Q1","RPQ P1 Q2">,
<"RPQ P2 Q1","RPQ P2 Q2"> >,
"R0"
>
X => Str
<<<"XPQ P1 Q1","XPQ P1 Q2">,
<"XPQ P2 Q1","XPQ P2 Q2">>>
{p=P2 ; r=R0}
<<2>,<3>>
{p=P2 ; r1=RP P1 ; r2=RPQ P1 Q2 ; r3=R0 }
< <2> , <1, 1> , <2, 1, 2> , <3>>
## 2
param defns
P = P1 | PQ Q
Q = Q1 | QR R
R = R1 | R2
translation
P1 = <1>
PQ Q1 = <2,1>
PQ QR R1 = <2,2,1>
PQ QR R2 = <2,2,2>
Q1 = <1>
QR R1 = <2,1>
QR R2 = <2,2>
R1 = <1>
R2 = <2>
P => Str
<"P1",<"PQ Q1",<"PQ (QR R1)","PQ (QR R2)">>>
{q:Q ; p:P} => Str
< <"Q1;P1",<"Q1;PQ Q1",<"Q1;PQ (QR R1)","Q1;PQ (QR R2)">>>,
<
<"QR R1;P1",<"QR R1;PQ Q1",<"QR R1;PQ (QR R1)","QR R1;PQ (QR R2)">>>,
<"QR R2;P1",<"QR R2;PQ Q1",<"QR R2;PQ (QR R1)","QR R2;PQ (QR R2)">>>
>
>
{q=Q1 ; p=P1} = <<1>,<1>>
{q=Q1 ; p=PQ Q1} = <<1>,<2,1>>
{q=Q1 ; p=PQ (QR R1)} = <<1>,<2,2,1>>
{q=Q1 ; p=PQ (QR R2)} = <<1>,<2,2,2>>
{q=QR R1 ; p=P1} = <<2,1>,<1>>
{q=QR R1 ; p=PQ Q1} = <<2,1>,<2,1>>
{q=QR R1 ; p=PQ (QR R1)} = <<2,1>,<2,2,1>>
{q=QR R1 ; p=PQ (QR R2)} = <<2,1>,<2,2,2>>
{q=QR R2 ; p=P1} = <<2,2>,<1>>
{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>>

44
testsuite/lpgf/walking/Walking.hs
View File

@@ -38,34 +38,34 @@ walking = LPGF {
concretes = Map.fromList [
(mkCId "WalkingEng", Concr {
-- lincats = Map.fromList [
-- (mkCId "S", LTStr),
-- (mkCId "NP", LTProduct [LTStr, LTInt 2]),
-- (mkCId "VP", LTProduct [LTStr, LTStr])
-- (mkCId "S", StrType),
-- (mkCId "NP", ProductType [StrType, IxType 2]),
-- (mkCId "VP", ProductType [StrType, StrType])
-- ],
lins = Map.fromList [
(mkCId "And", mkConcat [LFArgument 1, LFToken "and", LFArgument 2]),
-- (mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFArgument 2) (LFProjection (LFArgument 1) (LFInt 2))]),
(mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFProjection (LFArgument 2) (LFInt 1)) (LFProjection (LFArgument 1) (LFInt 2))]),
(mkCId "John", LFTuple [LFToken "John", LFInt 1]),
(mkCId "We", LFTuple [LFToken "we", LFInt 2]),
-- (mkCId "Walk", LFTuple [LFToken "walks", LFToken "walk"])
(mkCId "Walk", LFTuple [LFTuple [LFToken "walks", LFToken "walk"]])
(mkCId "And", mkConcat [Argument 1, Token "and", Argument 2]),
-- (mkCId "Pred", mkConcat [Projection (Argument 1) (Ix 1), Projection (Argument 2) (Projection (Argument 1) (Ix 2))]),
(mkCId "Pred", mkConcat [Projection (Argument 1) (Ix 1), Projection (Projection (Argument 2) (Ix 1)) (Projection (Argument 1) (Ix 2))]),
(mkCId "John", Tuple [Token "John", Ix 1]),
(mkCId "We", Tuple [Token "we", Ix 2]),
-- (mkCId "Walk", Tuple [Token "walks", Token "walk"])
(mkCId "Walk", Tuple [Tuple [Token "walks", Token "walk"]])
]
}),
(mkCId "WalkingGer", Concr {
-- lincats = Map.fromList [
-- (mkCId "S", LTStr),
-- (mkCId "NP", LTProduct [LTStr, LTInt 2, LTInt 3]),
-- (mkCId "VP", LTProduct [LTProduct [LTStr, LTStr, LTStr], LTProduct [LTStr, LTStr, LTStr]])
-- (mkCId "S", StrType),
-- (mkCId "NP", ProductType [StrType, IxType 2, IxType 3]),
-- (mkCId "VP", ProductType [ProductType [StrType, StrType, StrType], ProductType [StrType, StrType, StrType]])
-- ],
lins = Map.fromList [
(mkCId "And", mkConcat [LFArgument 1, LFToken "und", LFArgument 2]),
-- (mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFProjection (LFArgument 2) (LFProjection (LFArgument 1) (LFInt 2))) (LFProjection (LFArgument 1) (LFInt 3))]),
(mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFProjection (LFProjection (LFArgument 2) (LFInt 1)) (LFProjection (LFArgument 1) (LFInt 2))) (LFProjection (LFArgument 1) (LFInt 3))]),
(mkCId "John", LFTuple [LFToken "John", LFInt 1, LFInt 3]),
(mkCId "We", LFTuple [LFToken "wir", LFInt 2, LFInt 1]),
-- (mkCId "Walk", LFTuple [LFTuple [LFToken "gehe", LFToken "gehst", LFToken "geht"], LFTuple [LFToken "gehen", LFToken "geht", LFToken "gehen"]])
(mkCId "Walk", LFTuple [LFTuple [LFTuple [LFToken "gehe", LFToken "gehst", LFToken "geht"], LFTuple [LFToken "gehen", LFToken "geht", LFToken "gehen"]]])
(mkCId "And", mkConcat [Argument 1, Token "und", Argument 2]),
-- (mkCId "Pred", mkConcat [Projection (Argument 1) (Ix 1), Projection (Projection (Argument 2) (Projection (Argument 1) (Ix 2))) (Projection (Argument 1) (Ix 3))]),
(mkCId "Pred", mkConcat [Projection (Argument 1) (Ix 1), Projection (Projection (Projection (Argument 2) (Ix 1)) (Projection (Argument 1) (Ix 2))) (Projection (Argument 1) (Ix 3))]),
(mkCId "John", Tuple [Token "John", Ix 1, Ix 3]),
(mkCId "We", Tuple [Token "wir", Ix 2, Ix 1]),
-- (mkCId "Walk", Tuple [Tuple [Token "gehe", Token "gehst", Token "geht"], Tuple [Token "gehen", Token "geht", Token "gehen"]])
(mkCId "Walk", Tuple [Tuple [Tuple [Token "gehe", Token "gehst", Token "geht"], Tuple [Token "gehen", Token "geht", Token "gehen"]]])
]
})
]
@@ -73,6 +73,6 @@ walking = LPGF {
-- | Helper for building concat trees
mkConcat :: [LinFun] -> LinFun
mkConcat [] = LFEmpty
mkConcat [] = Empty
mkConcat [x] = x
mkConcat xs = foldl1 LFConcat xs
mkConcat xs = foldl1 Concat xs