mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
fix in the GF compiler and runtime which let us to define pre construct detecting whether this is the last token.
This commit is contained in:
@@ -379,7 +379,7 @@ convertTerm opts sel ctype (Alts s alts)
|
||||
strings (C u v) = strings u ++ strings v
|
||||
strings (Strs ss) = concatMap strings ss
|
||||
strings (EPatt p) = getPatts p
|
||||
strings Empty = [] -- ??
|
||||
strings Empty = [""]
|
||||
strings t = bug $ "strings "++show t
|
||||
|
||||
getPatts p =
|
||||
|
||||
@@ -47,7 +47,7 @@ data Forest
|
||||
--------------------------------------------------------------------
|
||||
|
||||
linearizeWithBrackets :: Maybe Int -> Forest -> BracketedString
|
||||
linearizeWithBrackets dp = head . snd . untokn "" . bracketedTokn dp
|
||||
linearizeWithBrackets dp = head . snd . untokn Nothing . bracketedTokn dp
|
||||
|
||||
---------------------------------------------------------------
|
||||
-- Internally we have to do everything with Tokn first because
|
||||
|
||||
@@ -23,7 +23,7 @@ import qualified Data.Set as Set
|
||||
|
||||
-- | Linearizes given expression as string in the language
|
||||
linearize :: PGF -> Language -> Tree -> String
|
||||
linearize pgf lang = concat . take 1 . map (unwords . concatMap flattenBracketedString . snd . untokn "" . firstLin) . linTree pgf lang
|
||||
linearize pgf lang = concat . take 1 . map (unwords . concatMap flattenBracketedString . snd . untokn Nothing . firstLin) . linTree pgf lang
|
||||
|
||||
-- | The same as 'linearizeAllLang' but does not return
|
||||
-- the language.
|
||||
@@ -37,7 +37,7 @@ linearizeAllLang pgf t = [(lang,linearize pgf lang t) | lang <- Map.keys (concre
|
||||
|
||||
-- | Linearizes given expression as a bracketed string in the language
|
||||
bracketedLinearize :: PGF -> Language -> Tree -> BracketedString
|
||||
bracketedLinearize pgf lang = head . concat . map (snd . untokn "" . firstLin) . linTree pgf lang
|
||||
bracketedLinearize pgf lang = head . concat . map (snd . untokn Nothing . firstLin) . linTree pgf lang
|
||||
where
|
||||
-- head [] = error "cannot linearize"
|
||||
head [] = Leaf ""
|
||||
@@ -53,7 +53,7 @@ firstLin (_,arr)
|
||||
tabularLinearizes :: PGF -> Language -> Expr -> [[(String,String)]]
|
||||
tabularLinearizes pgf lang e = map cnv (linTree pgf lang e)
|
||||
where
|
||||
cnv ((cat,_),lin) = zip (lbls cat) $ map (unwords . concatMap flattenBracketedString . snd . untokn "") (elems lin)
|
||||
cnv ((cat,_),lin) = zip (lbls cat) $ map (unwords . concatMap flattenBracketedString . snd . untokn Nothing) (elems lin)
|
||||
|
||||
lbls cat = case Map.lookup cat (cnccats (lookConcr pgf lang)) of
|
||||
Just (CncCat _ _ lbls) -> elems lbls
|
||||
|
||||
@@ -177,19 +177,24 @@ lengthBracketedString :: BracketedString -> Int
|
||||
lengthBracketedString (Leaf _) = 1
|
||||
lengthBracketedString (Bracket _ _ _ _ _ bss) = sum (map lengthBracketedString bss)
|
||||
|
||||
untokn :: String -> BracketedTokn -> (String,[BracketedString])
|
||||
untokn nw (LeafKS ts) = (head ts,map Leaf ts)
|
||||
untokn :: Maybe String -> BracketedTokn -> (Maybe String,[BracketedString])
|
||||
untokn nw (LeafKS ts) = (has_tok nw (head ts),map Leaf ts)
|
||||
untokn nw (LeafKP d vs) = let ts = sel d vs nw
|
||||
in (head ts,map Leaf ts)
|
||||
in (has_tok nw (head ts),map Leaf ts)
|
||||
where
|
||||
sel d vs nw =
|
||||
case [v | Alt v cs <- vs, any (\c -> isPrefixOf c nw) cs] of
|
||||
sel d vs Nothing = d
|
||||
sel d vs (Just w) =
|
||||
case [v | Alt v cs <- vs, any (\c -> isPrefixOf c w) cs] of
|
||||
v:_ -> v
|
||||
_ -> d
|
||||
untokn nw (Bracket_ cat fid index fun es bss) =
|
||||
let (nw',bss') = mapAccumR untokn nw bss
|
||||
in (nw',[Bracket cat fid index fun es (concat bss')])
|
||||
|
||||
has_tok nw t
|
||||
| null t = nw
|
||||
| otherwise = Just t
|
||||
|
||||
type CncType = (CId, FId) -- concrete type is the abstract type (the category) + the forest id
|
||||
|
||||
mkLinTable :: Concr -> (CncType -> Bool) -> [CId] -> FunId -> [(CncType,CId,[Expr],LinTable)] -> LinTable
|
||||
|
||||
Reference in New Issue
Block a user