Use name_base in plval base.
This commit is contained in:
parent
dda16f807c
commit
c17964c06d
@ -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;
|
||||
|
@ -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"
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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, _) ->
|
||||
|
@ -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) ->
|
||||
|
Loading…
x
Reference in New Issue
Block a user