mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-27 11:48:55 -06:00
"junk verbs" in DictionaryGer converted to something meaningful (but correctness to be checked)
This commit is contained in:
@@ -26,6 +26,10 @@ isError lang u v = case lang of
|
|||||||
"mkV" | head v == '"' -> notElem (dp 2 (stringOf v)) ["er","ir","re"]
|
"mkV" | head v == '"' -> notElem (dp 2 (stringOf v)) ["er","ir","re"]
|
||||||
"mkV2" | head v == '"' -> notElem (dp 2 (stringOf v)) ["er","ir","re"]
|
"mkV2" | head v == '"' -> notElem (dp 2 (stringOf v)) ["er","ir","re"]
|
||||||
_ -> False
|
_ -> False
|
||||||
|
"Ger" -> case bareOp u of
|
||||||
|
"mkV" | head v == '"' -> notElem (dp 2 (stringOf v)) ["en","rn","ln"]
|
||||||
|
"mkV2" | head v == '"' -> notElem (dp 2 (stringOf v)) ["en","rn","ln"]
|
||||||
|
_ -> False
|
||||||
|
|
||||||
dp :: Int -> String -> String
|
dp :: Int -> String -> String
|
||||||
dp i s = drop (length s - i) s
|
dp i s = drop (length s - i) s
|
||||||
@@ -33,3 +37,5 @@ dp i s = drop (length s - i) s
|
|||||||
stringOf s = takeWhile (/='"') (tail s)
|
stringOf s = takeWhile (/='"') (tail s)
|
||||||
|
|
||||||
bareOp = filter (flip notElem "()")
|
bareOp = filter (flip notElem "()")
|
||||||
|
|
||||||
|
lexs s = case lex s of [(t,cs@(_:_))] -> t:lexs cs ; [(t,[])] -> [t] ; _ -> []
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
@@ -20,7 +20,7 @@ Comments can be added at the merging phase.
|
|||||||
|
|
||||||
Other lines than 'lin' rules are taken from "old". The rules in the resulting grammar are sorted alphabetically.
|
Other lines than 'lin' rules are taken from "old". The rules in the resulting grammar are sorted alphabetically.
|
||||||
|
|
||||||
The boolean argument is set False if you do not want to add new rules to already existing old ones:
|
The Preference argument is set POldOnly if you do not want to add new rules to already existing old ones:
|
||||||
|
|
||||||
lin f = t1 | ... | tm ; -- comment1
|
lin f = t1 | ... | tm ; -- comment1
|
||||||
lin f = u1 | ... | un ; -- comment2
|
lin f = u1 | ... | un ; -- comment2
|
||||||
@@ -31,7 +31,7 @@ where m > 0, results in
|
|||||||
|
|
||||||
Usage:
|
Usage:
|
||||||
|
|
||||||
mergeDict <OldFile> <NewFile> Bool (Maybe separator) <TargetFile>
|
mergeDict <OldFile> <NewFile> (POld|PNew|PMerge) (Maybe separator) <TargetFile>
|
||||||
|
|
||||||
Example:
|
Example:
|
||||||
|
|
||||||
@@ -42,9 +42,10 @@ Example:
|
|||||||
|
|
||||||
import Data.List
|
import Data.List
|
||||||
|
|
||||||
|
data Preference = PNew | POld | PMerge deriving Eq
|
||||||
|
|
||||||
mergeDict :: FilePath -> FilePath -> Bool -> Maybe String -> FilePath -> IO ()
|
mergeDict :: FilePath -> FilePath -> Preference -> Maybe String -> FilePath -> IO ()
|
||||||
mergeDict old new ifAdd comm file = do
|
mergeDict old new pref comm file = do
|
||||||
olds1 <- readFile old >>= return . lines
|
olds1 <- readFile old >>= return . lines
|
||||||
news1 <- readFile new >>= return . lines
|
news1 <- readFile new >>= return . lines
|
||||||
let (preamble,olds2) = break ((== ["lin"]) . take 1 . words) olds1
|
let (preamble,olds2) = break ((== ["lin"]) . take 1 . words) olds1
|
||||||
@@ -52,7 +53,7 @@ mergeDict old new ifAdd comm file = do
|
|||||||
let news = [mkRule 1 (w:ws) | w:ws <- map words news1, w == "lin"]
|
let news = [mkRule 1 (w:ws) | w:ws <- map words news1, w == "lin"]
|
||||||
let lins = sort $ olds ++ news
|
let lins = sort $ olds ++ news
|
||||||
let linss = groupBy (\x y -> (fun x) == (fun y)) lins
|
let linss = groupBy (\x y -> (fun x) == (fun y)) lins
|
||||||
let lins2 = map (mergeRule ifAdd comm) linss
|
let lins2 = map (mergeRule pref comm) linss
|
||||||
writeFile file $ unlines preamble
|
writeFile file $ unlines preamble
|
||||||
appendFile file $ unlines $ map prRule lins2
|
appendFile file $ unlines $ map prRule lins2
|
||||||
appendFile file "}"
|
appendFile file "}"
|
||||||
@@ -67,7 +68,7 @@ mkRule i ws = case ws of
|
|||||||
where
|
where
|
||||||
rule f i (l,c) = R f i l c
|
rule f i (l,c) = R f i l c
|
||||||
getLin ws = case break isComment ws of
|
getLin ws = case break isComment ws of
|
||||||
(ls,cc) -> (getVariants (init ls), cc)
|
(ls,cc) -> (getVariants (initSC ls), cc)
|
||||||
getVariants ws = case break (=="|") ws of
|
getVariants ws = case break (=="|") ws of
|
||||||
(e,vs) | isEmpty e -> getVariants vs
|
(e,vs) | isEmpty e -> getVariants vs
|
||||||
(v,_:vs) -> v : getVariants vs
|
(v,_:vs) -> v : getVariants vs
|
||||||
@@ -76,11 +77,20 @@ mkRule i ws = case ws of
|
|||||||
isEmpty v = elem v [["variants{}"],["variants","{}"],["variants{};"],["variants","{};"]]
|
isEmpty v = elem v [["variants{}"],["variants","{}"],["variants{};"],["variants","{};"]]
|
||||||
isComment = (=="--") . take 2
|
isComment = (=="--") . take 2
|
||||||
|
|
||||||
mergeRule :: Bool -> Maybe String -> [Rule] -> Rule
|
initSC :: [String] -> [String]
|
||||||
mergeRule ifAdd mco rs = case rs of
|
initSC ss =
|
||||||
|
let lss = last ss in
|
||||||
|
case lss of
|
||||||
|
";" -> init ss
|
||||||
|
_ -> if last lss == ';' then init ss ++ [init lss] else ss
|
||||||
|
|
||||||
|
|
||||||
|
mergeRule :: Preference -> Maybe String -> [Rule] -> Rule
|
||||||
|
mergeRule pref mco rs = case rs of
|
||||||
[r] -> r
|
[r] -> r
|
||||||
[old,new]
|
[old,new]
|
||||||
| ifAdd == False && not (null (lins old)) -> old -- old has something: just keep it
|
| pref == POld && not (null (lins old)) -> old -- old has something: just keep it
|
||||||
|
| pref == PNew && not (null (lins new)) -> new -- new has something: just take it
|
||||||
| null (lins old) && null (lins new) -> old -- both are empty: just keep old
|
| null (lins old) && null (lins new) -> old -- both are empty: just keep old
|
||||||
| null (lins old) -> new -- old is empty: just keep new
|
| null (lins old) -> new -- old is empty: just keep new
|
||||||
| otherwise -> case filter (flip notElem (lins old)) (lins new) of
|
| otherwise -> case filter (flip notElem (lins old)) (lins new) of
|
||||||
|
|||||||
Reference in New Issue
Block a user