mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-31 05:38:55 -06:00
some translate.probs decreased ; fine-tuning in pgf-hsbind-trans
This commit is contained in:
@@ -7,6 +7,7 @@ import PGF2
|
|||||||
import PGF.Lexing (lexText')
|
import PGF.Lexing (lexText')
|
||||||
|
|
||||||
import Data.Char(isSpace,toLower)
|
import Data.Char(isSpace,toLower)
|
||||||
|
import Data.List (nub)
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
@@ -33,14 +34,19 @@ getConcr' pgf lang =
|
|||||||
maybe (fail $ "Concrete syntax not found: "++show lang) return $
|
maybe (fail $ "Concrete syntax not found: "++show lang) return $
|
||||||
Map.lookup lang (languages pgf)
|
Map.lookup lang (languages pgf)
|
||||||
|
|
||||||
linearizeAndShow gr mxv (t,p) = [show t]++take mxv (linearizeAll gr t)++[show p]
|
linearizeAndShow gr mxv (t,p) = [show t]++take mxv (nub (map unstar (linearizeAll gr t)))++[show p]
|
||||||
|
where
|
||||||
|
unstar s = case s of
|
||||||
|
'*':' ':cs -> cs
|
||||||
|
_ -> s
|
||||||
|
|
||||||
translates pgf cfrom cto cat (mxt,mxv) s0 =
|
translates pgf cfrom cto cat (mxt,mxv) s0 =
|
||||||
let s = lextext cfrom s0
|
let s1 = lextext cfrom s0
|
||||||
|
(s,p) = case reverse s1 of c:_ | elem c ".?!" -> (init s1,[c]) ; _ -> (s1,[]) -- separate final punctuation
|
||||||
in
|
in
|
||||||
case cparse pgf cfrom cat s of
|
case cparse pgf cfrom cat s of
|
||||||
Left tok -> unlines [s,"Parse error: "++tok]
|
Left tok -> unlines [s,"Parse error: "++tok]
|
||||||
Right ts -> unlines $ take mxt $ map (unlines . linearizeAndShow cto mxv) ts
|
Right ts -> unlines $ (("> "++ s):) $ take mxt $ map ((++p) . unlines . linearizeAndShow cto mxv) ts -- append punctuation
|
||||||
|
|
||||||
cparse pgf concr cat input = parseWithHeuristics concr cat input (-1) callbacks where
|
cparse pgf concr cat input = parseWithHeuristics concr cat input (-1) callbacks where
|
||||||
callbacks = maybe [] cb $ lookup "App" literalCallbacks
|
callbacks = maybe [] cb $ lookup "App" literalCallbacks
|
||||||
|
|||||||
Reference in New Issue
Block a user