mirror of
https://github.com/macocianradu/RosettaHaskellCompiler.git
synced 2026-03-18 13:00:08 +00:00
Fixed ifelse and added newlines at printing
This commit is contained in:
@@ -15,6 +15,7 @@ import Semantic.ExpressionChecker
|
||||
import Semantic.FunctionChecker
|
||||
import Model.Type
|
||||
import System.Environment.Blank (getArgs)
|
||||
import Parser.Expression
|
||||
import Model.Enum
|
||||
import Data.Either
|
||||
|
||||
|
||||
@@ -15,7 +15,7 @@ type TestType:
|
||||
type TestSomeType: <"description">
|
||||
testSomeType int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">
|
||||
|
||||
type TestZeroOneType:
|
||||
type TestZeroOneType extends Period:
|
||||
testZeroOneType int (1..1)
|
||||
|
||||
type ObservationPrimitive:
|
||||
@@ -27,8 +27,17 @@ func EquityPriceObservation: <"Function specification for the observation of an
|
||||
valuationDate ObservationPrimitive (0..1)
|
||||
valuationTime int (0..1)
|
||||
timeType TestType (0..1)
|
||||
determinationMethod ObservationPrimitive (1..*)
|
||||
determinationMethod ObservationPrimitive (1..1)
|
||||
output:
|
||||
observation ObservationPrimitive (0..1)
|
||||
|
||||
assign-output: if 2 = 3 then valuationDate
|
||||
assign-output: if True and False then valuationDate
|
||||
|
||||
func Something: <"asd">
|
||||
inputs:
|
||||
equity1 boolean (1..1)
|
||||
something1 boolean (1..1)
|
||||
output:
|
||||
valuation ObservationPrimitive (1..1)
|
||||
|
||||
assign-output: if True and False then determinationMethod else determinationMethod
|
||||
@@ -13,7 +13,7 @@ printEnum (MakeEnum name description values) =
|
||||
(vcat ["data" <+> pretty name <+> "=",
|
||||
indent 4 (printEnumValues values),
|
||||
"",
|
||||
printDisplayNames name values])
|
||||
printDisplayNames name values, emptyDoc])
|
||||
|
||||
-- |Converts a list of EnumValues into a haskell valid Doc
|
||||
printEnumValues :: [EnumValue] -> Doc a
|
||||
|
||||
@@ -12,7 +12,7 @@ import Model.Type
|
||||
|
||||
-- |Converts a Function into a haskell valid String
|
||||
printFunction :: Function -> String
|
||||
printFunction f = show $ vcat [printFunctionSignature f, printFunctionBody f]
|
||||
printFunction f = show $ vcat [printFunctionSignature f, printFunctionBody f, emptyDoc]
|
||||
|
||||
-- |Converts the body of a Function into a haskell valid Doc
|
||||
printFunctionBody :: Function -> Doc a
|
||||
|
||||
@@ -8,15 +8,15 @@ import Model.Type
|
||||
|
||||
-- |Converts an EnumType into a haskell valid String
|
||||
printType :: Type -> String
|
||||
printType (MakeType name (Just (MakeType super _ _ _)) description attributes) = printType (MakeType name Nothing description (superToAttribute super:attributes))
|
||||
printType (MakeType name (Just (MakeType super _ _ _)) description attributes) = printType (MakeType name Nothing description (superToAttribute name super:attributes))
|
||||
printType (MakeType _ (Just (BasicType _)) _ _) = error "Can't extend basic types"
|
||||
printType (MakeType name Nothing description attributes) =
|
||||
show $ printDescription description (vcat [nest 4 $ vcat ("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": printAttributes attributes), "}", ""])
|
||||
show $ printDescription description (vcat [nest 4 $ vcat ("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": printAttributes attributes), "}", "", emptyDoc])
|
||||
printType (BasicType name) = show $ pretty name
|
||||
|
||||
-- |Creates an attribute that accesses the super type
|
||||
superToAttribute :: String -> TypeAttribute
|
||||
superToAttribute name = MakeTypeAttribute "super" (MakeType name Nothing Nothing []) (Bounds (1, 1)) (Just "Pointer to super class")
|
||||
superToAttribute :: String -> String -> TypeAttribute
|
||||
superToAttribute name typ = MakeTypeAttribute ("super" ++ name) (MakeType typ Nothing Nothing []) (Bounds (1, 1)) (Just "Pointer to super class")
|
||||
|
||||
-- |Converts a list of TypeAttributes into a list of haskell valid Docs
|
||||
printAttributes :: [TypeAttribute] -> [Doc a]
|
||||
|
||||
@@ -100,8 +100,8 @@ checkExpression symbolMap (IfSimple cond ex)
|
||||
checkedExp = checkExpression symbolMap ex
|
||||
-- |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)
|
||||
| isRight condType || isRight (typeMatch (fromRightUnsafe condType) (BasicType "Boolean", Bounds (1, 1))) = Left $ IfConditionNotBoolean $ show cond
|
||||
| isRight ex1Type || isRight ex2Type || isRight (typeMatch (fromRightUnsafe ex1Type) (fromRightUnsafe ex2Type)) = Left $ IfExpressionsDifferentTypes (show ex1) (show ex2)
|
||||
| isLeft condType || isLeft (typeMatch (fromRightUnsafe condType) (BasicType "Boolean", Bounds (1, 1))) = Left $ IfConditionNotBoolean $ show cond
|
||||
| isLeft ex1Type || isLeft ex2Type || isLeft (typeMatch (fromRightUnsafe ex1Type) (fromRightUnsafe ex2Type)) = Left $ IfExpressionsDifferentTypes (show ex1) (show ex2)
|
||||
| otherwise = ex1Type
|
||||
where condType = checkExpression symbolMap cond
|
||||
ex1Type = checkExpression symbolMap ex1
|
||||
@@ -127,7 +127,7 @@ checkList1 symbs (ex : exps) typ
|
||||
|
||||
-- |Checks whether the function that is called is already defined with the same argument types
|
||||
checkFunctionCall :: [Symbol] -> String -> [Either TypeCheckError (Type, Cardinality)] -> Either TypeCheckError (Type, Cardinality)
|
||||
checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ concatMap (typeName . fst) (rights args) ++ "]"
|
||||
checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ show (rights args) ++ "]"
|
||||
checkFunctionCall ((Func n a r):symbolMap) name args
|
||||
| length right /= length args = Left $ ErrorInsideFunction (name ++ ": " ++ show args ++ show (lefts args))
|
||||
| name == n && all isRight (zipWith typeMatch a right) = Right r
|
||||
|
||||
Reference in New Issue
Block a user