GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 19:42:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

simplify FSymbol type

Browse Source
This commit is contained in:
krasimir
2008-05-29 11:43:28 +00:00
parent ce03503702
commit 687173736c
6 changed files with 31 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src-3.0/GF/Compile/GenerateFCFG.hs
View File

@@ -163,7 +163,7 @@ translateLin idxArgs lbl' ((lbl,syms) : lins)
instSym = either (\(lbl, nr, xnr) -> instCat lbl nr xnr 0 idxArgs) FSymTok instSym = either (\(lbl, nr, xnr) -> instCat lbl nr xnr 0 idxArgs) FSymTok
instCat lbl nr xnr nr' ((idx,xargs):idxArgs) instCat lbl nr xnr nr' ((idx,xargs):idxArgs)
| nr == idx = let (fcat, PFCat _ rcs _) = xargs !! xnr | nr == idx = let (fcat, PFCat _ rcs _) = xargs !! xnr
in FSymCat fcat (index lbl rcs 0) (nr'+xnr) in FSymCat (index lbl rcs 0) (nr'+xnr)
| otherwise = instCat lbl nr xnr (nr'+length xargs) idxArgs | otherwise = instCat lbl nr xnr (nr'+length xargs) idxArgs
index lbl' (lbl:lbls) idx index lbl' (lbl:lbls) idx
@@ -337,7 +337,7 @@ genFCatArg cnc_defs ctype env@(FRulesEnv last_id fcatSet rules) (PFCat cat rcs t
= foldBM (\tcs st (either_fcat,last_id,tmap,rules) -> = foldBM (\tcs st (either_fcat,last_id,tmap,rules) ->
let (last_id1,tmap1,fcat_arg) = addArg tcs last_id tmap let (last_id1,tmap1,fcat_arg) = addArg tcs last_id tmap
rule = FRule wildCId [[0]] [fcat_arg] fcat rule = FRule wildCId [[0]] [fcat_arg] fcat
(listArray (0,length rcs-1) [listArray (0,0) [FSymCat fcat_arg lbl 0] | lbl <- [0..length rcs-1]]) (listArray (0,length rcs-1) [listArray (0,0) [FSymCat lbl 0] | lbl <- [0..length rcs-1]])
in if st in if st
then (Right fcat, last_id1,tmap1,rule:rules) then (Right fcat, last_id1,tmap1,rule:rules)
else (either_fcat,last_id, tmap, rules)) else (either_fcat,last_id, tmap, rules))

4
src-3.0/GF/Formalism/FCFG.hs
View File

@@ -59,7 +59,7 @@ fcatVar = (-4)
-- Symbol -- Symbol
type FIndex = Int type FIndex = Int
data FSymbol data FSymbol
= FSymCat {-# UNPACK #-} !FCat {-# UNPACK #-} !FIndex {-# UNPACK #-} !Int = FSymCat {-# UNPACK #-} !FIndex {-# UNPACK #-} !Int
| FSymTok FToken | FSymTok FToken
@@ -78,7 +78,7 @@ instance Print CId where
prt = prCId prt = prCId
instance Print FSymbol where instance Print FSymbol where
prt (FSymCat c l n) = "($" ++ prt n ++ "!" ++ prt l ++ ")" prt (FSymCat l n) = "($" ++ prt n ++ "!" ++ prt l ++ ")"
prt (FSymTok t) = simpleShow (prt t) prt (FSymTok t) = simpleShow (prt t)
where simpleShow str = "\"" ++ concatMap mkEsc str ++ "\"" where simpleShow str = "\"" ++ concatMap mkEsc str ++ "\""
mkEsc '\\' = "\\\\" mkEsc '\\' = "\\\\"

2
src-3.0/GF/GFCC/GFCCtoJS.hs
View File

@@ -113,7 +113,7 @@ lins2js :: Array FIndex (Array FPointPos FSymbol) -> JS.Expr
lins2js ls = JS.EArray [ JS.EArray [ sym2js s | s <- Array.elems l] | l <- Array.elems ls] lins2js ls = JS.EArray [ JS.EArray [ sym2js s | s <- Array.elems l] | l <- Array.elems ls]
sym2js :: FSymbol -> JS.Expr sym2js :: FSymbol -> JS.Expr
sym2js (FSymCat _ l n) = new "ArgProj" [JS.EInt n, JS.EInt l] sym2js (FSymCat l n) = new "ArgProj" [JS.EInt n, JS.EInt l]
sym2js (FSymTok t) = new "Terminal" [JS.EStr t] sym2js (FSymTok t) = new "Terminal" [JS.EStr t]
new :: String -> [JS.Expr] -> JS.Expr new :: String -> [JS.Expr] -> JS.Expr

5
src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
View File

@@ -5,7 +5,6 @@ import GF.GFCC.DataGFCC
import GF.GFCC.Raw.AbsGFCCRaw import GF.GFCC.Raw.AbsGFCCRaw
import GF.Infra.PrintClass import GF.Infra.PrintClass
import GF.Data.Assoc
import GF.Formalism.FCFG import GF.Formalism.FCFG
import GF.Formalism.Utilities import GF.Formalism.Utilities
import GF.Parsing.FCFG.PInfo (FCFPInfo(..), buildFCFPInfo) import GF.Parsing.FCFG.PInfo (FCFPInfo(..), buildFCFPInfo)
@@ -95,7 +94,7 @@ toFName (App f ts) = (mkCId f, lmap toProfile ts)
toProfile (App "_U" ts) = [expToInt t | App "_A" [t] <- ts] toProfile (App "_U" ts) = [expToInt t | App "_A" [t] <- ts]
toSymbol :: RExp -> FSymbol toSymbol :: RExp -> FSymbol
toSymbol (App "P" [c,n,l]) = FSymCat (expToInt c) (expToInt l) (expToInt n) toSymbol (App "P" [n,l]) = FSymCat (expToInt l) (expToInt n)
toSymbol (AStr t) = FSymTok t toSymbol (AStr t) = FSymTok t
toType :: RExp -> Type toType :: RExp -> Type
@@ -231,7 +230,7 @@ fromFName (f,ps) | f == wildCId = fromProfile (head ps)
daughter n = App "_A" [intToExp n] daughter n = App "_A" [intToExp n]
fromSymbol :: FSymbol -> RExp fromSymbol :: FSymbol -> RExp
fromSymbol (FSymCat c l n) = App "P" [intToExp c, intToExp n, intToExp l] fromSymbol (FSymCat l n) = App "P" [intToExp n, intToExp l]
fromSymbol (FSymTok t) = AStr t fromSymbol (FSymTok t) = AStr t
-- ** Utilities -- ** Utilities

27
src-3.0/GF/Parsing/FCFG/Active.hs
View File

@@ -54,7 +54,8 @@ process strategy pinfo toks ((c,item):items) chart = process strategy pinfo toks
univRule cat item@(Active found rng lbl ppos node@(SNode ruleid recs)) chart univRule cat item@(Active found rng lbl ppos node@(SNode ruleid recs)) chart
| inRange (bounds lin) ppos = | inRange (bounds lin) ppos =
case lin ! ppos of case lin ! ppos of
FSymCat c r d -> case recs !! d of FSymCat r d -> let c = args !! d
in case recs !! d of
[] -> case insertXChart chart item c of [] -> case insertXChart chart item c of
Nothing -> chart Nothing -> chart
Just chart -> let items = do item@(Final found' _) <- lookupXChartFinal chart c Just chart -> let items = do item@(Final found' _) <- lookupXChartFinal chart c
@@ -68,31 +69,31 @@ process strategy pinfo toks ((c,item):items) chart = process strategy pinfo toks
found' -> let items = do rng <- concatRange rng (found' !! r) found' -> let items = do rng <- concatRange rng (found' !! r)
return (c, Active found rng lbl (ppos+1) node) return (c, Active found rng lbl (ppos+1) node)
in process strategy pinfo toks items chart in process strategy pinfo toks items chart
FSymTok tok -> let items = do t_rng <- inputToken toks ? tok FSymTok tok -> let items = do t_rng <- inputToken toks ? tok
rng' <- concatRange rng t_rng rng' <- concatRange rng t_rng
return (cat, Active found rng' lbl (ppos+1) node) return (cat, Active found rng' lbl (ppos+1) node)
in process strategy pinfo toks items chart in process strategy pinfo toks items chart
| otherwise = | otherwise =
if inRange (bounds lins) (lbl+1) if inRange (bounds lins) (lbl+1)
then univRule cat (Active (rng:found) EmptyRange (lbl+1) 0 node) chart then univRule cat (Active (rng:found) EmptyRange (lbl+1) 0 node) chart
else univRule cat (Final (reverse (rng:found)) node) chart else univRule cat (Final (reverse (rng:found)) node) chart
where where
(FRule _ _ _ cat lins) = allRules pinfo ! ruleid (FRule _ _ args cat lins) = allRules pinfo ! ruleid
lin = lins ! lbl lin = lins ! lbl
univRule cat item@(Final found' node) chart = univRule cat item@(Final found' node) chart =
case insertXChart chart item cat of case insertXChart chart item cat of
Nothing -> chart Nothing -> chart
Just chart -> let items = do (Active found rng l ppos node@(SNode ruleid _)) <- lookupXChartAct chart cat Just chart -> let items = do (Active found rng l ppos node@(SNode ruleid _)) <- lookupXChartAct chart cat
let FRule _ _ _ _ lins = allRules pinfo ! ruleid let FRule _ _ args _ lins = allRules pinfo ! ruleid
FSymCat cat r d = lins ! l ! ppos FSymCat r d = lins ! l ! ppos
rng <- concatRange rng (found' !! r) rng <- concatRange rng (found' !! r)
return (cat, Active found rng l (ppos+1) (updateChildren node d found')) return (args !! d, Active found rng l (ppos+1) (updateChildren node d found'))
++ ++
do guard (isBU strategy) do guard (isBU strategy)
ruleid <- leftcornerCats pinfo ? cat ruleid <- leftcornerCats pinfo ? cat
let FRule _ _ _ _ lins = allRules pinfo ! ruleid let FRule _ _ args _ lins = allRules pinfo ! ruleid
FSymCat cat r d = lins ! 0 ! 0 FSymCat r d = lins ! 0 ! 0
return (cat, Active [] (found' !! r) 0 1 (updateChildren (emptyChildren ruleid pinfo) d found')) return (args !! d, Active [] (found' !! r) 0 1 (updateChildren (emptyChildren ruleid pinfo) d found'))
updateChildren :: SyntaxNode RuleId RangeRec -> Int -> RangeRec -> SyntaxNode RuleId RangeRec updateChildren :: SyntaxNode RuleId RangeRec -> Int -> RangeRec -> SyntaxNode RuleId RangeRec
updateChildren (SNode ruleid recs) i rec = SNode ruleid $! updateNth (const rec) i recs updateChildren (SNode ruleid recs) i rec = SNode ruleid $! updateNth (const rec) i recs

