GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -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
instCat lbl nr xnr nr' ((idx,xargs):idxArgs)
| 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
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) ->
let (last_id1,tmap1,fcat_arg) = addArg tcs last_id tmap
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
then (Right fcat, last_id1,tmap1,rule: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
type FIndex = Int
data FSymbol
= FSymCat {-# UNPACK #-} !FCat {-# UNPACK #-} !FIndex {-# UNPACK #-} !Int
= FSymCat {-# UNPACK #-} !FIndex {-# UNPACK #-} !Int
| FSymTok FToken
@@ -78,7 +78,7 @@ instance Print CId where
prt = prCId
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)
where simpleShow str = "\"" ++ concatMap mkEsc str ++ "\""
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]
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]
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.Infra.PrintClass
import GF.Data.Assoc
import GF.Formalism.FCFG
import GF.Formalism.Utilities
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]
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
toType :: RExp -> Type
@@ -231,7 +230,7 @@ fromFName (f,ps) | f == wildCId = fromProfile (head ps)
daughter n = App "_A" [intToExp n]
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
-- ** 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
| inRange (bounds lin) ppos =
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
Nothing -> chart
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)
return (c, Active found rng lbl (ppos+1) node)
in process strategy pinfo toks items chart
FSymTok tok -> let items = do t_rng <- inputToken toks ? tok
rng' <- concatRange rng t_rng
return (cat, Active found rng' lbl (ppos+1) node)
in process strategy pinfo toks items chart
FSymTok tok -> let items = do t_rng <- inputToken toks ? tok
rng' <- concatRange rng t_rng
return (cat, Active found rng' lbl (ppos+1) node)
in process strategy pinfo toks items chart
| otherwise =
if inRange (bounds lins) (lbl+1)
then univRule cat (Active (rng:found) EmptyRange (lbl+1) 0 node) chart
else univRule cat (Final (reverse (rng:found)) node) chart
where
(FRule _ _ _ cat lins) = allRules pinfo ! ruleid
lin = lins ! lbl
(FRule _ _ args cat lins) = allRules pinfo ! ruleid
lin = lins ! lbl
univRule cat item@(Final found' node) chart =
case insertXChart chart item cat of
Nothing -> chart
Just chart -> let items = do (Active found rng l ppos node@(SNode ruleid _)) <- lookupXChartAct chart cat
let FRule _ _ _ _ lins = allRules pinfo ! ruleid
FSymCat cat r d = lins ! l ! ppos
let FRule _ _ args _ lins = allRules pinfo ! ruleid
FSymCat r d = lins ! l ! ppos
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)
ruleid <- leftcornerCats pinfo ? cat
let FRule _ _ _ _ lins = allRules pinfo ! ruleid
FSymCat cat r d = lins ! 0 ! 0
return (cat, Active [] (found' !! r) 0 1 (updateChildren (emptyChildren ruleid pinfo) d found'))
let FRule _ _ args _ lins = allRules pinfo ! ruleid
FSymCat r d = lins ! 0 ! 0
return (args !! d, Active [] (found' !! r) 0 1 (updateChildren (emptyChildren ruleid pinfo) d found'))
updateChildren :: SyntaxNode RuleId RangeRec -> Int -> RangeRec -> SyntaxNode RuleId RangeRec
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
FSymTok tok -> Just tok
_ -> Nothing
| otherwise = Nothing
FSymTok tok -> [tok]
_ -> []
| otherwise = []
where
syms = lins ! 0
getLeftCornerCat lins
getLeftCornerCat (FRule _ _ args _ lins)
| inRange (bounds syms) 0 = case syms ! 0 of
FSymCat c _ _ -> Just c
_ -> Nothing
| otherwise = Nothing
FSymCat _ d -> [args !! d]
_ -> []
| otherwise = []
where
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]
epsilonrules = [ ruleid | (ruleid, FRule _ _ _ _ lins) <- assocs allrules,
not (inRange (bounds (lins ! 0)) 0) ]
leftcorncats = accumAssoc id
[ (fromJust (getLeftCornerCat lins), ruleid) |
(ruleid, FRule _ _ _ _ lins) <- assocs allrules, isJust (getLeftCornerCat lins) ]
leftcorntoks = accumAssoc id
[ (fromJust (getLeftCornerTok lins), ruleid) |
(ruleid, FRule _ _ _ _ lins) <- assocs allrules, isJust (getLeftCornerTok lins) ]
leftcorncats = accumAssoc id [ (cat, ruleid) | (ruleid, rule) <- assocs allrules, cat <- getLeftCornerCat rule ]
leftcorntoks = accumAssoc id [ (tok, ruleid) | (ruleid, rule) <- assocs allrules, tok <- getLeftCornerTok rule ]
grammarcats = aElems topdownrules
grammartoks = nubsort [t | (FRule _ _ _ _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin]