Skip to content

Commit 5621f2e

Browse files
natefaubionnatefaubion
authored
Support type application syntax (#51)
* Support type application syntax * Shorten AppVisibleType to AppType * Remove TypeVarBindingWithVisibility type synonym
1 parent 7a0a448 commit 5621f2e

File tree

5 files changed

+139
-31
lines changed

5 files changed

+139
-31
lines changed

‎src/PureScript/CST/Parser.purs

+28-14
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ import PureScript.CST.Layout (currentIndent)
2929
import PureScript.CST.Parser.Monad (Parser, eof, lookAhead, many, optional, recover, take, try)
3030
import PureScript.CST.TokenStream (TokenStep(..), TokenStream, layoutStack)
3131
import PureScript.CST.TokenStream as TokenStream
32-
import PureScript.CST.Types (Binder(..), ClassFundep(..), DataCtor(..), DataMembers(..), Declaration(..), Delimited, DoStatement(..), Export(..), Expr(..), Fixity(..), FixityOp(..), Foreign(..), Guarded(..), GuardedExpr(..), Ident(..), Import(..), ImportDecl(..), Instance(..), InstanceBinding(..), IntValue(..), Label(..), Labeled(..), LetBinding(..), Module(..), ModuleBody(..), ModuleHeader(..), ModuleName(..), Name(..), OneOrDelimited(..), Operator(..), PatternGuard(..), Proper(..), QualifiedName(..), RecordLabeled(..), RecordUpdate(..), Role(..), Row(..), Separated(..), SourceToken, Token(..), Type(..), TypeVarBinding(..), Where(..), Wrapped(..))
32+
import PureScript.CST.Types (AppSpine(..), Binder(..), ClassFundep(..), DataCtor(..), DataMembers(..), Declaration(..), Delimited, DoStatement(..), Export(..), Expr(..), Fixity(..), FixityOp(..), Foreign(..), Guarded(..), GuardedExpr(..), Ident(..), Import(..), ImportDecl(..), Instance(..), InstanceBinding(..), IntValue(..), Label(..), Labeled(..), LetBinding(..), Module(..), ModuleBody(..), ModuleHeader(..), ModuleName(..), Name(..), OneOrDelimited(..), Operator(..), PatternGuard(..), Prefixed(..), Proper(..), QualifiedName(..), RecordLabeled(..), RecordUpdate(..), Role(..), Row(..), Separated(..), SourceToken, Token(..), Type(..), TypeVarBinding(..), Where(..), Wrapped(..))
3333

3434
type Recovered :: (P.Type -> P.Type) -> P.Type
3535
type Recovered f = f RecoveredError
@@ -179,7 +179,7 @@ parseDeclData = do
179179

180180
parseDeclData1 :: SourceToken -> Name Proper -> Parser (Recovered Declaration)
181181
parseDeclData1 keyword name = do
182-
vars <- many parseTypeVarBinding
182+
vars <- many parseTypeVarBindingPlain
183183
ctors <- optional (Tuple <$> tokEquals <*> separated tokPipe parseDataCtor)
184184
pure $ DeclData { keyword, name, vars } ctors
185185

@@ -198,7 +198,7 @@ parseDeclNewtype = do
198198

199199
parseDeclNewtype1 :: SourceToken -> Name Proper -> Parser (Recovered Declaration)
200200
parseDeclNewtype1 keyword name = do
201-
vars <- many parseTypeVarBinding
201+
vars <- many parseTypeVarBindingPlain
202202
tok <- tokEquals
203203
wrapper <- parseProper
204204
body <- parseTypeAtom
@@ -218,7 +218,7 @@ parseDeclType1 keyword = do
218218

219219
parseDeclType2 :: SourceToken -> Name Proper -> Parser (Recovered Declaration)
220220
parseDeclType2 keyword name = do
221-
vars <- many parseTypeVarBinding
221+
vars <- many parseTypeVarBindingPlain
222222
tok <- tokEquals
223223
body <- parseType
224224
pure $ DeclType { keyword, name, vars } tok body
@@ -252,7 +252,7 @@ parseDeclClass1 :: SourceToken -> Parser (Recovered Declaration)
252252
parseDeclClass1 keyword = do
253253
super <- optional $ try $ Tuple <$> parseClassConstraints parseType5 <*> tokLeftFatArrow
254254
name <- parseProper
255-
vars <- many parseTypeVarBinding
255+
vars <- many parseTypeVarBindingPlain
256256
fundeps <- optional $ Tuple <$> tokPipe <*> separated tokComma parseFundep
257257
members <- optional $ Tuple <$> tokKeyword "where" <*> layoutNonEmpty parseClassMember
258258
pure $ DeclClass { keyword, super, name, vars, fundeps } members
@@ -525,18 +525,27 @@ parseForall :: Parser (Recovered Type)
525525
parseForall = defer \_ ->
526526
TypeForall
527527
<$> tokForall
528-
<*> many1 parseTypeVarBinding
528+
<*> many1 parseTypeVarBindingWithVisibility
529529
<*> tokDot
530530
<*> parseType1
531531

532-
parseTypeVarBinding :: Parser (Recovered TypeVarBinding)
533-
parseTypeVarBinding = defer \_ ->
534-
parseTypeVarKinded
535-
<|> TypeVarName <$> parseIdent
532+
parseTypeVarBindingWithVisibility :: Parser (Recovered (TypeVarBinding (Prefixed (Name Ident))))
533+
parseTypeVarBindingWithVisibility = defer \_ -> parseTypeVarBinding ado
534+
prefix <- optional tokAt
535+
value <- parseIdent
536+
in Prefixed { prefix, value }
536537

537-
parseTypeVarKinded :: Parser (Recovered TypeVarBinding)
538-
parseTypeVarKinded = TypeVarKinded <$> parens do
539-
label <- parseIdent
538+
parseTypeVarBindingPlain :: Parser (Recovered (TypeVarBinding (Name Ident)))
539+
parseTypeVarBindingPlain = parseTypeVarBinding parseIdent
540+
541+
parseTypeVarBinding :: forall a. Parser a -> Parser (Recovered (TypeVarBinding a))
542+
parseTypeVarBinding parseBindingName =
543+
parseTypeVarKinded parseBindingName
544+
<|> TypeVarName <$> parseBindingName
545+
546+
parseTypeVarKinded :: forall a. Parser a -> Parser (Recovered (TypeVarBinding a))
547+
parseTypeVarKinded parseBindingName = TypeVarKinded <$> parens do
548+
label <- parseBindingName
540549
separator <- tokDoubleColon
541550
value <- parseType
542551
pure $ Labeled { label, separator, value }
@@ -586,7 +595,7 @@ parseExpr3 = defer \_ -> do
586595
parseExpr4 :: Parser (Recovered Expr)
587596
parseExpr4 = defer \_ -> do
588597
expr <- parseExpr5
589-
args <- many parseExpr5
598+
args <- many parseExprAppSpine
590599
pure case NonEmptyArray.fromArray args of
591600
Nothing -> expr
592601
Just as -> ExprApp expr as
@@ -601,6 +610,11 @@ parseExpr5 = defer \_ ->
601610
<|> parseAdo
602611
<|> parseExpr6
603612

613+
parseExprAppSpine :: Parser (Recovered (AppSpine Expr))
614+
parseExprAppSpine = defer \_ ->
615+
AppType <$> tokAt <*> parseTypeAtom
616+
<|> AppTerm <$> parseExpr5
617+
604618
parseIf :: Parser (Recovered Expr)
605619
parseIf = do
606620
keyword <- tokKeyword "if"

‎src/PureScript/CST/Range.purs

+38-4
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ module PureScript.CST.Range
66
) where
77

