From 35c10e716b339cc31674dc0e9efddf4325d1fc17 Mon Sep 17 00:00:00 2001 From: scottolsen Date: Mon, 9 Aug 2021 12:53:13 -0400 Subject: [PATCH 1/2] refactor: Refactor AssignTypes This commit contains a minimal refactor of the AssignTypes module: - Add an export list. - Use the xobj patterns defined in the Forms module. - Break out local functions into top level declarations. --- src/AssignTypes.hs | 94 +++++++++++++++++++++++++--------------------- 1 file changed, 51 insertions(+), 43 deletions(-) diff --git a/src/AssignTypes.hs b/src/AssignTypes.hs index 44b0ea5af..300f4a482 100644 --- a/src/AssignTypes.hs +++ b/src/AssignTypes.hs @@ -1,56 +1,42 @@ -module AssignTypes where +-- | Module AssignTypes defines routines for replacing type variables with +-- concrete types. +module AssignTypes + ( assignTypes, + beautifyTypeVariables, + ) +where import Data.List (nub) +import Forms import qualified Map import Obj import TypeError import Types +-------------------------------------------------------------------------------- +-- Public functions + {-# ANN assignTypes "HLint: ignore Eta reduce" #-} --- | Walk the whole expression tree and replace all occurences of VarTy with their corresponding actual type. +-- | Walk the whole expression tree and replace all occurrences of VarTy with +-- their corresponding actual type. assignTypes :: TypeMappings -> XObj -> Either TypeError XObj -assignTypes mappings root = visit root - where - visit xobj = - case xobjObj xobj of - (Lst _) -> visitList xobj - (Arr _) -> visitArray xobj - (StaticArr _) -> visitStaticArray xobj - _ -> assignType xobj - visitList :: XObj -> Either TypeError XObj - visitList (XObj (Lst xobjs) i t) = - do - visited <- mapM (assignTypes mappings) xobjs - let xobj' = XObj (Lst visited) i t - assignType xobj' - visitList _ = error "The function 'visitList' only accepts XObjs with lists in them." - visitArray :: XObj -> Either TypeError XObj - visitArray (XObj (Arr xobjs) i t) = - do - visited <- mapM (assignTypes mappings) xobjs - let xobj' = XObj (Arr visited) i t - assignType xobj' - visitArray _ = error "The function 'visitArray' only accepts XObjs with arrays in them." - visitStaticArray :: XObj -> Either TypeError XObj - visitStaticArray (XObj (StaticArr xobjs) i t) = - do - visited <- mapM (assignTypes mappings) xobjs - let xobj' = XObj (StaticArr visited) i t - assignType xobj' - visitStaticArray _ = error "The function 'visitStaticArray' only accepts XObjs with arrays in them." - assignType :: XObj -> Either TypeError XObj - assignType xobj = case xobjTy xobj of - Just startingType -> - let finalType = replaceTyVars mappings startingType - in if isArrayTypeOK finalType - then Right (xobj {xobjTy = Just finalType}) - else Left (ArraysCannotContainRefs xobj) - Nothing -> pure xobj - -isArrayTypeOK :: Ty -> Bool -isArrayTypeOK (StructTy (ConcreteNameTy (SymPath [] "Array")) [RefTy _ _]) = False -- An array containing refs! -isArrayTypeOK _ = True +assignTypes mappings x@(ListPat xs) = + do + visited <- mapM (assignTypes mappings) xs + let xobj' = XObj (Lst visited) (xobjInfo x) (xobjTy x) + assignType mappings xobj' +assignTypes mappings x@(ArrPat xs) = + do + visited <- mapM (assignTypes mappings) xs + let xobj' = XObj (Arr visited) (xobjInfo x) (xobjTy x) + assignType mappings xobj' +assignTypes mappings x@(StaticArrPat xs) = + do + visited <- mapM (assignTypes mappings) xs + let xobj' = XObj (StaticArr visited) (xobjInfo x) (xobjTy x) + assignType mappings xobj' +assignTypes mappings xobj = assignType mappings xobj -- | Change auto generated type names (i.e. 't0') to letters (i.e. 'a', 'b', 'c', etc...) -- | TODO: Only change variables that are machine generated. @@ -65,3 +51,25 @@ beautifyTypeVariables root = (map (VarTy . (: [])) ['a' ..]) ) in assignTypes mappings root + +-------------------------------------------------------------------------------- +-- Private functions + +-- | Replace a type variable with a concrete type, ensuring refs aren't passed +-- as members of arrays. +assignType :: TypeMappings -> XObj -> Either TypeError XObj +assignType mappings xobj = + case xobjTy xobj of + Just startingType -> + let finalType = replaceTyVars mappings startingType + in if isArrayTypeOK finalType + then Right (xobj {xobjTy = Just finalType}) + else Left (ArraysCannotContainRefs xobj) + Nothing -> pure xobj + +-- | Returns false if an array contains a Ref type as a member. +isArrayTypeOK :: Ty -> Bool +isArrayTypeOK (StructTy (ConcreteNameTy (SymPath [] "Array")) [RefTy _ _]) = + -- An array containing refs! + False +isArrayTypeOK _ = True From f2418ba7b6b54669ac88dfb34e7bc52643401aa6 Mon Sep 17 00:00:00 2001 From: scottolsen Date: Mon, 9 Aug 2021 15:46:31 -0400 Subject: [PATCH 2/2] refactor: further simplify assign types using composition --- src/AssignTypes.hs | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/src/AssignTypes.hs b/src/AssignTypes.hs index 300f4a482..9d1730da5 100644 --- a/src/AssignTypes.hs +++ b/src/AssignTypes.hs @@ -22,21 +22,12 @@ import Types -- their corresponding actual type. assignTypes :: TypeMappings -> XObj -> Either TypeError XObj assignTypes mappings x@(ListPat xs) = - do - visited <- mapM (assignTypes mappings) xs - let xobj' = XObj (Lst visited) (xobjInfo x) (xobjTy x) - assignType mappings xobj' + mapM (assignTypes mappings) xs >>= pure . (setObj x) . Lst assignTypes mappings x@(ArrPat xs) = - do - visited <- mapM (assignTypes mappings) xs - let xobj' = XObj (Arr visited) (xobjInfo x) (xobjTy x) - assignType mappings xobj' + mapM (assignTypes mappings) xs >>= pure . (setObj x) . Arr assignTypes mappings x@(StaticArrPat xs) = - do - visited <- mapM (assignTypes mappings) xs - let xobj' = XObj (StaticArr visited) (xobjInfo x) (xobjTy x) - assignType mappings xobj' -assignTypes mappings xobj = assignType mappings xobj + mapM (assignTypes mappings) xs >>= pure . (setObj x) . StaticArr +assignTypes mappings x = assignType mappings x -- | Change auto generated type names (i.e. 't0') to letters (i.e. 'a', 'b', 'c', etc...) -- | TODO: Only change variables that are machine generated.