summaryrefslogtreecommitdiff
path: root/src/GF/Canon/Share.hs
diff options
context:
space:
mode:
authorpeb <unknown>2005-02-09 11:46:54 +0000
committerpeb <unknown>2005-02-09 11:46:54 +0000
commita0d412986305d4b45e82afde62ea48f1b06edb9d (patch)
treebca6f55ef01469442ef55f6bd0caa511e147350f /src/GF/Canon/Share.hs
parent4fd0c636f8590bf800715f2598e54ccc22c99b90 (diff)
"Committed_by_peb"
Diffstat (limited to 'src/GF/Canon/Share.hs')
-rw-r--r--src/GF/Canon/Share.hs20
1 files changed, 13 insertions, 7 deletions
diff --git a/src/GF/Canon/Share.hs b/src/GF/Canon/Share.hs
index a5a5f5349..89323eb2f 100644
--- a/src/GF/Canon/Share.hs
+++ b/src/GF/Canon/Share.hs
@@ -27,11 +27,20 @@ import qualified Modules as M
-- following advice of Josef Svenningsson
type OptSpec = [Integer] ---
+
doOptFactor opt = elem 2 opt
doOptValues opt = elem 3 opt
+
+shareOpt :: OptSpec
shareOpt = []
+
+paramOpt :: OptSpec
paramOpt = [2]
+
+valOpt :: OptSpec
valOpt = [3]
+
+allOpt :: OptSpec
allOpt = [2,3]
shareModule :: OptSpec -> (Ident, CanonModInfo) -> (Ident, CanonModInfo)
@@ -44,7 +53,7 @@ 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
+-- | the function putting together optimizations
shareOptim :: OptSpec -> Ident -> Term -> Term
shareOptim opt c
| doOptFactor opt && doOptValues opt = values . factor c 0
@@ -52,9 +61,8 @@ shareOptim opt c
| doOptValues opt = values
| otherwise = share
--- we need no counter to create new variable names, since variables are
+-- | we need no counter to create new variable names, since variables are
-- local to tables
-
share :: Term -> Term
share t = case t of
T ty cs -> shareT ty [(p, share v) | Cas ps v <- cs, p <- ps] -- only substant.
@@ -79,8 +87,7 @@ share t = case t of
finalize ty css = T ty [Cas (map fst ps) t | ps@((_,t):_) <- css]
--- do even more: factor parametric branches
-
+-- | do even more: factor parametric branches
factor :: Ident -> Int -> Term -> Term
factor c i t = case t of
T _ [_] -> t
@@ -111,8 +118,7 @@ factor c i t = case t of
pIdent c i = identC ("p_" ++ prt c ++ "__" ++ show i)
--- we need to replace subterms
-
+-- | we need to replace subterms
replace :: Term -> Term -> Term -> Term
replace old new trm = case trm of
T ty cs -> T ty [Cas p (repl v) | Cas p v <- cs]