diff --git a/bowtie/src/Bowtie/Surface/Parse.hs b/bowtie/src/Bowtie/Surface/Parse.hs index fbdfec8..8ef9b37 100644 --- a/bowtie/src/Bowtie/Surface/Parse.hs +++ b/bowtie/src/Bowtie/Surface/Parse.hs @@ -33,7 +33,7 @@ parse path = -- | -- >>> parseTest sourceParser "type A = A\n\ntype B = B" --- AST {astTypes = OrderedMap (fromList [(Id "A",(0,TypeDeclaration [] (fromList [(Id "A",[])]))),(Id "B",(1,TypeDeclaration [] (fromList [(Id "B",[])])))]) (fromList [(0,(Id "A",TypeDeclaration [] (fromList [(Id "A",[])]))),(1,(Id "B",TypeDeclaration [] (fromList [(Id "B",[])])))]), astTerms = OrderedMap (fromList []) (fromList [])} +-- AST {astTypes = OrderedMap (fromList [(Id "A",(0,TypeDeclaration [] (OrderedMap (fromList [(Id "A",(0,[]))]) (fromList [(0,(Id "A",[]))])))),(Id "B",(1,TypeDeclaration [] (OrderedMap (fromList [(Id "B",(0,[]))]) (fromList [(0,(Id "B",[]))]))))]) (fromList [(0,(Id "A",TypeDeclaration [] (OrderedMap (fromList [(Id "A",(0,[]))]) (fromList [(0,(Id "A",[]))])))),(1,(Id "B",TypeDeclaration [] (OrderedMap (fromList [(Id "B",(0,[]))]) (fromList [(0,(Id "B",[]))]))))]), astTerms = OrderedMap (fromList []) (fromList [])} -- -- ^^ TODO: OrderedMaps do not do well with Show sourceParser :: Parser AST diff --git a/bowtie/src/Bowtie/Type/AST.hs b/bowtie/src/Bowtie/Type/AST.hs index 839c235..bea97cf 100644 --- a/bowtie/src/Bowtie/Type/AST.hs +++ b/bowtie/src/Bowtie/Type/AST.hs @@ -1,6 +1,7 @@ module Bowtie.Type.AST where import Bowtie.Lib.FreeVars +import Bowtie.Lib.OrderedMap (OrderedMap) import Bowtie.Lib.Prelude import qualified Data.Set as Set @@ -9,7 +10,7 @@ import qualified Data.Set as Set data TypeDeclaration = TypeDeclaration [Id]-- ^ Polymorphic over these variables - (HashMap Id [Type]) + (OrderedMap Id [Type]) deriving (Eq, Show) data Type diff --git a/bowtie/src/Bowtie/Type/Kindcheck.hs b/bowtie/src/Bowtie/Type/Kindcheck.hs index e533349..1afb956 100644 --- a/bowtie/src/Bowtie/Type/Kindcheck.hs +++ b/bowtie/src/Bowtie/Type/Kindcheck.hs @@ -19,7 +19,7 @@ kindcheck = -- E.g. if the first is Maybe, the second is Nothing and Just. constructorsFromDecls :: (Id, TypeDeclaration) -> [(Id, TypeScheme)] constructorsFromDecls (typeId, TypeDeclaration polyVars constructors) = - fmap constructorType (HashMap.toList constructors) + fmap constructorType (OrderedMap.toList constructors) where constructorType :: (Id, [Type]) -> (Id, TypeScheme) constructorType (conId, args) = diff --git a/bowtie/src/Bowtie/Type/Parse.hs b/bowtie/src/Bowtie/Type/Parse.hs index 0ae2b1b..99119ea 100644 --- a/bowtie/src/Bowtie/Type/Parse.hs +++ b/bowtie/src/Bowtie/Type/Parse.hs @@ -26,8 +26,8 @@ import Control.Applicative.Combinators.NonEmpty import Text.Megaparsec hiding (State, Token, parse, parseTest, runParser, sepBy1) +import qualified Bowtie.Lib.OrderedMap as OrderedMap import qualified Data.Char as Char -import qualified Data.HashMap.Strict as HashMap import qualified Data.List.NonEmpty as NE import qualified Data.Text as Text import qualified Text.Megaparsec as Mega @@ -54,9 +54,9 @@ type ParserErrorBundle = ParseErrorBundle Text Void -- ) -- -- >>> parseTest declEntryParser "type Foo a b = Bar Bool a | Baz Int b" --- (Id "Foo",TypeDeclaration [Id "a",Id "b"] (fromList [(Id "Baz",[TConstructor (Id "Int"),TVariable (Id "b")]),(Id "Bar",[TConstructor (Id "Bool"),TVariable (Id "a")])])) +-- (Id "Foo",TypeDeclaration [Id "a",Id "b"] (OrderedMap (fromList [(Id "Baz",(1,[TConstructor (Id "Int"),TVariable (Id "b")])),(Id "Bar",(0,[TConstructor (Id "Bool"),TVariable (Id "a")]))]) (fromList [(0,(Id "Bar",[TConstructor (Id "Bool"),TVariable (Id "a")])),(1,(Id "Baz",[TConstructor (Id "Int"),TVariable (Id "b")]))]))) -- --- TODO: switch type constructors to ordered map +-- ^^ TODO: OrderedMaps do not do well with Show declEntryParser :: Parser (Id, TypeDeclaration) declEntryParser = do -- Note that we don't parse a @Break@ here. If each top level @@ -67,7 +67,12 @@ declEntryParser = do typeArgs <- many (lexeme lowerIdParser) symbol "=" constructors <- constructorParser `sepBy` symbol "|" - pure (typeId, TypeDeclaration typeArgs (HashMap.fromList constructors)) + case OrderedMap.fromList constructors of + Left id -> + fail ("Duplicate constructors found in type declaration with id: " <> Text.unpack (unId id)) + + Right constructorMap -> + pure (typeId, TypeDeclaration typeArgs constructorMap) -- | -- >>> parseTest constructorParser "Bar Bool a"