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

parsing works with path expressions

Browse Source
This commit is contained in:
Macocian Adrian Radu
2022-05-15 01:51:49 +02:00
parent ee26710515
commit 47051dbbbd
16 changed files with 238 additions and 122 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
app/Main.hs
View File

@@ -26,6 +26,8 @@ import Data.Void
import Utils.Utils
import Data.Text (Text)
-- :set args resources/Rosetta/test-multiple.rosetta
-- :set args resources/Rosetta/test-all.rosetta
-- :l resources/Generated/testAll.hs resources/Generated/testPeriod.hs
@@ -62,8 +64,10 @@ parseWithImport file =
let importedFunctions = concat $ sndlst importedSymbolTable
case addNewTypes importedTypes objs of
Left errors -> error $ show errors
Right definedTypes ->
case addNewFunctions (definedTypes, importedFunctions) objs of
Right emptyTypes ->
case populateTypes emptyTypes of
Left errors -> error $ show errors
Right definedTypes -> case addNewFunctions (definedTypes, importedFunctions) objs of
Left errors -> error $ show errors
Right definedFunctions -> return $ ((definedTypes, definedFunctions), (MakeHeader name desc vers imp, objs)) : concat imports

2
resources/Rosetta/test-all.rosetta
View File

@@ -11,6 +11,8 @@ type TestSomeType: <"description">
type TestZeroOneType extends Period:
testZeroOneType int (1..1)
condition important: <"This is an important condition">
observationPrimitive < 0
type ObservationPrimitive:
observationPrimitive int (1..1)

23
resources/Rosetta/test-multiple.rosetta Normal file
View File

@@ -0,0 +1,23 @@
namespace test.multiple : <"Something">
version "${version.ok}"
type ExchangeRate:
from int (1..1)
to int (1..1)
type Obs:
constant number (0..1)
exchangeRate ExchangeRate (0..1)
condition: one-of
func ExchangeRateFunc:
inputs:
from int (1..1)
to int (1..1)
output:
observable Obs (1..1)
assign-output observable -> exchangeRate -> from:
from
assign-output observable -> exchangeRate -> to:
to

4
src/Model/Function.hs
View File

@@ -15,13 +15,13 @@ data FunctionSignature =
data Function =
MakeFunction {
signature :: FunctionSignature,
assignment :: Expression
assignment :: [(Expression, Expression)]
}
deriving (Show)
data ExplicitFunction =
MakeExplicitFunction {
sign :: FunctionSignature,
explicitAssignment :: ExplicitExpression
explicitAssignment :: [(ExplicitExpression, ExplicitExpression)]
}
deriving Show

3
src/Model/Type.hs
View File

@@ -22,13 +22,13 @@ instance Eq Type where
(==) _ _ = False
data Condition = MakeCondition {
conditionName :: String,
conditionDescription :: Maybe String,
expressionExpression :: Expression
} deriving (Show)
-- |The representation of an expression
data Expression = Variable String
| PathExpression Expression Expression
| Int String
| Real String
| Boolean String
@@ -48,6 +48,7 @@ data ExplicitExpression = ExplicitEmpty
| Value {name :: String, returnCoercion :: Coercion}
| ExplicitList [ExplicitExpression]
| ExplicitParens ExplicitExpression
| ExplicitPath {super :: ExplicitExpression, sub :: ExplicitExpression, returnCoercion :: Coercion}
| ExplicitFunction {name :: String, args :: [(ExplicitExpression, Coercion)], returnCoercion :: Coercion}
| ExplicitIfSimple {cond :: (ExplicitExpression, Coercion), block1 :: (ExplicitExpression, Coercion), returnCoercion :: Coercion}
| ExplicitIfElse {cond :: (ExplicitExpression, Coercion), block1 :: (ExplicitExpression, Coercion), block2 :: (ExplicitExpression, Coercion), returnCoercion :: Coercion}

45
src/Parser/Expression.hs
View File

