rearranged some functions,

added check for multiple definitions
changed naming of attributes in haskell

app/Main.hs

@@ -33,6 +33,12 @@ main = do
     args <- getArgs
     let mainFile = head args
     parseResult <- parseWithImport mainFile
+
+    --Start
+    let maps = fstlst parseResult
+    let funcs = concat $ sndlst maps
+    print funcs
+    --END
     let checked = checkObjects parseResult
     let headers = fstlst checked
     let objects = nestedRights $ sndlst checked
@@ -59,7 +65,8 @@ parseWithImport file =
                     let importedTypes = concat $ fstlst importedSymbolTable
                     let importedFunctions = concat $ sndlst importedSymbolTable
                     let definedTypes = addNewTypes importedTypes objs
-                    let definedFunctions = addNewFunctions (definedTypes, importedFunctions) objs
+                    let definedFunctions = addNewFunctions (definedTypes, importedFunctions) objs 
+                    let _ = last definedFunctions
                     return $ ((definedTypes, definedFunctions), (MakeHeader name desc vers imp, objs)) : concat imports
 
 -- |Parse a file into a list of RosettaObjects

resources/Rosetta/test-all.rosetta

@@ -36,6 +36,15 @@ func Something: <"asd">
 
     assign-output: if True and False then valuationTime
 
+func Something: <"asd">
+    inputs:
+      equity1 boolean (1..1)
+      valuationTime ObservationPrimitive (1..1)
+    output:
+      valuation ObservationPrimitive (0..*)
+
+    assign-output: if True and False then valuationTime
+
 func SomethingElse: <"dsa">
     inputs:
       valuationTime ObservationPrimitive (1..1)

src/PrettyPrinter/Type.hs

@@ -5,12 +5,13 @@ module PrettyPrinter.Type where
 import Prettyprinter
 import PrettyPrinter.General
 import Model.Type
+import Utils.Utils
 
 -- |Converts an EnumType into a haskell valid String
 printType :: Type -> String
 printType (MakeType name (MakeType super _ _ _) description attributes) = printType (MakeType name (BasicType "Object") description (superToAttribute name super:attributes))
 printType (MakeType name (BasicType "Object") description attributes) =
-    show $ printDescription description (vcat [nest 4 $ vcat ("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": printAttributes attributes), "}", "", emptyDoc])
+    show $ printDescription description (vcat [nest 4 $ vcat ("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": printAttributes name attributes), "}", "", emptyDoc])
 printType (MakeType _ (BasicType _) _ _) = error "Can't extend basic types"
 printType (BasicType name) = show $ pretty name
    
@@ -19,16 +20,16 @@ superToAttribute :: String -> String -> TypeAttribute
 superToAttribute name typ = MakeTypeAttribute ("super" ++ name) (MakeType typ (BasicType "Object") 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]
-printAttributes [] = []
-printAttributes [at] = [printAttribute at]
-printAttributes (at : ats) = (printAttribute at <> ",") : printAttributes ats
+printAttributes :: String -> [TypeAttribute] -> [Doc a]
+printAttributes _ [] = []
+printAttributes objName [at] = [printAttribute objName at]
+printAttributes objName (at : ats) = (printAttribute objName at <> ",") : printAttributes objName ats
    
 -- |Converts a TypeAttribute into a haskell valid Doc
-printAttribute :: TypeAttribute -> Doc a
-printAttribute (MakeTypeAttribute name typ crd description) =
+printAttribute :: String -> TypeAttribute -> Doc a
+printAttribute objName (MakeTypeAttribute name typ crd description) =
     printDescription description 
-        (pretty name <+> "::" <+> printCardinality (MakeTypeAttribute name typ crd description))
+        (pretty objName <> pretty (capitalize name) <+> "::" <+> printCardinality (MakeTypeAttribute name typ crd description))
 
 -- |Converts a Cardinality into a haskell valid Doc
 printCardinality :: TypeAttribute -> Doc a

src/Semantic/ExpressionChecker.hs

@@ -5,6 +5,7 @@ import Data.Either
 import Data.Maybe
 import Model.Type
 import Semantic.TypeChecker
