mirror of
https://github.com/macocianradu/RosettaHaskellCompiler.git
synced 2026-03-18 21:10:07 +00:00
Parser and type checker almost completely working
Added testing env
This commit is contained in:
@@ -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) <> "]"
|
||||
Reference in New Issue
Block a user