From 1fbe3e6b9a7565b36010e0ece6b7e2203fde7ede Mon Sep 17 00:00:00 2001 From: Denis Stoyanov Date: Tue, 28 Mar 2017 18:01:11 +0300 Subject: [PATCH 1/6] Refactor - Lenses for `Ann` in Oczor.Syntax.Types --- src/Oczor/Compiler/Utl.hs | 4 ++-- src/Oczor/Infer/InferAst.hs | 8 ++++---- src/Oczor/Syntax/Ast.hs | 26 ++++++++++---------------- 3 files changed, 16 insertions(+), 22 deletions(-) diff --git a/src/Oczor/Compiler/Utl.hs b/src/Oczor/Compiler/Utl.hs index 70c8787..ef712e6 100644 --- a/src/Oczor/Compiler/Utl.hs +++ b/src/Oczor/Compiler/Utl.hs @@ -46,14 +46,14 @@ compileJsPartTxt x = do inferTxt2 x = either (putStrLn . pack . show) (putStrLn . pack . prettyShow) $ inferTxt x inferType :: Expr -> Either Error TypeExpr -inferType y = (fst . attr . snd) <$> inferAllExpr baseTypeContext y +inferType y = (fst . view attr . snd) <$> inferAllExpr baseTypeContext y inferTxt :: String -> Either Error TypeExpr inferTxt x = normalizeType <$> (Parser.parseExpr x >>= inferType) inferAstTxt2 :: String -> Either Error InferExpr inferAstTxt2 x = Parser.parseExpr x >>= (\y -> snd <$> inferAllExpr emptyContext y) - + inferContext :: InferContext -> ModuleName -> String -> Either Error InferContext inferContext context fileName x = fst <$> inferAllTxtWith context fileName x diff --git a/src/Oczor/Infer/InferAst.hs b/src/Oczor/Infer/InferAst.hs index 9c41b11..9d3a244 100644 --- a/src/Oczor/Infer/InferAst.hs +++ b/src/Oczor/Infer/InferAst.hs @@ -3,15 +3,15 @@ module Oczor.Infer.InferAst where import ClassyPrelude import Data.Functor.Foldable hiding (Foldable) import Oczor.Syntax.Syntax -import Oczor.Infer.Substitutable +import Oczor.Infer.Substitutable import Oczor.Infer.InferContext import Oczor.Utl - type InferExprF = AnnF ExprF (TypeExpr, InferContext) type InferExpr = Ann ExprF (TypeExpr, InferContext) -attrType = fst . attr +attrType :: Ann a (x, y) -> x +attrType = view (attr . _1) annType x y = Ann x (y, emptyContext) @@ -25,4 +25,4 @@ removeContext = cata $ \case instance Substitutable InferExpr where -- apply s | traceArgs ["apply inferExpr", show s] = undefined apply s = cata $ \case (AnnF ast (tp,ctx)) -> Ann (apply s ast) (apply s tp, apply s ctx) -- TODO FF (apply ast) - -- ftv = cata $ \case (AnnF ast tp) -> ftv tp + -- ftv = cata $ \case (AnnF ast tp) -> ftv tp diff --git a/src/Oczor/Syntax/Ast.hs b/src/Oczor/Syntax/Ast.hs index 1b4ed80..d76bd59 100644 --- a/src/Oczor/Syntax/Ast.hs +++ b/src/Oczor/Syntax/Ast.hs @@ -10,6 +10,7 @@ module Oczor.Syntax.Ast (module Oczor.Syntax.Ast, module Oczor.Syntax.Types, Lit import ClassyPrelude import Data.Functor.Foldable import Data.Functor.Foldable.TH +import Control.Lens import Oczor.Syntax.Types type ModuleName = [String] @@ -70,34 +71,27 @@ makeBaseFunctor ''Expr deriving instance Show a => Show (ExprF a) -data Ann f a = Ann (f (Ann f a)) a deriving (Functor, Foldable, Traversable) -data AnnF f a r = AnnF (f r) a deriving (Functor, Foldable, Traversable) +data Ann f a = Ann { _unAnn :: f (Ann f a), _attr :: a } deriving (Functor, Foldable, Traversable) +data AnnF f a r = AnnF { _unAnnF :: f r, _attrF :: a } deriving (Functor, Foldable, Traversable) + +makeLenses ''Ann +makeLenses ''AnnF type instance Base (Ann f a) = AnnF f a instance Functor f => Recursive (Ann f a) where - project = \case Ann f a -> AnnF f a + project = \case Ann f a -> AnnF f a instance Functor f => Corecursive (Ann f a) where - embed = \case AnnF f a -> Ann f a + embed = \case AnnF f a -> Ann f a instance Show a => Show (Ann ExprF a) where - show (Ann x y) = "(" ++ show x ++ " ANN " ++ show y ++ ")" + show (Ann x y) = "(" <> show x <> " ANN " <> show y <> ")" stripAnns :: Ann ExprF a -> Expr -stripAnns = cata $ \case AnnF x _ -> embed x - -attr :: Ann f a -> a -attr (Ann _ a) = a - -unAnn :: Ann f a -> f (Ann f a) -unAnn (Ann a _) = a - -changeAttr :: Ann f a -> a -> Ann f a -changeAttr (Ann x a) = Ann x +stripAnns = cata $ embed . view unAnnF pattern UnAnn x <- Ann x y pattern ExprListMD x <- MD y (ExprList x) pattern LabelAccessCall label e = Call (LabelAccess label) e - From 0170c075cbed37228ed4f35c60286ca267bb7ec2 Mon Sep 17 00:00:00 2001 From: Denis Stoyanov Date: Tue, 28 Mar 2017 18:05:11 +0300 Subject: [PATCH 2/6] Refactor - Lenses for `Ann` in Oczor.Syntax.Types #2 --- src/Oczor/Compiler/Utl.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Oczor/Compiler/Utl.hs b/src/Oczor/Compiler/Utl.hs index ef712e6..3831704 100644 --- a/src/Oczor/Compiler/Utl.hs +++ b/src/Oczor/Compiler/Utl.hs @@ -46,7 +46,7 @@ compileJsPartTxt x = do inferTxt2 x = either (putStrLn . pack . show) (putStrLn . pack . prettyShow) $ inferTxt x inferType :: Expr -> Either Error TypeExpr -inferType y = (fst . view attr . snd) <$> inferAllExpr baseTypeContext y +inferType y = (attrType . snd) <$> inferAllExpr baseTypeContext y inferTxt :: String -> Either Error TypeExpr inferTxt x = normalizeType <$> (Parser.parseExpr x >>= inferType) From 941606199d82fe93a374095e0de665a747d1b52e Mon Sep 17 00:00:00 2001 From: Denis Stoyanov Date: Tue, 28 Mar 2017 18:26:20 +0300 Subject: [PATCH 3/6] Refactor - Lenses for `Ann` in Oczor.Syntax.Types #3 --- src/Oczor/Compiler/Utl.hs | 2 +- src/Oczor/Infer/InferAst.hs | 2 +- src/Oczor/Syntax/Ast.hs | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Oczor/Compiler/Utl.hs b/src/Oczor/Compiler/Utl.hs index 3831704..fe76443 100644 --- a/src/Oczor/Compiler/Utl.hs +++ b/src/Oczor/Compiler/Utl.hs @@ -56,7 +56,7 @@ inferAstTxt2 x = Parser.parseExpr x >>= (\y -> snd <$> inferAllExpr emptyContext inferContext :: InferContext -> ModuleName -> String -> Either Error InferContext inferContext context fileName x = fst <$> inferAllTxtWith context fileName x - + inferAllTxt :: String -> Either Error (InferContext, InferExpr) -- inferAllTxt x | traceArgs ["inferAllTxt", x] = undefined diff --git a/src/Oczor/Infer/InferAst.hs b/src/Oczor/Infer/InferAst.hs index 9d3a244..feeaa56 100644 --- a/src/Oczor/Infer/InferAst.hs +++ b/src/Oczor/Infer/InferAst.hs @@ -25,4 +25,4 @@ removeContext = cata $ \case instance Substitutable InferExpr where -- apply s | traceArgs ["apply inferExpr", show s] = undefined apply s = cata $ \case (AnnF ast (tp,ctx)) -> Ann (apply s ast) (apply s tp, apply s ctx) -- TODO FF (apply ast) - -- ftv = cata $ \case (AnnF ast tp) -> ftv tp + -- ftv = cata $ \case (AnnF ast tp) -> ftv tp diff --git a/src/Oczor/Syntax/Ast.hs b/src/Oczor/Syntax/Ast.hs index d76bd59..f08eea7 100644 --- a/src/Oczor/Syntax/Ast.hs +++ b/src/Oczor/Syntax/Ast.hs @@ -8,9 +8,9 @@ module Oczor.Syntax.Ast (module Oczor.Syntax.Ast, module Oczor.Syntax.Types, Lits(..), Stmts(..)) where import ClassyPrelude +import Control.Lens import Data.Functor.Foldable import Data.Functor.Foldable.TH -import Control.Lens import Oczor.Syntax.Types type ModuleName = [String] @@ -86,7 +86,7 @@ instance Functor f => Corecursive (Ann f a) where embed = \case AnnF f a -> Ann f a instance Show a => Show (Ann ExprF a) where - show (Ann x y) = "(" <> show x <> " ANN " <> show y <> ")" + show (Ann x y) = "(" ++ show x ++ " ANN " ++ show y ++ ")" stripAnns :: Ann ExprF a -> Expr stripAnns = cata $ embed . view unAnnF From dcc5d972adccf9964de863f3c18bee49f4dea161 Mon Sep 17 00:00:00 2001 From: Denis Stoyanov Date: Tue, 28 Mar 2017 18:49:22 +0300 Subject: [PATCH 4/6] Fix --- src/Oczor/Compiler/Utl.hs | 2 +- src/Oczor/Infer/InferAst.hs | 6 +++--- src/Oczor/Syntax/Ast.hs | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Oczor/Compiler/Utl.hs b/src/Oczor/Compiler/Utl.hs index fe76443..3831704 100644 --- a/src/Oczor/Compiler/Utl.hs +++ b/src/Oczor/Compiler/Utl.hs @@ -56,7 +56,7 @@ inferAstTxt2 x = Parser.parseExpr x >>= (\y -> snd <$> inferAllExpr emptyContext inferContext :: InferContext -> ModuleName -> String -> Either Error InferContext inferContext context fileName x = fst <$> inferAllTxtWith context fileName x - + inferAllTxt :: String -> Either Error (InferContext, InferExpr) -- inferAllTxt x | traceArgs ["inferAllTxt", x] = undefined diff --git a/src/Oczor/Infer/InferAst.hs b/src/Oczor/Infer/InferAst.hs index feeaa56..9c41b11 100644 --- a/src/Oczor/Infer/InferAst.hs +++ b/src/Oczor/Infer/InferAst.hs @@ -3,15 +3,15 @@ module Oczor.Infer.InferAst where import ClassyPrelude import Data.Functor.Foldable hiding (Foldable) import Oczor.Syntax.Syntax -import Oczor.Infer.Substitutable +import Oczor.Infer.Substitutable import Oczor.Infer.InferContext import Oczor.Utl + type InferExprF = AnnF ExprF (TypeExpr, InferContext) type InferExpr = Ann ExprF (TypeExpr, InferContext) -attrType :: Ann a (x, y) -> x -attrType = view (attr . _1) +attrType = fst . attr annType x y = Ann x (y, emptyContext) diff --git a/src/Oczor/Syntax/Ast.hs b/src/Oczor/Syntax/Ast.hs index f08eea7..d76bd59 100644 --- a/src/Oczor/Syntax/Ast.hs +++ b/src/Oczor/Syntax/Ast.hs @@ -8,9 +8,9 @@ module Oczor.Syntax.Ast (module Oczor.Syntax.Ast, module Oczor.Syntax.Types, Lits(..), Stmts(..)) where import ClassyPrelude -import Control.Lens import Data.Functor.Foldable import Data.Functor.Foldable.TH +import Control.Lens import Oczor.Syntax.Types type ModuleName = [String] @@ -86,7 +86,7 @@ instance Functor f => Corecursive (Ann f a) where embed = \case AnnF f a -> Ann f a instance Show a => Show (Ann ExprF a) where - show (Ann x y) = "(" ++ show x ++ " ANN " ++ show y ++ ")" + show (Ann x y) = "(" <> show x <> " ANN " <> show y <> ")" stripAnns :: Ann ExprF a -> Expr stripAnns = cata $ embed . view unAnnF From 6a0e2c556f5a1b77a29456d28933b56bc131d402 Mon Sep 17 00:00:00 2001 From: Denis Stoyanov Date: Tue, 28 Mar 2017 18:50:58 +0300 Subject: [PATCH 5/6] Fix #2 --- src/Oczor/Compiler/Utl.hs | 2 +- src/Oczor/Infer/InferAst.hs | 6 +++--- src/Oczor/Syntax/Ast.hs | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Oczor/Compiler/Utl.hs b/src/Oczor/Compiler/Utl.hs index 3831704..fe76443 100644 --- a/src/Oczor/Compiler/Utl.hs +++ b/src/Oczor/Compiler/Utl.hs @@ -56,7 +56,7 @@ inferAstTxt2 x = Parser.parseExpr x >>= (\y -> snd <$> inferAllExpr emptyContext inferContext :: InferContext -> ModuleName -> String -> Either Error InferContext inferContext context fileName x = fst <$> inferAllTxtWith context fileName x - + inferAllTxt :: String -> Either Error (InferContext, InferExpr) -- inferAllTxt x | traceArgs ["inferAllTxt", x] = undefined diff --git a/src/Oczor/Infer/InferAst.hs b/src/Oczor/Infer/InferAst.hs index 9c41b11..feeaa56 100644 --- a/src/Oczor/Infer/InferAst.hs +++ b/src/Oczor/Infer/InferAst.hs @@ -3,15 +3,15 @@ module Oczor.Infer.InferAst where import ClassyPrelude import Data.Functor.Foldable hiding (Foldable) import Oczor.Syntax.Syntax -import Oczor.Infer.Substitutable +import Oczor.Infer.Substitutable import Oczor.Infer.InferContext import Oczor.Utl - type InferExprF = AnnF ExprF (TypeExpr, InferContext) type InferExpr = Ann ExprF (TypeExpr, InferContext) -attrType = fst . attr +attrType :: Ann a (x, y) -> x +attrType = view (attr . _1) annType x y = Ann x (y, emptyContext) diff --git a/src/Oczor/Syntax/Ast.hs b/src/Oczor/Syntax/Ast.hs index d76bd59..f08eea7 100644 --- a/src/Oczor/Syntax/Ast.hs +++ b/src/Oczor/Syntax/Ast.hs @@ -8,9 +8,9 @@ module Oczor.Syntax.Ast (module Oczor.Syntax.Ast, module Oczor.Syntax.Types, Lits(..), Stmts(..)) where import ClassyPrelude +import Control.Lens import Data.Functor.Foldable import Data.Functor.Foldable.TH -import Control.Lens import Oczor.Syntax.Types type ModuleName = [String] @@ -86,7 +86,7 @@ instance Functor f => Corecursive (Ann f a) where embed = \case AnnF f a -> Ann f a instance Show a => Show (Ann ExprF a) where - show (Ann x y) = "(" <> show x <> " ANN " <> show y <> ")" + show (Ann x y) = "(" ++ show x ++ " ANN " ++ show y ++ ")" stripAnns :: Ann ExprF a -> Expr stripAnns = cata $ embed . view unAnnF From 1b8b8b49ca37f1d3b9dde26824a9606d24536a6d Mon Sep 17 00:00:00 2001 From: Denis Stoyanov Date: Tue, 28 Mar 2017 19:28:50 +0300 Subject: [PATCH 6/6] Apply patch --- src/Oczor/Compiler/Utl.hs | 4 ++-- src/Oczor/Infer/InferAst.hs | 3 ++- src/Oczor/Syntax/Ast.hs | 5 +++-- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/Oczor/Compiler/Utl.hs b/src/Oczor/Compiler/Utl.hs index fe76443..945b311 100644 --- a/src/Oczor/Compiler/Utl.hs +++ b/src/Oczor/Compiler/Utl.hs @@ -53,10 +53,10 @@ inferTxt x = normalizeType <$> (Parser.parseExpr x >>= inferType) inferAstTxt2 :: String -> Either Error InferExpr inferAstTxt2 x = Parser.parseExpr x >>= (\y -> snd <$> inferAllExpr emptyContext y) - + inferContext :: InferContext -> ModuleName -> String -> Either Error InferContext inferContext context fileName x = fst <$> inferAllTxtWith context fileName x - + inferAllTxt :: String -> Either Error (InferContext, InferExpr) -- inferAllTxt x | traceArgs ["inferAllTxt", x] = undefined diff --git a/src/Oczor/Infer/InferAst.hs b/src/Oczor/Infer/InferAst.hs index feeaa56..05392a6 100644 --- a/src/Oczor/Infer/InferAst.hs +++ b/src/Oczor/Infer/InferAst.hs @@ -3,10 +3,11 @@ module Oczor.Infer.InferAst where import ClassyPrelude import Data.Functor.Foldable hiding (Foldable) import Oczor.Syntax.Syntax -import Oczor.Infer.Substitutable +import Oczor.Infer.Substitutable import Oczor.Infer.InferContext import Oczor.Utl + type InferExprF = AnnF ExprF (TypeExpr, InferContext) type InferExpr = Ann ExprF (TypeExpr, InferContext) diff --git a/src/Oczor/Syntax/Ast.hs b/src/Oczor/Syntax/Ast.hs index f08eea7..cb3e24e 100644 --- a/src/Oczor/Syntax/Ast.hs +++ b/src/Oczor/Syntax/Ast.hs @@ -80,10 +80,10 @@ makeLenses ''AnnF type instance Base (Ann f a) = AnnF f a instance Functor f => Recursive (Ann f a) where - project = \case Ann f a -> AnnF f a + project = \case Ann f a -> AnnF f a instance Functor f => Corecursive (Ann f a) where - embed = \case AnnF f a -> Ann f a + embed = \case AnnF f a -> Ann f a instance Show a => Show (Ann ExprF a) where show (Ann x y) = "(" ++ show x ++ " ANN " ++ show y ++ ")" @@ -95,3 +95,4 @@ pattern UnAnn x <- Ann x y pattern ExprListMD x <- MD y (ExprList x) pattern LabelAccessCall label e = Call (LabelAccess label) e +