Merge branch 'klntsky/parser-tweaks/sean/mandatory-kinds' into sean/m…

…andatory-kinds

src/Language/PureScript/CST/Convert.hs

@@ -653,7 +653,7 @@ convertDeclaration fileName decl = case decl of
   DeclInstanceChain _ insts -> do
     let
       chainId = mkChainId fileName $ startSourcePos $ instKeyword $ instHead $ sepHead insts
-      goInst ix inst@(Instance (InstanceHead _ nameSep ctrs cls args) bd) = do
+      goInst ix inst@(Instance (InstanceHead _ _todo nameSep ctrs cls args) bd) = do
         let ann' = uncurry (sourceAnnCommented fileName) $ instanceRange inst
             clsAnn = findInstanceAnn cls args
         cstrnt <- traverse (convertConstraint False fileName) $  maybe [] (toList . fst) ctrs
@@ -666,7 +666,7 @@ convertDeclaration fileName decl = case decl of
           args'
           (AST.ExplicitInstance instBinding)
     traverse (uncurry goInst) $ zip [0..] (toList insts)
-  DeclDerive _ _ new (InstanceHead kw nameSep ctrs cls args) -> do
+  DeclDerive _ _ new (InstanceHead kw _todo nameSep ctrs cls args) -> do
     let
       chainId = mkChainId fileName $ startSourcePos kw
       name' = mkPartialInstanceName nameSep cls args

src/Language/PureScript/CST/Flatten.hs

@@ -46,12 +46,13 @@ flattenInstance (Instance a b) =
   flattenInstanceHead a <> foldMap (\(c, d) -> pure c <> foldMap flattenInstanceBinding d) b
 
 flattenInstanceHead :: InstanceHead a -> DList SourceToken
-flattenInstanceHead (InstanceHead a b c d e) =
+flattenInstanceHead (InstanceHead a b c d e f) =
   pure a <>
-  foldMap (\(n, s) -> flattenName n <> pure s) b <>
-  foldMap (\(g, h) -> flattenOneOrDelimited flattenConstraint g <> pure h) c <>
-  flattenQualifiedName d <>
-  foldMap flattenType e
+  foldMap (\(s, bs) -> pure s <> foldMap flattenTypeVarBinding bs) b <>
+  foldMap (\(n, s) -> flattenName n <> pure s) c <>
+  foldMap (\(g, h) -> flattenOneOrDelimited flattenConstraint g <> pure h) d <>
+  flattenQualifiedName e <>
+  foldMap flattenType f
 
 flattenInstanceBinding :: InstanceBinding a -> DList SourceToken
 flattenInstanceBinding = \case

src/Language/PureScript/CST/Parser.y

@@ -363,12 +363,12 @@ rowLabel :: { Labeled Label (Type ()) }
 typeVarBinding :: { TypeVarBinding () }
   : ident { TypeVarName (Nothing, $1) }
   | '@' ident { TypeVarName (Just $1, $2) }
-  | '(' ident '::' type ')' {% checkNoWildcards $4 *> pure (TypeVarKinded (Wrapped $1 (Labeled (Nothing, $2) $3 $4) $5)) }
-  | '(' '@' ident '::' type ')' {% checkNoWildcards $5 *> pure (TypeVarKinded (Wrapped $1 (Labeled (Just $2, $3) $4 $5) $6)) }
+  | '(' ident '::' kind ')' {% checkNoWildcards $4 *> pure (TypeVarKinded (Wrapped $1 (Labeled (Nothing, $2) $3 $4) $5)) }
+  | '(' '@' ident '::' kind ')' {% checkNoWildcards $5 *> pure (TypeVarKinded (Wrapped $1 (Labeled (Just $2, $3) $4 $5) $6)) }
 
 typeVarBindingPlain :: { TypeVarBinding () }
   : ident { TypeVarName (Nothing, $1) }
