mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -06:00
Replace list comprehension lookups with maps. Halfway through transitioning to new strategy for tables/params, see testsuite/lpgf/README.md.
This commit is contained in:
John J. Camilleri
@@ -51,9 +51,37 @@ mkCanon2lpgf opts gr am = do
|
|||||||
mkConcrete (C.Concrete modId absModId flags params' lincats lindefs) = do
|
mkConcrete (C.Concrete modId absModId flags params' lincats lindefs) = do
|
||||||
let
|
let
|
||||||
(C.Abstract _ _ _ funs) = ab
|
(C.Abstract _ _ _ funs) = ab
|
||||||
params = inlineParamAliases params' -- TODO remove by making mkParamTuples return map
|
params = inlineParamAliases params'
|
||||||
paramTuples = mkParamTuples params'
|
|
||||||
let
|
-- Builds maps for lookups
|
||||||
|
|
||||||
|
paramValueMap :: Map.Map C.ParamId C.ParamDef -- constructor -> definition
|
||||||
|
paramValueMap = Map.fromList [ (v,d) | d@(C.ParamDef _ vs) <- params, (C.Param v _) <- vs ]
|
||||||
|
|
||||||
|
lincatMap :: Map.Map C.CatId C.LincatDef
|
||||||
|
lincatMap = Map.fromList [ (cid,d) | d@(C.LincatDef cid _) <- lincats ]
|
||||||
|
|
||||||
|
funMap :: Map.Map C.FunId C.FunDef
|
||||||
|
funMap = Map.fromList [ (fid,d) | d@(C.FunDef fid _) <- funs ]
|
||||||
|
|
||||||
|
-- | Lookup lintype for a function
|
||||||
|
lookupLinType :: C.FunId -> Either String C.LinType
|
||||||
|
lookupLinType funId = do
|
||||||
|
fun <- m2e (printf "Cannot find type for: %s" (show funId)) (Map.lookup funId funMap)
|
||||||
|
let (C.FunDef _ (C.Type _ (C.TypeApp catId _))) = fun
|
||||||
|
lincat <- m2e (printf "Cannot find lincat for: %s" (show catId)) (Map.lookup catId lincatMap)
|
||||||
|
let (C.LincatDef _ lt) = lincat
|
||||||
|
return lt
|
||||||
|
|
||||||
|
-- | Lookup lintype for a function's argument
|
||||||
|
lookupLinTypeArg :: C.FunId -> Int -> Either String C.LinType
|
||||||
|
lookupLinTypeArg funId argIx = do
|
||||||
|
fun <- m2e (printf "Cannot find type for: %s" (show funId)) (Map.lookup funId funMap)
|
||||||
|
let (C.FunDef _ (C.Type args _)) = fun
|
||||||
|
let (C.TypeBinding _ (C.Type _ (C.TypeApp catId _))) = args !! argIx
|
||||||
|
lincat <- m2e (printf "Cannot find lincat for: %s" (show catId)) (Map.lookup catId lincatMap)
|
||||||
|
let (C.LincatDef _ lt) = lincat
|
||||||
|
return lt
|
||||||
|
|
||||||
-- filter out record fields from defn which don't appear in lincat
|
-- filter out record fields from defn which don't appear in lincat
|
||||||
-- this seems to be an inconsistency in the canonical representation
|
-- this seems to be an inconsistency in the canonical representation
|
||||||
@@ -69,19 +97,7 @@ mkCanon2lpgf opts gr am = do
|
|||||||
es = map mkLin lindefs'
|
es = map mkLin lindefs'
|
||||||
lins = Map.fromList $ rights es
|
lins = Map.fromList $ rights es
|
||||||
|
|
||||||
-- | Lookup lintype for a function
|
-- | Main code generation function
|
||||||
lookupLinType :: C.FunId -> Either String C.LinType
|
|
||||||
lookupLinType funId = do
|
|
||||||
(C.Type _ (C.TypeApp catId _)) <- [ ftype | C.FunDef fid ftype <- funs, fid == funId ] `headOrLeft` printf "Cannot find type for: %s" (show funId)
|
|
||||||
[ lt | C.LincatDef cid lt <- lincats, cid == catId ] `headOrLeft` printf "Cannot find lincat for: %s" (show catId)
|
|
||||||
|
|
||||||
-- | Lookup lintype for a function's argument
|
|
||||||
lookupLinTypeArg :: C.FunId -> Int -> Either String C.LinType
|
|
||||||
lookupLinTypeArg funId argIx = do
|
|
||||||
(C.Type args _) <- [ ftype | C.FunDef fid ftype <- funs, fid == funId ] `headOrLeft` printf "Cannot find type for: %s" (show funId)
|
|
||||||
let C.TypeBinding _ (C.Type _ (C.TypeApp catId _)) = args !! argIx
|
|
||||||
[ lt | C.LincatDef cid lt <- lincats, cid == catId ] `headOrLeft` printf "Cannot find lincat for: %s" (show catId)
|
|
||||||
|
|
||||||
mkLin :: C.LinDef -> Either String (CId, L.LinFun)
|
mkLin :: C.LinDef -> Either String (CId, L.LinFun)
|
||||||
mkLin (C.LinDef funId varIds linValue) = do
|
mkLin (C.LinDef funId varIds linValue) = do
|
||||||
(lf, _) <- val2lin linValue
|
(lf, _) <- val2lin linValue
|
||||||
@@ -102,14 +118,11 @@ mkCanon2lpgf opts gr am = do
|
|||||||
|
|
||||||
C.ErrorValue err -> return (L.Error err, Nothing)
|
C.ErrorValue err -> return (L.Error err, Nothing)
|
||||||
|
|
||||||
-- the expressions built here can be quite large,
|
|
||||||
-- but will be reduced during optimisation if possible
|
|
||||||
C.ParamConstant (C.Param pid lvs) -> do
|
C.ParamConstant (C.Param pid lvs) -> do
|
||||||
let
|
let
|
||||||
collectProjections :: C.LinValue -> Either String [L.LinFun]
|
collectProjections :: C.LinValue -> Either String [L.LinFun]
|
||||||
collectProjections (C.ParamConstant (C.Param pid lvs)) = do
|
collectProjections (C.ParamConstant (C.Param pid lvs)) = do
|
||||||
def <- [ d | d@(C.ParamDef _ ps) <- params, any (\(C.Param p _) -> p == pid) ps ]
|
def <- m2e (printf "Cannot find param definition: %s" (show pid)) (Map.lookup pid paramValueMap)
|
||||||
`headOrLeft` printf "Cannot find param group: %s" (show pid)
|
|
||||||
let (C.ParamDef tpid defpids) = def
|
let (C.ParamDef tpid defpids) = def
|
||||||
pidIx <- eitherElemIndex pid [ p | C.Param p _ <- defpids ]
|
pidIx <- eitherElemIndex pid [ p | C.Param p _ <- defpids ]
|
||||||
rest <- mapM collectProjections lvs
|
rest <- mapM collectProjections lvs
|
||||||
@@ -117,38 +130,31 @@ mkCanon2lpgf opts gr am = do
|
|||||||
collectProjections lv = do
|
collectProjections lv = do
|
||||||
(lf,_) <- val2lin lv
|
(lf,_) <- val2lin lv
|
||||||
return [lf]
|
return [lf]
|
||||||
|
|
||||||
-- 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 _) = def
|
|
||||||
|
|
||||||
-- let tuple = paramTuples !! gix
|
|
||||||
lfs <- collectProjections lv
|
lfs <- collectProjections lv
|
||||||
-- let term = foldl L.Projection tuple lfs
|
let term = L.Tuple lfs
|
||||||
let term = L.Tuple lfs -- unapplied!
|
def <- m2e (printf "Cannot find param definition: %s" (show pid)) (Map.lookup pid paramValueMap)
|
||||||
|
let (C.ParamDef tpid _) = def
|
||||||
return (term, Just $ C.ParamType (C.ParamTypeId tpid))
|
return (term, Just $ C.ParamType (C.ParamTypeId tpid))
|
||||||
|
|
||||||
C.Selection v1 v2 -> do
|
-- C.Selection v1 v2 -> do
|
||||||
(v1', t1) <- val2lin v1
|
-- (v1', t1) <- val2lin v1
|
||||||
(v2', t2) <- val2lin v2
|
-- (v2', t2) <- val2lin v2
|
||||||
-- let Just (C.TableType t11 t12) = t1 -- t11 == t2
|
-- -- let Just (C.TableType t11 t12) = t1 -- t11 == t2
|
||||||
|
--
|
||||||
case t1 of
|
-- case t1 of
|
||||||
Just (C.TableType (C.ParamType (C.ParamTypeId pid)) tret) -> do
|
-- Just (C.TableType (C.ParamType (C.ParamTypeId pid)) tret) -> do
|
||||||
(gix,_) <- [ (gix,d) | (gix,d@(C.ParamDef p _)) <- zip [0..] params, p == pid ]
|
-- (gix,_) <- [ (gix,d) | (gix,d@(C.ParamDef p _)) <- zip [0..] params, p == pid ]
|
||||||
`headOrLeft` printf "Cannot find param group: %s" (show pid)
|
-- `headOrLeft` printf "Cannot find param group: %s" (show pid)
|
||||||
let tuple = paramTuples !! gix
|
-- let tuple = paramTuples !! gix
|
||||||
let v2'' = case v2' of
|
-- let v2'' = case v2' of
|
||||||
L.Tuple lfs -> foldl L.Projection tuple lfs
|
-- L.Tuple lfs -> foldl L.Projection tuple lfs
|
||||||
lf -> L.Projection tuple lf
|
-- lf -> L.Projection tuple lf
|
||||||
return (L.Projection v1' v2'', Just tret)
|
-- return (L.Projection v1' v2'', Just tret)
|
||||||
|
--
|
||||||
Just (C.TableType (C.RecordType rrts) tret) ->
|
-- Just (C.TableType (C.RecordType rrts) tret) ->
|
||||||
return (L.Projection v1' v2', Just tret)
|
-- return (L.Projection v1' v2', Just tret)
|
||||||
|
--
|
||||||
_ -> Left $ printf "Unhandled type in selection: %s" (show t1)
|
-- _ -> Left $ printf "Unhandled type in selection: %s" (show t1)
|
||||||
|
|
||||||
C.PredefValue (C.PredefId pid) -> case pid of
|
C.PredefValue (C.PredefId pid) -> case pid of
|
||||||
"BIND" -> return (L.Bind, Nothing)
|
"BIND" -> return (L.Bind, Nothing)
|
||||||
@@ -217,11 +223,11 @@ mkCanon2lpgf opts gr am = do
|
|||||||
let C.RecordRow _ lt = rrs !! lblIx
|
let C.RecordRow _ lt = rrs !! lblIx
|
||||||
return (L.Projection v1' (L.Ix (lblIx+1)), Just lt)
|
return (L.Projection v1' (L.Ix (lblIx+1)), Just lt)
|
||||||
|
|
||||||
-- C.Selection v1 v2 -> do
|
C.Selection v1 v2 -> do
|
||||||
-- (v1', t1) <- val2lin v1
|
(v1', t1) <- val2lin v1
|
||||||
-- (v2', t2) <- val2lin v2
|
(v2', t2) <- val2lin v2
|
||||||
-- let Just (C.TableType t11 t12) = t1
|
let Just (C.TableType t11 t12) = t1 -- t11 == t2
|
||||||
-- return (L.Projection v1' v2', Just t12)
|
return (L.Projection v1' v2', Just t12)
|
||||||
|
|
||||||
C.CommentedValue cmnt lv -> val2lin lv
|
C.CommentedValue cmnt lv -> val2lin lv
|
||||||
|
|
||||||
@@ -357,10 +363,10 @@ reduce lf = case lf of
|
|||||||
(t',u') -> L.Projection t' u'
|
(t',u') -> L.Projection t' u'
|
||||||
t -> t
|
t -> t
|
||||||
|
|
||||||
-- | If list is non-empty return its head, else a fallback value
|
-- -- | If list is non-empty return its head, else a fallback value
|
||||||
headOrLeft :: [a] -> b -> Either b a
|
-- headOrLeft :: [a] -> b -> Either b a
|
||||||
headOrLeft (a:_) _ = Right a
|
-- headOrLeft (a:_) _ = Right a
|
||||||
headOrLeft _ b = Left b
|
-- headOrLeft _ b = Left b
|
||||||
|
|
||||||
-- | Convert Maybe to Either value with error
|
-- | Convert Maybe to Either value with error
|
||||||
m2e :: String -> Maybe a -> Either String a
|
m2e :: String -> Maybe a -> Either String a
|
||||||
|
|||||||
@@ -102,9 +102,9 @@ data TableRow rhs = TableRow LinPattern rhs
|
|||||||
|
|
||||||
-- *** Identifiers in Concrete Syntax
|
-- *** Identifiers in Concrete Syntax
|
||||||
|
|
||||||
newtype PredefId = PredefId Id deriving (Eq,Ord,Show)
|
newtype PredefId = PredefId Id deriving (Eq,Ord,Show)
|
||||||
newtype LabelId = LabelId Id deriving (Eq,Ord,Show)
|
newtype LabelId = LabelId Id deriving (Eq,Ord,Show)
|
||||||
data VarValueId = VarValueId QualId deriving (Eq,Ord,Show)
|
newtype VarValueId = VarValueId QualId deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
-- | Name of param type or param value
|
-- | Name of param type or param value
|
||||||
newtype ParamId = ParamId QualId deriving (Eq,Ord,Show)
|
newtype ParamId = ParamId QualId deriving (Eq,Ord,Show)
|
||||||
@@ -115,7 +115,7 @@ newtype ParamId = ParamId QualId deriving (Eq,Ord,Show)
|
|||||||
newtype ModId = ModId Id deriving (Eq,Ord,Show)
|
newtype ModId = ModId Id deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
newtype CatId = CatId Id deriving (Eq,Ord,Show)
|
newtype CatId = CatId Id deriving (Eq,Ord,Show)
|
||||||
newtype FunId = FunId Id deriving (Eq,Show)
|
newtype FunId = FunId Id deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data VarId = Anonymous | VarId Id deriving (Eq,Show)
|
data VarId = Anonymous | VarId Id deriving (Eq,Show)
|
||||||
|
|
||||||
|
|||||||
@@ -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 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"
|
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>>
|
||||||
|
|||||||
@@ -38,34 +38,34 @@ walking = LPGF {
|
|||||||
concretes = Map.fromList [
|
concretes = Map.fromList [
|
||||||
(mkCId "WalkingEng", Concr {
|
(mkCId "WalkingEng", Concr {
|
||||||
-- lincats = Map.fromList [
|
-- lincats = Map.fromList [
|
||||||
-- (mkCId "S", LTStr),
|
-- (mkCId "S", StrType),
|
||||||
-- (mkCId "NP", LTProduct [LTStr, LTInt 2]),
|
-- (mkCId "NP", ProductType [StrType, IxType 2]),
|
||||||
-- (mkCId "VP", LTProduct [LTStr, LTStr])
|
-- (mkCId "VP", ProductType [StrType, StrType])
|
||||||
-- ],
|
-- ],
|
||||||
lins = Map.fromList [
|
lins = Map.fromList [
|
||||||
(mkCId "And", mkConcat [LFArgument 1, LFToken "and", LFArgument 2]),
|
(mkCId "And", mkConcat [Argument 1, Token "and", Argument 2]),
|
||||||
-- (mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFArgument 2) (LFProjection (LFArgument 1) (LFInt 2))]),
|
-- (mkCId "Pred", mkConcat [Projection (Argument 1) (Ix 1), Projection (Argument 2) (Projection (Argument 1) (Ix 2))]),
|
||||||
(mkCId "Pred", mkConcat [LFProjection (LFArgument 1) (LFInt 1), LFProjection (LFProjection (LFArgument 2) (LFInt 1)) (LFProjection (LFArgument 1) (LFInt 2))]),
|
(mkCId "Pred", mkConcat [Projection (Argument 1) (Ix 1), Projection (Projection (Argument 2) (Ix 1)) (Projection (Argument 1) (Ix 2))]),
|
||||||
(mkCId "John", LFTuple [LFToken "John", LFInt 1]),
|
(mkCId "John", Tuple [Token "John", Ix 1]),
|
||||||
(mkCId "We", LFTuple [LFToken "we", LFInt 2]),
|
(mkCId "We", Tuple [Token "we", Ix 2]),
|
||||||
-- (mkCId "Walk", LFTuple [LFToken "walks", LFToken "walk"])
|
-- (mkCId "Walk", Tuple [Token "walks", Token "walk"])
|
||||||
(mkCId "Walk", LFTuple [LFTuple [LFToken "walks", LFToken "walk"]])
|
(mkCId "Walk", Tuple [Tuple [Token "walks", Token "walk"]])
|
||||||
]
|
]
|
||||||
}),
|
}),
|
||||||
(mkCId "WalkingGer", Concr {
|
(mkCId "WalkingGer", Concr {
|
||||||
-- lincats = Map.fromList [
|
-- lincats = Map.fromList [
|
||||||
-- (mkCId "S", LTStr),
|
-- (mkCId "S", StrType),
|
||||||
-- (mkCId "NP", LTProduct [LTStr, LTInt 2, LTInt 3]),
|
-- (mkCId "NP", ProductType [StrType, IxType 2, IxType 3]),
|
||||||
-- (mkCId "VP", LTProduct [LTProduct [LTStr, LTStr, LTStr], LTProduct [LTStr, LTStr, LTStr]])
|
-- (mkCId "VP", ProductType [ProductType [StrType, StrType, StrType], ProductType [StrType, StrType, StrType]])
|
||||||
-- ],
|
-- ],
|
||||||
lins = Map.fromList [
|
lins = Map.fromList [
|
||||||
(mkCId "And", mkConcat [LFArgument 1, LFToken "und", LFArgument 2]),
|
(mkCId "And", mkConcat [Argument 1, Token "und", Argument 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 [Projection (Argument 1) (Ix 1), Projection (Projection (Argument 2) (Projection (Argument 1) (Ix 2))) (Projection (Argument 1) (Ix 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 "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", LFTuple [LFToken "John", LFInt 1, LFInt 3]),
|
(mkCId "John", Tuple [Token "John", Ix 1, Ix 3]),
|
||||||
(mkCId "We", LFTuple [LFToken "wir", LFInt 2, LFInt 1]),
|
(mkCId "We", Tuple [Token "wir", Ix 2, Ix 1]),
|
||||||
-- (mkCId "Walk", LFTuple [LFTuple [LFToken "gehe", LFToken "gehst", LFToken "geht"], LFTuple [LFToken "gehen", LFToken "geht", LFToken "gehen"]])
|
-- (mkCId "Walk", Tuple [Tuple [Token "gehe", Token "gehst", Token "geht"], Tuple [Token "gehen", Token "geht", Token "gehen"]])
|
||||||
(mkCId "Walk", LFTuple [LFTuple [LFTuple [LFToken "gehe", LFToken "gehst", LFToken "geht"], LFTuple [LFToken "gehen", LFToken "geht", LFToken "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
|
-- | Helper for building concat trees
|
||||||
mkConcat :: [LinFun] -> LinFun
|
mkConcat :: [LinFun] -> LinFun
|
||||||
mkConcat [] = LFEmpty
|
mkConcat [] = Empty
|
||||||
mkConcat [x] = x
|
mkConcat [x] = x
|
||||||
mkConcat xs = foldl1 LFConcat xs
|
mkConcat xs = foldl1 Concat xs
|
||||||
|
|||||||
Reference in New Issue
Block a user