mirror of
https://github.com/macocianradu/RosettaHaskellCompiler.git
synced 2026-03-18 13:00:08 +00:00
added coercions and explicit functions
it compiles needs testing
This commit is contained in:
Macocian Adrian Radu
23
app/Main.hs
23
app/Main.hs
@@ -10,6 +10,7 @@ import Text.Megaparsec
|
||||
import PrettyPrinter.Enum
|
||||
import PrettyPrinter.Type
|
||||
import PrettyPrinter.Function
|
||||
import PrettyPrinter.RosettaObject
|
||||
import Semantic.TypeChecker
|
||||
import Semantic.ExpressionChecker
|
||||
import Semantic.FunctionChecker
|
||||
@@ -71,32 +72,32 @@ parseFile :: String -> Either (ParseErrorBundle Text Void) (Header, [RosettaObje
|
||||
parseFile plainText = parse rosettaParser "" (Text.pack plainText)
|
||||
|
||||
-- |Converts a RosettaObject into a plain haskell string
|
||||
printObject :: RosettaObject -> String
|
||||
printObject (TypeObject t) = printType t
|
||||
printObject (FunctionObject f) = printFunction f
|
||||
printObject (EnumObject e) = printEnum e
|
||||
-- printObject :: CheckedRosettaObject -> String
|
||||
-- printObject (CheckedTypeObject t) = printType t
|
||||
-- printObject (CheckedFunctionObject f) = printFunction f
|
||||
-- printObject (CheckedEnumObject e) = printEnum e
|
||||
|
||||
-- |Checks all the objects from a list
|
||||
checkObjects :: [(([Type], [Symbol]), (Header, [RosettaObject]))] -> [(Header, [Either [TypeCheckError] RosettaObject])]
|
||||
checkObjects :: [(([Type], [Symbol]), (Header, [RosettaObject]))] -> [(Header, [Either [TypeCheckError] CheckedRosettaObject])]
|
||||
checkObjects [] = []
|
||||
checkObjects (((definedTypes, definedSymbols), (header, objs)) : rest) = (header, checked) : checkObjects rest
|
||||
where
|
||||
checked = map (checkObject (definedTypes, definedSymbols)) objs
|
||||
|
||||
-- |Checks the RosettaObject for type errors
|
||||
checkObject :: ([Type], [Symbol]) -> RosettaObject -> Either [TypeCheckError] RosettaObject
|
||||
checkObject :: ([Type], [Symbol]) -> RosettaObject -> Either [TypeCheckError] CheckedRosettaObject
|
||||
-- |Checks the type and attributes of a type
|
||||
checkObject (definedTypes, _) (TypeObject t) =
|
||||
case checkType definedTypes t of
|
||||
Left errors -> Left errors
|
||||
Right typ -> Right $ TypeObject typ
|
||||
Right typ -> Right $ CheckedTypeObject typ
|
||||
-- |If an enum parses, it cannot throw an error
|
||||
checkObject _ (EnumObject e) = Right (EnumObject e)
|
||||
checkObject _ (EnumObject e) = Right $ CheckedEnumObject e
|
||||
-- |Checks the function inputs, output and assignment
|
||||
checkObject (definedTypes, definedFunctions) (FunctionObject fun) =
|
||||
case checkFunction (definedTypes, defaultMap ++ definedFunctions) fun of
|
||||
Left errors -> Left errors
|
||||
Right func -> Right $ FunctionObject func
|
||||
Right func -> Right $ CheckedFunctionObject func
|
||||
|
||||
-- |Adds new defined functions into the symbol table
|
||||
addNewFunctions :: ([Type], [Symbol]) -> [RosettaObject] -> Either [TypeCheckError] [Symbol]
|
||||
@@ -140,5 +141,5 @@ parseFunction = do
|
||||
FunctionObject <$> functionParser
|
||||
|
||||
-- |Generate a new haskell file based on the rosetta objects and header
|
||||
generateFile :: (Header, [RosettaObject]) -> IO ()
|
||||
generateFile (header, objects) = writeFile (haskellFileName $ namespace header) (printHeader header ++ concatMap printObject objects)
|
||||
generateFile :: (Header, [CheckedRosettaObject]) -> IO ()
|
||||
generateFile (header, objects) = writeFile (haskellFileName $ namespace header) (printHeader header ++ concatMap printRosettaObject objects)
|
||||
@@ -24,3 +24,4 @@ data ExplicitFunction =
|
||||
sign :: FunctionSignature,
|
||||
explicitAssignment :: ExplicitExpression
|
||||
}
|
||||
deriving Show
|
||||
@@ -10,3 +10,9 @@ data RosettaObject =
|
||||
| TypeObject Type
|
||||
| FunctionObject Function
|
||||
deriving Show
|
||||
|
||||
data CheckedRosettaObject =
|
||||
CheckedEnumObject EnumType
|
||||
| CheckedTypeObject Type
|
||||
| CheckedFunctionObject ExplicitFunction
|
||||
deriving Show
|
||||
@@ -45,12 +45,12 @@ data Expression = Variable String
|
||||
|
||||
data ExplicitExpression = ExplicitEmpty
|
||||
| ExplicitVariable {name :: String, returnCoercion :: Coercion}
|
||||
| Value {returnCoercion :: Coercion}
|
||||
| Value {name :: String, returnCoercion :: Coercion}
|
||||
| ExplicitList [ExplicitExpression]
|
||||
| ExplicitParens ExplicitExpression
|
||||
| ExplicitFunction {name :: String, args :: [Coercion], returnCoercion :: Coercion}
|
||||
| ExplicitIfSimple {cond :: Coercion, returnCoercion :: Coercion}
|
||||
| ExplicitIfEsle {cond :: Coercion, args :: [Coercion], returnCoercion :: Coercion}
|
||||
| ExplicitFunction {name :: String, args :: [(ExplicitExpression, Coercion)], returnCoercion :: Coercion}
|
||||
| ExplicitIfSimple {cond :: (ExplicitExpression, Coercion), block1 :: (ExplicitExpression, Coercion), returnCoercion :: Coercion}
|
||||
| ExplicitIfElse {cond :: (ExplicitExpression, Coercion), block1 :: (ExplicitExpression, Coercion), block2 :: (ExplicitExpression, Coercion), returnCoercion :: Coercion}
|
||||
deriving (Show)
|
||||
|
||||
data TypeCoercion =
|
||||
@@ -61,7 +61,12 @@ data TypeCoercion =
|
||||
|
||||
data CardinalityCoercion =
|
||||
MakeCardinalityIdCoercion {toCardinality :: Cardinality}
|
||||
| MakeCardinalityCoercion {fromCardinality :: Cardinality, toCardinality :: Cardinality, transformCardinality :: String}
|
||||
| MakeListCardinalityCoercion {fromCardinality :: Cardinality, toCardinality :: Cardinality}
|
||||
| MakeNothing2MaybeCoercion {fromCardinality :: Cardinality, toCardinality :: Cardinality}
|
||||
| MakeNothing2ListCoercion {fromCardinality :: Cardinality, toCardinality :: Cardinality}
|
||||
| MakeMaybe2ListCoercion {fromCardinality :: Cardinality, toCardinality :: Cardinality}
|
||||
| MakeObject2MaybeCoercion {fromCardinality :: Cardinality, toCardinality :: Cardinality}
|
||||
| MakeObject2ListCoercion {fromCardinality :: Cardinality, toCardinality :: Cardinality}
|
||||
deriving (Show)
|
||||
|
||||
-- |Used to handle polymorphism in Rosetta
|
||||
|
||||
@@ -11,60 +11,63 @@ import Model.Type
|
||||
-- show printStatementTree
|
||||
|
||||
-- |Converts a Function into a haskell valid String
|
||||
printFunction :: Function -> String
|
||||
printFunction f = show $ vcat [printFunctionSignature f, printFunctionBody f, emptyDoc]
|
||||
printFunction :: ExplicitFunction -> String
|
||||
printFunction f = show $ vcat [printFunctionSignature (sign f), printFunctionBody f, emptyDoc]
|
||||
|
||||
-- |Converts the body of a Function into a haskell valid Doc
|
||||
printFunctionBody :: Function -> Doc a
|
||||
printFunctionBody (MakeFunction name _ inp out ex) = pretty name <+> printVariableNames inp <+> "=" <+> printExpression inp (cardinality out) ex
|
||||
printExpression :: [TypeAttribute] -> Cardinality -> Expression -> Doc a
|
||||
printExpression inps c (Variable s) = printVariable varC c s
|
||||
where
|
||||
varC = getVarCardinality inps s
|
||||
printExpression inps c (Int s) = printVariable (Bounds (1, 1)) c s
|
||||
printExpression inps c (Real s) = printVariable (Bounds (1, 1)) c s
|
||||
printExpression inps c (Boolean s) = printVariable (Bounds (1, 1)) c s
|
||||
printExpression inps c Empty = "empty"
|
||||
printExpression inps c (Parens ex) = "(" <> printExpression inps c ex <> ")"
|
||||
printExpression inps c (List ex) = list (map (printExpression inps c) ex)
|
||||
printExpression inps c (Function name ex) = pretty name <> tupled (map (printExpression inps c) ex)
|
||||
printExpression inps c (PrefixExp name ex) = pretty name <+> printExpression inps c ex
|
||||
printExpression inps c (PostfixExp "exists" ex) = "isJust" <+> printExpression inps c ex
|
||||
printExpression inps c (PostfixExp "is absent" ex) = "isNothing" <+> printExpression inps c ex
|
||||
printExpression inps c (PostfixExp "single exists" ex) = "length" <+> printExpression inps c ex <+> "==" <+> "1"
|
||||
printExpression inps c (PostfixExp "multiple exists" ex) = "length" <+> printExpression inps c ex <+> ">" <+> "1"
|
||||
printExpression inps c (PostfixExp "count" ex) = "length" <+> printExpression inps c ex
|
||||
printExpression inps c (PostfixExp name ex) = pretty name <+> printExpression inps c ex
|
||||
printFunctionBody :: ExplicitFunction -> Doc a
|
||||
printFunctionBody (MakeExplicitFunction (MakeFunctionSignature name _ inp out) ex) = pretty name <+> printVariableNames inp <+> "=" <+> printExpression ex
|
||||
printExpression :: ExplicitExpression -> Doc a
|
||||
printExpression ExplicitEmpty = "[]"
|
||||
printExpression (ExplicitVariable name coer) = printCoercion coer $ pretty name
|
||||
printExpression (Value s coer) = printCoercion coer $ pretty s
|
||||
printExpression (ExplicitParens ex) = "(" <> printExpression ex <> ")"
|
||||
printExpression (ExplicitList ex) = list (map printExpression ex)
|
||||
printExpression (ExplicitFunction "exists" args returnCoerce) = printCoercion returnCoerce "isJust" <+> printCoercion (snd $ head args) (printExpression $ fst $ head args)
|
||||
printExpression (ExplicitFunction "is absent" args returnCoerce) = printCoercion returnCoerce "isNothing" <+> printCoercion (snd $ head args) (printExpression $ fst $ head args)
|
||||
printExpression (ExplicitFunction "single exists" args returnCoerce) = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression $ fst $ head args) <+> "==" <+> "1"
|
||||
printExpression (ExplicitFunction "multiple exists" args returnCoerce) = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression $ fst $ head args) <+> ">" <+> "1"
|
||||
printExpression (ExplicitFunction "count" args returnCoerce) = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression $ fst $ head args)
|
||||
-- Equality expressions
|
||||
-- [a] a all =
|
||||
-- any <>
|
||||
printExpression inps c (InfixExp "=" ex1 ex2) = printExpression inps c ex1 <+> "==" <+> printExpression inps c ex2
|
||||
printExpression inps c (InfixExp "<>" ex1 ex2) = printExpression inps c ex1 <+> "/=" <+> printExpression inps c ex2
|
||||
printExpression inps c (InfixExp "any =" ex1 ex2) = printExpression inps c ex2 <+> "`elem`" <+> printExpression inps c ex1
|
||||
printExpression inps c (InfixExp "all <>" ex1 ex2) = printExpression inps c ex2 <+> "`notElem`" <+> printExpression inps c ex1
|
||||
--printExpression (InfixExp "all =" ex1 ex2) = "all (Eq)" <+> printExpression ex2 <+> printExpression ex1
|
||||
printExpression inps c (InfixExp "and" ex1 ex2) = printExpression inps c ex1 <+> "&&" <+> printExpression inps c ex2
|
||||
printExpression inps c (InfixExp "or" ex1 ex2) = printExpression inps c ex1 <+> "||" <+> printExpression inps c ex2
|
||||
printExpression inps c (InfixExp name ex1 ex2) = printExpression inps c ex1 <+> pretty name <+> printExpression inps c ex2
|
||||
printExpression inps (Bounds (0, 1)) (IfSimple cond ex) = "if" <+> printExpression inps (Bounds (1, 1)) cond <+> "then" <+> printExpression inps (Bounds (0, 1)) ex <+> "else" <+> "Nothing"
|
||||
printExpression inps c (IfSimple cond ex) = "if" <+> printExpression inps (Bounds (1, 1)) cond <+> "then" <+> printExpression inps c ex <+> "else" <+> "[]"
|
||||
printExpression inps c (IfElse cond ex1 ex2) = "if" <+> printExpression inps (Bounds (1, 1)) cond <+> "then" <+> printExpression inps c ex1 <+> "else" <+> printExpression inps c ex2
|
||||
printExpression (ExplicitFunction "=" args returnCoerce) = printCoercion (snd $ head args) (printExpression $ fst $ head args) <+> "==" <+> printCoercion (snd $ head $ tail args) (printExpression $ fst $ head $ tail args)
|
||||
printExpression (ExplicitFunction "<>" args returnCoerce) = printCoercion (snd $ head args) (printExpression $ fst $ head args) <+> "/=" <+> printCoercion (snd $ head $ tail args) (printExpression $ fst $ head $ tail args)
|
||||
printExpression (ExplicitFunction "any =" args returnCoerce) = printCoercion (snd $ head $ tail args) (printExpression $ fst $ head $ tail args)<+> "`elem`" <+> printCoercion (snd $ head args) (printExpression $ fst $ head args)
|
||||
printExpression (ExplicitFunction "all <>" args returnCoerce) = printCoercion (snd $ head $ tail args) (printExpression $ fst $ head $ tail args)<+> "`notElem`" <+> printCoercion (snd $ head args) (printExpression $ fst $ head args)
|
||||
printExpression (ExplicitFunction "all =" args returnCoerce) = "all (Eq)" <+> printCoercion (snd $ head $ tail args) (printExpression $ fst $ head $ tail args) <+> printCoercion (snd $ head args) (printExpression $ fst $ head args)
|
||||
printExpression (ExplicitFunction "and" args returnCoerce) = printCoercion (snd $ head args) (printExpression $ fst $ head args) <+> "&&" <+> printCoercion (snd $ head $ tail args) (printExpression $ fst $ head $ tail args)
|
||||
printExpression (ExplicitFunction "or" args returnCoerce) = printCoercion (snd $ head args) (printExpression $ fst $ head args) <+> "||" <+> printCoercion (snd $ head $ tail args) (printExpression $ fst $ head $ tail args)
|
||||
printExpression (ExplicitFunction name args returnCoerce) = pretty name <+> tupled (zipWith printCoercion [c | (e,c) <- args] [printExpression e | (e, c) <- args])
|
||||
printExpression (ExplicitIfSimple cond thenBlock returnCoercion) = "if" <+> printCoercion (snd cond) (printExpression $ fst cond) <+> "then" <+> printCoercion (snd thenBlock) (printExpression $ fst thenBlock) <+> "else" <+> "Nothing"
|
||||
printExpression (ExplicitIfElse cond thenBlock elseBlock returnCoercion) = "if" <+> printCoercion (snd cond) (printExpression $ fst cond) <+> "then" <+> printCoercion (snd thenBlock) (printExpression $ fst thenBlock) <+> "else" <+> printCoercion (snd elseBlock) (printExpression $ fst elseBlock)
|
||||
|
||||
-- |Converts a variable into a maybe or list depending on necessity
|
||||
printVariable :: Cardinality -> Cardinality -> String -> Doc a
|
||||
printVariable (Bounds (1, 1)) (Bounds (1, 1)) s = pretty s
|
||||
printVariable (Bounds (1, 1)) (Bounds (0, 1)) s = "Just" <+> pretty s
|
||||
printVariable (Bounds (0, 1)) (Bounds (0, 1)) s = pretty s
|
||||
printVariable (Bounds (1, 1)) _ s = "[" <+> pretty s <+> "]"
|
||||
printVariable _ _ s = pretty s
|
||||
-- |Converts a coercion into a haskell string
|
||||
printCoercion :: Coercion -> Doc a -> Doc a
|
||||
printCoercion (MakeCoercion [] crd) d = printCardinalityCoercion crd d
|
||||
printCoercion (MakeCoercion (t: ts) crd) d = printTypeCoercion t <+> printCoercion (MakeCoercion ts crd) d
|
||||
|
||||
printCardinalityCoercion :: CardinalityCoercion -> Doc a -> Doc a
|
||||
printCardinalityCoercion (MakeCardinalityIdCoercion _) d = d
|
||||
printCardinalityCoercion (MakeListCardinalityCoercion _ _) d = d
|
||||
printCardinalityCoercion (MakeNothing2MaybeCoercion _ _) d = "Nothing"
|
||||
printCardinalityCoercion (MakeNothing2ListCoercion _ _) d = "[]"
|
||||
printCardinalityCoercion (MakeMaybe2ListCoercion _ _) d = "maybeToList" <+> d
|
||||
printCardinalityCoercion (MakeObject2MaybeCoercion _ _) d = "Just" <+> d
|
||||
printCardinalityCoercion (MakeObject2ListCoercion _ _) d = "[" <> d <> "]"
|
||||
|
||||
printTypeCoercion :: TypeCoercion -> Doc a
|
||||
printTypeCoercion (MakeIdCoercion _) = emptyDoc
|
||||
printTypeCoercion (MakeSuperCoercion _ _) = "super"
|
||||
printTypeCoercion (MakeTypeCoercion _ _ t) = pretty t
|
||||
|
||||
-- |Converts a list of type attributes to a Doc with a list of variable names
|
||||
printVariableNames :: [TypeAttribute] -> Doc a
|
||||
printVariableNames vars = foldl (<+>) emptyDoc (map (pretty . attributeName) vars)
|
||||
|
||||
-- |Converts a function into a haskell valid Doc representing the signature of the function
|
||||
printFunctionSignature :: Function -> Doc a
|
||||
printFunctionSignature (MakeFunction name description inputs output _) =
|
||||
printFunctionSignature :: FunctionSignature -> Doc a
|
||||
printFunctionSignature (MakeFunctionSignature name description inputs output) =
|
||||
printDescription description (pretty name <+> prettyPrintType (Prelude.map printCardinality (inputs ++ [output])))
|
||||
|
||||
-- |Zips the signature with the needed characters ('::', '->')
|
||||
|
||||
@@ -6,7 +6,7 @@ import PrettyPrinter.Function
|
||||
import PrettyPrinter.Type
|
||||
|
||||
-- |Converts a supported Rosetta object into a haskell valid String
|
||||
printRosettaObject :: RosettaObject -> String
|
||||
printRosettaObject (EnumObject a) = printEnum a
|
||||
printRosettaObject (TypeObject a) = printType a
|
||||
printRosettaObject (FunctionObject a) = printFunction a
|
||||
printRosettaObject :: CheckedRosettaObject -> String
|
||||
printRosettaObject (CheckedEnumObject a) = printEnum a
|
||||
printRosettaObject (CheckedTypeObject a) = printType a
|
||||
printRosettaObject (CheckedFunctionObject a) = printFunction a
|
||||
@@ -6,6 +6,7 @@ import Data.Maybe
|
||||
import Model.Type
|
||||
import Semantic.TypeChecker
|
||||
import Utils.Utils
|
||||
import Model.Type (CardinalityCoercion(MakeNothing2MaybeCoercion, MakeNothing2ListCoercion, MakeMaybe2ListCoercion, MakeObject2MaybeCoercion, MakeObject2ListCoercion))
|
||||
|
||||
-- |A declared variable or function
|
||||
data Symbol = Var{
|
||||
@@ -87,10 +88,10 @@ addVariables s ((MakeTypeAttribute name typ crd _) : vars) = Var name (toHaskel
|
||||
-- |Checks the type of a given expression
|
||||
checkExpression :: [Symbol] -> Expression -> Either TypeCheckError ExplicitExpression
|
||||
checkExpression symbolMap (Variable var) = findVarType var symbolMap
|
||||
checkExpression _ (Int _) = Right $ Value $ MakeCoercion [MakeIdCoercion (BasicType "Integer")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
|
||||
checkExpression _ (Real _) = Right $ Value $ MakeCoercion [MakeIdCoercion (BasicType "Double")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
|
||||
checkExpression _ (Boolean _) = Right $ Value $ MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
|
||||
checkExpression _ Empty = Right $ Value $ MakeCoercion [MakeIdCoercion (BasicType "Empty")] (MakeCardinalityIdCoercion (Bounds (0, 0)))
|
||||
checkExpression _ (Int val) = Right $ Value val $ MakeCoercion [MakeIdCoercion (BasicType "Integer")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
|
||||
checkExpression _ (Real val) = Right $ Value val $ MakeCoercion [MakeIdCoercion (BasicType "Double")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
|
||||
checkExpression _ (Boolean val) = Right $ Value val $ MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
|
||||
checkExpression _ Empty = Right $ Value "empty" $ MakeCoercion [MakeIdCoercion (BasicType "Empty")] (MakeCardinalityIdCoercion (Bounds (0, 0)))
|
||||
checkExpression symbolMap (Parens ex) =
|
||||
case checkExpression symbolMap ex of
|
||||
Left err -> Left err
|
||||
@@ -104,34 +105,34 @@ checkExpression symbolMap (InfixExp name ex1 ex2) = checkFunctionCall symbolMap
|
||||
checkExpression symbolMap (IfSimple cond ex) =
|
||||
case checkExpression symbolMap cond of
|
||||
Left err -> Left $ IfConditionNotBoolean $ show err
|
||||
Right condType -> case coercionType conditionPreCoercion `isSubType` BasicType "Boolean" of
|
||||
Left err -> Left $ IfConditionNotBoolean $ show cond ++ " :: " ++ show (coercionType conditionPreCoercion)
|
||||
Right condType -> case returnCoercion condType `coercionIncluded` MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1))) of
|
||||
Left err -> Left $ IfConditionNotBoolean $ show cond ++ " :: " ++ show (coercionType $ typeCoercion $ returnCoercion condType)
|
||||
Right condCoerce ->
|
||||
case checkExpression symbolMap ex of
|
||||
Left err -> Left err
|
||||
Right thenCoerce ->
|
||||
Right $ ExplicitIfSimple
|
||||
(MakeCoercion (condCoerce ++ conditionPreCoercion) (cardinalityCoercion $ returnCoercion condType)) (returnCoercion thenCoerce)
|
||||
where
|
||||
conditionPreCoercion = typeCoercion $ returnCoercion condType
|
||||
Right thenExp ->
|
||||
Right $ ExplicitIfSimple (condType, condCoerce)
|
||||
(thenExp, MakeCoercion [MakeIdCoercion $ coercionType $ typeCoercion $ returnCoercion thenExp]
|
||||
(MakeCardinalityIdCoercion $ toCardinality $ cardinalityCoercion $ returnCoercion thenExp)) (returnCoercion thenExp)
|
||||
|
||||
-- |Checks if the condition of the if statement is of type boolean, and then checks that both the then and else statements have the same type
|
||||
checkExpression symbolMap (IfElse cond ex1 ex2) =
|
||||
case checkExpression symbolMap cond of
|
||||
Left err -> Left $ IfConditionNotBoolean $ show err
|
||||
Right condType ->
|
||||
case coercionType conditionPreCoercion `isSubType` BasicType "Boolean" of
|
||||
Left err -> Left $ IfConditionNotBoolean $ show cond ++ " :: " ++ show (coercionType conditionPreCoercion)
|
||||
Right condCoerce ->
|
||||
case checkExpression symbolMap ex1 of
|
||||
Right condType -> case returnCoercion condType `coercionIncluded` MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1))) of
|
||||
Left err -> Left $ IfConditionNotBoolean $ show cond ++ " :: " ++ show (coercionType $ typeCoercion $ returnCoercion condType)
|
||||
Right condCoerce ->
|
||||
case checkExpression symbolMap ex1 of
|
||||
Left err -> Left $ ErrorInsideFunction $ show err
|
||||
Right thenExp -> case checkExpression symbolMap ex2 of
|
||||
Left err -> Left $ ErrorInsideFunction $ show err
|
||||
Right ex1Checked -> case checkExpression symbolMap ex2 of
|
||||
Left err -> Left $ ErrorInsideFunction $ show err
|
||||
Right ex2Checked -> Right $ ExplicitIfEsle
|
||||
(MakeCoercion (condCoerce ++ conditionPreCoercion) (cardinalityCoercion $ returnCoercion condType))
|
||||
(returnCoercion ex1Checked : [returnCoercion ex2Checked]) (returnCoercion ex1Checked)
|
||||
--(typeMatch ex1Type ex2Type, smallestBound ex1Card ex2Type)
|
||||
where
|
||||
conditionPreCoercion = typeCoercion $ returnCoercion condType
|
||||
Right elseExp ->
|
||||
Right $ ExplicitIfElse (condType, condCoerce)
|
||||
(thenExp, MakeCoercion [MakeIdCoercion $ coercionType $ typeCoercion $ returnCoercion thenExp]
|
||||
(MakeCardinalityIdCoercion $ toCardinality $ cardinalityCoercion $ returnCoercion thenExp))
|
||||
(elseExp, MakeCoercion [MakeIdCoercion $ coercionType $ typeCoercion $ returnCoercion elseExp]
|
||||
(MakeCardinalityIdCoercion $ toCardinality $ cardinalityCoercion $ returnCoercion elseExp)) (returnCoercion thenExp)
|
||||
--(typeMatch ex1Type ex2Type, smallestBound ex1Card ex2Type)
|
||||
|
||||
|
||||
-- |TODO Handle nested lists and lists with parens
|
||||
@@ -168,7 +169,7 @@ checkFunctionCall :: [Symbol] -> String -> [Either TypeCheckError ExplicitExpres
|
||||
checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ show (rights args) ++ "]"
|
||||
checkFunctionCall ((Func n a r):symbolMap) name args
|
||||
| length (rights args) /= length args = Left $ ErrorInsideFunction (name ++ ": " ++ show args ++ show (lefts args))
|
||||
| name == n && all isRight coerce = Right $ ExplicitFunction name (rights coerce) (MakeCoercion [MakeIdCoercion (fst r)] (MakeCardinalityIdCoercion (snd r)))
|
||||
| name == n && all isRight coerce = Right $ ExplicitFunction name (zip (rights args) (rights coerce)) (MakeCoercion [MakeIdCoercion (fst r)] (MakeCardinalityIdCoercion (snd r)))
|
||||
| otherwise = checkFunctionCall symbolMap name args
|
||||
where
|
||||
argCoerce = map returnCoercion (rights args)
|
||||
@@ -227,19 +228,24 @@ isSubType x y
|
||||
-- |Checks whether the first cardinality is included into the second one
|
||||
cardinalityIncluded :: Cardinality -> Cardinality -> Either TypeCheckError CardinalityCoercion
|
||||
-- |Special Cases
|
||||
cardinalityIncluded (Bounds (0, 0)) (Bounds (0, 1)) = Right $ MakeCardinalityCoercion (Bounds (0, 0)) (Bounds (0, 1)) "Nothing"
|
||||
cardinalityIncluded (Bounds (0, 0)) (OneBound 0) = Right $ MakeCardinalityCoercion (Bounds (0, 0)) (OneBound 0) "[]"
|
||||
cardinalityIncluded (Bounds (0, 1)) (OneBound 0) = Right $ MakeCardinalityCoercion (Bounds (0, 1)) (OneBound 0) "[Just]"
|
||||
cardinalityIncluded (Bounds (1, 1)) (Bounds (0, 1)) = Right $ MakeCardinalityCoercion (Bounds (0, 1)) (Bounds (0, 1)) "Just"
|
||||
cardinalityIncluded (Bounds (1, 1)) (OneBound 1) = Right $ MakeCardinalityCoercion (Bounds (0, 1)) (OneBound 1) "[]"
|
||||
-- |Transform nothing into a maybe
|
||||
cardinalityIncluded (Bounds (0, 0)) (Bounds (0, 1)) = Right $ MakeNothing2MaybeCoercion (Bounds (0, 0)) (Bounds (0, 1))
|
||||
-- |Transform nothing into a list
|
||||
cardinalityIncluded (Bounds (0, 0)) (OneBound 0) = Right $ MakeNothing2ListCoercion (Bounds (0, 0)) (OneBound 0)
|
||||
-- |Transform maybe into list
|
||||
cardinalityIncluded (Bounds (0, 1)) (OneBound 0) = Right $ MakeMaybe2ListCoercion (Bounds (0, 1)) (OneBound 0)
|
||||
-- |Transform object into maybe
|
||||
cardinalityIncluded (Bounds (1, 1)) (Bounds (0, 1)) = Right $ MakeObject2MaybeCoercion (Bounds (0, 1)) (Bounds (0, 1))
|
||||
-- |Transform object into list
|
||||
cardinalityIncluded (Bounds (1, 1)) (OneBound 1) = Right $ MakeObject2ListCoercion (Bounds (0, 1)) (OneBound 1)
|
||||
-- |General
|
||||
cardinalityIncluded (OneBound x) (OneBound y)
|
||||
| x >= y = Right $ MakeCardinalityCoercion (OneBound x) (OneBound y) "id"
|
||||
| x >= y = Right $ MakeListCardinalityCoercion (OneBound x) (OneBound y)
|
||||
| otherwise = Left $ CardinalityMismatch (OneBound x) (OneBound y)
|
||||
cardinalityIncluded (Bounds (x1, y1)) (OneBound y)
|
||||
| x1 >= y = Right $ MakeCardinalityCoercion (Bounds (x1, y1)) (OneBound y) "id"
|
||||
| x1 >= y = Right $ MakeListCardinalityCoercion (Bounds (x1, y1)) (OneBound y)
|
||||
| otherwise = Left $ CardinalityMismatch (Bounds (x1, y1)) (OneBound y)
|
||||
cardinalityIncluded (OneBound x) (Bounds (x2, y2)) = Left $ CardinalityMismatch (OneBound x) (Bounds (x2, y2))
|
||||
cardinalityIncluded (Bounds (x1, x2)) (Bounds (y1, y2))
|
||||
| x1 >= y1 && x2 <= y2 = Right $ MakeCardinalityCoercion (Bounds (x1, x2)) (Bounds (y1, y2)) "id"
|
||||
| x1 >= y1 && x2 <= y2 = Right $ MakeListCardinalityCoercion (Bounds (x1, x2)) (Bounds (y1, y2))
|
||||
| otherwise = Left $ CardinalityMismatch (Bounds (x1, x2)) (Bounds (y1, y2))
|
||||
|
||||
Reference in New Issue
Block a user