diff --git a/src/Plume/Syntax/Blocks.hs b/src/Plume/Syntax/Blocks.hs index 4cdd24f..d02fc49 100644 --- a/src/Plume/Syntax/Blocks.hs +++ b/src/Plume/Syntax/Blocks.hs @@ -75,9 +75,9 @@ removeUselessBlocks isInner (AST.ELocated e p) = do e' <- removeUselessBlocks isInner e [AST.ELocated e' p] removeUselessBlocks _ (AST.EType ann ts) = [AST.EType ann ts] -removeUselessBlocks isInner (AST.ETypeExtension gens ann var mems p) = do +removeUselessBlocks isInner (AST.ETypeExtension gens ann var mems) = do let mems' = map (removeUselessBlocksExt isInner) mems - [AST.ETypeExtension gens ann var mems' p] + [AST.ETypeExtension gens ann var mems'] removeUselessBlocks _ e = [e] removeUselessBlocksExt :: (Bool, Bool) -> AST.ExtensionMember -> AST.ExtensionMember diff --git a/src/Plume/Syntax/Common/Type.hs b/src/Plume/Syntax/Common/Type.hs index 5a7657e..8028e40 100644 --- a/src/Plume/Syntax/Common/Type.hs +++ b/src/Plume/Syntax/Common/Type.hs @@ -79,7 +79,7 @@ pattern TCon s ts = TApp (TId s) ts pattern TInt, TBool, TString, TChar, TFloat, TUnit :: PlumeType pattern TInt = TId "int" pattern TBool = TId "bool" -pattern TString = TCon "list" [TChar] +pattern TString = TId "str" pattern TChar = TId "char" pattern TFloat = TId "float" pattern TUnit = TId "unit" diff --git a/src/Plume/Syntax/Concrete/Expression.hs b/src/Plume/Syntax/Concrete/Expression.hs index ad3f51e..b5e6051 100644 --- a/src/Plume/Syntax/Concrete/Expression.hs +++ b/src/Plume/Syntax/Concrete/Expression.hs @@ -70,8 +70,6 @@ data PostfixOperator = PostfixSlice deriving (Show, Eq) -type Priority = Integer - -- | A concrete expression is an expression that is used to represent -- | a program. It is a more concrete representation of a program than -- | an abstract syntax tree. It is used to represent the program in a @@ -98,7 +96,7 @@ data Expression t f interfaceDeduction :: Maybe (Text, Text) } | EReturn (Expression t f) - | ETypeExtension [PlumeGeneric] (Annotation [t]) (Maybe Text) [ExtensionMember t f] Priority + | ETypeExtension [PlumeGeneric] (Annotation [t]) (Maybe Text) [ExtensionMember t f] | ENativeFunction Text Text [Text] t LibraryType IsStandard | ETypeAlias (Annotation [Text]) t | EVariableDeclare [PlumeGeneric] Text (f t) @@ -147,7 +145,7 @@ instance (Eq t, Eq (f t)) => Eq (Expression t f) where ESwitch x xs == ESwitch x' xs' = x == x' && xs == xs' EReturn x == EReturn y = x == y EInterface x xs ys d == EInterface x' xs' ys' d' = x == x' && xs == xs' && ys == ys' && d == d' - ETypeExtension xs x t ys p == ETypeExtension xs' x' t' ys' p' = xs == xs' && x == x' && ys == ys' && t == t' && p == p' + ETypeExtension xs x t ys == ETypeExtension xs' x' t' ys' = xs == xs' && x == x' && ys == ys' && t == t' ENativeFunction x y xs z t isStd == ENativeFunction x' y' xs' z' t' isStd' = x == x' && y == y' && xs == xs' && z == z' && t == t' && isStd == isStd' EVariableDeclare xs x t == EVariableDeclare xs' x' t' = xs == xs' && x == x' && t == t' ELocated x _ == ELocated y _ = x == y @@ -182,7 +180,7 @@ instance (Show t, Show (f t)) => Show (Expression t f) where show (ESwitch x xs) = "switch " <> show x <> " { " <> S.intercalate "; " (map (\(p, e) -> show p <> " -> " <> show e) xs) <> " }" show (EInterface x xs ys d) = "interface " <> show x <> " " <> show xs <> " " <> show ys <> " " <> maybe "" (\(x', y) -> "deduct " <> toString x' <> " " <> toString y) d show (EReturn x) = "return " <> show x - show (ETypeExtension xs x t ys _) = "extend " <> show xs <> " " <> show x <> " " <> maybe "" ((" as " <>) . toString) t <> " " <> show ys + show (ETypeExtension xs x t ys) = "extend " <> show xs <> " " <> show x <> " " <> maybe "" ((" as " <>) . toString) t <> " " <> show ys show (ENativeFunction x y xs _ _ _) = "native " <> toString x <> " " <> toString y <> " " <> show xs show (ETypeAlias x t) = "type " <> show x <> " = " <> show t show (EVariableDeclare xs x t) = "declare " <> show xs <> " " <> toString x <> " " <> show t diff --git a/src/Plume/Syntax/Concrete/Internal/Pretty.hs b/src/Plume/Syntax/Concrete/Internal/Pretty.hs index 7a36404..465de4e 100644 --- a/src/Plume/Syntax/Concrete/Internal/Pretty.hs +++ b/src/Plume/Syntax/Concrete/Internal/Pretty.hs @@ -98,7 +98,7 @@ prettyExpr _ (ESwitch e ps) = where prettyCase (p, e') = anCol Blue "case" <+> prettyPat p <+> "=>" <+> prettyExpr 0 e' prettyExpr _ (EReturn e) = anCol Blue "return" <+> prettyExpr 0 e -prettyExpr _ (ETypeExtension gens a var es _) = +prettyExpr _ (ETypeExtension gens a var es) = anCol Blue "extends" <> angles (hsep . punctuate comma $ map ansiPretty gens) <+> pretty a.annotationName <> angles (hsep . punctuate comma $ map ansiPretty a.annotationValue) diff --git a/src/Plume/Syntax/Parser/Modules/Literal.hs b/src/Plume/Syntax/Parser/Modules/Literal.hs index f97093f..707b0e3 100644 --- a/src/Plume/Syntax/Parser/Modules/Literal.hs +++ b/src/Plume/Syntax/Parser/Modules/Literal.hs @@ -59,14 +59,10 @@ parseStringWithInterpolation = lexeme $ do let y' = combineCharsIntoString y case (x', y') of - (ELiteral (LString a), ELiteral (LString b)) -> stringToList (a <> b) + (ELiteral (LString a), ELiteral (LString b)) -> ELiteral (LString (a <> b)) _ -> EBinary "+" x' y' - combineCharsIntoString (ELiteral (LString s)) = stringToList s combineCharsIntoString x = x -stringToList :: Text -> Expression -stringToList xs = EList (map (ELiteral . LChar) (T.unpack xs)) - -- | Parse a character literal -- | A character literal is a single character enclosed in single quotes -- | Example: 'a' diff --git a/src/Plume/Syntax/Parser/Parser.hs b/src/Plume/Syntax/Parser/Parser.hs index 6a6bdcb..31ad69d 100644 --- a/src/Plume/Syntax/Parser/Parser.hs +++ b/src/Plume/Syntax/Parser/Parser.hs @@ -783,10 +783,8 @@ tExtension = do tc <- Cmm.Annotation . Cmm.fromText <$> L.identifier <*> L.angles (Typ.tType `P.sepBy1` L.comma) <*> pure False - Cmm.LInt priority <- P.option (Cmm.LInt 0) $ L.parens (L.reserved "priority" *> Lit.parseInteger) - members <- L.braces (P.many eExtensionMember) - return [CST.ETypeExtension gens tc Nothing members priority] + return [CST.ETypeExtension gens tc Nothing members] -- | Parses a type declaration -- | A type declaration is a statement that is used to declare a new diff --git a/src/Plume/Syntax/Require/Resolution.hs b/src/Plume/Syntax/Require/Resolution.hs index 8b35c19..54bb3a5 100644 --- a/src/Plume/Syntax/Require/Resolution.hs +++ b/src/Plume/Syntax/Require/Resolution.hs @@ -257,7 +257,7 @@ checkForUndefined m (HLIR.EMutUpdate n e1 e2) = do maybe (pure m') (checkForUndefined m') e2 else throwError ("Variable " <> toString n' <> " is not defined", pos) checkForUndefined m (HLIR.ERequire _) = pure m -checkForUndefined m (HLIR.ETypeExtension _ ann _ exts _) = do +checkForUndefined m (HLIR.ETypeExtension _ ann _ exts) = do let (var, _) = interpretAnnot ann unless (isClassDefined 0 var m) $ do diff --git a/src/Plume/Syntax/Translation/ConcreteToAbstract.hs b/src/Plume/Syntax/Translation/ConcreteToAbstract.hs index 28adfe7..0c381c8 100644 --- a/src/Plume/Syntax/Translation/ConcreteToAbstract.hs +++ b/src/Plume/Syntax/Translation/ConcreteToAbstract.hs @@ -141,11 +141,11 @@ concreteToAbstract (CST.EReturn e) = do -- them into a block. e' <- fmap interpretSpreadable <$> concreteToAbstract e transRet $ AST.EReturn <$> e' -concreteToAbstract (CST.ETypeExtension g ann var ems p) = do +concreteToAbstract (CST.ETypeExtension g ann var ems) = do ann' <- mapM (mapM transformType) ann ems' <- fmap flat . sequence <$> mapM concreteToAbstractExtensionMember ems - transRet $ AST.ETypeExtension g ann' var <$> ems' <*> pure p + transRet $ AST.ETypeExtension g ann' var <$> ems' concreteToAbstract (CST.ENativeFunction fp n gens t libTy _) = do sc <- readIORef mode diff --git a/src/Plume/Syntax/Translation/Substitution.hs b/src/Plume/Syntax/Translation/Substitution.hs index 18d7d9c..ca928e5 100644 --- a/src/Plume/Syntax/Translation/Substitution.hs +++ b/src/Plume/Syntax/Translation/Substitution.hs @@ -70,12 +70,12 @@ substitute (name, expr) (AST.ESwitch e ps) = | name `S.notMember` ftv p = (p, substitute (name, expr) e') | otherwise = (p, e') substitute (name, expr) (AST.EReturn e) = AST.EReturn (substitute (name, expr) e) -substitute (name, expr) (AST.ETypeExtension g ann (Just var) ems p) +substitute (name, expr) (AST.ETypeExtension g ann (Just var) ems) | name /= var = - AST.ETypeExtension g ann (Just var) (map (substituteExt (name, expr)) ems) p - | otherwise = AST.ETypeExtension g ann (Just var) ems p -substitute (name, expr) (AST.ETypeExtension g ann Nothing ems p) = - AST.ETypeExtension g ann Nothing (map (substituteExt (name, expr)) ems) p + AST.ETypeExtension g ann (Just var) (map (substituteExt (name, expr)) ems) + | otherwise = AST.ETypeExtension g ann (Just var) ems +substitute (name, expr) (AST.ETypeExtension g ann Nothing ems) = + AST.ETypeExtension g ann Nothing (map (substituteExt (name, expr)) ems) substitute _ (AST.ENativeFunction fp n gens t st isStd) = AST.ENativeFunction fp n gens t st isStd substitute _ (AST.EInterface ann gs ms d) = AST.EInterface ann gs ms d diff --git a/src/Plume/TypeChecker/Checker/Extension.hs b/src/Plume/TypeChecker/Checker/Extension.hs index a8b8b65..8975aea 100644 --- a/src/Plume/TypeChecker/Checker/Extension.hs +++ b/src/Plume/TypeChecker/Checker/Extension.hs @@ -87,7 +87,7 @@ getMapNames ((IsIn _ _, Post.EVariable n _) : xs) = n.identifier : getMapNames x getMapNames (_ : xs) = getMapNames xs getMapNames [] = [] -isInstanceAlreadyDefined :: MonadChecker m => PlumeQualifier -> m (Maybe ([PlumeType], Integer)) +isInstanceAlreadyDefined :: MonadChecker m => PlumeQualifier -> m (Maybe [PlumeType]) isInstanceAlreadyDefined p = do p' <- liftIO $ compressQual p MkExtendEnv instances <- gets (extendEnv . environment) @@ -98,13 +98,13 @@ isInstanceAlreadyDefined p = do doesMatchQual p''' p' case found of - Just (IsIn ty _, MkInstance _ _ _ _ priority) -> return (Just (ty, priority)) + Just (IsIn ty _, _) -> return (Just ty) _ -> return Nothing synthExt :: Infer -> Infer synthExt infer - (Pre.ETypeExtension generics (Annotation tcName tcTy _) _ methods priority) = do + (Pre.ETypeExtension generics (Annotation tcName tcTy _) _ methods) = do -- Dealing with pre-types and building the qualified qualifiers -- for the typeclass instance (used to indicate the instance form and its -- superclasses) @@ -120,8 +120,8 @@ synthExt -- Checking if the instance is already defined possibleInst <- isInstanceAlreadyDefined instH when (isJust possibleInst) $ case possibleInst of - Just (ty', p) | p == priority -> throw $ AlreadyDefinedInstance tcName.identifier ty' - _ -> pure () + Just ty' -> throw $ AlreadyDefinedInstance tcName.identifier ty' + _ -> throw $ CompilerError "Instance already defined" -- Pre-generating an instance dictionary only based on types cls@(MkClass _ _ meths ded) <- findClass tcName.identifier @@ -138,7 +138,7 @@ synthExt let quals' = case quals of xs :=>: t -> (xs <> gens) :=>: t - let preInst = MkInstance qvars quals' mempty finalMethods priority + let preInst = MkInstance qvars quals' mempty finalMethods let qs'' = TypeQuantified <$> qs' sub <- liftIO . composeSubs =<< zipWithM unifyAndGetSub qs'' ty @@ -293,7 +293,7 @@ synthExt throw $ UnknownExtensionMethods tcName.identifier unknown -- Creating the new instance to insert it in the extend environment - let inst = MkInstance qvars pred' dict dictFunTys priority + let inst = MkInstance qvars pred' dict dictFunTys let cls'' = (instH, void inst) addClassInstance cls'' diff --git a/src/Plume/TypeChecker/Constraints/Typeclass.hs b/src/Plume/TypeChecker/Constraints/Typeclass.hs index 052853c..36c6116 100644 --- a/src/Plume/TypeChecker/Constraints/Typeclass.hs +++ b/src/Plume/TypeChecker/Constraints/Typeclass.hs @@ -41,15 +41,12 @@ discharge cenv p = do s <- gets substitution -- Checking if some extension exists for the given qualifier and getting the -- first to match. - - let cenv' = sortBy (\c1 c2 -> compare (thd3 c2) (thd3 c1)) (getQuals cenv) - p' <- liftIO $ applyQual s =<< compressQual p - x <- forM cenv' $ \(qvs, sch, _) -> do + x <- forM (getQuals cenv) $ \(qvs, sch) -> do sub <- Map.fromList <$> mapM (\c -> (c,) <$> fresh) qvs (a :=>: b, _) <- instantiateQual sub sch b' <- liftIO $ compressQual b - + First <$> (fmap (a,b,) <$> matchMut' b' p') `tryOr` pure Nothing case getFirst $ mconcat x of @@ -151,8 +148,8 @@ getDict (IsQVar t) = t createInstNames :: [PlumeType] -> Text createInstNames = List.foldl' (\acc x -> acc <> "_" <> createInstName x) "" -getQuals :: ExtendEnv -> [([QuVar], Qualified PlumeQualifier, Integer)] -getQuals (MkExtendEnv env) = map (\(a, MkInstance qs quals _ _ priority) -> (qs, a <$ quals, priority)) env +getQuals :: ExtendEnv -> [([QuVar], Qualified PlumeQualifier)] +getQuals (MkExtendEnv env) = map (\(a, MkInstance qs quals _ _) -> (qs, a <$ quals)) env unqualType :: Qualified PlumeType -> PlumeType unqualType (_ :=>: zs) = zs diff --git a/src/Plume/TypeChecker/Monad/State.hs b/src/Plume/TypeChecker/Monad/State.hs index 5e7f000..593a92f 100644 --- a/src/Plume/TypeChecker/Monad/State.hs +++ b/src/Plume/TypeChecker/Monad/State.hs @@ -69,13 +69,13 @@ newtype ExtendEnv = MkExtendEnv [(PlumeQualifier, Instance Typed.Expression ())] -- | (where the key is the method name and the value is the method expression), -- | and a map of types (where the key is the type name and the value is -- | the type). -data Instance val a = MkInstance [QuVar] (Qualified a) (Map Text val) (Map Text PlumeScheme) Integer +data Instance val a = MkInstance [QuVar] (Qualified a) (Map Text val) (Map Text PlumeScheme) deriving (Eq, Show) -- | Instancing the Functor typeclass for the Instance type, in order to -- | be able to apply `void` function to the Instance type. instance Functor (Instance val) where - fmap f (MkInstance qs q m t p) = MkInstance qs (fmap f q) m t p + fmap f (MkInstance qs q m t) = MkInstance qs (fmap f q) m t -- | Empty state -- | The empty state is the initial state of the type checker diff --git a/src/Plume/TypeChecker/Monad/Type.hs b/src/Plume/TypeChecker/Monad/Type.hs index 6ca06b3..8d4c624 100644 --- a/src/Plume/TypeChecker/Monad/Type.hs +++ b/src/Plume/TypeChecker/Monad/Type.hs @@ -78,7 +78,7 @@ pattern TList t = TypeApp (TypeId "list") [t] pattern TInt, TBool, TString, TChar, TFloat, TUnit :: PlumeType pattern TInt = TypeId "int" pattern TBool = TypeId "bool" -pattern TString = TList TChar +pattern TString = TypeId "str" pattern TChar = TypeId "char" pattern TFloat = TypeId "float" pattern TUnit = TypeId "unit"