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

IT'S WORKIIING! IT'S WORKINGGG

Browse Source
This commit is contained in:
Macocian Adrian Radu
2022-06-05 14:23:48 +02:00
parent 27d2f5fb26
commit ca6ed20663
3 changed files with 13 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
src/Model/Type.hs
View File

@@ -115,6 +115,7 @@ data CardinalityCoercion =
| MakeObject2MaybeCoercion {fromCardinality :: Cardinality, toCardinality :: Cardinality} | MakeObject2MaybeCoercion {fromCardinality :: Cardinality, toCardinality :: Cardinality}
| MakeObject2ListCoercion {fromCardinality :: Cardinality, toCardinality :: Cardinality} | MakeObject2ListCoercion {fromCardinality :: Cardinality, toCardinality :: Cardinality}
| MakeOneOfCoercion {toCardinality :: Cardinality} | MakeOneOfCoercion {toCardinality :: Cardinality}
| MakeMaybe2ObjectCoercion {toCardinality :: Cardinality}
deriving (Eq, Show) deriving (Eq, Show)
-- |Used to handle polymorphism in Rosetta -- |Used to handle polymorphism in Rosetta

5
src/PrettyPrinter/Expression.hs
View File

@@ -51,7 +51,7 @@ printExpression (ExplicitFunction "and" args returnCoerce) = printCoercion (snd
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 "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) = printExpression (ExplicitFunction name args returnCoerce) =
if null printedArgs then pretty (uncapitalize name) if null printedArgs then pretty (uncapitalize name)
else pretty (uncapitalize name) <+> printCoercion returnCoerce (hsep (map (enclose "(" ")") printedArgs)) else pretty (uncapitalize name) <+> (hsep (map (enclose "(" ")") printedArgs))
where printedArgs = zipWith printCoercion [c | (e,c) <- args] [printExpression e | (e, c) <- args] where printedArgs = zipWith printCoercion [c | (e,c) <- args] [printExpression e | (e, c) <- args]
printExpression (ExplicitIfSimple cond thenBlock returnCoercion) = printExpression (ExplicitIfSimple cond thenBlock returnCoercion) =
printIf printIf
@@ -101,7 +101,8 @@ printCardinalityCoercion (MakeListCardinalityCoercion _ _) d = d
printCardinalityCoercion (MakeNothing2MaybeCoercion _ _) d = "Nothing" printCardinalityCoercion (MakeNothing2MaybeCoercion _ _) d = "Nothing"
printCardinalityCoercion (MakeNothing2ListCoercion _ _) d = "[]" printCardinalityCoercion (MakeNothing2ListCoercion _ _) d = "[]"
printCardinalityCoercion (MakeMaybe2ListCoercion _ _) d = "maybeToList" <+> enclose "(" ")" d printCardinalityCoercion (MakeMaybe2ListCoercion _ _) d = "maybeToList" <+> enclose "(" ")" d
printCardinalityCoercion (MakeObject2MaybeCoercion _ _) d = "fromJust" <+> enclose "(" ")" d printCardinalityCoercion (MakeObject2MaybeCoercion _ _) d = "Just" <+> enclose "(" ")" d
printCardinalityCoercion (MakeMaybe2ObjectCoercion _) d = "fromJust" <+> enclose "(" ")" d
printCardinalityCoercion (MakeObject2ListCoercion _ _) d = "[" <> d <> "]" printCardinalityCoercion (MakeObject2ListCoercion _ _) d = "[" <> d <> "]"
printCardinalityCoercion (MakeOneOfCoercion _) d = d printCardinalityCoercion (MakeOneOfCoercion _) d = d

7
src/Semantic/ExpressionChecker.hs
View File

@@ -166,13 +166,18 @@ checkExpression defT symbolMap (PathExpression ex1 (Variable b)) =
Left err -> Left err Left err -> Left err
Right exp1 -> case findAttributeTypeRec defT b type1 of Right exp1 -> case findAttributeTypeRec defT b type1 of
Left err -> Left $ UndefinedVariable $ show (typeName type1) ++ " -> " ++ b Left err -> Left $ UndefinedVariable $ show (typeName type1) ++ " -> " ++ b
Right exp2 -> case Bounds(1, 1) `cardinalityIncluded` crd1 of Right exp2 -> case cardC of
Left err -> Left $ PathExpressionOnList (show ex1) Left err -> Left $ PathExpressionOnList (show ex1)
Right c -> if MakeCondition Nothing (Keyword "one-of") `elem` conditions (typeFromExpression exp1) Right c -> if MakeCondition Nothing (Keyword "one-of") `elem` conditions (typeFromExpression exp1)
then Right $ ExplicitPath (changeCoercion exp1 ((returnCoercion exp1){cardinalityCoercion = c})) (changeCoercion exp2 exp2C) exp2C then Right $ ExplicitPath (changeCoercion exp1 ((returnCoercion exp1){cardinalityCoercion = c})) (changeCoercion exp2 exp2C) exp2C
else Right $ ExplicitPath (changeCoercion exp1 ((returnCoercion exp1){cardinalityCoercion = c})) exp2 (returnCoercion exp2) else Right $ ExplicitPath (changeCoercion exp1 ((returnCoercion exp1){cardinalityCoercion = c})) exp2 (returnCoercion exp2)
where where
exp2C = MakeCoercion (typeCoercion $ returnCoercion exp2) (MakeOneOfCoercion (Bounds (1,1))) exp2C = MakeCoercion (typeCoercion $ returnCoercion exp2) (MakeOneOfCoercion (Bounds (1,1)))
cardC = case crd1 of
Bounds (1, 1) -> Right $ MakeCardinalityIdCoercion crd1
Bounds (0, 1) -> Right $ MakeMaybe2ObjectCoercion (Bounds (1, 1))
_ -> Left $ PathExpressionOnList (show ex1)
where where
type1 = typeFromExpression exp1 type1 = typeFromExpression exp1
crd1 = toCardinality $ cardinalityCoercion $ returnCoercion exp1 crd1 = toCardinality $ cardinalityCoercion $ returnCoercion exp1