improve EUnexpectedToken; do Lambda parsing
This commit is contained in:
parent
387a7d4baa
commit
68839eb9c8
|
@ -47,10 +47,10 @@ module Bare : LocaleT = struct
|
|||
pp_print_string fmtp "#unexpected_eof; ctx=";
|
||||
pp_print_string fmtp (fmt_error_ctx x)
|
||||
| EUnexpectedToken (x, t) ->
|
||||
pp_print_string fmtp "#unexpected_eof; ctx=";
|
||||
pp_print_string fmtp "#unexpected_token; ctx=";
|
||||
pp_print_string fmtp (fmt_error_ctx x);
|
||||
pp_print_string fmtp "; token=";
|
||||
pp_print_string fmtp (token_to_string t)
|
||||
pp_print_string fmtp "; expected_token=";
|
||||
pp_print_string fmtp (token_kind_to_string t)
|
||||
| EUnhandled x ->
|
||||
pp_print_string fmtp "#unhandled; ";
|
||||
pp_print_string fmtp (String.escaped x)
|
||||
|
@ -115,8 +115,8 @@ module En : LocaleT = struct
|
|||
| EUnexpectedToken (x, t) ->
|
||||
pp_print_string fmtp "unexpected token inside ";
|
||||
pp_print_string fmtp (fmt_error_ctx x);
|
||||
pp_print_string fmtp ": ";
|
||||
pp_print_string fmtp (token_to_string t)
|
||||
pp_print_string fmtp ": expected: ";
|
||||
pp_print_string fmtp (token_kind_to_string t)
|
||||
| EUnhandled x ->
|
||||
pp_print_string fmtp "unhandled charachter: ";
|
||||
pp_print_string fmtp (String.escaped x)
|
||||
|
|
|
@ -62,26 +62,15 @@ let rec parse_minexpr ps =
|
|||
let (k, s, ps) = next_in_noeof ps XRefOf in
|
||||
match k with
|
||||
| Ident i -> (RefOf (s, env_lookup i s ps), ps)
|
||||
| _ -> Yanais_syntax_err (EUnexpectedToken (XRefOf, k), s) |> raise
|
||||
| _ -> Yanais_syntax_err (EUnexpectedToken (XRefOf, TkIdent), s) |> raise
|
||||
)
|
||||
| LLiteral l -> (ELiteral l, ps)
|
||||
| Paren Open -> (
|
||||
let (inner, ps) = parse_expr ps in
|
||||
let (_, ps) = require XParens (got (Paren Close)) ps in
|
||||
let (_, ps) = require_token XParens (Paren Close) ps in
|
||||
(inner, ps)
|
||||
)
|
||||
(*
|
||||
| Lambda -> (
|
||||
let (pat, ps) = Pattern.parse in
|
||||
let (pty, ps) = match parse_ty_annot ps with
|
||||
| None -> (None, ps)
|
||||
| Some (s, ptyx, ps) -> (Some (s, ptyx), ps)
|
||||
in let pmt = (pat, pty) in
|
||||
let body_span_start = ps.offset in
|
||||
let (body, ps) = parse_minexpr
|
||||
)
|
||||
*)
|
||||
| _ -> Yanais_syntax_err (EUnexpectedToken (XExpression, k), s) |> raise
|
||||
| _ -> Yanais_syntax_err (EExpected XExpression, s) |> raise
|
||||
|
||||
and parse_ty_annot ps = when_got DubColon (fun (_, ps) ->
|
||||
let span_start = ps.offset in
|
||||
|
@ -97,13 +86,41 @@ and parse_letbinds ps acc = match ps.lt with
|
|||
| Some (x, y, ps) -> (Some (x, y), ps)
|
||||
| None -> (None, ps)
|
||||
in
|
||||
let (_, ps) = require XLet (got Assign) ps in
|
||||
let (_, ps) = require_token XLet Assign ps in
|
||||
let value_start = ps.offset in
|
||||
let (value, ps) = parse_expr ps in
|
||||
let value_span = loc_span_of_start_end value_start ps.offset in
|
||||
let ps = { ps with names = Pattern.exports ps.names pat } in
|
||||
let (_, ps) = require XLet (got SemiColon) ps in
|
||||
let (_, ps) = require_token XLet SemiColon ps in
|
||||
parse_letbinds ps ((pat, pty, (value_span, value)) :: acc)
|
||||
| _ -> (acc, ps)
|
||||
|
||||
and parse_expr _ = failwith "unimplemented"
|
||||
and parse_expr ps = match ps.lt with
|
||||
| (Lambda, s)::lt -> (
|
||||
let ps = { ps with lt; offset = loc_span_end s; } in
|
||||
let (pat, ps) = Pattern.parse ps in
|
||||
let (pty, ps) = match parse_ty_annot ps with
|
||||
| None -> (None, ps)
|
||||
| Some (s, ptyx, ps) -> (Some (s, ptyx), ps)
|
||||
in
|
||||
let body_span_start = ps.offset in
|
||||
let (body, ps) = parse_expr ps in
|
||||
let lam = { pat; pty; body_span = Asai.Range.make (body_span_start, ps.offset); body; } in
|
||||
(Lambda (msr_of_lambda lam, lam), ps)
|
||||
)
|
||||
| (TyLambda, s)::lt -> (
|
||||
let ps = { ps with lt; offset = loc_span_end s; } in
|
||||
let (_, ps) = require_token XLambda (Paren Open) ps in
|
||||
let (bind_layout, ps) = parse_expr ps in
|
||||
let (_, ps) = require_token XLambda (Paren Close) ps in
|
||||
let (pat, ps) = Pattern.parse ps in
|
||||
let (pty, ps) = match parse_ty_annot ps with
|
||||
| None -> (None, ps)
|
||||
| Some (s, ptyx, ps) -> (Some (s, ptyx), ps)
|
||||
in
|
||||
let body_span_start = ps.offset in
|
||||
let (body, ps) = parse_expr ps in
|
||||
let lam = { pat; pty; body_span = Asai.Range.make (body_span_start, ps.offset); body; } in
|
||||
(TyLambda (Int.max (msr_of_lambda lam) (msr_of_expr bind_layout), bind_layout, lam), ps)
|
||||
)
|
||||
| _ -> parse_minexpr ps
|
||||
|
|
|
@ -28,7 +28,7 @@ let parse_opt ps =
|
|||
| (Brace Close, s)::lt ->
|
||||
let ps = { ps with lt; offset = loc_span_end s; } in
|
||||
((osp, oisz, frg), ps)
|
||||
| (k, s)::_ -> Yanais_syntax_err (EUnexpectedToken (XTagGroupItem, k), s) |> raise
|
||||
| (_, s)::_ -> Yanais_syntax_err (EExpected XTagGroupItem, s) |> raise
|
||||
| [] ->
|
||||
Yanais_syntax_err (EUnexpectedEof XTagGroupItem, osp) |> raise
|
||||
in inner2 ps FieldsReg.empty
|
||||
|
|
|
@ -76,6 +76,26 @@ let token_to_string = function
|
|||
| Match -> "match"
|
||||
| KTagGroup -> "tag_group"
|
||||
|
||||
type token_kind =
|
||||
| TkToken of token
|
||||
| TkIntSize
|
||||
| TkNatural
|
||||
| TkType
|
||||
| TkIdent
|
||||
| TkPatOut
|
||||
| TkDotIdent
|
||||
| TkString
|
||||
|
||||
let token_kind_to_string = function
|
||||
| TkToken t -> token_to_string t
|
||||
| TkIntSize -> "<IntSize>"
|
||||
| TkNatural -> "<Natural>"
|
||||
| TkType -> "<Type literal>"
|
||||
| TkIdent -> "<Identifier>"
|
||||
| TkPatOut -> "<$Identifier>"
|
||||
| TkDotIdent -> "<.Identifier>"
|
||||
| TkString -> "<String>"
|
||||
|
||||
type error_ctx =
|
||||
| XComment
|
||||
| XExpression
|
||||
|
@ -113,7 +133,7 @@ let str_of_ectx = function
|
|||
type error_kind =
|
||||
| EExpected of error_ctx
|
||||
| EUnexpectedEof of error_ctx
|
||||
| EUnexpectedToken of error_ctx * token
|
||||
| EUnexpectedToken of error_ctx * token_kind
|
||||
| EUnhandled of string
|
||||
| ERecordDupIdent of string
|
||||
| EPatternDupIdent of string
|
||||
|
@ -159,6 +179,11 @@ let require ctx parse_inner ps = match parse_inner ps with
|
|||
| [] -> Asai.Range.eof ps.offset
|
||||
in Yanais_syntax_err (EExpected ctx, sp) |> raise
|
||||
|
||||
let require_token ctx tok ps = match parse_one ps with
|
||||
| Some (k, s, ps) when k == tok -> (s, ps)
|
||||
| Some (_, s, _) -> Yanais_syntax_err (EUnexpectedToken (ctx, TkToken tok), s) |> raise
|
||||
| None -> Yanais_syntax_err (EUnexpectedToken (ctx, TkToken tok), Asai.Range.eof ps.offset) |> raise
|
||||
|
||||
let env_lookup_opt name ps =
|
||||
let rec inner names count = match names with
|
||||
| [] -> None
|
||||
|
|
Loading…
Reference in a new issue