From 22a27dca3b807268afa289d84537c771b831eda3 Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Wed, 6 Dec 2023 10:22:38 -0700
Subject: [PATCH] case expr rules

---
 src/Core/Parse.y   | 15 ++++++++++++++-
 src/Core/Syntax.hs |  6 ++++--
 2 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/src/Core/Parse.y b/src/Core/Parse.y
index 26021ac..7082216 100644
--- a/src/Core/Parse.y
+++ b/src/Core/Parse.y
@@ -34,7 +34,8 @@ import Data.Default.Class   (def)
       letrec          { Located _ _ _ TokenLetrec }
       module          { Located _ _ _ TokenModule }
       where           { Located _ _ _ TokenWhere }
-      ','             { Located _ _ _ TokenComma }
+      case            { Located _ _ _ TokenCase }
+      of              { Located _ _ _ TokenOf }
       in              { Located _ _ _ TokenIn }
       litint          { Located _ _ _ (TokenLitInt $$) }
       varname         { Located _ _ _ (TokenVarName $$) }
@@ -85,6 +86,7 @@ Expr            :: { Expr }
 Expr            : LetExpr                       { $1 }
                 | 'λ' Binders '->' Expr         { Lam $2 $4 }
                 | Application                   { $1 }
+                | CaseExpr                      { $1 }
                 | Expr1                         { $1 }
 
 LetExpr         :: { Expr }
@@ -103,6 +105,17 @@ AppArgs         :: { [Expr] }
 AppArgs         : Expr1 AppArgs                 { $1 : $2 }
                 | Expr1                         { [$1] }
 
+CaseExpr        :: { Expr }
+CaseExpr        : case Expr of '{' Alters '}'   { Case $2 $5 }
+
+Alters          :: { [Alter] }
+Alters          : Alter ';' Alters              { $1 : $3 }
+                | Alter ';'                     { [$1] }
+                | Alter                         { [$1] }
+
+Alter           :: { Alter }
+Alter           : litint ParList '->' Expr      { Alter $1 $2 $4 }
+
 Expr1           :: { Expr }
 Expr1           : litint                        { IntE $1 }
                 | Id                            { Var $1 }
diff --git a/src/Core/Syntax.hs b/src/Core/Syntax.hs
index 62ee607..aba8cdb 100644
--- a/src/Core/Syntax.hs
+++ b/src/Core/Syntax.hs
@@ -11,6 +11,7 @@ module Core.Syntax
     , Rec(..)
     , Alter(..)
     , Name
+    , Tag
     , ScDef(..)
     , Module(..)
     , Program(..)
@@ -31,7 +32,7 @@ import Language.Haskell.TH.Syntax   (Lift)
 ----------------------------------------------------------------------------------
 
 data Expr = Var Name
-          | Con Int Int -- Con Tag Arity
+          | Con Tag Int -- Con Tag Arity
           | Let Rec [Binding] Expr
           | Case Expr [Alter]
           | Lam [Name] Expr
@@ -56,10 +57,11 @@ data Rec = Rec
          | NonRec
          deriving (Show, Eq, Lift)
 
-data Alter = Alter Int [Name] Expr
+data Alter = Alter Tag [Name] Expr
     deriving (Show, Lift, Eq)
 
 type Name = String
+type Tag = Int
 
 data ScDef = ScDef Name [Name] Expr
     deriving (Show, Lift, Eq)