PGF service: apply the token binding operator &+ to all linearizations

The &+ operator is now consistently eliminated from the output of commmands
that produce linearizations. Before, only the commands translate and
translategroup did this.
This commit is contained in:
hallgren
2013-04-24 18:32:53 +00:00
parent 322968fb5c
commit 74ea0c9cf4

View File

@@ -218,12 +218,12 @@ doTranslateGroup pgf input mcat mfrom tos mlimit =
[makeObj ["from".=langOnly (PGF.showLanguage from), [makeObj ["from".=langOnly (PGF.showLanguage from),
"to".=langOnly (PGF.showLanguage to), "to".=langOnly (PGF.showLanguage to),
"linearizations".= "linearizations".=
[toJSObject (("text", doText (doBind alt)) : disamb lg from ts) [toJSObject (("text", doText alt) : disamb lg from ts)
| (ts,alt) <- output, let lg = length output] | (ts,alt) <- output, let lg = length output]
] ]
| |
(from,po,bs) <- parse' pgf input mcat mfrom, (from,po,bs) <- parse' pgf input mcat mfrom,
(to,output) <- groupResults [(t, linearize' pgf tos t) | t <- case po of {PGF.ParseOk ts -> maybe id take mlimit ts; _ -> []}] (to,output) <- groupResults [(t, linearizeAndBind pgf tos t) | t <- case po of {PGF.ParseOk ts -> maybe id take mlimit ts; _ -> []}]
] ]
where where
groupResults = Map.toList . foldr more Map.empty . start . collect groupResults = Map.toList . foldr more Map.empty . start . collect
@@ -237,21 +237,16 @@ doTranslateGroup pgf input mcat mfrom tos mlimit =
else (ts,y) : insertAlt t x xs2 else (ts,y) : insertAlt t x xs2
_ -> [([t],x)] _ -> [([t],x)]
doBind = unwords . bind . words
doText s = case s of doText s = case s of
c:cs | elem (last s) ".?!" -> toUpper c : init (init cs) ++ [last s] c:cs | elem (last s) ".?!" -> toUpper c : init (init cs) ++ [last s]
_ -> s _ -> s
bind ws = case ws of
w : "&+" : u : ws2 -> bind ((w ++ u) : ws2)
"&+":ws2 -> bind ws2
w : ws2 -> w : bind ws2
_ -> ws
langOnly = reverse . take 3 . reverse langOnly = reverse . take 3 . reverse
disamb lg from ts = disamb lg from ts =
if lg < 2 if lg < 2
then [] then []
else [("tree", "-- " ++ groupDisambs [doText (doBind (disambLang from t)) | t <- ts])] else [("tree", "-- " ++ groupDisambs [doText (disambLang from t) | t <- ts])]
groupDisambs = unwords . intersperse "/" groupDisambs = unwords . intersperse "/"
@@ -292,12 +287,18 @@ doComplete pgf input mcat mfrom mlimit = showJSON
doLinearize :: PGF -> PGF.Tree -> [PGF.Language] -> JSValue doLinearize :: PGF -> PGF.Tree -> [PGF.Language] -> JSValue
doLinearize pgf tree tos = showJSON doLinearize pgf tree tos = showJSON
[makeObj ["to".=to, "text".=text,"brackets".=bs] [makeObj ["to".=to, "text".=text,"brackets".=bs]
| (to,text,bs) <- linearize' pgf tos tree] | (to,text,bs) <- linearizeAndBind pgf tos tree]
doLinearizes :: PGF -> PGF.Tree -> [PGF.Language] -> JSValue doLinearizes :: PGF -> PGF.Tree -> [PGF.Language] -> JSValue
doLinearizes pgf tree tos = showJSON doLinearizes pgf tree tos = showJSON
[makeObj ["to".=to, "texts".=texts] [makeObj ["to".=to, "texts".=map doBind texts]
| (to,texts) <- linearizes' pgf tos tree] | (to,texts) <- linearizes' pgf tos tree]
where
linearizes' pgf tos tree =
[(to,lins to (transfer to tree)) | to <- langs]
where
langs = if null tos then PGF.languages pgf else tos
lins to = nub . concatMap (map snd) . PGF.tabularLinearizes pgf to
doLinearizeTabular :: PGF -> PGF.Tree -> [PGF.Language] -> JSValue doLinearizeTabular :: PGF -> PGF.Tree -> [PGF.Language] -> JSValue
doLinearizeTabular pgf tree tos = showJSON doLinearizeTabular pgf tree tos = showJSON
@@ -322,7 +323,7 @@ doGenerate pgf mcat mdepth mlimit tos =
showJSON [makeObj ["tree".=PGF.showExpr [] tree, showJSON [makeObj ["tree".=PGF.showExpr [] tree,
"linearizations".= "linearizations".=
[makeObj ["to".=to, "text".=text] [makeObj ["to".=to, "text".=text]
| (to,text,bs) <- linearize' pgf tos tree]] | (to,text,bs) <- linearizeAndBind pgf tos tree]]
| tree <- limit trees] | tree <- limit trees]
where where
trees = PGF.generateAllDepth pgf cat (Just depth) trees = PGF.generateAllDepth pgf cat (Just depth)
@@ -567,26 +568,10 @@ complete' pgf from typ mlimit input =
Left es -> (ps,w:ws) Left es -> (ps,w:ws)
Right ps -> loop ps ws Right ps -> loop ps ws
linearize' :: PGF -> [PGF.Language] -> PGF.Tree -> [(PGF.Language,String,PGF.BracketedString)]
linearize' pgf to tree =
[(to,s,bs) | to<-langs,
let bs = PGF.bracketedLinearize pgf to (transfer to tree)
s = unwords $ PGF.flattenBracketedString bs]
where
langs = if null to then PGF.languages pgf else to
transfer lang = if "LaTeX" `isSuffixOf` show lang transfer lang = if "LaTeX" `isSuffixOf` show lang
then fold -- OpenMath LaTeX transfer then fold -- OpenMath LaTeX transfer
else id else id
-- | list all variants and their forms
linearizes' :: PGF -> [PGF.Language] -> PGF.Tree -> [(PGF.Language,[String])]
linearizes' pgf tos tree =
[(to,lins to (transfer to tree)) | to <- langs]
where
langs = if null tos then PGF.languages pgf else tos
lins to = nub . concatMap (map snd) . PGF.tabularLinearizes pgf to
-- | tabulate all variants and their forms -- | tabulate all variants and their forms
linearizeTabular linearizeTabular
:: PGF -> [PGF.Language] -> PGF.Tree -> [(PGF.Language,[(String,[String])])] :: PGF -> [PGF.Language] -> PGF.Tree -> [(PGF.Language,[(String,[String])])]
@@ -594,19 +579,24 @@ linearizeTabular pgf tos tree =
[(to,lintab to (transfer to tree)) | to <- langs] [(to,lintab to (transfer to tree)) | to <- langs]
where where
langs = if null tos then PGF.languages pgf else tos langs = if null tos then PGF.languages pgf else tos
lintab to t = [(p,nub [t|(p',t)<-vs,p'==p])|p<-ps] lintab to t = [(p,map doBind (nub [t|(p',t)<-vs,p'==p]))|p<-ps]
where where
ps = nub (map fst vs) ps = nub (map fst vs)
vs = concat (PGF.tabularLinearizes pgf to t) vs = concat (PGF.tabularLinearizes pgf to t)
linearizeAndBind pgf mto t = linearizeAndBind pgf mto tree =
[(la, binds s,bs) | (la,s,bs) <- linearize' pgf mto t] [(to,s,bs) | to<-langs,
let bs = PGF.bracketedLinearize pgf to (transfer to tree)
s = unwords . bind $ PGF.flattenBracketedString bs]
where where
binds = unwords . bs . words langs = if null mto then PGF.languages pgf else mto
bs ws = case ws of
u:"&+":v:ws2 -> bs ((u ++ v):ws2) doBind = unwords . bind . words
u:ws2 -> u : bs ws2 bind ws = case ws of
_ -> [] w : "&+" : u : ws2 -> bind ((w ++ u) : ws2)
"&+":ws2 -> bind ws2
w : ws2 -> w : bind ws2
_ -> ws
selectLanguage :: PGF -> Maybe (Accept Language) -> PGF.Language selectLanguage :: PGF -> Maybe (Accept Language) -> PGF.Language
selectLanguage pgf macc = case acceptable of selectLanguage pgf macc = case acceptable of