Fix external core syntax (though not full compilation)

This patch updates the External Core creator, pretty-printer, and parser to
agree on a concrete syntax for External Core, including the constructs
required by the change to System FC. Code to create valid ASTs from External
Core files will come later, as will bits for renaming, typechecking, and
desugaring.

diff --git a/compiler/coreSyn/ExternalCore.lhs b/compiler/coreSyn/ExternalCore.lhs
index 89b2712..2fdcf2d 100644 (file)
--- a/compiler/coreSyn/ExternalCore.lhs
+++ b/compiler/coreSyn/ExternalCore.lhs
@@ -62,6 +62,7 @@ data Kind
   | Kunboxed
   | Kopen
   | Karrow Kind Kind
   | Kunboxed
   | Kopen
   | Karrow Kind Kind

+  | Keq Ty Ty

 
 data Lit 
   = Lint Integer Ty
 
 data Lit 
   = Lint Integer Ty

diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs
index 150ae16..de907cf 100644 (file)
--- a/compiler/coreSyn/MkExternalCore.lhs
+++ b/compiler/coreSyn/MkExternalCore.lhs
@@ -20,6 +20,7 @@ import Type
 import PprExternalCore -- Instances
 import DataCon
 import CoreSyn
 import PprExternalCore -- Instances
 import DataCon
 import CoreSyn

+import Coercion

 import Var
 import IdInfo
 import Literal
 import Var
 import IdInfo
 import Literal

@@ -179,7 +180,8 @@ make_ty (NoteTy _ t)        = make_ty t
 
 
 make_kind :: Kind -> C.Kind
 
 
 make_kind :: Kind -> C.Kind

-make_kind (PredTy p) | isEqPred p = panic "coercion kinds in external core not implemented!"
+make_kind (PredTy p) | isEqPred p = C.Keq (make_ty t1) (make_ty t2)
+    where (t1, t2) = getEqPredTys p

 make_kind (FunTy k1 k2)  = C.Karrow (make_kind k1) (make_kind k2)
 make_kind k
   | isLiftedTypeKind k   = C.Klifted
 make_kind (FunTy k1 k2)  = C.Karrow (make_kind k1) (make_kind k2)
 make_kind k
   | isLiftedTypeKind k   = C.Klifted

diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs
index 502c268..9f4c011 100644 (file)
--- a/compiler/coreSyn/PprExternalCore.lhs
+++ b/compiler/coreSyn/PprExternalCore.lhs
@@ -76,6 +76,7 @@ pakind (Kopen) = char '?'
 pakind k = parens (pkind k)
 
 pkind (Karrow k1 k2) = parens (pakind k1 <> text "->" <> pkind k2)
 pakind k = parens (pkind k)
 
 pkind (Karrow k1 k2) = parens (pakind k1 <> text "->" <> pkind k2)

+pkind (Keq t1 t2) = parens (pty t1 <> text ":=:" <> pty t2)

 pkind k = pakind k
 
 paty (Tvar n) = pname n
 pkind k = pakind k
 
 paty (Tvar n) = pname n

@@ -132,7 +133,7 @@ pexp (Let vd e) = (text "%let" <+> pvdefg vd) $$ (text "%in" <+> pexp e)
 pexp (Case e vb ty alts) = sep [text "%case" <+> parens (paty ty) <+> paexp e,
                             text "%of" <+> pvbind vb]
                        $$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))
 pexp (Case e vb ty alts) = sep [text "%case" <+> parens (paty ty) <+> paexp e,
                             text "%of" <+> pvbind vb]
                        $$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))

-pexp (Cast e co) = (text "%cast" <+> pexp e) $$ paty co
+pexp (Cast e co) = (text "%cast" <+> parens (pexp e)) $$ paty co

 pexp (Note s e) = (text "%note" <+> pstring s) $$ pexp e
 pexp (External n cc t) = (text "%external" <+> text cc <+> pstring n) $$ paty t
 pexp (DynExternal cc t) = (text "%dynexternal" <+> text cc) $$ paty t
 pexp (Note s e) = (text "%note" <+> pstring s) $$ pexp e
 pexp (External n cc t) = (text "%external" <+> text cc <+> pstring n) $$ paty t
 pexp (DynExternal cc t) = (text "%dynexternal" <+> text cc) $$ paty t

