radumaco/RosettaHaskellCompiler
1
0
Fork 0
mirror of https://github.com/macocianradu/RosettaHaskellCompiler.git synced 2026-03-18 21:10:07 +00:00
Code Issues Packages Projects Releases Wiki Activity

Working generation, need to add list functions

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

40
src/Semantic/ExpressionChecker.hs
View File

@@ -41,6 +41,8 @@ defaultMap = [
Func "contains" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds (1, 1)),
Func "disjoint" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds (1, 1)),
Func "=" [(BasicType "Any", Bounds(1, 1)), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
Func "=" [(BasicType "Any", Bounds(0, 1)), (BasicType "Any", Bounds(0, 1))] (BasicType "Boolean", Bounds(1, 1)),
Func "=" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
Func ">=" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
Func "<=" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
@@ -68,7 +70,7 @@ defaultMap = [
-- |Checks whether a function is valid (inputs, outputs are of valid type and all variables are defined) and adds it to the symbol table
addFunction :: ([Type], [Symbol]) -> Function -> Either [TypeCheckError] [Symbol]
addFunction (definedTypes, definedSymbols) (MakeFunction (MakeFunctionSignature name _ inps out) _) =
addFunction (definedTypes, definedSymbols) (MakeFunction (MakeFunctionSignature name _ inps out) _ _) =
case head $ checkAttributes definedTypes [out] of
Left err -> Left [err]
Right checkedOutput -> if null (lefts checkedInputs)
@@ -92,6 +94,12 @@ checkExpression _ _ (Int val) = Right $ Value val $ MakeCoercion [MakeIdCoercion
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 defT symbolMap (Enum enum val) = case getType enum defT of
Left err -> Left err
Right typ -> if val `elem` map attributeName (typeAttributes typ)
then Right $ ExplicitEnumCall enum val $ MakeCoercion [MakeIdCoercion typ] (MakeCardinalityIdCoercion (Bounds (1, 1)))
else Left $ UndefinedVariable val
checkExpression _ _ (Keyword k) = Right $ ExplicitKeyword k
checkExpression defT symbolMap (PathExpression ex1 (Variable b)) =
case checkExpression defT symbolMap ex1 of
@@ -107,7 +115,7 @@ checkExpression _ _ (PathExpression _ ex) = Left $ UnsupportedExpressionInPathEx
checkExpression defT symbolMap (Parens ex) =
case checkExpression defT symbolMap ex of
Left err -> Left err
Right exp -> Right $ ExplicitParens exp
Right exp -> Right $ ExplicitParens exp (returnCoercion exp)
checkExpression defT symbolMap (List lst) = checkList defT symbolMap lst
checkExpression defT symbolMap (PrefixExp name ex) = checkFunctionCall symbolMap name [checkExpression defT symbolMap ex]
checkExpression defT symbolMap (Function name exps) = checkFunctionCall symbolMap name (map (checkExpression defT symbolMap) exps)
@@ -181,21 +189,28 @@ checkList1 defT symbs (ex : exps) typ =
-- |Checks whether the function that is called is already defined with the same argument types
checkFunctionCall :: [Symbol] -> String -> [Either TypeCheckError ExplicitExpression ] -> Either TypeCheckError ExplicitExpression
checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ show (rights args) ++ "]"
checkFunctionCall [] fun args = error $ show 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 (zip (rights args) (rights coerce)) (MakeCoercion [MakeIdCoercion (fst r)] (MakeCardinalityIdCoercion (snd r)))
| not $ null $ lefts args = Left $ ErrorInsideFunction (name ++ ": " ++ show args ++ show (lefts args))
| name == n = if all isRight coerce then Right $ ExplicitFunction name (zip (rights args) (rights coerce)) (MakeCoercion [MakeIdCoercion (fst r)] (MakeCardinalityIdCoercion (snd r)))
else error $ show argCoerce
| otherwise = checkFunctionCall symbolMap name args
where
argCoerce = map returnCoercion (rights args)
coerce = zipWith coercionIncluded argCoerce (map createCoercion a)
checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name args
getType :: String -> [Type] -> Either TypeCheckError Type
getType t [] = Left $ UndefinedType t
getType typ (t : ts)
| typ == typeName t = Right t
| otherwise = getType typ ts
typeIncluded :: (Type, Cardinality) -> (Type, Cardinality) -> Either TypeCheckError Coercion
typeIncluded (t1, c1) (t2, c2) =
case t1 `isSubType` t2 of
Left err -> Left err
Right typeCoercion ->
Right typeCoercion ->
case c1 `cardinalityIncluded` c2 of
Left err -> Left err
Right cardCoercion -> Right $ MakeCoercion typeCoercion cardCoercion
@@ -238,6 +253,7 @@ findAttributeType var (t : ts)
-- |Checks whether the first argument is a subtype of the second argument
isSubType :: Type -> Type -> Either TypeCheckError [TypeCoercion]
isSubType (BasicType "Integer") (BasicType "Double") = Right [MakeTypeCoercion (BasicType "Integer") (BasicType "Double") "fromInteger"]
isSubType t (BasicType "Any") = Right [MakeIdCoercion t]
isSubType (BasicType x) y
| x == typeName y = Right [MakeIdCoercion y]
| otherwise = Left $ TypeMismatch x (typeName y)
@@ -250,12 +266,12 @@ isSubType x y
-- |Finds the type attributes from a type in the symbol table
getTypeAttributes :: [Type] -> Type -> [TypeAttribute]
getTypeAttributes [] t = []
getTypeAttributes (defT : ts) t
| typeName defT == typeName t =
[MakeTypeAttribute {attributeName = attributeName attr,
attributeType = toHaskell (attributeType attr),
Model.Type.cardinality = if MakeCondition Nothing (Keyword "one-of") `elem` conditions defT then Bounds (1,1) else Model.Type.cardinality attr,
attributeDescription = attributeDescription attr}
getTypeAttributes (defT : ts) t
| typeName defT == typeName t =
[MakeTypeAttribute {attributeName = attributeName attr,
attributeType = toHaskell (attributeType attr),
Model.Type.cardinality = if MakeCondition Nothing (Keyword "one-of") `elem` conditions defT then Bounds (1,1) else Model.Type.cardinality attr,
attributeDescription = attributeDescription attr}
| attr <- typeAttributes defT]
| otherwise = getTypeAttributes ts t