mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -06:00
remove the deprecated RP constructor in GFCC
This commit is contained in:
@@ -199,7 +199,6 @@ convertTerm cnc_defs selector (K (KP strs vars))((lbl_path,lin) : lins) =
|
|||||||
do projectHead lbl_path
|
do projectHead lbl_path
|
||||||
toks <- member (strs:[strs' | Var strs' _ <- vars])
|
toks <- member (strs:[strs' | Var strs' _ <- vars])
|
||||||
return ((lbl_path, map Tok toks ++ lin) : lins)
|
return ((lbl_path, map Tok toks ++ lin) : lins)
|
||||||
convertTerm cnc_defs selector (RP _ term) lins = convertTerm cnc_defs selector term lins
|
|
||||||
convertTerm cnc_defs selector (F id) lins = do term <- Map.lookup id cnc_defs
|
convertTerm cnc_defs selector (F id) lins = do term <- Map.lookup id cnc_defs
|
||||||
convertTerm cnc_defs selector term lins
|
convertTerm cnc_defs selector term lins
|
||||||
convertTerm cnc_defs selector (W s t) ((lbl_path,lin) : lins) = do
|
convertTerm cnc_defs selector (W s t) ((lbl_path,lin) : lins) = do
|
||||||
@@ -257,7 +256,6 @@ evalTerm cnc_defs path (R record) = case path of
|
|||||||
evalTerm cnc_defs path (P term sel) = do index <- evalTerm cnc_defs [] sel
|
evalTerm cnc_defs path (P term sel) = do index <- evalTerm cnc_defs [] sel
|
||||||
evalTerm cnc_defs (index:path) term
|
evalTerm cnc_defs (index:path) term
|
||||||
evalTerm cnc_defs path (FV terms) = member terms >>= evalTerm cnc_defs path
|
evalTerm cnc_defs path (FV terms) = member terms >>= evalTerm cnc_defs path
|
||||||
evalTerm cnc_defs path (RP alias _) = evalTerm cnc_defs path alias
|
|
||||||
evalTerm cnc_defs path (F id) = do term <- Map.lookup id cnc_defs
|
evalTerm cnc_defs path (F id) = do term <- Map.lookup id cnc_defs
|
||||||
evalTerm cnc_defs path term
|
evalTerm cnc_defs path term
|
||||||
evalTerm cnc_defs path x = error ("evalTerm ("++show x++")")
|
evalTerm cnc_defs path x = error ("evalTerm ("++show x++")")
|
||||||
@@ -271,14 +269,11 @@ unifyPType nr path (C max_index) =
|
|||||||
Nothing -> do index <- member [0..max_index]
|
Nothing -> do index <- member [0..max_index]
|
||||||
restrictArg nr path index
|
restrictArg nr path index
|
||||||
return index
|
return index
|
||||||
unifyPType nr path (RP alias _) = unifyPType nr path alias
|
|
||||||
|
|
||||||
unifyPType nr path t = error $ "unifyPType " ++ show t ---- AR 2/10/2007
|
unifyPType nr path t = error $ "unifyPType " ++ show t ---- AR 2/10/2007
|
||||||
|
|
||||||
selectTerm :: FPath -> Term -> Term
|
selectTerm :: FPath -> Term -> Term
|
||||||
selectTerm [] term = term
|
selectTerm [] term = term
|
||||||
selectTerm (index:path) (R record) = selectTerm path (record !! index)
|
selectTerm (index:path) (R record) = selectTerm path (record !! index)
|
||||||
selectTerm path (RP _ term) = selectTerm path term
|
|
||||||
|
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
@@ -362,7 +357,6 @@ genFCatArg cnc_defs ctype env@(FRulesEnv last_id fcatSet rules) (PFCat cat rcs t
|
|||||||
gen_tcs :: Term -> FPath -> [(FPath,FIndex)] -> BacktrackM Bool [(FPath,FIndex)]
|
gen_tcs :: Term -> FPath -> [(FPath,FIndex)] -> BacktrackM Bool [(FPath,FIndex)]
|
||||||
gen_tcs (R record) path acc = foldM (\acc (label,ctype) -> gen_tcs ctype (label:path) acc) acc (zip [0..] record)
|
gen_tcs (R record) path acc = foldM (\acc (label,ctype) -> gen_tcs ctype (label:path) acc) acc (zip [0..] record)
|
||||||
gen_tcs (S _) path acc = return acc
|
gen_tcs (S _) path acc = return acc
|
||||||
gen_tcs (RP _ term) path acc = gen_tcs term path acc
|
|
||||||
gen_tcs (C max_index) path acc =
|
gen_tcs (C max_index) path acc =
|
||||||
case List.lookup path tcs of
|
case List.lookup path tcs of
|
||||||
Just index -> return $! addConstraint path index acc
|
Just index -> return $! addConstraint path index acc
|
||||||
@@ -429,7 +423,6 @@ mkSingletonSelectors cnc_defs term = sels0
|
|||||||
(sels0,tcss0) = loop [] ([],[]) term
|
(sels0,tcss0) = loop [] ([],[]) term
|
||||||
|
|
||||||
loop path st (R record) = List.foldl' (\st (index,term) -> loop (index:path) st term) st (zip [0..] record)
|
loop path st (R record) = List.foldl' (\st (index,term) -> loop (index:path) st term) st (zip [0..] record)
|
||||||
loop path st (RP _ t) = loop path st t
|
|
||||||
loop path (sels,tcss) (C i) = ( sels,map ((,) path) [0..i] : tcss)
|
loop path (sels,tcss) (C i) = ( sels,map ((,) path) [0..i] : tcss)
|
||||||
loop path (sels,tcss) (S _) = (mkSelector [path] tcss0 : sels, tcss)
|
loop path (sels,tcss) (S _) = (mkSelector [path] tcss0 : sels, tcss)
|
||||||
loop path (sels,tcss) (F id) = case Map.lookup id cnc_defs of
|
loop path (sels,tcss) (F id) = case Map.lookup id cnc_defs of
|
||||||
|
|||||||
@@ -67,7 +67,6 @@ data Term =
|
|||||||
| FV [Term]
|
| FV [Term]
|
||||||
| W String Term
|
| W String Term
|
||||||
| TM String
|
| TM String
|
||||||
| RP Term Term
|
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data Tokn =
|
data Tokn =
|
||||||
|
|||||||
@@ -69,7 +69,6 @@ term2js n l t = f t
|
|||||||
D.F f -> JS.ECall (JS.EMember (JS.EIndex (JS.EMember (JS.EVar $ JS.Ident n) (JS.Ident "concretes")) (JS.EStr l)) (JS.Ident "rule")) [JS.EStr (prCId f), JS.EVar children]
|
D.F f -> JS.ECall (JS.EMember (JS.EIndex (JS.EMember (JS.EVar $ JS.Ident n) (JS.Ident "concretes")) (JS.EStr l)) (JS.Ident "rule")) [JS.EStr (prCId f), JS.EVar children]
|
||||||
D.FV xs -> new "Variants" (map f xs)
|
D.FV xs -> new "Variants" (map f xs)
|
||||||
D.W str x -> new "Suffix" [JS.EStr str, f x]
|
D.W str x -> new "Suffix" [JS.EStr str, f x]
|
||||||
D.RP x y -> new "Rp" [f x, f y]
|
|
||||||
D.TM _ -> new "Meta" []
|
D.TM _ -> new "Meta" []
|
||||||
|
|
||||||
tokn2js :: D.Tokn -> JS.Expr
|
tokn2js :: D.Tokn -> JS.Expr
|
||||||
|
|||||||
@@ -23,7 +23,6 @@ realize trm = case trm of
|
|||||||
KP s _ -> unwords s ---- prefix choice TODO
|
KP s _ -> unwords s ---- prefix choice TODO
|
||||||
W s t -> s ++ realize t
|
W s t -> s ++ realize t
|
||||||
FV ts -> realize (ts !! 0) ---- other variants TODO
|
FV ts -> realize (ts !! 0) ---- other variants TODO
|
||||||
RP _ r -> realize r ---- DEPREC
|
|
||||||
TM s -> s
|
TM s -> s
|
||||||
_ -> "ERROR " ++ show trm ---- debug
|
_ -> "ERROR " ++ show trm ---- debug
|
||||||
|
|
||||||
@@ -52,7 +51,6 @@ compute :: GFCC -> CId -> [Term] -> Term -> Term
|
|||||||
compute mcfg lang args = comp where
|
compute mcfg lang args = comp where
|
||||||
comp trm = case trm of
|
comp trm = case trm of
|
||||||
P r p -> proj (comp r) (comp p)
|
P r p -> proj (comp r) (comp p)
|
||||||
RP i t -> RP (comp i) (comp t) ---- DEPREC
|
|
||||||
W s t -> W s (comp t)
|
W s t -> W s (comp t)
|
||||||
R ts -> R $ lmap comp ts
|
R ts -> R $ lmap comp ts
|
||||||
V i -> idx args i -- already computed
|
V i -> idx args i -- already computed
|
||||||
@@ -80,13 +78,11 @@ compute mcfg lang args = comp where
|
|||||||
|
|
||||||
getIndex t = case t of
|
getIndex t = case t of
|
||||||
C i -> i
|
C i -> i
|
||||||
RP p _ -> getIndex p ---- DEPREC
|
|
||||||
TM _ -> 0 -- default value for parameter
|
TM _ -> 0 -- default value for parameter
|
||||||
_ -> trace ("ERROR in grammar compiler: index from " ++ show t) 666
|
_ -> trace ("ERROR in grammar compiler: index from " ++ show t) 666
|
||||||
|
|
||||||
getField t i = case t of
|
getField t i = case t of
|
||||||
R rs -> idx rs i
|
R rs -> idx rs i
|
||||||
RP _ r -> getField r i ---- DEPREC
|
|
||||||
TM s -> TM s
|
TM s -> TM s
|
||||||
_ -> error ("ERROR in grammar compiler: field from " ++ show t) t
|
_ -> error ("ERROR in grammar compiler: field from " ++ show t) t
|
||||||
|
|
||||||
|
|||||||
@@ -136,7 +136,6 @@ toTerm e = case e of
|
|||||||
App "S" es -> S (lmap toTerm es)
|
App "S" es -> S (lmap toTerm es)
|
||||||
App "FV" es -> FV (lmap toTerm es)
|
App "FV" es -> FV (lmap toTerm es)
|
||||||
App "P" [e,v] -> P (toTerm e) (toTerm v)
|
App "P" [e,v] -> P (toTerm e) (toTerm v)
|
||||||
App "RP" [e,v] -> RP (toTerm e) (toTerm v) ----
|
|
||||||
App "W" [AStr s,v] -> W s (toTerm v)
|
App "W" [AStr s,v] -> W s (toTerm v)
|
||||||
App "A" [AInt i] -> V (fromInteger i)
|
App "A" [AInt i] -> V (fromInteger i)
|
||||||
App f [] -> F (mkCId f)
|
App f [] -> F (mkCId f)
|
||||||
@@ -203,7 +202,6 @@ fromTerm e = case e of
|
|||||||
S es -> App "S" (lmap fromTerm es)
|
S es -> App "S" (lmap fromTerm es)
|
||||||
FV es -> App "FV" (lmap fromTerm es)
|
FV es -> App "FV" (lmap fromTerm es)
|
||||||
P e v -> App "P" [fromTerm e, fromTerm v]
|
P e v -> App "P" [fromTerm e, fromTerm v]
|
||||||
RP e v -> App "RP" [fromTerm e, fromTerm v] ----
|
|
||||||
W s v -> App "W" [AStr s, fromTerm v]
|
W s v -> App "W" [AStr s, fromTerm v]
|
||||||
C i -> AInt (toInteger i)
|
C i -> AInt (toInteger i)
|
||||||
TM _ -> AMet
|
TM _ -> AMet
|
||||||
|
|||||||
Reference in New Issue
Block a user