diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml index efb64e50c98..54c48f7d090 100644 --- a/src/boot/fe/ast.ml +++ b/src/boot/fe/ast.ml @@ -348,8 +348,7 @@ and pexp' = | PEXP_custom of name * (pexp array) * (string option) and plval = - PLVAL_ident of ident - | PLVAL_app of (ident * (ty array)) + PLVAL_base of name_base | PLVAL_ext_name of (pexp * name_component) | PLVAL_ext_pexp of (pexp * pexp) | PLVAL_ext_deref of pexp @@ -555,8 +554,7 @@ let sane_name (n:name) : bool = let rec plval_is_atomic (plval:plval) : bool = match plval with - PLVAL_ident _ - | PLVAL_app _ -> true + PLVAL_base _ -> true | PLVAL_ext_name (p, _) -> pexp_is_atomic p @@ -1039,10 +1037,7 @@ and fmt_pexp (ff:Format.formatter) (pexp:pexp) : unit = and fmt_plval (ff:Format.formatter) (plval:plval) : unit = match plval with - PLVAL_ident id -> fmt_ident ff id - | PLVAL_app (id, tys) -> - fmt_ident ff id; - fmt_bracketed_arr_sep "[" "]" "," fmt_ty ff tys + PLVAL_base nb -> fmt_name_base ff nb | PLVAL_ext_name (pexp, nc) -> fmt_pexp ff pexp; diff --git a/src/boot/fe/cexp.ml b/src/boot/fe/cexp.ml index ac05105ea19..5ec174184b6 100644 --- a/src/boot/fe/cexp.ml +++ b/src/boot/fe/cexp.ml @@ -520,7 +520,7 @@ and eval_pexp (env:env) (exp:Ast.pexp) : pval = | _ -> bug () "Unexpected unop in Cexp.eval_pexp" end - | Ast.PEXP_lval (Ast.PLVAL_ident ident) -> + | Ast.PEXP_lval (Ast.PLVAL_base (Ast.BASE_ident ident)) -> begin match ltab_search !(env.env_bindings) ident with None -> raise (err (Printf.sprintf "no binding for '%s' found" diff --git a/src/boot/fe/pexp.ml b/src/boot/fe/pexp.ml index 58a6447430d..ec4053c6063 100644 --- a/src/boot/fe/pexp.ml +++ b/src/boot/fe/pexp.ml @@ -559,13 +559,13 @@ and parse_bottom_pexp (ps:pstate) : Ast.pexp = (Some COMMA) parse_ty) ps in let bpos = lexpos ps in - span ps apos bpos (Ast.PEXP_lval (Ast.PLVAL_app (i, tys))) + span ps apos bpos (Ast.PEXP_lval (Ast.PLVAL_base (Ast.BASE_app (i, tys)))) end | _ -> begin let bpos = lexpos ps in - span ps apos bpos (Ast.PEXP_lval (Ast.PLVAL_ident i)) + span ps apos bpos (Ast.PEXP_lval (Ast.PLVAL_base (Ast.BASE_ident i))) end end @@ -960,13 +960,8 @@ let rec desugar_lval (ps:pstate) (pexp:Ast.pexp) let (apos, bpos) = (s.lo, s.hi) in match pexp.node with - Ast.PEXP_lval (Ast.PLVAL_ident ident) -> - let nb = span ps apos bpos (Ast.BASE_ident ident) in - ([||], Ast.LVAL_base nb) - - | Ast.PEXP_lval (Ast.PLVAL_app (ident, tys)) -> - let nb = span ps apos bpos (Ast.BASE_app (ident, tys)) in - ([||], Ast.LVAL_base nb) + Ast.PEXP_lval (Ast.PLVAL_base nb) -> + ([||], Ast.LVAL_base (span ps apos bpos nb)) | Ast.PEXP_lval (Ast.PLVAL_ext_name (base_pexp, comp)) -> let (base_stmts, base_atom) = desugar_expr_atom ps base_pexp in diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml index 3c355c1cebf..cb40dfc924c 100644 --- a/src/boot/me/resolve.ml +++ b/src/boot/me/resolve.ml @@ -492,9 +492,9 @@ let type_resolving_visitor inner.Walk.visit_pexp_post p; let rebuild_plval pl = match pl with - Ast.PLVAL_ident _ -> pl - | Ast.PLVAL_app (id, tys) -> - Ast.PLVAL_app (id, Array.map resolve_ty tys) + Ast.PLVAL_base (Ast.BASE_app (id, tys)) -> + Ast.PLVAL_base (Ast.BASE_app (id, Array.map resolve_ty tys)) + | Ast.PLVAL_base _ -> pl | Ast.PLVAL_ext_name (pexp, nc) -> let pexp = get_rebuilt_pexp pexp in let nc = @@ -668,8 +668,8 @@ let lval_base_resolving_visitor Ast.PEXP_lval pl -> begin match pl with - (Ast.PLVAL_ident ident) - | (Ast.PLVAL_app (ident, _)) -> + (Ast.PLVAL_base (Ast.BASE_ident ident)) + | (Ast.PLVAL_base (Ast.BASE_app (ident, _))) -> let id = lookup_defn_by_ident p.id ident in iflog cx diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml index 01457454003..0d350bc5e47 100644 --- a/src/boot/me/semant.ml +++ b/src/boot/me/semant.ml @@ -579,10 +579,8 @@ let rec lval_to_name (lv:Ast.lval) : Ast.name = let rec plval_to_name (pl:Ast.plval) : Ast.name = match pl with - Ast.PLVAL_ident ident -> - Ast.NAME_base (Ast.BASE_ident ident) - | Ast.PLVAL_app (ident, tys) -> - Ast.NAME_base (Ast.BASE_app (ident, tys)) + Ast.PLVAL_base nb -> + Ast.NAME_base nb | Ast.PLVAL_ext_name ({node = Ast.PEXP_lval pl}, nc) -> Ast.NAME_ext (plval_to_name pl, nc) | _ -> bug () "plval_to_name with plval that contains non-name components" @@ -1431,8 +1429,7 @@ let rec pexp_is_const (cx:ctxt) (pexp:Ast.pexp) : bool = and plval_is_const (cx:ctxt) (plval:Ast.plval) : bool = match plval with - Ast.PLVAL_ident _ - | Ast.PLVAL_app _ -> + Ast.PLVAL_base _ -> bug () "Semant.plval_is_const on plval base" | Ast.PLVAL_ext_name (pexp, _) -> diff --git a/src/boot/me/walk.ml b/src/boot/me/walk.ml index 73bb3dffe9f..eb469dfbc00 100644 --- a/src/boot/me/walk.ml +++ b/src/boot/me/walk.ml @@ -631,9 +631,9 @@ and walk_plval : unit = let children _ = match p with - Ast.PLVAL_ident _ -> () - | Ast.PLVAL_app (_, tys) -> + | Ast.PLVAL_base (Ast.BASE_app (_, tys)) -> Array.iter (walk_ty v) tys + | Ast.PLVAL_base _ -> () | Ast.PLVAL_ext_name (pexp, _) -> walk_pexp v pexp | Ast.PLVAL_ext_pexp (a, b) ->