mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -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
|
||||
toks <- member (strs:[strs' | Var strs' _ <- vars])
|
||||
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 term lins
|
||||
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 (index:path) term
|
||||
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 term
|
||||
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]
|
||||
restrictArg nr path index
|
||||
return index
|
||||
unifyPType nr path (RP alias _) = unifyPType nr path alias
|
||||
|
||||
unifyPType nr path t = error $ "unifyPType " ++ show t ---- AR 2/10/2007
|
||||
|
||||
selectTerm :: FPath -> Term -> Term
|
||||
selectTerm [] term = term
|
||||
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 (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 (RP _ term) path acc = gen_tcs term path acc
|
||||
gen_tcs (C max_index) path acc =
|
||||
case List.lookup path tcs of
|
||||
Just index -> return $! addConstraint path index acc
|
||||
@@ -429,7 +423,6 @@ mkSingletonSelectors cnc_defs term = sels0
|
||||
(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 (RP _ t) = loop path st t
|
||||
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) (F id) = case Map.lookup id cnc_defs of
|
||||
|
||||
@@ -67,7 +67,6 @@ data Term =
|
||||
| FV [Term]
|
||||
| W String Term
|
||||
| TM String
|
||||
| RP Term Term
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
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.FV xs -> new "Variants" (map f xs)
|
||||
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" []
|
||||
|
||||
tokn2js :: D.Tokn -> JS.Expr
|
||||
|
||||
@@ -23,7 +23,6 @@ realize trm = case trm of
|
||||
KP s _ -> unwords s ---- prefix choice TODO
|
||||
W s t -> s ++ realize t
|
||||
FV ts -> realize (ts !! 0) ---- other variants TODO
|
||||
RP _ r -> realize r ---- DEPREC
|
||||
TM s -> s
|
||||
_ -> "ERROR " ++ show trm ---- debug
|
||||
|
||||
@@ -52,7 +51,6 @@ compute :: GFCC -> CId -> [Term] -> Term -> Term
|
||||
compute mcfg lang args = comp where
|
||||
comp trm = case trm of
|
||||
P r p -> proj (comp r) (comp p)
|
||||
RP i t -> RP (comp i) (comp t) ---- DEPREC
|
||||
W s t -> W s (comp t)
|
||||
R ts -> R $ lmap comp ts
|
||||
V i -> idx args i -- already computed
|
||||
@@ -80,13 +78,11 @@ compute mcfg lang args = comp where
|
||||
|
||||
getIndex t = case t of
|
||||
C i -> i
|
||||
RP p _ -> getIndex p ---- DEPREC
|
||||
TM _ -> 0 -- default value for parameter
|
||||
_ -> trace ("ERROR in grammar compiler: index from " ++ show t) 666
|
||||
|
||||
getField t i = case t of
|
||||
R rs -> idx rs i
|
||||
RP _ r -> getField r i ---- DEPREC
|
||||
TM s -> TM s
|
||||
_ -> 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 "FV" es -> FV (lmap toTerm es)
|
||||
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 "A" [AInt i] -> V (fromInteger i)
|
||||
App f [] -> F (mkCId f)
|
||||
@@ -203,7 +202,6 @@ fromTerm e = case e of
|
||||
S es -> App "S" (lmap fromTerm es)
|
||||
FV es -> App "FV" (lmap fromTerm es)
|
||||
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]
|
||||
C i -> AInt (toInteger i)
|
||||
TM _ -> AMet
|
||||
|
||||
Reference in New Issue
Block a user