Sugar has arrived

Grammar.cf

@@ -13,8 +13,10 @@ DBind. Def ::= Bind;
 DSig.  Def ::= Sig;
 DData. Def ::= Data; 
 
-Sig.   Sig ::= LIdent ":" Type;
-Bind. Bind ::= LIdent [LIdent] "=" Exp;
+internal Sig.   Sig ::= LIdent ":" Type;
+         SigS.   Sig ::= VarName ":" Type;
+internal Bind. Bind ::= LIdent [LIdent] "=" Exp;
+         BindS. Bind ::= VarName [LIdent] "=" Exp;
 
 -------------------------------------------------------------------------------
 -- * Types
@@ -42,15 +44,22 @@ Inj. Inj ::= UIdent ":" Type ;
 -- * Expressions
 -------------------------------------------------------------------------------
 
-EVar.  Exp4 ::= LIdent;
-EInj.  Exp4 ::= UIdent;
-ELit.  Exp4 ::= Lit;
-EApp.  Exp3 ::= Exp3 Exp4;
-EAdd.  Exp2 ::= Exp2 "+" Exp3;
-ELet.  Exp1  ::= "let" Bind "in" Exp1; 
-EAbs.  Exp1  ::= "\\" LIdent "." Exp1;
-ECase. Exp1  ::= "case" Exp "of" "{" [Branch] "}";
-EAnn.  Exp  ::= Exp1 ":" Type;
+internal EVar.  Exp4 ::= LIdent;
+         EVarS. Exp4 ::= VarName ;
+         EInj.  Exp4 ::= UIdent;
+         ELit.  Exp4 ::= Lit;
+         EApp.  Exp3 ::= Exp3 Exp4;
+         EAdd.  Exp2 ::= Exp2 "+" Exp3;
+         ELet.  Exp1  ::= "let" Bind "in" Exp1; 
+         EAbs.  Exp1  ::= "\\" LIdent "." Exp1;
+         ECase. Exp1  ::= "case" Exp "of" "{" [Branch] "}";
+         EAnn.  Exp  ::= Exp1 ":" Type;
+
+VSymbol. VarName ::= "." Symbol;
+VIdent. VarName ::= LIdent;
+
+infixSymbol. Exp2 ::= Exp2 Symbol Exp3 ;
+define infixSymbol e1 vn e3 = EApp (EApp (EVarS (VSymbol vn)) e1) e3;
 
 -------------------------------------------------------------------------------
 -- * LITERALS
@@ -93,6 +102,7 @@ coercions Type 1 ;
 
 token UIdent (upper (letter | digit | '_')*) ;
 token LIdent (lower (letter | digit | '_')*) ;
+token Symbol (["@#%^&*_-+=|?/<>,•"]+) ;
 
 comment "--";
 comment "{-" "-}";

src/Desugar/Desugar.hs

@@ -5,27 +5,68 @@ module Desugar.Desugar where
 import Data.Function (on)
 import Grammar.Abs
 
+{-
+
+The entire module should never have any catch all pattern matches as that
+will disble warnings for when the grammar is expanded.
+
+-}
+
 desugar :: Program -> Program
 desugar (Program defs) = Program (map desugarDef defs)
 
+desugarVarName :: VarName -> LIdent
+desugarVarName (VSymbol (Symbol i)) = LIdent i
+desugarVarName (VIdent i) = i
+
 desugarDef :: Def -> Def
 desugarDef = \case
     DBind b -> DBind (desugarBind b)
-    DSig sig -> DSig sig
-    DData d -> DData d
+    DSig sig -> DSig (desugarSig sig)
+    DData d -> DData (desugarData d)
 
 desugarBind :: Bind -> Bind
+desugarBind (BindS name args e) = Bind (desugarVarName name) args (desugarExp e)
 desugarBind (Bind name args e) = Bind name args (desugarExp e)
 
+desugarSig :: Sig -> Sig
+desugarSig (SigS ident typ) = Sig (desugarVarName ident) (desugarType typ)
+desugarSig (Sig ident typ) = Sig ident (desugarType typ)
+
+desugarData :: Data -> Data
+desugarData (Data typ injs) = Data (desugarType typ) (map desugarInj injs)
+
+desugarType :: Type -> Type
+desugarType t = t
+
+desugarInj :: Inj -> Inj
+desugarInj (Inj ident typ) = Inj ident (desugarType typ)
+
 desugarExp :: Exp -> Exp
 desugarExp = \case
-    EApp e1 e2 -> (EApp `on` desugarExp) e1 e2
-    EAdd e1 e2 -> (EAdd `on` desugarExp) e1 e2
+    EApp e1 e2 -> EApp (desugarExp e1) (desugarExp e2)
+    EAdd e1 e2 -> EAdd (desugarExp e1) (desugarExp e2)
     EAbs i e -> EAbs i (desugarExp e)
     ELet b e -> ELet (desugarBind b) (desugarExp e)
     ECase e br -> ECase (desugarExp e) (map desugarBranch br)
     EAnn e t -> EAnn (desugarExp e) t
-    e -> e
+    EVarS (VSymbol (Symbol symb)) -> EVar (LIdent symb)
+    EVarS (VIdent ident) -> EVar ident
+    EVar i -> EVar i
+    ELit l -> ELit l
+    EInj i -> EInj i
 
 desugarBranch :: Branch -> Branch
-desugarBranch (Branch p e) = Branch p (desugarExp e)
+desugarBranch (Branch p e) = Branch (desugarPattern p) (desugarExp e)
+
+desugarPattern :: Pattern -> Pattern
+desugarPattern = \case
+    PVar ident -> PVar ident
+    PLit lit -> PLit (desugarLit lit)
+    PCatch -> PCatch
+    PEnum ident -> PEnum ident
+    PInj ident patterns -> PInj ident (map desugarPattern patterns)
+
+desugarLit :: Lit -> Lit
+desugarLit (LInt i) = LInt i
+desugarLit (LChar c) = LChar c