diff --git a/compiler/parser/LexCore.hs b/compiler/parser/LexCore.hs
index 936786d..9109c04 100644 (file)
--- a/compiler/parser/LexCore.hs
+++ b/compiler/parser/LexCore.hs
@@ -6,7 +6,7 @@ import Char
 import Numeric
 
 isNameChar c = isAlpha c || isDigit c || (c == '_') || (c == '\'')
 import Numeric
 
 isNameChar c = isAlpha c || isDigit c || (c == '_') || (c == '\'')

-              || (c == ':') || (c == '$')
+              || (c == '$') || (c == '-') || (c == '.')

 isKeywordChar c = isAlpha c || (c == '_') 
 
 lexer :: (Token -> P a) -> P a 
 isKeywordChar c = isAlpha c || (c == '_') 
 
 lexer :: (Token -> P a) -> P a 

@@ -29,6 +29,7 @@ lexer cont (')':cs)   = cont TKcparen cs
 lexer cont ('{':cs)    = cont TKobrace cs
 lexer cont ('}':cs)    = cont TKcbrace cs
 lexer cont ('=':cs)     = cont TKeq cs
 lexer cont ('{':cs)    = cont TKobrace cs
 lexer cont ('}':cs)    = cont TKcbrace cs
 lexer cont ('=':cs)     = cont TKeq cs

+lexer cont (':':'=':':':cs) = cont TKcoloneqcolon cs

 lexer cont (':':':':cs) = cont TKcoloncolon cs
 lexer cont ('*':cs)    = cont TKstar cs
 lexer cont ('.':cs)    = cont TKdot cs
 lexer cont (':':':':cs) = cont TKcoloncolon cs
 lexer cont ('*':cs)    = cont TKstar cs
 lexer cont ('.':cs)    = cont TKdot cs

@@ -37,7 +38,9 @@ lexer cont ('@':cs)   = cont TKat cs
 lexer cont ('?':cs)    = cont TKquestion cs
 lexer cont (';':cs)    = cont TKsemicolon cs
 -- 20060420 GHC spits out constructors with colon in them nowadays. jds
 lexer cont ('?':cs)    = cont TKquestion cs
 lexer cont (';':cs)    = cont TKsemicolon cs
 -- 20060420 GHC spits out constructors with colon in them nowadays. jds

-lexer cont (':':cs)     = lexName cont TKcname (':':cs)
+-- 20061103 but it's easier to parse if we split on the colon, and treat them
+-- as several tokens
+lexer cont (':':cs)     = cont TKcolon cs

 -- 20060420 Likewise does it create identifiers starting with dollar. jds
 lexer cont ('$':cs)     = lexName cont TKname ('$':cs)
 lexer cont (c:cs)      = failP "invalid character" [c]
 -- 20060420 Likewise does it create identifiers starting with dollar. jds
 lexer cont ('$':cs)     = lexName cont TKname ('$':cs)
 lexer cont (c:cs)      = failP "invalid character" [c]

@@ -94,6 +97,7 @@ lexKeyword cont cs =
       ("cast",rest) -> cont TKcast rest        
       ("note",rest) -> cont TKnote rest        
       ("external",rest) -> cont TKexternal rest
       ("cast",rest) -> cont TKcast rest        
       ("note",rest) -> cont TKnote rest        
       ("external",rest) -> cont TKexternal rest

+      ("local",rest) -> cont TKlocal rest

       ("_",rest) -> cont TKwild rest
       _ -> failP "invalid keyword" ('%':cs) 
 
       ("_",rest) -> cont TKwild rest
       _ -> failP "invalid keyword" ('%':cs) 
 

diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y
index b37add3..225c164 100644 (file)
--- a/compiler/parser/ParserCore.y
+++ b/compiler/parser/ParserCore.y
@@ -11,9 +11,9 @@ import Type ( Kind,
               liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
               argTypeKindTyCon, ubxTupleKindTyCon, mkArrowKind, mkTyConApp
             )
               liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
               argTypeKindTyCon, ubxTupleKindTyCon, mkArrowKind, mkTyConApp
             )

-import Name( Name, nameOccName, nameModule )
+import Name( Name, nameOccName, nameModule, mkExternalName )

 import Module
 import Module