88
import Prelude
9+
import Prim hiding (Row, Type)
910

1011
import Control.Lazy (defer)
1112
import Data.Array as Array
@@ -14,11 +15,10 @@ import Data.Array.NonEmpty as NonEmptyArray
1415
import Data.Foldable (foldMap)
1516
import Data.Maybe (Maybe(..), maybe)
1617
import Data.Tuple (Tuple(..), fst, snd)
17-
import Prim hiding (Row, Type)
1818
import PureScript.CST.Errors (RecoveredError(..))
1919
import PureScript.CST.Range.TokenList (TokenList, cons, singleton)
2020
import PureScript.CST.Range.TokenList as TokenList
21-
import PureScript.CST.Types (Binder(..), ClassFundep(..), DataCtor(..), DataMembers(..), Declaration(..), DoStatement(..), Export(..), Expr(..), FixityOp(..), Foreign(..), Guarded(..), GuardedExpr(..), Import(..), ImportDecl(..), Instance(..), InstanceBinding(..), Labeled(..), LetBinding(..), Module(..), ModuleBody(..), ModuleHeader(..), Name(..), OneOrDelimited(..), PatternGuard(..), QualifiedName(..), RecordLabeled(..), RecordUpdate(..), Row(..), Separated(..), SourceRange, Type(..), TypeVarBinding(..), Where(..), Wrapped(..))
21+
import PureScript.CST.Types (AppSpine(..), Binder(..), ClassFundep(..), DataCtor(..), DataMembers(..), Declaration(..), DoStatement(..), Export(..), Expr(..), FixityOp(..), Foreign(..), Guarded(..), GuardedExpr(..), Import(..), ImportDecl(..), Instance(..), InstanceBinding(..), Labeled(..), LetBinding(..), Module(..), ModuleBody(..), ModuleHeader(..), Name(..), OneOrDelimited(..), PatternGuard(..), Prefixed(..), QualifiedName(..), RecordLabeled(..), RecordUpdate(..), Row(..), Separated(..), SourceRange, Type(..), TypeVarBinding(..), Where(..), Wrapped(..))
2222

