Skip to content

Commit

Permalink
Rename Term.simplifyFix to Term.simplifyTheory. #148
Browse files Browse the repository at this point in the history
  • Loading branch information
epost committed Aug 22, 2019
1 parent b7712e6 commit 656001a
Show file tree
Hide file tree
Showing 3 changed files with 11 additions and 11 deletions.
6 changes: 3 additions & 3 deletions src/Language/CQL/Collage.hs
Original file line number Diff line number Diff line change
Expand Up @@ -46,8 +46,8 @@ import Data.Map.Strict as Map hiding (foldr, size)
import Data.Set as Set hiding (foldr, size)
import Data.Void
import Language.CQL.Common
import Language.CQL.Term (Head(..), Term(..), simplifyFix, occsTerm, upp)
import Language.CQL.Term (EQ(..), Ctx)
import Language.CQL.Term (Ctx, EQ(..), Head(..), Term(..), occsTerm, upp)
import qualified Language.CQL.Term as T (simplifyTheory)
import Prelude hiding (EQ)

data Collage var ty sym en fk att gen sk
Expand Down Expand Up @@ -83,7 +83,7 @@ simplify
simplify (Collage ceqs' ctys' cens' csyms' cfks' catts' cgens' csks' )
= (Collage ceqs'' ctys' cens' csyms' cfks' catts' cgens'' csks'', f)
where
(ceqs'', f) = simplifyFix ceqs' []
(ceqs'', f) = T.simplifyTheory ceqs' []
cgens'' = Map.fromList $ Prelude.filter (\(x,_) -> notElem (HGen x) $ fmap fst f) $ Map.toList cgens'
csks'' = Map.fromList $ Prelude.filter (\(x,_) -> notElem (HSk x) $ fmap fst f) $ Map.toList csks'

Expand Down
4 changes: 2 additions & 2 deletions src/Language/CQL/Instance/Algebra.hs
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ import qualified Data.Set as Set
import Data.Void
import Language.CQL.Common (intercalate, mapl, section, MultiTyMap, TyMap, type (+))
import Language.CQL.Schema as Schema
import Language.CQL.Term as Term
import Language.CQL.Term (EQ(..), Head(HSk), Term(..), subst, upp, replaceRepeatedly, simplifyTheory)
import Language.CQL.Typeside as Typeside
import Prelude hiding (EQ)
import qualified Text.Tabular as T
Expand Down Expand Up @@ -181,7 +181,7 @@ simplify
Algebra sch en' nf''' nf'''2 repr''' ty'' nf''''' repr'''' teqs''''
where
teqs'' = Set.map (\x -> (Map.empty, x)) teqs'
(teqs''', f) = simplifyFix teqs'' []
(teqs''', f) = simplifyTheory teqs'' []
teqs'''' = Set.map snd teqs'''
ty'' t = Set.filter (\x -> notElem (HSk x) $ map fst f) $ ty' t
nf''''' e = replaceRepeatedly f $ nf'''' e
Expand Down
12 changes: 6 additions & 6 deletions src/Language/CQL/Term.hs
Original file line number Diff line number Diff line change
Expand Up @@ -314,23 +314,23 @@ replaceRepeatedly
replaceRepeatedly [] t = t
replaceRepeatedly ((s,t):r) e = replaceRepeatedly r $ replace' s t e

-- | Takes in a theory and a translation function and repeatedly (to fixpoint) attempts to simplfiy (extend) it.
simplifyFix
-- | Takes in a theory and a translation function and repeatedly (to fixpoint) attempts to simplify (extend) it.
simplifyTheory
:: (MultiTyMap '[Ord] '[var, ty, sym, en, fk, att, gen, sk])
=> Set (Ctx var (ty + en), EQ var ty sym en fk att gen sk)
-> [(Head ty sym en fk att gen sk, Term var ty sym en fk att gen sk)]
-> (Set (Ctx var (ty+en), EQ var ty sym en fk att gen sk), [(Head ty sym en fk att gen sk, Term var ty sym en fk att gen sk)])
simplifyFix eqs subst0 = case simplify eqs of
simplifyTheory eqs subst0 = case simplifyTheoryStep eqs of
Nothing -> (eqs, subst0)
Just (eqs1, subst1) -> simplifyFix eqs1 $ subst0 ++ [subst1]
Just (eqs1, subst1) -> simplifyTheory eqs1 $ subst0 ++ [subst1]

-- | Does a one step simplifcation of a theory, looking for equations @gen/sk = term@, yielding also a
-- translation function from the old theory to the new, encoded as a list of (symbol, term) pairs.
simplify
simplifyTheoryStep
:: (MultiTyMap '[Ord] '[var, ty, sym, en, fk, att, gen, sk])
=> Set (Ctx var (ty+en), EQ var ty sym en fk att gen sk)
-> Maybe (Set (Ctx var (ty+en), EQ var ty sym en fk att gen sk), (Head ty sym en fk att gen sk, Term var ty sym en fk att gen sk))
simplify eqs = case findSimplifiable eqs of
simplifyTheoryStep eqs = case findSimplifiable eqs of
Nothing -> Nothing
Just (toRemove, replacer) -> let
eqs2 = Set.map (\(ctx, EQ (lhs, rhs)) -> (ctx, EQ (replace' toRemove replacer lhs, replace' toRemove replacer rhs))) eqs
Expand Down

0 comments on commit 656001a

Please sign in to comment.