GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-09 03:02:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

unlexer concat

Browse Source
This commit is contained in:
aarne
2005-02-08 15:35:58 +00:00
parent 6fe9cca0ff
commit 4fd0c636f8
9 changed files with 106 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
src/GF/Canon/Share.hs
View File

@@ -18,6 +18,7 @@ import AbsGFC
import Ident
import GFC
import qualified CMacros as C
import PrGrammar (prt)
import Operations
import List
import qualified Modules as M
@@ -39,15 +40,15 @@ shareModule opt (i,m) = case m of
(i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
_ -> (i,m)
shareInfo opt (c, CncCat ty t m) = (c, CncCat ty (shareOptim opt t) m)
shareInfo opt (c, CncFun k xs t m) = (c, CncFun k xs (shareOptim opt t) m)
shareInfo opt (c, CncCat ty t m) = (c, CncCat ty (shareOptim opt c t) m)
shareInfo opt (c, CncFun k xs t m) = (c, CncFun k xs (shareOptim opt c t) m)
shareInfo _ i = i
-- the function putting together optimizations
shareOptim :: OptSpec -> Term -> Term
shareOptim opt
| doOptFactor opt && doOptValues opt = values . factor 0
| doOptFactor opt = share . factor 0
shareOptim :: OptSpec -> Ident -> Term -> Term
shareOptim opt c
| doOptFactor opt && doOptValues opt = values . factor c 0
| doOptFactor opt = share . factor c 0
| doOptValues opt = values
| otherwise = share
@@ -80,22 +81,22 @@ share t = case t of
-- do even more: factor parametric branches
factor :: Int -> Term -> Term
factor i t = case t of
factor :: Ident -> Int -> Term -> Term
factor c i t = case t of
T _ [_] -> t
T _ [] -> t
T ty cs -> T ty $ factors i [Cas [p] (factor (i+1) v) | Cas ps v <- cs, p <- ps]
R lts -> R [Ass l (factor i t) | Ass l t <- lts]
P t l -> P (factor i t) l
S t a -> S (factor i t) (factor i a)
C t a -> C (factor i t) (factor i a)
FV ts -> FV (map (factor i) ts)
T ty cs -> T ty $ factors i [Cas [p] (factor c (i+1) v) | Cas ps v <- cs, p <- ps]
R lts -> R [Ass l (factor c i t) | Ass l t <- lts]
P t l -> P (factor c i t) l
S t a -> S (factor c i t) (factor c i a)
C t a -> C (factor c i t) (factor c i a)
FV ts -> FV (map (factor c i) ts)
_ -> t
where
factors i psvs = -- we know psvs has at least 2 elements
let p = pIdent i
let p = pIdent c i
vs' = map (mkFun p) psvs
in if allEqs vs'
then mkCase p vs'
@@ -107,7 +108,7 @@ factor i t = case t of
mkCase p (v:_) = [Cas [PV p] v]
pIdent i = identC ("p__" ++ show i)
pIdent c i = identC ("p_" ++ prt c ++ "__" ++ show i)
-- we need to replace subterms