2323
class RangeOf a where
2424
rangeOf :: a -> SourceRange
@@ -121,6 +121,24 @@ instance tokensOfLabeled :: (TokensOf a, TokensOf b) => TokensOf (Labeled a b) w
121121
tokensOf (Labeled { label, separator, value }) =
122122
tokensOf label <> singleton separator <> tokensOf value
123123

124+
instance rangeOfPrefixed :: RangeOf a => RangeOf (Prefixed a) where
125+
rangeOf (Prefixed { prefix, value }) =
126+
case prefix of
127+
Just tok ->
128+
{ start: tok.range.start
129+
, end: (rangeOf value).end
130+
}
131+
Nothing ->
132+
rangeOf value
133+
134+
instance tokensOfPrefixed :: TokensOf a => TokensOf (Prefixed a) where
135+
tokensOf (Prefixed { prefix, value }) =
136+
case prefix of
137+
Just tok ->
138+
cons tok $ defer \_ -> tokensOf value
139+
Nothing ->
140+
tokensOf value
141+
124142
instance rangeOfOneOrDelimited :: RangeOf a => RangeOf (OneOrDelimited a) where
125143
rangeOf = case _ of
126144
One a -> rangeOf a
@@ -240,14 +258,14 @@ instance tokensOfRow :: TokensOf e => TokensOf (Row e) where
240258
foldMap tokensOf labels
241259
<> foldMap (\(Tuple t ty) -> cons t $ tokensOf ty) tail
242260

243-
instance rangeOfTypeVarBinding :: RangeOf (TypeVarBinding e) where
261+
instance rangeOfTypeVarBinding :: RangeOf a => RangeOf (TypeVarBinding a e) where
244262
rangeOf = case _ of
245263
TypeVarKinded w ->
246264
rangeOf w
247265
TypeVarName n ->
248266
rangeOf n
249267

250-
instance tokensOfTypeVarBinding :: TokensOf e => TokensOf (TypeVarBinding e) where
268+
instance tokensOfTypeVarBinding :: (TokensOf a, TokensOf e) => TokensOf (TypeVarBinding a e) where
251269
tokensOf = case _ of
252270
TypeVarKinded w ->
253271
tokensOf w
@@ -825,6 +843,22 @@ instance tokensOfExpr :: TokensOf e => TokensOf (Expr e) where
825843
ExprError e ->
826844
tokensOf e
827845

846+
instance rangeOfAppSpine :: (RangeOf e, RangeOf (f e)) => RangeOf (AppSpine f e) where
847+
rangeOf = case _ of
848+
AppType t a ->
849+
{ start: t.range.start
850+
, end: (rangeOf a).end
851+
}
852+
AppTerm a ->
853+
rangeOf a
854+
855+
instance tokensOfAppSpine :: (TokensOf e, TokensOf (f e)) => TokensOf (AppSpine f e) where
856+
tokensOf = case _ of
857+
AppType t a ->
858+
cons t $ defer \_ -> tokensOf a
859+
AppTerm a ->
860+
tokensOf a
861+
828862
instance tokensOfRecordUpdate :: TokensOf e => TokensOf (RecordUpdate e) where
829863
tokensOf = case _ of
830864
RecordUpdateLeaf n t e ->

‎src/PureScript/CST/Traversal.purs

+15-5
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,7 @@ module PureScript.CST.Traversal
5959
, traverseRow
6060
, traverseTypeVarBinding
6161
, traverseExpr
62+
, traverseExprAppSpine
6263
, traverseDelimited
6364
, traverseDelimitedNonEmpty
6465
, traverseSeparated
@@ -98,6 +99,7 @@ module PureScript.CST.Traversal
9899
) where
99100

100101
import Prelude
102+
import Prim hiding (Row, Type)
101103

102104
import Control.Monad.Free (Free, runFree)
103105
import Control.Monad.Reader.Trans (ReaderT(..), runReaderT)
@@ -109,8 +111,7 @@ import Data.Newtype (un)
109111
import Data.Traversable (traverse)
110112
import Data.Tuple (Tuple(..), curry, uncurry)
111113
import Prim as P
112-
import Prim hiding (Row, Type)
113-
import PureScript.CST.Types (AdoBlock, Binder(..), CaseOf, ClassHead, DataCtor(..), DataHead, Declaration(..), Delimited, DelimitedNonEmpty, DoBlock, DoStatement(..), Expr(..), Foreign(..), Guarded(..), GuardedExpr(..), IfThenElse, Instance(..), InstanceBinding(..), InstanceHead, Labeled(..), Lambda, LetBinding(..), LetIn, Module(..), ModuleBody(..), OneOrDelimited(..), PatternGuard(..), RecordAccessor, RecordLabeled(..), RecordUpdate(..), Row(..), Separated(..), Type(..), TypeVarBinding(..), ValueBindingFields, Where(..), Wrapped(..))
114+
import PureScript.CST.Types (AdoBlock, AppSpine(..), Binder(..), CaseOf, ClassHead, DataCtor(..), DataHead, Declaration(..), Delimited, DelimitedNonEmpty, DoBlock, DoStatement(..), Expr(..), Foreign(..), Guarded(..), GuardedExpr(..), IfThenElse, Instance(..), InstanceBinding(..), InstanceHead, Labeled(..), Lambda, LetBinding(..), LetIn, Module(..), ModuleBody(..), OneOrDelimited(..), PatternGuard(..), RecordAccessor, RecordLabeled(..), RecordUpdate(..), Row(..), Separated(..), Type(..), TypeVarBinding(..), ValueBindingFields, Where(..), Wrapped(..))
114115
import Type.Row (type (+))
115116

116117
type Rewrite e f (g :: P.Type -> P.Type) = g e -> f (g e)
@@ -312,10 +313,10 @@ traverseRow k (Row r) =
312313
<*> traverse (traverse k.onType) r.tail
313314

314315
traverseTypeVarBinding
315-
:: forall e f r
316+
:: forall e f r a
316317
. Applicative f
317318
=> { | OnType (Rewrite e f) + r }
318-
-> Rewrite e f TypeVarBinding
319+
-> Rewrite e f (TypeVarBinding a)
319320
traverseTypeVarBinding k = case _ of
320321
TypeVarKinded labeled -> TypeVarKinded <$> traverseWrapped (traverseLabeled k.onType) labeled
321322
TypeVarName name -> pure (TypeVarName name)
@@ -335,7 +336,7 @@ traverseExpr k = case _ of
335336
ExprNegate tok expr -> ExprNegate tok <$> k.onExpr expr
336337
ExprRecordAccessor recordAccessor -> ExprRecordAccessor <$> traverseRecordAccessor k recordAccessor
337338
ExprRecordUpdate expr recordUpdates -> ExprRecordUpdate <$> k.onExpr expr <*> traverseWrapped (traverseSeparated (traverseRecordUpdate k)) recordUpdates
338-
ExprApp expr args -> ExprApp <$> k.onExpr expr <*> traverse k.onExpr args
339+
ExprApp expr args -> ExprApp <$> k.onExpr expr <*> traverse (traverseExprAppSpine k) args
339340
ExprLambda lambda -> ExprLambda <$> traverseLambda k lambda
340341
ExprIf ifThenElse -> ExprIf <$> traverseIfThenElse k ifThenElse
341342
ExprCase caseOf -> ExprCase <$> traverseCaseOf k caseOf
@@ -344,6 +345,15 @@ traverseExpr k = case _ of
344345
ExprAdo adoBlock -> ExprAdo <$> traverseAdoBlock k adoBlock
345346
expr -> pure expr
346347

348+
traverseExprAppSpine
349+
:: forall e f r
350+
. Applicative f
351+
=> { | OnBinder (Rewrite e f) + OnExpr (Rewrite e f) + OnType (Rewrite e f) + r }
352+
-> Rewrite e f (AppSpine Expr)
353+
traverseExprAppSpine k = case _ of
354+
AppType tok ty -> AppType tok <$> traverseType k ty
355+
AppTerm expr -> AppTerm <$> traverseExpr k expr
356+
347357
traverseDelimited
348358
:: forall f a
349359
. Applicative f

‎src/PureScript/CST/Types.purs

+18-7
Original file line numberDiff line numberDiff line change
@@ -153,6 +153,13 @@ newtype Labeled a b = Labeled
153153

154154
derive instance newtypeLabeled :: Newtype (Labeled a b) _
155155

156+
newtype Prefixed a = Prefixed
157+
{ prefix :: Maybe SourceToken
158+
, value :: a
159+
}
160+
161+
derive instance newtypePrefixed :: Newtype (Prefixed a) _
162+
156163
type Delimited a = Wrapped (Maybe (Separated a))
157164
type DelimitedNonEmpty a = Wrapped (Separated a)
158165

@@ -169,7 +176,7 @@ data Type e
169176
| TypeInt (Maybe SourceToken) SourceToken IntValue
170177
| TypeRow (Wrapped (Row e))
171178
| TypeRecord (Wrapped (Row e))
172-
| TypeForall SourceToken (NonEmptyArray (TypeVarBinding e)) SourceToken (Type e)
179+
| TypeForall SourceToken (NonEmptyArray (TypeVarBinding (Prefixed (Name Ident)) e)) SourceToken (Type e)
173180
| TypeKinded (Type e) SourceToken (Type e)
174181
| TypeApp (Type e) (NonEmptyArray (Type e))
175182
| TypeOp (Type e) (NonEmptyArray (Tuple (QualifiedName Operator) (Type e)))
@@ -180,9 +187,9 @@ data Type e
180187
| TypeParens (Wrapped (Type e))
181188
| TypeError e
182189

183-
data TypeVarBinding e
184-
= TypeVarKinded (Wrapped (Labeled (Name Ident) (Type e)))
185-
| TypeVarName (Name Ident)
190+
data TypeVarBinding a e
191+
= TypeVarKinded (Wrapped (Labeled a (Type e)))
192+
| TypeVarName a
186193

187194
newtype Row e = Row
188195
{ labels :: Maybe (Separated (Labeled (Name Label) (Type e)))
@@ -275,7 +282,7 @@ data Import e
275282
type DataHead e =
276283
{ keyword :: SourceToken
277284
, name :: Name Proper
278-
, vars :: Array (TypeVarBinding e)
285+
, vars :: Array (TypeVarBinding (Name Ident) e)
279286
}
280287

281288
newtype DataCtor e = DataCtor
@@ -289,7 +296,7 @@ type ClassHead e =
289296
{ keyword :: SourceToken
290297
, super :: Maybe (Tuple (OneOrDelimited (Type e)) SourceToken)
291298
, name :: Name Proper
292-
, vars :: Array (TypeVarBinding e)
299+
, vars :: Array (TypeVarBinding (Name Ident) e)
293300
, fundeps :: Maybe (Tuple SourceToken (Separated ClassFundep))
294301
}
295302

@@ -376,7 +383,7 @@ data Expr e
376383
| ExprNegate SourceToken (Expr e)
377384
| ExprRecordAccessor (RecordAccessor e)
378385
| ExprRecordUpdate (Expr e) (DelimitedNonEmpty (RecordUpdate e))
379-
| ExprApp (Expr e) (NonEmptyArray (Expr e))
386+
| ExprApp (Expr e) (NonEmptyArray (AppSpine Expr e))
380387
| ExprLambda (Lambda e)
381388
| ExprIf (IfThenElse e)
382389
| ExprCase (CaseOf e)
@@ -385,6 +392,10 @@ data Expr e
385392
| ExprAdo (AdoBlock e)
386393
| ExprError e
387394

395+
data AppSpine f e
396+
= AppType SourceToken (Type e)
397+
| AppTerm (f e)
398+
388399
data RecordLabeled a
389400
= RecordPun (Name Ident)
390401
| RecordField (Name Label) SourceToken a

‎test/Main.purs

+40-1
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ import Effect (Effect)
1313
import Effect.Class.Console as Console
1414
import Node.Process as Process
1515
import PureScript.CST (RecoveredParserResult(..), parseBinder, parseDecl, parseExpr, parseModule, parseType)
16-
import PureScript.CST.Types (Binder, Declaration(..), DoStatement(..), Expr(..), Label(..), LetBinding(..), Module(..), ModuleBody(..), Name(..), RecordLabeled(..), Separated(..), Token(..), Type, Wrapped(..))
16+
import PureScript.CST.Types (AppSpine(..), Binder, Declaration(..), DoStatement(..), Expr(..), Label(..), Labeled(..), LetBinding(..), Module(..), ModuleBody(..), Name(..), Prefixed(..), RecordLabeled(..), Separated(..), Token(..), Type(..), TypeVarBinding(..), Wrapped(..))
1717

1818
class ParseFor f where
1919
parseFor :: String -> RecoveredParserResult f
@@ -252,3 +252,42 @@ main = do
252252
true
253253
_ ->
254254
false
255+
256+
assertParse "Type applications"
257+
"""
258+
foo @Bar bar @(Baz 42) 42
259+
"""
260+
case _ of
261+
(ParseSucceeded (ExprApp _ apps))
262+
| [ AppType _ _
263+
, AppTerm _
264+
, AppType _ _
265+
, AppTerm _
266+
] <- NonEmptyArray.toArray apps ->
267+
true
268+
_ ->
269+
false
270+
271+
assertParse "Forall visibility"
272+
"""
273+
forall @a (@b :: Type) c. a -> c
274+
"""
275+
case _ of
276+
ParseSucceeded (TypeForall _ binders _ _)
277+
| [ TypeVarName (Prefixed { prefix: Just _ })
278+
, TypeVarKinded (Wrapped { value: Labeled { label: Prefixed { prefix: Just _ } } })
279+
, TypeVarName (Prefixed { prefix: Nothing })
280+
] <- NonEmptyArray.toArray binders ->
281+
true
282+
_ ->
283+
false
284+
285+
assertParse "Kind applications not supported"
286+
"""
287+
Foo @Bar
288+
"""
289+
case _ of
290+
ParseSucceeded (TypeConstructor _) ->
291+
true
292+
_ ->
293+
false

0 commit comments

Comments
 (0)