@@ -69,16 +69,7 @@ listParser =
variableParser :: Parser Expression
variableParser =
do
var <- camelNameParser
inner <- many innerVariableParser
return $ Variable (var ++ concatMap ("->" ++) inner)
-- |Parses an inner variable (a -> b) in Rosetta into an Expression
innerVariableParser :: Parser String
innerVariableParser =
do
_ <- lexeme $ string "->"
camelNameParser
Variable <$> camelNameParser
-- |Parses an integer in Rosetta into an Expression
integerParser :: Parser Expression
@@ -174,16 +165,6 @@ factorParser =
Left _ -> return p
Right o -> factorParser >>= \ex -> return $ reverseExpression $ InfixExp [o] p ex
-- |Parses a boolean statement in Rosetta into an Expression
boolOpParser :: Parser Expression
boolOpParser =
do
p <- postfixParser
op <- lexeme $ observing (string "or" <|> string "and")
case op of
Left _ -> return p
Right o -> boolOpParser >>= \ex -> return $ InfixExp (Text.unpack o) p ex
-- |Parses a power statement in Rosetta into an Expression
powerParser :: Parser Expression
powerParser =
@@ -194,16 +175,37 @@ powerParser =
Left _ -> return p
Right _ -> powerParser >>= \ex -> return $ InfixExp "^" p ex
-- |Parses a boolean statement in Rosetta into an Expression
boolOpParser :: Parser Expression
boolOpParser =
do
p <- postfixParser
op <- lexeme $ observing (string "or" <|> string "and")
case op of
Left _ -> return p
Right o -> boolOpParser >>= \ex -> return $ InfixExp (Text.unpack o) p ex
-- |Parses a postfix function in Rosetta into an Expression
postfixParser :: Parser Expression
postfixParser =
do
t <- terminalParser
t <- pathExpressionParser
op <- lexeme $ observing $ choice $ fmap (try . string . Text.pack) postfixFunctions
case op of
Left _ -> return t
Right o -> return $ PostfixExp (Text.unpack o) t
-- |Parses a path expression (a -> b) in Rosetta into an Expression
pathExpressionParser :: Parser Expression
pathExpressionParser =
do
var <- terminalParser
op <- lexeme $ observing $ string "->"
case op of
Left _ -> return var
Right _ -> pathExpressionParser >>= \ex -> return $ reverseExpression $ PathExpression var ex
-- |The list of existing postfix Rosetta functions
postfixFunctions :: [String]
postfixFunctions = ["exists", "is absent", "count", "only-element", "single exists", "multiple exists"]
@@ -217,6 +219,7 @@ reverseExpression :: Expression -> Expression
reverseExpression (InfixExp op t1 (InfixExp op2 t2 e))
| precedence op == precedence op2 = InfixExp op2 (reverseExpression (InfixExp op t1 t2)) e
| otherwise = InfixExp op t1 (InfixExp op2 t2 e)
reverseExpression (PathExpression e1 (PathExpression e2 e3)) = PathExpression (reverseExpression (PathExpression e1 e2)) e3
reverseExpression e = e

9
src/Parser/Function.hs
View File

@@ -20,15 +20,18 @@ functionParser =
fDescription <- optional descriptionParser
fInput <- inputAttributesParser
fOutput <- outputAttributeParser
MakeFunction (MakeFunctionSignature fName fDescription fInput fOutput) <$> assignmentParser
MakeFunction (MakeFunctionSignature fName fDescription fInput fOutput) <$> many assignmentParser
-- parseTest assignmentParser (Text.pack "assign-output observable -> exchangeRate -> from: from")
-- |Parses the output assignment statement from a function in Rosetta into an Expression
assignmentParser :: Parser Expression
assignmentParser :: Parser (Expression, Expression)
assignmentParser =
do
_ <- lexeme $ string "assign-output"
out <- expressionParser
_ <- lexeme $ char ':'
expressionParser
assignment <- expressionParser
return (out, assignment)
-- |Parses the input attributes from a function statement in Rosetta into a list of TypeAttributes
inputAttributesParser :: Parser [TypeAttribute]

5
src/Parser/Type.hs
View File