+import Utils.Utils
   
 -- |A declared variable or function
 data Symbol = Var{
@@ -59,7 +60,9 @@ 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 name _ inps out _)
-    | null (lefts checkedInputs) && isRight checkedOutput = Right $ Func name (map typeAndCardinality (rights checkedInputs)) (attributeType $ fromRightUnsafe checkedOutput, Model.Type.cardinality out) : definedSymbols
+    | null (lefts checkedInputs) && isRight checkedOutput = if name `elem` map funcName definedSymbols
+        then Left [MultipleDeclarations name]
+        else Right $ Func name (map typeAndCardinality (rights checkedInputs)) (attributeType $ fromRightUnsafe checkedOutput, Model.Type.cardinality out) : definedSymbols
     | isLeft checkedOutput = Left [fromLeftUnsafe checkedOutput]
     | otherwise = Left $  lefts checkedInputs 
     where 

src/Semantic/FunctionChecker.hs

@@ -6,6 +6,7 @@ import Semantic.ExpressionChecker
 import Semantic.TypeChecker
 import Data.Either
 import Data.Char
+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] Function
@@ -16,7 +17,7 @@ checkFunction (definedTypes, symbols) (MakeFunction name desc inp out ex)
             Left err -> Left [err] 
     | otherwise = Left $ lefts [checkedOut] ++ lefts checkedIn ++ lefts [checkedEx]
         where 
+            checkedIn = checkAttributes definedTypes inp
             localEnv = addVariables symbols inp
             checkedEx = checkExpression localEnv ex
-            checkedIn = checkAttributes definedTypes inp
             checkedOut = head $ checkAttributes definedTypes [out]

src/Semantic/TypeChecker.hs

@@ -2,6 +2,7 @@ module Semantic.TypeChecker where
 
 import Model.Type
 import Data.Either
+import Utils.Utils
 
 -- |A datatype for the different types of type check errors
 data TypeCheckError =
@@ -13,6 +14,7 @@ data TypeCheckError =
    | UndefinedVariable String
    | TypeMismatch String String
    | CardinalityMismatch Cardinality Cardinality
+   | MultipleDeclarations String
    deriving (Show)
 
 -- |Checks whether a data type is valid
@@ -58,18 +60,6 @@ checkAttributeType definedTypes name
 addDefinedTypes :: [Type] -> [Type] -> [Type]
 addDefinedTypes l [] = l
 addDefinedTypes l (BasicType _ : ts) = addDefinedTypes l ts
-addDefinedTypes l (t:ts) = t : addDefinedTypes l ts
-
--- |Auxiliary function to get the right value from an either that stops with an error if the value is left
--- used when it is certain that the value will be right
-fromRightUnsafe :: (Show a) => Either a b -> b
-fromRightUnsafe x = case x of
-    Left a -> error ("Value is Left" ++ show a)
-    Right b -> b
-    
--- |Auxiliary function to get the left value from an either that stops with an error if the value is right
--- used when it is certain that the value will be left
-fromLeftUnsafe :: Either a b -> a
-fromLeftUnsafe x = case x of
-    Left a -> a
-    Right _ -> error "Value is Right"
+addDefinedTypes l (t:ts)
+    | typeName t `elem` map typeName l = error $ "Multiple declarations of " ++ show t
+    | otherwise = t : addDefinedTypes l ts

src/Utils/Utils.hs

@@ -3,6 +3,11 @@ module Utils.Utils where
 import Data.Either
 import Data.Char
 
+
+-- |Capitalise a string
+capitalize :: String -> String
+capitalize s = toUpper (head s) : tail s
+
 -- |Convert a namespace to a filename
 namespaceToName :: String -> String 
 namespaceToName [] = ".rosetta"
@@ -67,4 +72,19 @@ pairLefts ((a, b) : rst) = (a, lefts b) : pairLefts rst
 -- |Get the objects from a pair with an either
 pairRights :: [(a, [Either b c])] -> [(a, [c])]
 pairRights [] = []
-pairRights ((a, c) : rst) = (a, rights c) : pairRights rst
+pairRights ((a, c) : rst) = (a, rights c) : pairRights rst
+
+
+-- |Auxiliary function to get the right value from an either that stops with an error if the value is left
+-- used when it is certain that the value will be right
+fromRightUnsafe :: Either a b -> b
+fromRightUnsafe x = case x of
+    Left a -> error "Value is Left"
+    Right b -> b
+    
+-- |Auxiliary function to get the left value from an either that stops with an error if the value is right
+-- used when it is certain that the value will be left
+fromLeftUnsafe :: Either a b -> a
+fromLeftUnsafe x = case x of
+    Left a -> a
+    Right _ -> error "Value is Right"