Skip to content

Commit 9a84f28

Browse files
Merge pull request #3 from alexfmpe/higher-ranked
Allow higher-ranked types
2 parents 35ef9db + e9f3922 commit 9a84f28

File tree

3 files changed

+8
-2
lines changed

3 files changed

+8
-2
lines changed

free-theorems/src/Language/Haskell/FreeTheorems/Parser/Hsx.hs

+5-2
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,8 @@ import Control.Monad.Writer (Writer, tell)
1212
import Data.Generics (everywhere, mkT)
1313
import Data.Maybe (fromMaybe)
1414
import Data.List (nub, (\\), intersect)
15-
import Language.Haskell.Exts.Parser (parseModule, ParseResult(..))
15+
import Language.Haskell.Exts.Extension (Extension(EnableExtension), KnownExtension(RankNTypes))
16+
import Language.Haskell.Exts.Parser (defaultParseMode, parseModuleWithMode, ParseMode(..), ParseResult(..))
1617
import Language.Haskell.Exts.SrcLoc (SrcLoc, SrcSpanInfo, srcFilename, srcColumn, srcLine, fromSrcInfo)
1718
import Language.Haskell.Exts.Syntax
1819
--import Language.Haskell.Syntax;
@@ -72,13 +73,15 @@ import Language.Haskell.FreeTheorems.Frontend.Error
7273
-- successfully.
7374

7475
parse :: String -> Parsed [S.Declaration]
75-
parse text = case parseModule text of
76+
parse text = case parseModuleWithMode mode text of
7677
ParseOk hsModule -> let decls = transform . filterDeclarations $ hsModule
7778
in foldM collectDeclarations [] decls
7879
ParseFailed l _ -> do tell [pp ("Parse error at (" ++ show (srcLine l)
7980
++ ":" ++ show (srcColumn l) ++ ").")]
8081
return []
8182
where
83+
mode = defaultParseMode { extensions = [EnableExtension RankNTypes] }
84+
8285
collectDeclarations :: [S.Declaration] -> Decl SrcSpanInfo -> Parsed [S.Declaration]
8386
collectDeclarations ds d =
8487
case mkDeclaration d of

free-theorems/src/Language/Haskell/FreeTheorems/PrettyTheorems.hs

+2
Original file line numberDiff line numberDiff line change
@@ -328,6 +328,8 @@ prettyTermVariable (TVar v) = text v
328328
prettyRelation :: PrettyControl -> Bool -> Relation -> Doc
329329
prettyRelation _ _ (RelVar _ rv) = prettyRelationVariable rv
330330

331+
prettyRelation _ _ (RelConsFunVar _ rv) = prettyRelationVariable rv
332+
331333
prettyRelation pc _ (FunVar ri (Left t)) =
332334
case theoremType (relationLanguageSubset ri) of
333335
EquationalTheorem -> prettyTerm (noParens pc) t

free-theorems/src/Language/Haskell/FreeTheorems/Unfold.hs

+1
Original file line numberDiff line numberDiff line change
@@ -165,6 +165,7 @@ asCompleteTheorem i =
165165
unfoldFormula :: Term -> Term -> Relation -> Unfolded Formula
166166
unfoldFormula x y rel = case rel of
167167
RelVar _ _ -> return . Predicate . IsMember x y $ rel
168+
RelConsFunVar _ _ -> return . Predicate . IsMember x y $ rel
168169
FunVar ri term -> unfoldTerm x y ri term
169170
RelBasic ri -> unfoldBasic x y ri
170171
RelLift _ _ _ -> return . Predicate . IsMember x y $ rel

0 commit comments

Comments
 (0)