-  | '(' ident '::' type ')' {% checkNoWildcards $4 *> pure (TypeVarKinded (Wrapped $1 (Labeled (Nothing, $2) $3 $4) $5)) }
+  | '(' ident '::' kind ')' {% checkNoWildcards $4 *> pure (TypeVarKinded (Wrapped $1 (Labeled (Nothing, $2) $3 $4) $5)) }
 
 forall :: { SourceToken }
   : 'forall' { $1 }
@@ -750,14 +750,17 @@ classMember :: { Labeled (Name Ident) (Type ()) }
   : ident '::' type {% checkNoWildcards $3 *> pure (Labeled $1 $2 $3) }
 
 instHead :: { InstanceHead () }
-  : 'instance' constraints '=>' qualProperName manyOrEmpty(typeAtom)
-      { InstanceHead $1 Nothing (Just ($2, $3)) (getQualifiedProperName $4) $5 }
+  : 'instance' instForall constraints '=>' qualProperName manyOrEmpty(typeAtom)
+    { InstanceHead $1 (Just $2) Nothing (Just ($3, $4)) (getQualifiedProperName $5) $6 }
+  | 'instance' instForall qualProperName manyOrEmpty(typeAtom)
+    { InstanceHead $1 (Just $2) Nothing Nothing (getQualifiedProperName $3) $4 }
+  | 'instance' constraints '=>' qualProperName manyOrEmpty(typeAtom)
+    { InstanceHead $1 Nothing Nothing (Just ($2, $3)) (getQualifiedProperName $4) $5 }
   | 'instance' qualProperName manyOrEmpty(typeAtom)
-      { InstanceHead $1 Nothing Nothing (getQualifiedProperName $2) $3 }
-  | 'instance' ident '::' constraints '=>' qualProperName manyOrEmpty(typeAtom)
-      { InstanceHead $1 (Just ($2, $3)) (Just ($4, $5)) (getQualifiedProperName $6) $7 }
-  | 'instance' ident '::' qualProperName manyOrEmpty(typeAtom)
-      { InstanceHead $1 (Just ($2, $3)) Nothing (getQualifiedProperName $4) $5 }
+    { InstanceHead $1 Nothing Nothing Nothing (getQualifiedProperName $2) $3 }
+
+instForall :: { (SourceToken, NE.NonEmpty (TypeVarBinding ())) }
+  : forall many(typeVarBinding) '.' { ( $1, $2 ) }
 
 constraints :: { OneOrDelimited (Constraint ()) }
   : constraint { One $1 }

src/Language/PureScript/CST/Positions.hs

@@ -98,6 +98,8 @@ sepLast :: Separated a -> a
 sepLast (Separated hd []) = hd
 sepLast (Separated _ tl) = snd $ last tl
 
+-- | Contains the first and the last source token of a definition,
+-- used to track line numbers for the error messages.
 type TokenRange = (SourceToken, SourceToken)
 
 toSourceRange :: TokenRange -> SourceRange
@@ -207,7 +209,7 @@ instanceRange (Instance hd bd)
   where start = instanceHeadRange hd
 
 instanceHeadRange :: InstanceHead a -> TokenRange
-instanceHeadRange (InstanceHead kw _ _ cls types)
+instanceHeadRange (InstanceHead kw _ _ _ cls types)
   | [] <- types = (kw, qualTok cls)
   | otherwise = (kw, snd . typeRange $ last types)
 

src/Language/PureScript/CST/Types.hs

@@ -261,6 +261,9 @@ data ClassFundep
 
 data InstanceHead a = InstanceHead
   { instKeyword :: SourceToken
+  , instForall :: Maybe (SourceToken, NonEmpty (TypeVarBinding a))
+  -- we modified the parser to disallow named instances.
+  -- TODO: remove `instNameSep` field.
   , instNameSep :: Maybe (Name Ident, SourceToken)
   , instConstraints :: Maybe (OneOrDelimited (Constraint a), SourceToken)
   , instClass :: QualifiedName (N.ProperName 'N.ClassName)