Working generation, need to add list functions

This commit is contained in:
Macocian Adrian Radu
2022-05-19 01:53:19 +02:00
parent 26daa85feb
commit e73ff31f1d
18 changed files with 2521 additions and 88 deletions

View File

@@ -10,24 +10,27 @@ import Utils.Utils
-- |Checks if all the inputs and the output of a function call have valid types, and then checks that the assign-output expression is valid
checkFunction :: ([Type], [Symbol]) -> Function -> Either [TypeCheckError] ExplicitFunction
checkFunction (definedTypes, symbols) (MakeFunction (MakeFunctionSignature name desc inp out) ex) =
checkFunction (definedTypes, symbols) (MakeFunction (MakeFunctionSignature name desc inp out) alias ex) =
let checkedIn = checkAttributes definedTypes inp in
if null $ lefts checkedIn
then
case head $ checkAttributes definedTypes [out] of
let symbolTable = addVariables symbols (rights checkedIn) in
case addAliases definedTypes symbolTable alias of
Left err -> Left [err]
Right checkedOut -> case checkAssignment definedTypes (addVariables symbols (checkedOut : rights checkedIn)) ex of
Left err -> Left err
Right checkedEx -> Right $ MakeExplicitFunction (MakeFunctionSignature (toLower (head name) : tail name) desc (rights checkedIn) checkedOut) checkedEx
Right checkedAlias -> case head $ checkAttributes definedTypes [out] of
Left err -> Left [err]
Right checkedOut -> case checkAssignment definedTypes (addVariables (fst checkedAlias) [checkedOut]) ex of
Left err -> Left err
Right checkedEx -> Right $ MakeExplicitFunction (MakeFunctionSignature (toLower (head name) : tail name) desc (rights checkedIn) checkedOut) (snd checkedAlias) checkedEx
else
Left $ lefts checkedIn
checkAssignment :: [Type] -> [Symbol] -> [(Expression, Expression)] -> Either [TypeCheckError] [(ExplicitExpression, ExplicitExpression)]
checkAssignment _ _ [] = Right []
checkAssignment defT symbs ((assign, ex): assigns) =
-- Here we use only tail symbs, beacuse the head of the symbol table is the out variable, and that can't be used in the expression body
case checkExpression defT (tail symbs) ex of
Left err -> Left [err]
-- Here we use only tail symbs, beacuse the head of the symbol table is the out variable, and that can't be used in the expression body
Right checkedExp -> case checkExpression defT symbs assign of
Left err -> Left [err]
Right checkedA -> case checkAssignment defT symbs assigns of
@@ -35,4 +38,14 @@ checkAssignment defT symbs ((assign, ex): assigns) =
-- Add a final explicit transformation to match the expected output
Right checked -> case returnCoercion checkedExp `coercionIncluded` returnCoercion checkedA of
Left err -> Left [err]
Right c -> Right $ (checkedA, changeCoercion checkedExp c) : checked
Right c -> Right $ (checkedA, changeCoercion checkedExp c) : checked
addAliases :: [Type] -> [Symbol] -> [(String, Expression)] -> Either TypeCheckError ([Symbol], [(String, ExplicitExpression)])
addAliases definedTypes symbolMap [] = Right (symbolMap, [])
addAliases definedTypes symbolMap (alias : aliases) =
case checkExpression definedTypes symbolMap (snd alias) of
Left err -> Left err
Right ex -> case add of
Left err -> Left err
Right added -> Right (fst added, (fst alias, ex) : snd added)
where add = addAliases definedTypes (addVariables symbolMap [MakeTypeAttribute (fst alias) (coercionType $ typeCoercion $ returnCoercion ex) (toCardinality $ cardinalityCoercion $ returnCoercion ex) Nothing]) aliases