forked from GitHub/gf-core
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 (C u v) = strings u ++ strings v
|
||||||
strings (Strs ss) = concatMap strings ss
|
strings (Strs ss) = concatMap strings ss
|
||||||
strings (EPatt p) = getPatts p
|
strings (EPatt p) = getPatts p
|
||||||
strings Empty = [] -- ??
|
strings Empty = [""]
|
||||||
strings t = bug $ "strings "++show t
|
strings t = bug $ "strings "++show t
|
||||||
|
|
||||||
getPatts p =
|
getPatts p =
|
||||||
|
|||||||
@@ -47,7 +47,7 @@ data Forest
|
|||||||
--------------------------------------------------------------------
|
--------------------------------------------------------------------
|
||||||
|
|
||||||
linearizeWithBrackets :: Maybe Int -> Forest -> BracketedString
|
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
|
-- 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
|
-- | Linearizes given expression as string in the language
|
||||||
linearize :: PGF -> Language -> Tree -> String
|
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 same as 'linearizeAllLang' but does not return
|
||||||
-- the language.
|
-- 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
|
-- | Linearizes given expression as a bracketed string in the language
|
||||||
bracketedLinearize :: PGF -> Language -> Tree -> BracketedString
|
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
|
where
|
||||||
-- head [] = error "cannot linearize"
|
-- head [] = error "cannot linearize"
|
||||||
head [] = Leaf ""
|
head [] = Leaf ""
|
||||||
@@ -53,7 +53,7 @@ firstLin (_,arr)
|
|||||||
tabularLinearizes :: PGF -> Language -> Expr -> [[(String,String)]]
|
tabularLinearizes :: PGF -> Language -> Expr -> [[(String,String)]]
|
||||||
tabularLinearizes pgf lang e = map cnv (linTree pgf lang e)
|
tabularLinearizes pgf lang e = map cnv (linTree pgf lang e)
|
||||||
where
|
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
|
lbls cat = case Map.lookup cat (cnccats (lookConcr pgf lang)) of
|
||||||
Just (CncCat _ _ lbls) -> elems lbls
|
Just (CncCat _ _ lbls) -> elems lbls
|
||||||
|
|||||||
@@ -177,19 +177,24 @@ lengthBracketedString :: BracketedString -> Int
|
|||||||
lengthBracketedString (Leaf _) = 1
|
lengthBracketedString (Leaf _) = 1
|
||||||
lengthBracketedString (Bracket _ _ _ _ _ bss) = sum (map lengthBracketedString bss)
|
lengthBracketedString (Bracket _ _ _ _ _ bss) = sum (map lengthBracketedString bss)
|
||||||
|
|
||||||
untokn :: String -> BracketedTokn -> (String,[BracketedString])
|
untokn :: Maybe String -> BracketedTokn -> (Maybe String,[BracketedString])
|
||||||
untokn nw (LeafKS ts) = (head ts,map Leaf ts)
|
untokn nw (LeafKS ts) = (has_tok nw (head ts),map Leaf ts)
|
||||||
untokn nw (LeafKP d vs) = let ts = sel d vs nw
|
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
|
where
|
||||||
sel d vs nw =
|
sel d vs Nothing = d
|
||||||
case [v | Alt v cs <- vs, any (\c -> isPrefixOf c nw) cs] of
|
sel d vs (Just w) =
|
||||||
|
case [v | Alt v cs <- vs, any (\c -> isPrefixOf c w) cs] of
|
||||||
v:_ -> v
|
v:_ -> v
|
||||||
_ -> d
|
_ -> d
|
||||||
untokn nw (Bracket_ cat fid index fun es bss) =
|
untokn nw (Bracket_ cat fid index fun es bss) =
|
||||||
let (nw',bss') = mapAccumR untokn nw bss
|
let (nw',bss') = mapAccumR untokn nw bss
|
||||||
in (nw',[Bracket cat fid index fun es (concat 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
|
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
|
mkLinTable :: Concr -> (CncType -> Bool) -> [CId] -> FunId -> [(CncType,CId,[Expr],LinTable)] -> LinTable
|
||||||
|
|||||||
Reference in New Issue
Block a user