From 0caeeccde117d56f5d068ccd58328e6d71501b32 Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Wed, 13 Dec 2023 11:03:43 -0700
Subject: [PATCH] awkwardly demos broken dev branch

---
 src/Core/Lex.x     |  2 ++
 src/Core/Parse.y   |  4 ++--
 src/Core/Syntax.hs | 13 ++++++++++++-
 src/Core2Core.hs   |  1 +
 4 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/src/Core/Lex.x b/src/Core/Lex.x
index 7f90296..b666d69 100644
--- a/src/Core/Lex.x
+++ b/src/Core/Lex.x
@@ -68,6 +68,7 @@ rlp :-
     "{"                     { constTok TokenLBrace }
     "}"                     { constTok TokenRBrace }
     ";"                     { constTok TokenSemicolon }
+    "@"                     { constTok TokenTypeApp }
     "{-#"                   { constTok TokenLPragma `andBegin` pragma }
 
     "let"                   { constTok TokenLet }
@@ -133,6 +134,7 @@ data CoreToken = TokenLet
                | TokenLBrace
                | TokenRBrace
                | TokenSemicolon
+               | TokenTypeApp
                | TokenLPragma
                | TokenRPragma
                | TokenWord String
diff --git a/src/Core/Parse.y b/src/Core/Parse.y
index 1654038..94d0dcc 100644
--- a/src/Core/Parse.y
+++ b/src/Core/Parse.y
@@ -47,6 +47,7 @@ import Data.Default.Class   (def)
       'λ'             { Located _ _ _ TokenLambda }
       '->'            { Located _ _ _ TokenArrow }
       '='             { Located _ _ _ TokenEquals }
+      '@'             { Located _ _ _ TokenTypeApp }
       '('             { Located _ _ _ TokenLParen }
       ')'             { Located _ _ _ TokenRParen }
       '{'             { Located _ _ _ TokenLBrace }
@@ -104,9 +105,8 @@ Binders         : Var Binders                  { $1 : $2 }
                 | Var                          { [$1] }
 
 Application     :: { Expr Name }
-Application     : Expr1 AppArgs                 { foldl' App $1 $2 }
+Application     : Expr1 AppArgs                { foldl' App $1 $2 }
 
--- TODO: Application can probably be written as a single rule, without AppArgs
 AppArgs         :: { [Expr Name] }
 AppArgs         : Expr1 AppArgs                 { $1 : $2 }
                 | Expr1                         { [$1] }
diff --git a/src/Core/Syntax.hs b/src/Core/Syntax.hs
index 7a1f500..676cf3b 100644
--- a/src/Core/Syntax.hs
+++ b/src/Core/Syntax.hs
@@ -6,6 +6,7 @@ Description : Core ASTs and the like
 {-# LANGUAGE FunctionalDependencies #-}
 module Core.Syntax
     ( Expr(..)
+    , Type(..)
     , Literal(..)
     , pattern (:$)
     , Binding(..)
@@ -36,8 +37,8 @@ import Data.List                    (intersperse)
 import Data.Function                ((&))
 import Data.String
 -- Lift instances for the Core quasiquoters
-import Lens.Micro
 import Language.Haskell.TH.Syntax   (Lift)
+import Lens.Micro
 ----------------------------------------------------------------------------------
 
 data Expr b = Var Name
@@ -47,10 +48,20 @@ data Expr b = Var Name
             | Let Rec [Binding b] (Expr b)
             | App (Expr b) (Expr b)
             | LitE Literal
+            | Type Type
             deriving (Show, Read, Lift)
 
 deriving instance (Eq b) => Eq (Expr b)
 
+data Type = TyInt
+          | TyFun
+          | TyVar Name
+          | TyApp Type Type
+          | TyConApp TyCon [Type]
+          deriving (Show, Read, Lift, Eq)
+
+type TyCon = Name
+
 infixl 2 :$
 pattern (:$) :: Expr b  -> Expr b  -> Expr b 
 pattern f :$ x = App f x
diff --git a/src/Core2Core.hs b/src/Core2Core.hs
index c2f5a03..412c6d2 100644
--- a/src/Core2Core.hs
+++ b/src/Core2Core.hs
@@ -57,6 +57,7 @@ floatNonStrictCases g = goE
         goE :: Expr' -> Floater Expr'
         goE (Var k)             = pure (Var k)
         goE (LitE l)            = pure (LitE l)
+        goE (Case e as)         = pure (Case e as)
         goE (Let Rec bs e)      = Let Rec <$> bs' <*> goE e
             where bs' = travBs goE bs
         goE e                   = goC e