@@ -50,10 +50,9 @@ cardinalityParser = try parseBounded <|> try parseSemiBounded
conditionParser :: Parser Condition
conditionParser = do
_ <- lexeme $ string "condition"
name <- lexeme camelNameParser
_ <- lexeme $ char ':'
description <- optional descriptionParser
MakeCondition name description <$> expressionParser
_ <- lexeme $ char ':'
MakeCondition description <$> expressionParser
-- |Parses a bounded cardinality statement in Rosetta into a Cardinality
parseBounded :: Parser Cardinality

7
src/PrettyPrinter/Function.hs
View File

@@ -17,17 +17,20 @@ printFunction f = show $ vcat [printFunctionSignature (sign f), printFunctionBod
-- |Converts the body of a Function into a haskell valid Doc
printFunctionBody :: ExplicitFunction -> Doc a
printFunctionBody (MakeExplicitFunction (MakeFunctionSignature name _ inp out) ex) = pretty name <+> printVariableNames inp <+> "=" <+> printExpression ex (createCoercion (attributeType out, Model.Type.cardinality out))
printFunctionBody (MakeExplicitFunction (MakeFunctionSignature name _ inp out) ex) = pretty name <+> printVariableNames inp <+> "= where"
<+> vcat [printExpression (fst exp) (returnCoercion (fst exp)) <+> " = "
<+> printExpression (snd exp) (returnCoercion (fst exp)) |exp <- ex]
printExpression :: ExplicitExpression -> Coercion -> Doc a
printExpression ExplicitEmpty _ = "[]"
printExpression (ExplicitVariable name coer) out = case coer `coercionIncluded` out of
Left err -> error $ show err
Left err -> error $ show coer ++ " /// " ++ show out--show err
Right c -> printCoercion c $ pretty name
printExpression (Value s coer) out = case coer `coercionIncluded` out of
Left err -> error $ show err
Right c -> printCoercion c $ pretty s
printExpression (ExplicitParens ex) out = "(" <> printExpression ex out <> ")"
printExpression (ExplicitList ex) out = list [printExpression x out | x <- ex]
printExpression (ExplicitPath ex1 ex2 returnCoerce) out = printCoercion (returnCoercion ex1) (printExpression ex1 (returnCoercion ex1)) <+> "->" <+> printCoercion (returnCoercion ex2) (printExpression ex2 out)
printExpression (ExplicitFunction "exists" args returnCoerce) out = printCoercion returnCoerce "isJust" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
printExpression (ExplicitFunction "is absent" args returnCoerce) out = printCoercion returnCoerce "isNothing" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
printExpression (ExplicitFunction "single exists" args returnCoerce) out = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> "==" <+> "1"

2
src/PrettyPrinter/Type.hs
View File

@@ -40,4 +40,4 @@ printCardinality (MakeTypeAttribute _ typ (Bounds (x, y)) _)
printCardinality (MakeTypeAttribute _ typ (OneBound _) _) = "[" <> pretty (typeName typ) <> "]"
printCondition :: Condition -> Doc a
printCondition (MakeCondition name desc e) = printDescription desc ("--" <+> pretty name <+> pretty (show e))
printCondition (MakeCondition desc e) = printDescription desc ("--" <+> pretty (show e))

21
src/Semantic/ExpressionChecker.hs
View File

@@ -6,7 +6,6 @@ import Data.Maybe
import Model.Type
import Semantic.TypeChecker
import Utils.Utils
import Model.Type (CardinalityCoercion(MakeNothing2MaybeCoercion, MakeNothing2ListCoercion, MakeMaybe2ListCoercion, MakeObject2MaybeCoercion, MakeObject2ListCoercion))
-- |A declared variable or function
data Symbol = Var{
@@ -87,15 +86,27 @@ addVariables s ((MakeTypeAttribute name typ crd _) : vars) = Var name (toHaskel
-- |Checks the type of a given expression
checkExpression :: [Symbol] -> Expression -> Either TypeCheckError ExplicitExpression
--checkExpression sym _ = error $ show sym
checkExpression symbolMap (Variable var) = findVarType var symbolMap
checkExpression _ (Int val) = Right $ Value val $ MakeCoercion [MakeIdCoercion (BasicType "Integer")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
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 symbolMap (PathExpression ex1 (Variable b)) =
case checkExpression symbolMap ex1 of
Left err -> Left err
Right exp1 -> case findAttributeType b (typeAttributes type1) of
Left err -> Left $ UndefinedVariable $ show type1--ex1 ++ " -> " ++ b
Right exp2 -> Right $ ExplicitPath exp1 exp2 (returnCoercion exp2)
where
type1 = coercionType $ typeCoercion $ returnCoercion exp1
--checkExpression symbolMap (PathExpression ex1 (PathExpression ))
checkExpression symbolMap (Parens ex) =
case checkExpression symbolMap ex of
Left err -> Left err
Right exp -> Right $ ExplicitParens exp
-- |Getting here means that an expression is used inside a path expression and this is not supported
checkExpression _ (PathExpression _ ex) = Left $ UnsupportedExpressionInPathExpression $ show ex
checkExpression symbolMap (List lst) = checkList symbolMap lst
checkExpression symbolMap (PrefixExp name ex) = checkFunctionCall symbolMap name [checkExpression symbolMap ex]
checkExpression symbolMap (Function name exps) = checkFunctionCall symbolMap name (map (checkExpression symbolMap) exps)
@@ -138,7 +149,6 @@ checkExpression symbolMap (IfElse cond ex1 ex2) =
(MakeCardinalityIdCoercion $ toCardinality $ cardinalityCoercion $ returnCoercion elseExp)) (returnCoercion thenExp)
--(typeMatch ex1Type ex2Type, smallestBound ex1Card ex2Type)
-- |TODO Handle nested lists and lists with parens
-- |Checks that all the expressions in a list have compatible types
checkList :: [Symbol] -> [Expression] -> Either TypeCheckError ExplicitExpression
@@ -217,6 +227,13 @@ findVarType x ((Var name typ crd):symbols)
| otherwise = findVarType x symbols
findVarType x (_:symbols) = findVarType x symbols
-- |Find whether there is a attribute with the given name in the given type, and returns the attribute's type
findAttributeType :: String -> [TypeAttribute] -> Either TypeCheckError ExplicitExpression
findAttributeType var [] = Left $ UndefinedVariable var
findAttributeType var (t : ts)
| var == attributeName t = Right $ ExplicitVariable var (MakeCoercion [MakeIdCoercion $ attributeType t] (MakeCardinalityIdCoercion $ Model.Type.cardinality t))
| otherwise = findAttributeType var 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"]

23
src/Semantic/FunctionChecker.hs
View File

@@ -11,16 +11,25 @@ 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] ExplicitFunction
checkFunction (definedTypes, symbols) (MakeFunction (MakeFunctionSignature name desc inp out) ex) =
let checkedIn = checkAttributes definedTypes inp in
if null $ lefts checkedIn
then
case head $ checkAttributes definedTypes [out] of
Left err -> Left [err]
Right checkedOut -> case checkExpression (addVariables symbols inp) ex of
Left err -> Left [err]
Right checkedEx -> case returnCoercion checkedEx `coercionIncluded` createCoercion (attributeType checkedOut, Model.Type.cardinality out) of
Left err -> Left [err]
Right retCoercion -> Right $ MakeExplicitFunction (MakeFunctionSignature (toLower (head name) : tail name) desc (rights checkedIn) checkedOut) checkedEx
--Right _ -> error $ show (returnCoercion checkedEx) ++ " // " ++ show (createCoercion (attributeType checkedOut, Model.Type.cardinality out))
Right checkedOut -> case checkAssignment (addVariables symbols (checkedOut : rights checkedIn)) ex of
Left err -> Left err
Right checkedEx -> Right $ MakeExplicitFunction (MakeFunctionSignature (toLower (head name) : tail name) desc (rights checkedIn) checkedOut) checkedEx
else
Left $ lefts checkedIn
where checkedIn = checkAttributes definedTypes inp
checkAssignment :: [Symbol] -> [(Expression, Expression)] -> Either [TypeCheckError] [(ExplicitExpression, ExplicitExpression)]
checkAssignment _ [] = Right []
checkAssignment symbs ((assign, ex): assigns) =
case checkExpression (tail symbs) ex of
Left err -> Left [err]
-- Here we use only tail symbs, beacuse the head of the symbol table is the out variable, and that can't be used in the expression body
Right checkedExp -> case checkExpression symbs assign of
Left err -> Left [err]
Right checkedA -> case checkAssignment symbs assigns of
Left err -> Left err
Right checked -> Right $ (checkedA, checkedExp) : checked

53
src/Semantic/TypeChecker.hs
View File

@@ -16,6 +16,7 @@ data TypeCheckError =
| CardinalityMismatch Cardinality Cardinality
| MultipleDeclarations String
| TypeNameReserved String
| UnsupportedExpressionInPathExpression String
deriving (Show)
-- |Checks whether a data type is valid
@@ -46,16 +47,62 @@ checkAttributes definedTypes ((MakeTypeAttribute name typ crd desc):as) =
Left err -> Left err : checkAttributes definedTypes as
Right checked -> Right (MakeTypeAttribute name checked crd desc) : checkAttributes definedTypes as
populateAttributeType :: [Type] -> [Type] -> TypeAttribute -> Either TypeCheckError TypeAttribute
populateAttributeType _ _ (MakeTypeAttribute n (MakeType "int" _ _ _ _) c d ) = Right $ MakeTypeAttribute n (BasicType "Integer") c d
populateAttributeType _ _ (MakeTypeAttribute n (MakeType "string" _ _ _ _) c d ) = Right $ MakeTypeAttribute n (BasicType "String") c d
populateAttributeType _ _ (MakeTypeAttribute n (MakeType "number" _ _ _ _) c d ) = Right $ MakeTypeAttribute n (BasicType "Double") c d
populateAttributeType _ _ (MakeTypeAttribute n (MakeType "boolean" _ _ _ _) c d ) = Right $ MakeTypeAttribute n (BasicType "Bool") c d
populateAttributeType _ _ (MakeTypeAttribute n (MakeType "time" _ _ _ _) c d ) = Right $ MakeTypeAttribute n (BasicType "Time") c d
populateAttributeType _ _ (MakeTypeAttribute n (BasicType t) c d) = Right $ MakeTypeAttribute n (BasicType t) c d
populateAttributeType _ [] t = Left $ UndefinedType $ typeName $ attributeType t
populateAttributeType t (definedT : ts) typ
| definedT == attributeType typ =
let populatedAttr = map (populateAttributeType t t) (typeAttributes definedT)
in
if null $ lefts populatedAttr
then Right $ MakeTypeAttribute
(attributeName typ)
(MakeType (typeName definedT) (superType definedT) (typeDescription definedT) (rights populatedAttr) (conditions definedT))
(cardinality typ)
(attributeDescription typ)
else Left $ head $ lefts populatedAttr
| otherwise = populateAttributeType t ts typ
-- |Checks whether a type is predefined or in the symbol table
checkAttributeType :: [Type] -> Type -> Either TypeCheckError Type
checkAttributeType [] t = Left $ UndefinedType $ typeName t
checkAttributeType _ (MakeType "int" _ _ _ _) = Right $ BasicType "Integer"
checkAttributeType _ (MakeType "string" _ _ _ _) = Right $ BasicType "String"
checkAttributeType _ (MakeType "number" _ _ _ _) = Right $ BasicType "Double"
checkAttributeType _ (MakeType "boolean" _ _ _ _) = Right $ BasicType "Bool"
checkAttributeType _ (MakeType "time" _ _ _ _) = Right $ BasicType "Time"
checkAttributeType definedTypes name
| name `elem` definedTypes = Right name
| otherwise = Left $ UndefinedType (typeName name)
checkAttributeType (defined : ts) t
| defined == t = Right defined
| otherwise = checkAttributeType ts t
populateTypes :: [Type] -> Either [TypeCheckError] [Type]
populateTypes t = populateTypes1 t t
populateTypes1 :: [Type] -> [Type] -> Either [TypeCheckError] [Type]
populateTypes1 _ [] = Right []
populateTypes1 emptyTypes (BasicType t : ts) =
case populateTypes1 emptyTypes ts of
Left error -> Left error
Right definedTypes -> Right $ BasicType t : definedTypes
populateTypes1 emptyTypes (t : ts) =
case populateTypes1 emptyTypes ts of
Left error -> Left error
Right definedTypes ->
let populated = map (populateAttributeType emptyTypes emptyTypes) (typeAttributes t) in
if null $ lefts populated
then Right $ MakeType
(typeName t)
(superType t)
(typeDescription t)
(rights populated)
(conditions t) : definedTypes
else
Left $ lefts populated
-- |Add a list of defined types to the symbol table
addDefinedTypes :: [Type] -> [Type] -> Either [TypeCheckError] [Type]

8
test/Model/TypeSpec.hs
View File

@@ -51,16 +51,16 @@ spec = do
cards1 :: [Cardinality]
cards1 =
[Bounds (0, 20), Bounds (10, 15), Bounds (25, 50), Bounds (15, 16), NoBounds, OneBound 25, OneBound 2, OneBound 1, NoBounds, NoBounds]
[Bounds (0, 20), Bounds (10, 15), Bounds (25, 50), Bounds (15, 16), OneBound 0, OneBound 25, OneBound 2, OneBound 1, OneBound 0, OneBound 0]
cards2 :: [Cardinality]
cards2 =
[Bounds (2, 4), Bounds (4, 45), OneBound 6, NoBounds, Bounds (2, 5), Bounds (2, 30), OneBound 5, NoBounds, OneBound 5, NoBounds]
[Bounds (2, 4), Bounds (4, 45), OneBound 6, OneBound 0, Bounds (2, 5), Bounds (2, 30), OneBound 5, OneBound 0, OneBound 5, OneBound 0]
cardsSum :: [Cardinality]
cardsSum =
[Bounds (2, 24), Bounds (14, 60), OneBound 31, OneBound 15, OneBound 2, OneBound 27, OneBound 7, OneBound 1, OneBound 5, NoBounds]
[Bounds (2, 24), Bounds (14, 60), OneBound 31, OneBound 15, OneBound 2, OneBound 27, OneBound 7, OneBound 1, OneBound 5, OneBound 0]
smallestCards :: [Cardinality]
smallestCards =
[Bounds (0, 20), Bounds (4, 45), OneBound 6, NoBounds, NoBounds, OneBound 2, OneBound 2, NoBounds, NoBounds, NoBounds]
[Bounds (0, 20), Bounds (4, 45), OneBound 6, OneBound 0, OneBound 0, OneBound 2, OneBound 2, OneBound 0, OneBound 0, OneBound 0]

5
test/Parser/ExpressionSpec.hs
View File

@@ -6,6 +6,7 @@ import Test.Hspec
import Test.Hspec.Megaparsec
import Text.Megaparsec
import Model.Function
import Model.Type
import Parser.Expression
spec :: Spec
@@ -70,10 +71,10 @@ exps = [
Function "Function" [Int "3", InfixExp "+" (Int "3") (Int "2"), Variable "e"],
-- 10
IfElse (Function "Function" [InfixExp "+" (Int "2") (Int "3"), Variable "e"])
(InfixExp "-" (InfixExp "+" (Variable "a") (Variable "b")) (InfixExp "*" (Variable "c") (InfixExp "^" (Variable "d") (Variable "e->x"))))
(InfixExp "-" (InfixExp "+" (Variable "a") (Variable "b")) (InfixExp "*" (Variable "c") (InfixExp "^" (Variable "d") (PathExpression (Variable "e") (Variable "x")))))
(PrefixExp "not" (PostfixExp "exists" (Variable "a"))),
-- 11
IfSimple (List [Int "1", Function "Function" [Int "3"]]) (InfixExp "-" (InfixExp "-" (Int "1") (Int "2")) (InfixExp "*" (Int "3") (InfixExp "^" (Variable "a->b") (Variable "c")))),
IfSimple (List [Int "1", Function "Function" [Int "3"]]) (InfixExp "-" (InfixExp "-" (Int "1") (Int "2")) (InfixExp "*" (Int "3") (InfixExp "^" (PathExpression (Variable "a") (Variable "b")) (Variable "c")))),
-- 12
InfixExp "or" (Variable "a") (Variable "b")
]

38
test/Parser/TypeSpec.hs
View File

@@ -36,42 +36,46 @@ types :: [Type]
types = [
MakeType {typeName = "Period",
typeDescription = Just "description",
superType = MakeType "Something" (BasicType "Object") Nothing [],
typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [], cardinality = Bounds(1, 1),
superType = MakeType "Something" (BasicType "Object") Nothing [] [],
typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [] [], cardinality = Bounds(1, 1),
attributeDescription = Just "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."},
MakeTypeAttribute {attributeName = "testMany", attributeType = MakeType "TestType" (BasicType "Object") Nothing [], cardinality = OneBound 0,
MakeTypeAttribute {attributeName = "testMany", attributeType = MakeType "TestType" (BasicType "Object") Nothing [] [], cardinality = OneBound 0,
attributeDescription = Just "Test many"},
MakeTypeAttribute {attributeName = "testSome", attributeType = MakeType "TestSomeType" (BasicType "Object") Nothing [], cardinality = OneBound 1,
MakeTypeAttribute {attributeName = "testSome", attributeType = MakeType "TestSomeType" (BasicType "Object") Nothing [] [], cardinality = OneBound 1,
attributeDescription = Just "Test some"},
MakeTypeAttribute {attributeName = "testMaybeOne", attributeType = MakeType "TestZeroOneType" (BasicType "Object") Nothing [], cardinality = Bounds (0, 1),
MakeTypeAttribute {attributeName = "testMaybeOne", attributeType = MakeType "TestZeroOneType" (BasicType "Object") Nothing [] [], cardinality = Bounds (0, 1),
attributeDescription = Just "Test zero or one"},
MakeTypeAttribute {attributeName = "testAll", attributeType = MakeType "Test" (BasicType "Object") Nothing [], cardinality = Bounds (2, 15),
attributeDescription = Just "Test all"}]},
MakeTypeAttribute {attributeName = "testAll", attributeType = MakeType "Test" (BasicType "Object") Nothing [] [], cardinality = Bounds (2, 15),
attributeDescription = Just "Test all"}],
conditions = []},
MakeType {typeName = "TestType",
typeDescription = Nothing,
superType = BasicType "Object",
typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [], cardinality = Bounds(1, 1),
attributeDescription = Nothing}]},
typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [] [], cardinality = Bounds(1, 1),
attributeDescription = Nothing}],
conditions = []},
MakeType {typeName = "TestSomeType",
typeDescription = Just "description",
superType = BasicType "Object",
typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [], cardinality = Bounds(1, 1),
attributeDescription = Just "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."}]},
typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [] [], cardinality = Bounds(1, 1),
attributeDescription = Just "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."}],
conditions = []},
MakeType {typeName = "TestZeroOneType",
typeDescription = Nothing,
superType = MakeType "Period" (BasicType "Object") Nothing [],
typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [], cardinality = Bounds(1, 1),
attributeDescription = Nothing}]},
superType = MakeType "Period" (BasicType "Object") Nothing [] [],
typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [] [], cardinality = Bounds(1, 1),
attributeDescription = Nothing}],
conditions = []},
MakeType {typeName = "WrongCardinality", superType = BasicType "Object", typeDescription = Just "description", typeAttributes = []},
MakeType {typeName = "WrongCardinality", superType = BasicType "Object", typeDescription = Just "description", typeAttributes = [], conditions = []},
MakeType {typeName = "WrongCardinality2", superType = BasicType "Object", typeDescription = Just "description", typeAttributes = []},
MakeType {typeName = "WrongCardinality2", superType = BasicType "Object", typeDescription = Just "description", typeAttributes = [], conditions = []},
MakeType {typeName = "MissingType", superType = BasicType "Object", typeDescription = Just "description", typeAttributes = []}
MakeType {typeName = "MissingType", superType = BasicType "Object", typeDescription = Just "description", typeAttributes = [], conditions = []}
]