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

small fixes

Browse Source
This commit is contained in:
Macocian Adrian Radu
2022-06-05 18:01:09 +02:00
parent ca6ed20663
commit 3dff819d44
3 changed files with 10 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/PrettyPrinter/Expression.hs
View File

@@ -13,7 +13,7 @@ printExpression ExplicitEmpty = "[]"
printExpression (ExplicitVariable name coer)
| "item" `isPrefixOf` name = printCoercion coer $ pretty (replacePrefix "item" name "x")
| otherwise = printCoercion coer $ pretty name
printExpression (Value "empty" coer) = printCoercion coer "[]"
printExpression (Value "empty" coer) = error $ show coer --printCoercion coer "[]"
printExpression (Value s coer) = printCoercion coer $ pretty s
printExpression (ExplicitKeyword k) = pretty k
printExpression (ExplicitEnumCall name val coer) = printCoercion coer $ pretty name <> pretty val

6
src/PrettyPrinter/Type.hs
View File

@@ -32,12 +32,12 @@ superToAttribute typ = MakeTypeAttribute "super" (MakeType typ (BasicType "Objec
printAttributes :: String -> [Condition] -> [TypeAttribute] -> Doc a
printAttributes objName conditions ats
| MakeCondition Nothing (Keyword "one-of") `elem` conditions = vcat [nest 4 $ vcat $
zipWith (<>) ("" : repeat "| ") (map (printSumType objName) (increaseBound ats)) ++ map printCondition conditions, " deriving (Eq)"]
zipWith (<>) ("" : repeat "| ") (map (printSumType objName) (increaseBound ats)) ++ map printCondition conditions, " deriving (Show, Eq)"]
| null ats = emptyDoc
| length ats < 2 = vcat [nest 4 $ vcat $
zipWith (<>) ("" : repeat "| ") (map (printSumType objName) ats) ++ map printCondition conditions, " deriving (Eq)", printDefault objName (objName ++ capitalize (attributeName (head ats))) ats]
zipWith (<>) ("" : repeat "| ") (map (printSumType objName) ats) ++ map printCondition conditions, " deriving (Show, Eq)", printDefault objName (objName ++ capitalize (attributeName (head ats))) ats]
| otherwise = vcat [nest 4 $ vcat ("Make" <> pretty objName <+> "{" :
punctuate comma (map (printAttribute objName) ats) ++ map printCondition conditions), "}"] <+> "deriving (Eq)" <> line <> printDefault objName ("Make" ++ objName) ats
punctuate comma (map (printAttribute objName) ats) ++ map printCondition conditions), "}"] <+> "deriving (Show, Eq)" <> line <> printDefault objName ("Make" ++ objName) ats
-- |Converts a TypeAttribute into a haskell valid Doc
printAttribute :: String -> TypeAttribute -> Doc a

12
src/Semantic/ExpressionChecker.hs
View File

@@ -222,12 +222,12 @@ checkExpression defT symbolMap (IfElse cond ex1 ex2) =
Left err -> Left $ ErrorInsideFunction $ show err
Right thenExp -> case checkExpression defT symbolMap ex2 of
Left err -> Left $ ErrorInsideFunction $ show err
Right elseExp ->
Right $ ExplicitIfElse (condType, condCoerce)
(thenExp, MakeCoercion [MakeIdCoercion $ typeFromExpression thenExp]
(MakeCardinalityIdCoercion $ toCardinality $ cardinalityCoercion $ returnCoercion thenExp))
(elseExp, MakeCoercion [MakeIdCoercion $ typeFromExpression elseExp]
(MakeCardinalityIdCoercion $ toCardinality $ cardinalityCoercion $ returnCoercion elseExp)) (returnCoercion thenExp)
Right elseExp -> case returnCoercion elseExp `coercionIncluded` returnCoercion thenExp of
Left _ -> Left $ IfExpressionsDifferentTypes (show thenExp) (show elseExp)
Right c -> Right $ ExplicitIfElse (condType, condCoerce)
(thenExp, MakeCoercion [MakeIdCoercion $ typeFromExpression thenExp]
(MakeCardinalityIdCoercion $ toCardinality $ cardinalityCoercion $ returnCoercion thenExp))
(elseExp, c) (returnCoercion thenExp)
--(typeMatch ex1Type ex2Type, smallestBound ex1Card ex2Type)
-- |TODO Handle nested lists and lists with parens