-import PackageConfig   ( mainPackageId )
+import PackageConfig   ( mainPackageId, stringToPackageId )

 import ParserCoreUtils
 import LexCore
 import Literal
 import ParserCoreUtils
 import LexCore
 import Literal

@@ -24,6 +24,7 @@ import TyCon ( TyCon, tyConName )
 import FastString
 import Outputable
 import Char
 import FastString
 import Outputable
 import Char

+import Unique

 
 #include "../HsVersions.h"
 
 
 #include "../HsVersions.h"
 

@@ -45,6 +46,7 @@ import Char
  '%cast'       { TKcast }
  '%note'       { TKnote }
  '%external'   { TKexternal }
  '%cast'       { TKcast }
  '%note'       { TKnote }
  '%external'   { TKexternal }

+ '%local'      { TKlocal }

  '%_'          { TKwild }
  '('           { TKoparen }
  ')'           { TKcparen }
  '%_'          { TKwild }
  '('           { TKoparen }
  ')'           { TKcparen }

@@ -52,7 +54,9 @@ import Char
  '}'           { TKcbrace }
  '#'           { TKhash}
  '='           { TKeq }
  '}'           { TKcbrace }
  '#'           { TKhash}
  '='           { TKeq }

+ ':'           { TKcolon }

  '::'          { TKcoloncolon }
  '::'          { TKcoloncolon }

+ ':=:'         { TKcoloneqcolon }

  '*'           { TKstar }
  '->'          { TKrarrow }
  '\\'          { TKlambda}
  '*'           { TKstar }
  '->'          { TKrarrow }
  '\\'          { TKlambda}

@@ -73,27 +77,52 @@ import Char
 %%
 
 module :: { HsExtCore RdrName }
 %%
 
 module :: { HsExtCore RdrName }

-         : '%module' modid tdefs vdefgs { HsExtCore $2 $3 $4 }
+       -- : '%module' modid tdefs vdefgs       { HsExtCore $2 $3 $4 }
+       : '%module' modid tdefs vdefgs  { HsExtCore $2 [] [] }

 
 

+
+-------------------------------------------------------------
+--     Names: the trickiest bit in here
+
+-- A name of the form A.B.C could be:
+--   module A.B.C
+--   dcon C in module A.B
+--   tcon C in module A.B

 modid  :: { Module }
 modid  :: { Module }

-        : CNAME                         { mkModule mainPackageId  -- ToDo: wrong
-                                       (mkModuleNameFS (mkFastString $1)) }
+       : NAME ':' mparts               { undefined }
+
+q_dc_name :: { Name }
+         : NAME ':' mparts             { undefined }
+
+q_tc_name :: { Name }
+         : NAME ':' mparts             { undefined }
+
+q_var_occ :: { Name }
+          : NAME ':' vparts             { undefined }
+
+mparts :: { [String] }
+       : CNAME                         { [$1] }
+       | CNAME '.' mparts              { $1:$3 }
+
+vparts  :: { [String] }
+        : var_occ                       { [$1] }
+        | CNAME '.' vparts              { $1:$3 }

 
 -------------------------------------------------------------
 --     Type and newtype declarations are in HsSyn syntax
 
 tdefs  :: { [TyClDecl RdrName] }
        : {- empty -}   {[]}
 
 -------------------------------------------------------------
 --     Type and newtype declarations are in HsSyn syntax
 
 tdefs  :: { [TyClDecl RdrName] }
        : {- empty -}   {[]}

-       | tdef ';' tdefs        {$1:$3}
+       | tdef tdefs    {$1:$2}

 
 tdef   :: { TyClDecl RdrName }
 
 tdef   :: { TyClDecl RdrName }

-       : '%data' q_tc_name tv_bndrs '=' '{' cons '}'
+       : '%data' q_tc_name tv_bndrs '=' '{' cons '}' ';'

                 { mkTyData DataType ( noLoc []
                                    , noLoc (ifaceExtRdrName $2)
                                    , map toHsTvBndr $3
                                    , Nothing
                                    ) Nothing $6 Nothing }
                 { mkTyData DataType ( noLoc []
                                    , noLoc (ifaceExtRdrName $2)
                                    , map toHsTvBndr $3
                                    , Nothing
                                    ) Nothing $6 Nothing }

