From 134164c4d430b9d848706a2cbb362bda7183b743 Mon Sep 17 00:00:00 2001
From: Adam Wick <awick@uhsure.com>
Date: Fri, 7 Jan 2011 18:00:11 -0800
Subject: [PATCH] Did some work on datatype declarations.

---
 hsrc/Syntax/AST.hs   |  4 ++--
 hsrc/Syntax/Parser.y | 27 ++++++++++++++++++++++++++-
 2 files changed, 28 insertions(+), 3 deletions(-)

diff --git a/hsrc/Syntax/AST.hs b/hsrc/Syntax/AST.hs
index 976412e..b7be42c 100644
--- a/hsrc/Syntax/AST.hs
+++ b/hsrc/Syntax/AST.hs
@@ -26,7 +26,7 @@ data ImportName = ImportNamed QualifiedName
  deriving (Show)
 
 data Show a => Decl a =
-    DeclData a [Type] QualifiedName [QualifiedName] [DataClause]
+    DeclData a [Type] QualifiedName [QualifiedName] [DataClause a]
   | DeclType a [Type]
   | DeclNewtype a [Type]
   | DeclClass a [Type] 
@@ -45,7 +45,7 @@ addTypeRestrictions rs (DeclValue    s _ a b c) = DeclValue s rs a b c
 addTypeRestrictions rs (DeclExport   s d)     =
   DeclExport s (addTypeRestrictions rs d)
 
-data DataClause = DataClause QualifiedName [Type]
+data DataClause a = DataClause a QualifiedName [Maybe QualifiedName] [Type]
  deriving (Show)
 
 data Show a => Expr a =
diff --git a/hsrc/Syntax/Parser.y b/hsrc/Syntax/Parser.y
index d344738..5d6c6ee 100644
--- a/hsrc/Syntax/Parser.y
+++ b/hsrc/Syntax/Parser.y
@@ -152,7 +152,32 @@ decl2 :: { Decl Position }
 -- Data Declarations --------------------------------------------------------
 
 data_decl :: { Decl Position }
-  : 'datatype'    { undefined }
+  : 'datatype' TYPE_IDENT type_args '=' data_clauses
+    { DeclData $1 [] (makeQualified $2) $3 $5 }
+
+type_args :: { [QualifiedName] }
+  :                     { [] }
+  | type_args VAL_IDENT { $1 ++ [makeQualified $2] }
+
+data_clauses :: { [DataClause Position] }
+  : data_clause                  { [] }
+  | data_clauses '|' data_clause { $1 ++ [$3] }
+
+data_clause :: { DataClause Position }
+  : constructor_name '(' constructor_args ')'
+    { DataClause $2 $1 (map fst $3) (map snd $3) }
+
+constructor_name :: { QualifiedName }
+  : TYPE_IDENT       { makeQualified $1 }
+  | '(' OP_IDENT ')' { makeQualified $2 }
+
+constructor_args :: { [(Maybe QualifiedName,Type)] }
+  : constructor_arg                      { [$1] }
+  | constructor_args ',' constructor_arg { $1 ++ [$3] }
+
+constructor_arg :: { (Maybe QualifiedName,Type) }
+  : bang_type                            { (Nothing, $1) }
+  | VAL_IDENT '::' bang_type             { (Just (makeQualified $1), $3) }
 
 -- Type Declarations --------------------------------------------------------