Skip to content

Commit 8342fea

Browse files
marcoshmarcosh
committed
remove useless constraints #122 
1 parent 72557df commit 8342fea

14 files changed

+127
-113
lines changed

‎package.yaml

+10-7
Original file line numberDiff line numberDiff line change
@@ -34,14 +34,17 @@ library:
3434
source-dirs: src
3535

3636
ghc-options:
37-
- -Wunused-binds
38-
- -Wunused-foralls
39-
- -Wunused-imports
40-
- -Wincomplete-patterns
41-
- -Wdodgy-exports
42-
- -Wdodgy-imports
43-
- -Wunbanged-strict-patterns
37+
- -Weverything
4438
- -Werror
39+
- -Wno-implicit-prelude
40+
- -Wno-missing-export-lists
41+
- -Wno-missing-import-lists
42+
- -Wno-safe
43+
- -Wno-missing-local-signatures
44+
- -Wno-unsafe
45+
- -Wno-monomorphism-restriction
46+
- -Wno-unused-type-patterns
47+
- -Wno-name-shadowing
4548

4649
executables:
4750
aql-exe:

‎src/Language/AQL.hs

+1-2
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ import Control.Concurrent
2727
import Control.Exception
2828

2929
-- works
30-
timeout' :: (Show x, NFData x) => Integer -> Err x -> Err x
30+
timeout' :: (NFData x) => Integer -> Err x -> Err x
3131
timeout' i p = unsafePerformIO $ do
3232
m <- newEmptyMVar
3333
computer <- forkIO $ f m p
@@ -452,7 +452,6 @@ evalInstance prog env (InstanceSigma f' i o) = do
452452
o' <- toOptions (other env) o
453453
r <- evalSigmaInst f'' (fromJust $ ((cast i') :: Maybe (Instance var ty sym en fk att gen sk x y))) o'
454454
return $ InstanceEx r
455-
456455
evalInstance prog env (InstanceDelta f' i o) = do
457456
(MappingEx (f'' :: Mapping var ty sym en fk att en' fk' att')) <- evalMapping prog env f'
458457
(InstanceEx (i' :: Instance var'' ty'' sym'' en'' fk'' att'' gen sk x y)) <- evalInstance prog env i

‎src/Language/Instance.hs

+25-26
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@
1717

1818
module Language.Instance where
1919

20+
import Control.DeepSeq
2021
import qualified Data.Foldable as Foldable
2122
import Data.List hiding (intercalate)
2223
import Data.Map.Strict (Map, unionWith, (!))
@@ -37,7 +38,6 @@ import Language.Typeside as Typeside
3738
import Prelude hiding (EQ)
3839
import qualified Text.Tabular as T
3940
import qualified Text.Tabular.AsciiArt as Ascii
40-
import Control.DeepSeq
4141

4242

4343

@@ -108,7 +108,7 @@ down1 _ = error "Anomaly: please report. Function name: down1."
108108

109109
-- | Checks that an instance satisfies its schema.
110110
checkSatisfaction
111-
:: (ShowOrdN '[var, ty, sym, en, fk, att, gen, sk, x, y])
111+
:: (Show ty, Show sym, Show en, Show fk, Show att, Show gen, Show sk, Ord x)
112112
=> Instance var ty sym en fk att gen sk x y
113113
-> Err ()
114114
checkSatisfaction (Instance sch pres' dp' alg) = do
@@ -160,7 +160,7 @@ aSk :: Algebra var ty sym en fk att gen sk x y -> sk -> Term Void ty sym Void Vo
160160
aSk alg g = nf'' alg $ Sk g
161161

162162

163-
instance (NFData var, NFData ty, NFData sym, NFData en, NFData fk, NFData att, NFData gen, NFData sk, NFData x, NFData y)
163+
instance (NFData var, NFData ty, NFData sym, NFData en, NFData fk, NFData att, NFData x, NFData y)
164164
=> NFData (Algebra var ty sym en fk att gen sk x y)
165165
where
166166
rnf (Algebra s0 e0 nf0 repr0 ty0 nf1 repr1 eqs1) = deepseq s0 $ f e0 $ deepseq nf0 $ deepseq repr0
@@ -198,7 +198,7 @@ instance (NFData var, NFData ty, NFData sym, NFData en, NFData fk, NFData att, N
198198
=> NFData (Instance var ty sym en fk att gen sk x y) where
199199
rnf (Instance s0 p0 dp0 a0) = deepseq s0 $ deepseq p0 $ deepseq dp0 $ rnf a0
200200

201-
instance (NFData var, NFData ty, NFData sym, NFData en, NFData fk, NFData att, NFData gen, NFData sk)
201+
instance (NFData ty, NFData sym, NFData en, NFData fk, NFData att, NFData gen, NFData sk)
202202
=> NFData (Presentation var ty sym en fk att gen sk) where
203203
rnf (Presentation g s e) = deepseq g $ deepseq s $ rnf e
204204

@@ -211,7 +211,7 @@ data InstanceEx :: * where
211211

212212
-- | Converts an instance to a presentation.
213213
instToCol
214-
:: (ShowOrdN '[var, ty, sym, en, fk, att, gen, sk])
214+
:: (ShowOrdN '[var, ty, sym, en, fk, att], Ord gen, Ord sk)
215215
=> Schema var ty sym en fk att
216216
-> Presentation var ty sym en fk att gen sk
217217
-> Collage (()+var) ty sym en fk att gen sk
@@ -225,7 +225,7 @@ instToCol sch (Presentation gens' sks' eqs') =
225225

226226

227227
-- | Converts an instance into a presentation: adds one equation per fact in the algebra.
228-
algebraToPresentation :: (ShowOrdN '[var, ty, sym, en, fk, att, gen, sk], Ord y, Ord x)
228+
algebraToPresentation :: (Ord ty, Ord sym, Ord en, Ord fk, Ord att, Ord y, Ord x)
229229
=> Algebra var ty sym en fk att gen sk x y
230230
-> Presentation var ty sym en fk att x y
231231
algebraToPresentation (alg@(Algebra sch en' _ _ ty' _ _ _)) = Presentation gens' sks' eqs'
@@ -352,9 +352,9 @@ instance (Show en, Show fk, Show att, Show gen, Show sk) => Show (TalgGen en fk
352352

353353
deriving instance (Ord en, Ord fk, Ord att, Ord gen, Ord sk) => Ord (TalgGen en fk att gen sk)
354354

355-
deriving instance (Eq en, Eq fk, Eq att, Eq gen, Eq sk) => Eq (TalgGen en fk att gen sk)
355+
deriving instance (Eq fk, Eq att, Eq gen, Eq sk) => Eq (TalgGen en fk att gen sk)
356356

357-
assembleGens :: (ShowOrdN '[var, ty, sym, en, fk, att, gen, sk], Eq en)
357+
assembleGens :: (ShowOrdN '[var, ty, sym, en, fk, att, gen, sk])
358358
=> Collage var ty sym en fk att gen sk -> [Carrier en fk gen] -> Map en (Set (Carrier en fk gen))
359359
assembleGens col [] = Map.fromList $ Prelude.map (\x -> (x,Set.empty)) $ Set.toList $ cens col
360360
assembleGens col (e:tl) = Map.insert t (Set.insert e s) m
@@ -363,7 +363,7 @@ assembleGens col (e:tl) = Map.insert t (Set.insert e s) m
363363
s = fromJust $ Map.lookup t m
364364

365365
close
366-
:: (ShowOrdN '[var, ty, sym, en, fk, att, gen, sk], Eq en)
366+
:: (ShowOrdN '[var, ty, sym, en, fk, att, gen, sk])
367367
=> Collage var ty sym en fk att gen sk
368368
-> (EQ var ty sym en fk att gen sk -> Bool)
369369
-> [Term Void Void Void en fk Void gen Void]
@@ -385,7 +385,7 @@ dedup :: (EQ var ty sym en fk att gen sk -> Bool)
385385
-> [Term Void Void Void en fk Void gen Void]
386386
dedup dp' = nubBy (\x y -> dp' (EQ (upp x, upp y)))
387387

388-
close1 :: (ShowOrdN '[var, ty, sym, en, fk, att, gen, sk], Eq en)
388+
close1 :: (ShowOrdN '[var, ty, sym, en, fk, att, gen, sk])
389389
=> Collage var ty sym en fk att gen sk -> (EQ var ty sym en fk att gen sk -> Bool) -> Term Void Void Void en fk Void gen Void -> [ (Term Void Void Void en fk Void gen Void) ]
390390
close1 col _ e = e:(fmap (\(x,_) -> Fk x e) l)
391391
where t = typeOf col e
@@ -422,14 +422,14 @@ instance Deps InstanceExp where
422422

423423
getOptionsInstance :: InstanceExp -> [(String, String)]
424424
getOptionsInstance x = case x of
425-
InstanceVar _ -> []
426-
InstanceInitial _ -> []
427-
InstanceDelta _ _ o -> o
428-
InstanceSigma _ _ o -> o
429-
InstancePi _ _ -> undefined
430-
InstanceEval _ _ -> undefined
431-
InstanceCoEval _ _ -> undefined
432-
InstanceRaw (InstExpRaw' _ _ _ o _) -> o
425+
InstanceVar _ -> []
426+
InstanceInitial _ -> []
427+
InstanceDelta _ _ o -> o
428+
InstanceSigma _ _ o -> o
429+
InstancePi _ _ -> undefined
430+
InstanceEval _ _ -> undefined
431+
InstanceCoEval _ _ -> undefined
432+
InstanceRaw (InstExpRaw' _ _ _ o _) -> o
433433

434434

435435
----------------------------------------------------------------------------------------------------------------------
@@ -476,7 +476,7 @@ split'' ens2 tys2 ((w, ei):tl) =
476476
else Left $ "Not an entity or type: " ++ show ei
477477

478478
evalInstanceRaw'
479-
:: forall var ty sym en fk att . (ShowOrdN '[var, ty, sym, en, fk, att], Typeable ty, Typeable sym, Typeable en, Typeable fk, Typeable att)
479+
:: forall var ty sym en fk att . (Ord ty, Ord sym, Ord en, Ord fk, Ord att, Typeable ty, Typeable sym, Typeable en, Typeable fk, Typeable att)
480480
=> Schema var ty sym en fk att
481481
-> InstExpRaw'
482482
-> [Presentation var ty sym en fk att Gen Sk]
@@ -567,7 +567,7 @@ emptyInstance ts'' = Instance ts''
567567
-- Functorial data migration
568568

569569
subs
570-
:: (ShowOrdN '[var, ty, sym, en, fk, att, en', fk', att', gen, sk], Eq en')
570+
:: (Ord ty, Ord sym, Ord en, Ord fk, Ord att, Ord en', Ord fk', Ord att', Ord gen, Ord sk)
571571
=> Mapping var ty sym en fk att en' fk' att'
572572
-> Presentation var ty sym en fk att gen sk
573573
-> Presentation var ty sym en' fk' att' gen sk
@@ -606,7 +606,7 @@ changeEn' fks' atts' t = case t of
606606
Att h _ -> absurd h
607607

608608
evalSigmaInst
609-
:: (ShowOrdN '[var, ty, sym, en, fk, att, en', fk', att', gen, sk], Eq x, Eq y, Eq en')
609+
:: (ShowOrdN '[var, ty, sym, en', fk', att', gen, sk], Ord en, Ord fk, Ord att)
610610
=> Mapping var ty sym en fk att en' fk' att'
611611
-> Instance var ty sym en fk att gen sk x y -> Options
612612
-> Err (Instance var ty sym en' fk' att' gen sk (Carrier en' fk' gen) (TalgGen en' fk' att' gen sk))
@@ -624,8 +624,7 @@ mapGen _ _ = undefined
624624

625625
evalDeltaAlgebra
626626
:: forall var ty sym en fk att gen sk x y en' fk' att'
627-
. ( Show var, Show ty, Show sym, Show en, Show fk, Show att, Show gen, Show sk, Show x, Show y, Show en', Show fk', Show att'
628-
, Ord var, Ord ty, Ord sym, Ord en, Ord fk, Ord att, Ord gen, Ord sk, Ord x, Ord y, Ord en', Ord fk', Ord att')
627+
. (Ord en, Ord fk, Ord att, Ord x)
629628
=> Mapping var ty sym en fk att en' fk' att'
630629
-> Instance var ty sym en' fk' att' gen sk x y
631630
-> Algebra var ty sym en fk att (en, x) y (en, x) y
@@ -651,7 +650,7 @@ evalDeltaAlgebra (Mapping src' _ ens' fks0 atts0)
651650

652651

653652
evalDeltaInst
654-
:: forall var ty sym en fk att gen sk x y en' fk' att' . (ShowOrdN '[var, ty, sym, en, fk, att, gen, sk, x, y, en', fk', att'])
653+
:: forall var ty sym en fk att gen sk x y en' fk' att' . (Ord ty, Ord sym, Ord en, Ord fk, Ord att, Ord x, Ord y)
655654
=> Mapping var ty sym en fk att en' fk' att'
656655
-> Instance var ty sym en' fk' att' gen sk x y -> Options
657656
-> Err (Instance var ty sym en fk att (en,x) y (en,x) y)
@@ -699,7 +698,7 @@ instance (Show var, Show ty, Show sym, Show en, Show fk, Show att, Show gen, Sho
699698
prettyTypeEqns = intercalate "\n" (Set.map show teqs')
700699

701700
prettyEntity
702-
:: (Show var, Show ty, Show sym, Show en, Show fk, Show att, Show gen, Show sk, Show x, Show y, Eq en)
701+
:: (Show ty, Show sym, Show en, Show fk, Show att, Show x, Show y, Eq en)
703702
=> Algebra var ty sym en fk att gen sk x y
704703
-> en
705704
-> String
@@ -721,7 +720,7 @@ prettyEntity alg@(Algebra sch en' _ _ _ _ _ _) es =
721720

722721
-- TODO unquote identifiers; stick fks and attrs in separate `Group`s?
723722
prettyEntityTable
724-
:: (Show var, Show ty, Show sym, Show en, Show fk, Show att, Show gen, Show sk, Show x, Show y, Eq en)
723+
:: (Show ty, Show sym, Show en, Show fk, Show att, Show x, Show y, Eq en)
725724
=> Algebra var ty sym en fk att gen sk x y
726725
-> en
727726
-> String

‎src/Language/Mapping.hs

+8-8
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@
1919
--{-# LANGUAGE DisambiguateRecordFields #-}
2020

2121
module Language.Mapping where
22+
import Control.DeepSeq
2223
import Data.Map.Strict (Map)
2324
import qualified Data.Map.Strict as Map
2425
import Data.Maybe
@@ -29,7 +30,6 @@ import Language.Common
2930
import Language.Schema as Schema
3031
import Language.Term
3132
import Prelude hiding (EQ)
32-
import Control.DeepSeq
3333

3434
-- | Morphism of schemas.
3535
data Mapping var ty sym en fk att en' fk' att'
@@ -87,15 +87,15 @@ mapToMor (Mapping src' dst' ens' fks' atts') = Morphism (schToCol src') (schToCo
8787

8888
-- | Checks well-typedness of underlying theory.
8989
typecheckMapping
90-
:: (ShowOrdN '[var, ty], ShowOrdTypeableN '[sym, en, fk, att, en', fk', att'])
90+
:: (ShowOrdN '[var, ty, sym, en, fk, att, en', fk', att'])
9191
=> Mapping var ty sym en fk att en' fk' att'
9292
-> Err ()
9393
typecheckMapping m = typeOfMor $ mapToMor m
9494

9595
-- | Given @F@ checks that each @S |- p = q -> T |- F p = F q@.
9696
validateMapping
9797
:: forall var ty sym en fk att en' fk' att'
98-
. (ShowOrdN '[var, ty], ShowOrdTypeableN '[sym, en, fk, att, en', fk', att'])
98+
. (ShowOrdN '[var, ty, sym, en, fk, att, en', fk', att'])
9999
=> Mapping var ty sym en fk att en' fk' att'
100100
-> Err ()
101101
validateMapping (m@(Mapping src' dst' ens' _ _)) = do
@@ -132,9 +132,9 @@ data MappingExp where
132132

133133
getOptionsMapping :: MappingExp -> [(String, String)]
134134
getOptionsMapping x = case x of
135-
MappingVar _ -> []
136-
MappingId _ -> []
137-
MappingComp _ _ -> []
135+
MappingVar _ -> []
136+
MappingId _ -> []
137+
MappingComp _ _ -> []
138138
MappingRaw (MappingExpRaw' _ _ _ _ _ o _) -> o
139139

140140
instance Deps MappingExp where
@@ -186,7 +186,7 @@ data MappingExpRaw' =
186186
} deriving (Eq, Show)
187187

188188
evalMappingRaw'
189-
:: forall var ty sym en fk att en' fk' att' . (ShowOrdN '[var, ty], ShowOrdTypeableN '[sym, en, fk, att, en', fk', att'])
189+
:: forall var ty sym en fk att en' fk' att' . (ShowOrdTypeableN '[en, en'], Typeable sym, Ord fk, Typeable fk, Ord att, Typeable att, Ord fk', Typeable fk', Ord att', Typeable att')
190190
=> Schema var ty sym en fk att -> Schema var ty sym en' fk' att'
191191
-> MappingExpRaw'
192192
-> [Mapping var ty sym en fk att en' fk' att']
@@ -235,7 +235,7 @@ evalMappingRaw' src' dst' (MappingExpRaw' _ _ ens0 fks0 atts0 _ _) is = do
235235
g' v _ _ (RawApp x []) | v == x = Var ()
236236
g' v fks'' atts'' (RawApp x (a:[])) | elem' x fks'' = Fk (fromJust $ cast x) $ g' v fks'' atts'' a
237237
g' _ _ _ _ = error "impossible"
238-
g :: Typeable sym => String ->[fk']-> [att'] -> RawTerm -> Term () ty sym en' fk' att' Void Void
238+
g :: String ->[fk']-> [att'] -> RawTerm -> Term () ty sym en' fk' att' Void Void
239239
g v _ _ (RawApp x []) | v == x = Var ()
240240
g v fks'' atts'' (RawApp x (a:[])) | elem' x fks'' = Fk (fromJust $ cast x) $ g' v fks'' atts'' a
241241
g v fks'' atts'' (RawApp x (a:[])) | elem' x atts'' = Att (fromJust $ cast x) $ g' v fks'' atts'' a

‎src/Language/Options.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,9 @@
11
{-# LANGUAGE EmptyDataDeriving #-}
22

33
module Language.Options where
4+
import Data.Void
45
import Language.Common
56
import Text.Read
6-
import Data.Void
77

88
data Options = Options {
99
iOps :: IntOption -> Integer,
@@ -68,8 +68,8 @@ toBoolOption (k,v) = case matches of
6868
boolDef :: BoolOption -> Bool
6969
boolDef o = case o of
7070
Program_Allow_Nontermination_Unsafe -> False
71-
Allow_Empty_Sorts_Unsafe -> False
72-
Program_Allow_Nonconfluence_Unsafe -> False
71+
Allow_Empty_Sorts_Unsafe -> False
72+
Program_Allow_Nonconfluence_Unsafe -> False
7373

7474
-- | Default values for Integer options.
7575
intDef :: IntOption -> Integer

‎src/Language/Parser.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
module Language.Parser where
22

33
import Data.Map as Map
4+
import Data.Maybe
45
import Language.Common as C
56
import Language.Parser.Instance as I
67
import Language.Parser.LexerRules
@@ -11,7 +12,6 @@ import Language.Parser.Transform as TT
1112
import Language.Parser.Typeside as T'
1213
import Language.Program as P
1314
import Text.Megaparsec
14-
import Data.Maybe
1515

1616

1717
parseAqlProgram' :: Parser (String, Exp)
@@ -75,5 +75,5 @@ toProg' o ((v,e):p) = case e of
7575

7676
parseAqlProgram :: String -> Err Prog
7777
parseAqlProgram s = case runParser parseAqlProgram'' "" s of
78-
Left err -> Left $ "Parse error: " ++ (parseErrorPretty err)
79-
Right (o,x) -> pure $ toProg' o x
78+
Left err -> Left $ "Parse error: " ++ (parseErrorPretty err)
79+
Right (o,x) -> pure $ toProg' o x

‎src/Language/Parser/Instance.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,7 @@ instRawParser = do
5656
pure $ x
5757
where p t = do i <- optional $ do
5858
_ <- constant "imports"
59-
many instExpParser
59+
many instExpParser
6060
e <- optional $ do
6161
_ <- constant "generators"
6262
y <- many genParser

‎src/Language/Parser/Transform.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,13 @@
11
module Language.Parser.Transform (transExpParser) where
22

33
import Data.Maybe
4-
import Language.Transform
5-
import Text.Megaparsec
64
import Language.Parser.Instance
75
import Language.Parser.LexerRules
86
import Language.Parser.Mapping
97
import Language.Parser.Parser
108
import Language.Term
9+
import Language.Transform
10+
import Text.Megaparsec
1111

1212

1313
gParser :: Parser (String, RawTerm)

‎src/Language/Parser/Typeside.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ eqParser = do o <- p
3535
r <- rawTermParser
3636
return (o,l,r) --(fromMaybe [] o, l, r)
3737
where p = do _ <- constant "forall"
38-
g <- sepBy varParser $ constant ","
38+
g <- sepBy varParser $ constant ","
3939
_ <- constant "."
4040
return $ concat g
4141

@@ -64,7 +64,7 @@ typesideLiteralSectionParser :: Parser X.TypesideRaw'
6464
typesideLiteralSectionParser = do
6565
i <- optional $ do
6666
_ <- constant "imports"
67-
many typesideExpParser
67+
many typesideExpParser
6868
t <- optional $ do
6969
_ <- constant "types"
7070
many identifier

0 commit comments

Comments
 (0)