24
src-3.0/GF/Parsing/FCFG/PInfo.hs
View File

@@ -55,19 +55,19 @@ data FCFPInfo
} }
getLeftCornerTok lins getLeftCornerTok (FRule _ _ _ _ lins)
| inRange (bounds syms) 0 = case syms ! 0 of | inRange (bounds syms) 0 = case syms ! 0 of
FSymTok tok -> Just tok FSymTok tok -> [tok]
_ -> Nothing _ -> []
| otherwise = Nothing | otherwise = []
where where
syms = lins ! 0 syms = lins ! 0
getLeftCornerCat lins getLeftCornerCat (FRule _ _ args _ lins)
| inRange (bounds syms) 0 = case syms ! 0 of | inRange (bounds syms) 0 = case syms ! 0 of
FSymCat c _ _ -> Just c FSymCat _ d -> [args !! d]
_ -> Nothing _ -> []
| otherwise = Nothing | otherwise = []
where where
syms = lins ! 0 syms = lins ! 0
@@ -88,12 +88,8 @@ buildFCFPInfo (grammar,startup) = -- trace (unlines [prt (x,Set.toList set) | (x
topdownrules = accumAssoc id [(cat, ruleid) | (ruleid, FRule _ _ _ cat _) <- assocs allrules] topdownrules = accumAssoc id [(cat, ruleid) | (ruleid, FRule _ _ _ cat _) <- assocs allrules]
epsilonrules = [ ruleid | (ruleid, FRule _ _ _ _ lins) <- assocs allrules, epsilonrules = [ ruleid | (ruleid, FRule _ _ _ _ lins) <- assocs allrules,
not (inRange (bounds (lins ! 0)) 0) ] not (inRange (bounds (lins ! 0)) 0) ]
leftcorncats = accumAssoc id leftcorncats = accumAssoc id [ (cat, ruleid) | (ruleid, rule) <- assocs allrules, cat <- getLeftCornerCat rule ]
[ (fromJust (getLeftCornerCat lins), ruleid) | leftcorntoks = accumAssoc id [ (tok, ruleid) | (ruleid, rule) <- assocs allrules, tok <- getLeftCornerTok rule ]
(ruleid, FRule _ _ _ _ lins) <- assocs allrules, isJust (getLeftCornerCat lins) ]
leftcorntoks = accumAssoc id
[ (fromJust (getLeftCornerTok lins), ruleid) |
(ruleid, FRule _ _ _ _ lins) <- assocs allrules, isJust (getLeftCornerTok lins) ]
grammarcats = aElems topdownrules grammarcats = aElems topdownrules
grammartoks = nubsort [t | (FRule _ _ _ _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin] grammartoks = nubsort [t | (FRule _ _ _ _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin]