bhc_parser/
types.rs

1//! Type parsing.
2
3use bhc_ast::{Constraint, ModuleName, TyVar, Type};
4use bhc_intern::Ident;
5use bhc_lexer::TokenKind;
6
7use crate::{ParseError, ParseResult, Parser};
8
9impl<'src> Parser<'src> {
10    /// Parse a type.
11    pub fn parse_type(&mut self) -> ParseResult<Type> {
12        self.enter_recursion()?;
13        let result = self.parse_type_guarded();
14        self.exit_recursion();
15        result
16    }
17
18    fn parse_type_guarded(&mut self) -> ParseResult<Type> {
19        let start = self.current_span();
20
21        // Check for forall
22        if self.check(&TokenKind::Forall) {
23            return self.parse_forall_type();
24        }
25
26        // Try to parse a constrained type: `Eq a => ...`
27        // This is tricky because we need lookahead to distinguish
28        // `Class a => ...` from `Type -> ...`
29        if let Some(constraints) = self.try_parse_context()? {
30            let ty = self.parse_fun_type()?;
31            let span = start.to(ty.span());
32            return Ok(Type::Constrained(constraints, Box::new(ty), span));
33        }
34
35        self.parse_fun_type()
36    }
37
38    /// Try to parse a context (type class constraints).
39    /// Returns None if this doesn't look like a context.
40    pub(crate) fn try_parse_context(&mut self) -> ParseResult<Option<Vec<Constraint>>> {
41        // Save position for backtracking
42        let saved_pos = self.pos;
43
44        // A context looks like: `Class arg` or `(Class1 a, Class2 b)` followed by `=>`
45        let constraints = if self.check(&TokenKind::LParen) {
46            // Try to parse parenthesized context
47            self.advance(); // consume (
48
49            if self.check(&TokenKind::RParen) {
50                // Empty context `() =>` - unlikely but valid
51                self.advance();
52                if self.eat(&TokenKind::FatArrow) {
53                    return Ok(Some(vec![]));
54                }
55                // Not a context, backtrack
56                self.pos = saved_pos;
57                return Ok(None);
58            }
59
60            let mut constraints = vec![];
61            match self.try_parse_constraint() {
62                Ok(Some(c)) => constraints.push(c),
63                _ => {
64                    self.pos = saved_pos;
65                    return Ok(None);
66                }
67            }
68
69            while self.eat(&TokenKind::Comma) {
70                match self.try_parse_constraint() {
71                    Ok(Some(c)) => constraints.push(c),
72                    _ => {
73                        self.pos = saved_pos;
74                        return Ok(None);
75                    }
76                }
77            }
78
79            if !self.eat(&TokenKind::RParen) {
80                self.pos = saved_pos;
81                return Ok(None);
82            }
83
84            constraints
85        } else {
86            // Try to parse a single constraint
87            match self.try_parse_constraint() {
88                Ok(Some(c)) => vec![c],
89                _ => {
90                    self.pos = saved_pos;
91                    return Ok(None);
92                }
93            }
94        };
95
96        // Check for =>
97        if self.eat(&TokenKind::FatArrow) {
98            Ok(Some(constraints))
99        } else {
100            // Not a context, backtrack
101            self.pos = saved_pos;
102            Ok(None)
103        }
104    }
105
106    /// Try to parse a single constraint like `Eq a` or `Functor f`.
107    fn try_parse_constraint(&mut self) -> ParseResult<Option<Constraint>> {
108        let start = self.current_span();
109
110        // Constraint class must be a ConId
111        let class = match self.current_kind() {
112            Some(TokenKind::ConId(sym)) => {
113                let ident = Ident::new(*sym);
114                self.advance();
115                ident
116            }
117            _ => return Ok(None),
118        };
119
120        // Parse type arguments
121        let mut args = vec![];
122        while self.is_atype_start() {
123            args.push(self.parse_atype()?);
124        }
125
126        let end_span = args.last().map(|t| t.span()).unwrap_or(start);
127        let span = start.to(end_span);
128
129        Ok(Some(Constraint { class, args, span }))
130    }
131
132    /// Parse a function type: `a -> b`.
133    fn parse_fun_type(&mut self) -> ParseResult<Type> {
134        let lhs = self.parse_infix_type()?;
135
136        // Skip any doc comments before checking for ->
137        // (Haddock argument documentation like `-- ^`)
138        self.skip_doc_comments();
139
140        if self.eat(&TokenKind::Arrow) {
141            let rhs = self.parse_fun_type()?;
142            let span = lhs.span().to(rhs.span());
143            Ok(Type::Fun(Box::new(lhs), Box::new(rhs), span))
144        } else {
145            Ok(lhs)
146        }
147    }
148
149    /// Parse an infix type operator: `a :+: b` (right-associative).
150    fn parse_infix_type(&mut self) -> ParseResult<Type> {
151        let lhs = self.parse_app_type()?;
152
153        // Check for ConOperator (constructor operator like :+:, :*:, :|)
154        if let Some(TokenKind::ConOperator(sym)) = self.current_kind().cloned() {
155            let op = Ident::new(sym);
156            self.advance();
157            // Right-associative: recurse into parse_infix_type for RHS
158            let rhs = self.parse_infix_type()?;
159            let span = lhs.span().to(rhs.span());
160            Ok(Type::InfixOp(Box::new(lhs), op, Box::new(rhs), span))
161        } else {
162            Ok(lhs)
163        }
164    }
165
166    /// Parse a type application: `Maybe Int`.
167    fn parse_app_type(&mut self) -> ParseResult<Type> {
168        let mut ty = self.parse_atype()?;
169
170        while self.is_atype_start() {
171            let arg = self.parse_atype()?;
172            let span = ty.span().to(arg.span());
173            ty = Type::App(Box::new(ty), Box::new(arg), span);
174        }
175
176        Ok(ty)
177    }
178
179    /// Check if current token can start an atomic type.
180    pub fn is_atype_start(&self) -> bool {
181        match self.current_kind() {
182            Some(kind) => matches!(
183                kind,
184                TokenKind::Ident(_)
185                    | TokenKind::ConId(_)
186                    | TokenKind::QualConId(_, _)
187                    | TokenKind::LParen
188                    | TokenKind::LBracket
189                    // M9: Type-level naturals and promoted lists
190                    | TokenKind::IntLit(_)
191                    | TokenKind::TickLBracket
192                    // Strictness/laziness annotations for constructor fields
193                    | TokenKind::Bang
194                    | TokenKind::Tilde
195            ),
196            None => false,
197        }
198    }
199
200    /// Parse an atomic type.
201    pub fn parse_atype(&mut self) -> ParseResult<Type> {
202        let tok = self.current().ok_or(ParseError::UnexpectedEof {
203            expected: "type".to_string(),
204        })?;
205
206        match &tok.node.kind.clone() {
207            TokenKind::Ident(sym) => {
208                let ident = Ident::new(*sym);
209                let span = tok.span;
210                self.advance();
211                Ok(Type::Var(TyVar { name: ident, span }, span))
212            }
213
214            TokenKind::ConId(sym) => {
215                let ident = Ident::new(*sym);
216                let span = tok.span;
217                self.advance();
218                Ok(Type::Con(ident, span))
219            }
220
221            TokenKind::QualConId(qualifier, name) => {
222                let module_name = ModuleName {
223                    parts: vec![*qualifier],
224                    span: tok.span,
225                };
226                let ident = Ident::new(*name);
227                let span = tok.span;
228                self.advance();
229                Ok(Type::QualCon(module_name, ident, span))
230            }
231
232            TokenKind::LParen => self.parse_paren_type(),
233
234            TokenKind::LBracket => self.parse_list_type(),
235
236            // M9: Type-level natural literal
237            TokenKind::IntLit(lit) => {
238                let span = tok.span;
239                let value = lit.parse().ok_or_else(|| ParseError::Unexpected {
240                    found: "invalid integer".to_string(),
241                    expected: "type-level natural".to_string(),
242                    span,
243                })?;
244                // Type-level naturals must be non-negative
245                if value < 0 {
246                    return Err(ParseError::Unexpected {
247                        found: "negative integer".to_string(),
248                        expected: "type-level natural (non-negative)".to_string(),
249                        span,
250                    });
251                }
252                self.advance();
253                Ok(Type::NatLit(value as u64, span))
254            }
255
256            // M9: Promoted list syntax '[a, b, c]
257            TokenKind::TickLBracket => self.parse_promoted_list(),
258
259            // Strict type annotation: !Type
260            TokenKind::Bang => {
261                let start = tok.span;
262                self.advance();
263                let inner = self.parse_atype()?;
264                let span = start.to(inner.span());
265                Ok(Type::Bang(Box::new(inner), span))
266            }
267
268            // Lazy type annotation: ~Type
269            TokenKind::Tilde => {
270                let start = tok.span;
271                self.advance();
272                let inner = self.parse_atype()?;
273                let span = start.to(inner.span());
274                Ok(Type::Lazy(Box::new(inner), span))
275            }
276
277            _ => Err(ParseError::Unexpected {
278                found: tok.node.kind.description().to_string(),
279                expected: "type".to_string(),
280                span: tok.span,
281            }),
282        }
283    }
284
285    /// Parse a promoted list: `'[a, b, c]`.
286    fn parse_promoted_list(&mut self) -> ParseResult<Type> {
287        let start = self.current_span();
288        self.expect(&TokenKind::TickLBracket)?;
289
290        if self.eat(&TokenKind::RBracket) {
291            // Empty promoted list: '[]
292            let span = start.to(self.tokens[self.pos - 1].span);
293            return Ok(Type::PromotedList(vec![], span));
294        }
295
296        let mut elems = vec![self.parse_type()?];
297        while self.eat(&TokenKind::Comma) {
298            elems.push(self.parse_type()?);
299        }
300
301        let end = self.expect(&TokenKind::RBracket)?;
302        let span = start.to(end.span);
303
304        Ok(Type::PromotedList(elems, span))
305    }
306
307    /// Parse a parenthesized type or tuple type.
308    fn parse_paren_type(&mut self) -> ParseResult<Type> {
309        let start = self.current_span();
310        self.expect(&TokenKind::LParen)?;
311
312        if self.eat(&TokenKind::RParen) {
313            // Unit type: ()
314            let span = start.to(self.tokens[self.pos - 1].span);
315            return Ok(Type::Tuple(vec![], span));
316        }
317
318        // Check for function type in parens: (->)
319        if self.eat(&TokenKind::Arrow) {
320            let end = self.expect(&TokenKind::RParen)?;
321            let span = start.to(end.span);
322            return Ok(Type::Con(Ident::from_str("->"), span));
323        }
324
325        // Check for constructor operator in parens: (:+:)
326        if let Some(TokenKind::ConOperator(sym)) = self.current_kind().cloned() {
327            let saved = self.pos;
328            let ident = Ident::new(sym);
329            self.advance();
330            if self.check(&TokenKind::RParen) {
331                let end = self.expect(&TokenKind::RParen)?;
332                let span = start.to(end.span);
333                return Ok(Type::Con(ident, span));
334            }
335            // Not just `(:+:)`, backtrack and parse as regular type
336            self.pos = saved;
337        }
338
339        let first = self.parse_type()?;
340
341        if self.eat(&TokenKind::Comma) {
342            // Tuple type
343            let mut types = vec![first];
344            loop {
345                types.push(self.parse_type()?);
346                if !self.eat(&TokenKind::Comma) {
347                    break;
348                }
349            }
350            let end = self.expect(&TokenKind::RParen)?;
351            let span = start.to(end.span);
352            Ok(Type::Tuple(types, span))
353        } else {
354            // Parenthesized type
355            let end = self.expect(&TokenKind::RParen)?;
356            let span = start.to(end.span);
357            Ok(Type::Paren(Box::new(first), span))
358        }
359    }
360
361    /// Parse a list type: `[a]`.
362    fn parse_list_type(&mut self) -> ParseResult<Type> {
363        let start = self.current_span();
364        self.expect(&TokenKind::LBracket)?;
365
366        if self.eat(&TokenKind::RBracket) {
367            // List type constructor: []
368            let span = start.to(self.tokens[self.pos - 1].span);
369            return Ok(Type::Con(Ident::from_str("[]"), span));
370        }
371
372        let elem = self.parse_type()?;
373        let end = self.expect(&TokenKind::RBracket)?;
374        let span = start.to(end.span);
375
376        Ok(Type::List(Box::new(elem), span))
377    }
378
379    /// Parse a forall type: `forall a b. Type`.
380    fn parse_forall_type(&mut self) -> ParseResult<Type> {
381        let start = self.current_span();
382        self.expect(&TokenKind::Forall)?;
383
384        let mut vars = Vec::new();
385        while let Some(tok) = self.current() {
386            match &tok.node.kind {
387                TokenKind::Ident(sym) => {
388                    let name = Ident::new(*sym);
389                    let span = tok.span;
390                    self.advance();
391                    vars.push(TyVar { name, span });
392                }
393                // The `.` is lexed as TokenKind::Dot, not Operator(".")
394                TokenKind::Dot => {
395                    self.advance();
396                    break;
397                }
398                _ => break,
399            }
400        }
401
402        let ty = self.parse_type()?;
403        let span = start.to(ty.span());
404
405        Ok(Type::Forall(vars, Box::new(ty), span))
406    }
407}
bhc_parser/types.rs

bhc_parser/
types.rs
