Parser and type checker almost completely working

Added testing env
This commit is contained in:
macocianradu
2021-11-11 17:25:30 +01:00
parent 464ef29caa
commit 3890ed5f03
32 changed files with 287 additions and 356 deletions

View File

@@ -8,16 +8,24 @@ import Model.Type
printType :: Type -> String
printType (MakeType name _ description attributes) =
show $ printDescription description (vcat [nest 4 $ vcat("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": map printAttribute attributes), "}", ""])
show $ printDescription description (vcat [nest 4 $ vcat ("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": map printAttribute attributes), "}", ""])
printType (BasicType name) = show $ pretty name
printAttributes :: [TypeAttribute] -> [Doc a]
printAttributes [] = []
printAttributes [at] = [printAttribute at]
printAttributes (at : ats) = (printAttribute at <> ",") : printAttributes ats
printAttribute :: TypeAttribute -> Doc a
printAttribute (MakeTypeAttribute name typ crd description) =
printDescription description
(pretty name <+> "::" <+> printCardinality (MakeTypeAttribute name typ crd description))
printCardinality :: TypeAttribute -> Doc a
printCardinality (MakeTypeAttribute _ typ ExactlyOne _) = pretty (typeName typ)
printCardinality (MakeTypeAttribute _ typ OneOrMore _) = "[" <> pretty (typeName typ) <> "]"
printCardinality (MakeTypeAttribute _ typ ZeroOrMore _) = "[" <> pretty (typeName typ) <> "]"
printCardinality (MakeTypeAttribute _ typ ZeroOrOne _) = "Maybe" <+> pretty (typeName typ)
printCardinality (MakeTypeAttribute _ typ (Bounds (x, y)) _)
| x == 0 && y == 1 = "Maybe" <+> pretty (typeName typ)
| x == 1 && y == 1 = pretty (typeName typ)
| otherwise = "[" <> pretty (typeName typ) <> "]"
printCardinality (MakeTypeAttribute _ typ NoBounds _) = "[" <> pretty (typeName typ) <> "]"
printCardinality (MakeTypeAttribute _ typ (OneBound _) _) = "[" <> pretty (typeName typ) <> "]"