-       | '%newtype' q_tc_name tv_bndrs trep 
+       | '%newtype' q_tc_name tv_bndrs trep ';'

                { let tc_rdr = ifaceExtRdrName $2 in
                   mkTyData NewType ( noLoc []
                                   , noLoc tc_rdr
                { let tc_rdr = ifaceExtRdrName $2 in
                   mkTyData NewType ( noLoc []
                                   , noLoc tc_rdr

@@ -112,6 +141,7 @@ trep    :: { OccName -> [LConDecl RdrName] }
 
 cons   :: { [LConDecl RdrName] }
        : {- empty -}   { [] } -- 20060420 Empty data types allowed. jds
 
 cons   :: { [LConDecl RdrName] }
        : {- empty -}   { [] } -- 20060420 Empty data types allowed. jds

+        | con           { [$1] }

        | con ';' cons  { $1:$3 }
 
 con    :: { LConDecl RdrName }
        | con ';' cons  { $1:$3 }
 
 con    :: { LConDecl RdrName }

@@ -143,12 +173,13 @@ atys      :: { [IfaceType] }
        | aty atys      { $1:$2 }
 
 aty    :: { IfaceType }
        | aty atys      { $1:$2 }
 
 aty    :: { IfaceType }

-       : tv_occ    { IfaceTyVar $1 }
+       : fs_var_occ { IfaceTyVar $1 }

        | q_tc_name  { IfaceTyConApp (IfaceTc $1) [] }
        | '(' ty ')' { $2 }
 
 bty    :: { IfaceType }
        | q_tc_name  { IfaceTyConApp (IfaceTc $1) [] }
        | '(' ty ')' { $2 }
 
 bty    :: { IfaceType }

-       : tv_occ atys    { foldl IfaceAppTy (IfaceTyVar $1) $2 }
+       : fs_var_occ atys { foldl IfaceAppTy (IfaceTyVar $1) $2 }
+        | q_var_occ atys  { undefined }

         | q_tc_name atys  { IfaceTyConApp (IfaceTc $1) $2 }
         | '(' ty ')' { $2 }
 
         | q_tc_name atys  { IfaceTyConApp (IfaceTc $1) $2 }
         | '(' ty ')' { $2 }
 

@@ -165,25 +196,23 @@ vdefgs    :: { [IfaceBinding] }
        | let_bind ';' vdefgs   { $1 : $3 }
 
 let_bind :: { IfaceBinding }
        | let_bind ';' vdefgs   { $1 : $3 }
 
 let_bind :: { IfaceBinding }

-       : '%rec' '{' vdefs1 '}' { IfaceRec $3 }
+       : '%rec' '{' vdefs1 '}' { IfaceRec $3 } -- Can be empty. Do we care?

        |  vdef                 { let (b,r) = $1
                                  in IfaceNonRec b r }
 
 vdefs1 :: { [(IfaceIdBndr, IfaceExpr)] }
        |  vdef                 { let (b,r) = $1
                                  in IfaceNonRec b r }
 
 vdefs1 :: { [(IfaceIdBndr, IfaceExpr)] }

-       : vdef                  { [$1] }
+       : vdef                  { [$1] }

        | vdef ';' vdefs1       { $1:$3 }
 
 vdef   :: { (IfaceIdBndr, IfaceExpr) }
        | vdef ';' vdefs1       { $1:$3 }
 
 vdef   :: { (IfaceIdBndr, IfaceExpr) }

-       : qd_occ '::' ty '=' exp { (($1, $3), $5) }
+       : fs_var_occ '::' ty '=' exp { (($1, $3), $5) }
+        | '%local' vdef              { $2 }
+

   -- NB: qd_occ includes data constructors, because
   --     we allow data-constructor wrappers at top level
   -- But we discard the module name, because it must be the
   -- same as the module being compiled, and Iface syntax only
   -- NB: qd_occ includes data constructors, because
   --     we allow data-constructor wrappers at top level
   -- But we discard the module name, because it must be the
   -- same as the module being compiled, and Iface syntax only

-  -- has OccNames in binding positions
-
-qd_occ :: { FastString }
-        : var_occ { $1 }
-        | d_occ   { $1 }
+  -- has OccNames in binding positions. Ah, but it has Names now!

 
 ---------------------------------------
 --  Binders
 
 ---------------------------------------
 --  Binders

@@ -196,15 +225,11 @@ bndrs     :: { [IfaceBndr] }
        | bndr bndrs    { $1:$2 }
 
 id_bndr        :: { IfaceIdBndr }
        | bndr bndrs    { $1:$2 }
 
 id_bndr        :: { IfaceIdBndr }

-       : '(' var_occ '::' ty ')'       { ($2,$4) }
-
-id_bndrs :: { [IfaceIdBndr] }
-       : {-empty -}            { [] }
-       | id_bndr id_bndrs      { $1:$2 }
+       : '(' fs_var_occ '::' ty ')'    { ($2,$4) }

 
 tv_bndr        :: { IfaceTvBndr }
 
 tv_bndr        :: { IfaceTvBndr }

-       :  tv_occ                    { ($1, ifaceLiftedTypeKind) }
-       |  '(' tv_occ '::' akind ')' { ($2, $4) }
+       :  fs_var_occ                    { ($1, ifaceLiftedTypeKind) }
+       |  '(' fs_var_occ '::' akind ')' { ($2, $4) }

 
 tv_bndrs       :: { [IfaceTvBndr] }
        : {- empty -}   { [] }
 
 tv_bndrs       :: { [IfaceTvBndr] }
        : {- empty -}   { [] }

@@ -219,13 +244,15 @@ akind     :: { IfaceKind }
 kind   :: { IfaceKind }
        : akind            { $1 }
        | akind '->' kind  { ifaceArrow $1 $3 }
 kind   :: { IfaceKind }
        : akind            { $1 }
        | akind '->' kind  { ifaceArrow $1 $3 }

+        | ty ':=:' ty      { ifaceEq $1 $3 }

 
 -----------------------------------------
 --             Expressions
 
 aexp    :: { IfaceExpr }
 
 -----------------------------------------
 --             Expressions
 
 aexp    :: { IfaceExpr }

-       : var_occ                { IfaceLcl $1 }
-        | modid '.' qd_occ      { IfaceExt undefined {-ToDo!!! (ExtPkg $1 (mkVarOccFS $3))-} }
+       : fs_var_occ    { IfaceLcl $1 }
+        | q_var_occ            { IfaceExt $1 }
+       | q_dc_name     { IfaceExt $1 }

        | lit           { IfaceLit $1 }
        | '(' exp ')'   { $2 }
 
        | lit           { IfaceLit $1 }
        | '(' exp ')'   { $2 }
 

@@ -241,7 +268,7 @@ exp :: { IfaceExpr }
 -- gaw 2004
        | '%case' '(' ty ')' aexp '%of' id_bndr
          '{' alts1 '}'               { IfaceCase $5 (fst $7) $3 $9 }
 -- gaw 2004
        | '%case' '(' ty ')' aexp '%of' id_bndr
          '{' alts1 '}'               { IfaceCase $5 (fst $7) $3 $9 }

-        | '%cast' exp aty { IfaceCast $2 $3 }
+        | '%cast' aexp aty { IfaceCast $2 $3 }

        | '%note' STRING exp       
            { case $2 of
               --"SCC"      -> IfaceNote (IfaceSCC "scc") $3
        | '%note' STRING exp       
            { case $2 of
               --"SCC"      -> IfaceNote (IfaceSCC "scc") $3

@@ -257,11 +284,13 @@ alts1     :: { [IfaceAlt] }
        | alt ';' alts1 { $1:$3 }
 
 alt    :: { IfaceAlt }
        | alt ';' alts1 { $1:$3 }
 
 alt    :: { IfaceAlt }

-       : modid '.' d_pat_occ bndrs '->' exp 
-               { (IfaceDataAlt undefined {-ToDo!!! $3 -}, map ifaceBndrName $4, $6) } 
+       : q_dc_name bndrs '->' exp 
+               { (IfaceDataAlt $1, map ifaceBndrName $2, $4) } 

                        -- The external syntax currently includes the types of the
                       -- the args, but they aren't needed internally
                        -- Nor is the module qualifier
                        -- The external syntax currently includes the types of the
                       -- the args, but they aren't needed internally
                        -- Nor is the module qualifier

+       | q_dc_name '->' exp 
+               { (IfaceDataAlt $1, [], $3) } 

        | lit '->' exp
                { (IfaceLitAlt $1, [], $3) }
        | '%_' '->' exp
        | lit '->' exp
                { (IfaceLitAlt $1, [], $3) }
        | '%_' '->' exp

@@ -273,27 +302,18 @@ lit       :: { Literal }
        | '(' CHAR '::' aty ')'         { MachChar $2 }
        | '(' STRING '::' aty ')'       { MachStr (mkFastString $2) }
 
        | '(' CHAR '::' aty ')'         { MachChar $2 }
        | '(' STRING '::' aty ')'       { MachStr (mkFastString $2) }
 

-tv_occ :: { FastString }
-       : NAME  { mkFastString $1 }
+fs_var_occ     :: { FastString }
+               : NAME  { mkFastString $1 }

 
 

-var_occ        :: { FastString }
-       : NAME  { mkFastString $1 }
+var_occ        :: { String }
+       : NAME  { $1 }

 
 
 
 

--- Type constructor
-q_tc_name      :: { Name }
-        : modid '.' CNAME      { undefined {-ToDo!!! ExtPkg $1 (mkOccName tcName $3)-} }
-

 -- Data constructor in a pattern or data type declaration; use the dataName, 
 -- because that's what we expect in Core case patterns
 d_pat_occ :: { OccName }
         : CNAME      { mkOccName dataName $1 }
 
 -- Data constructor in a pattern or data type declaration; use the dataName, 
 -- because that's what we expect in Core case patterns
 d_pat_occ :: { OccName }
         : CNAME      { mkOccName dataName $1 }
 

--- Data constructor occurrence in an expression;
--- use the varName because that's the worker Id
-d_occ :: { FastString }
-       : CNAME { mkFastString $1 }
-

 {
 
 ifaceKind kc = IfaceTyConApp kc []
 {
 
 ifaceKind kc = IfaceTyConApp kc []

@@ -355,6 +375,8 @@ ifaceUnliftedTypeKind = ifaceTcType IfaceUnliftedTypeKindTc
 
 ifaceArrow ifT1 ifT2 = IfaceFunTy ifT1 ifT2
 
 
 ifaceArrow ifT1 ifT2 = IfaceFunTy ifT1 ifT2
 

+ifaceEq ifT1 ifT2 = IfacePredTy (IfaceEqPred ifT1 ifT2)
+

 toHsTvBndr :: IfaceTvBndr -> LHsTyVarBndr RdrName
 toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual (mkTyVarOcc tv)) (toKind k)
 
 toHsTvBndr :: IfaceTvBndr -> LHsTyVarBndr RdrName
 toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual (mkTyVarOcc tv)) (toKind k)
 

diff --git a/compiler/parser/ParserCoreUtils.hs b/compiler/parser/ParserCoreUtils.hs
index 4aa3341..124294b 100644 (file)
--- a/compiler/parser/ParserCoreUtils.hs
+++ b/compiler/parser/ParserCoreUtils.hs
@@ -30,6 +30,7 @@ getCoreModuleName fpath =
     (\ _ -> return "Main")
  where
    findMod [] = "Main"
     (\ _ -> return "Main")
  where
    findMod [] = "Main"

+   -- TODO: this should just return the module name, without the package name

    findMod ("%module":m:_) = m
    findMod (_:xs) = findMod xs
 
    findMod ("%module":m:_) = m
    findMod (_:xs) = findMod xs
 

@@ -47,6 +48,7 @@ data Token =
  | TKcast
  | TKnote
  | TKexternal
  | TKcast
  | TKnote
  | TKexternal

+ | TKlocal

  | TKwild
  | TKoparen
  | TKcparen
  | TKwild
  | TKoparen
  | TKcparen

@@ -54,7 +56,9 @@ data Token =
  | TKcbrace
  | TKhash
  | TKeq
  | TKcbrace
  | TKhash
  | TKeq

+ | TKcolon

  | TKcoloncolon
  | TKcoloncolon

+ | TKcoloneqcolon

  | TKstar
  | TKrarrow
  | TKlambda
  | TKstar
  | TKrarrow
  | TKlambda