From 5c82cb42e797599036746461eddf2bec1685eaf3 Mon Sep 17 00:00:00 2001 From: Graydon Hoare Date: Wed, 15 Sep 2010 16:10:08 -0700 Subject: Add Ast.ATOM_pexp and -pexp mode wherein pexps live beyond parsing, into later stages. Fixes to pexp pretty printer. --- src/boot/me/resolve.ml | 3 +++ src/boot/me/semant.ml | 1 + src/boot/me/trans.ml | 9 +++++++++ src/boot/me/type.ml | 1 + src/boot/me/typestate.ml | 1 + src/boot/me/walk.ml | 1 + 6 files changed, 16 insertions(+) (limited to 'src/boot/me') diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml index d957e3b7..1be2e3b9 100644 --- a/src/boot/me/resolve.ml +++ b/src/boot/me/resolve.ml @@ -495,6 +495,9 @@ let type_resolving_visitor | Ast.COMP_atom (Ast.ATOM_literal _) -> ext | Ast.COMP_atom (Ast.ATOM_lval lv) -> Ast.COMP_atom (Ast.ATOM_lval (rebuild_lval lv)) + | Ast.COMP_atom (Ast.ATOM_pexp _) -> + bug () "Resolve.rebuild_lval' on ATOM_pexp" + | Ast.COMP_named (Ast.COMP_app (ident, params)) -> Ast.COMP_named (Ast.COMP_app (ident, Array.map resolve_ty params)) diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml index 09576219..42df903b 100644 --- a/src/boot/me/semant.ml +++ b/src/boot/me/semant.ml @@ -1326,6 +1326,7 @@ let rec atom_type (cx:ctxt) (at:Ast.atom) : Ast.ty = | Ast.ATOM_literal {node=(Ast.LIT_nil); id=_} -> Ast.TY_nil | Ast.ATOM_literal {node=(Ast.LIT_mach_int (m,_)); id=_} -> Ast.TY_mach m | Ast.ATOM_lval lv -> lval_ty cx lv + | Ast.ATOM_pexp _ -> bug () "Semant.atom_type on ATOM_pexp" ;; let expr_type (cx:ctxt) (e:Ast.expr) : Ast.ty = diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index 757b9ef7..8053c0f9 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -1031,6 +1031,9 @@ let trans_visitor | Ast.ATOM_lval lv -> trans_const_lval lv + | Ast.ATOM_pexp _ -> + unimpl None "constant-folding pexp atom" + and trans_const_expr (expr:Ast.expr) : (Ast.ty * const) = @@ -1404,6 +1407,8 @@ let trans_visitor Il.Cell (fst (deref_ty DEREF_none false cell ty)) | Ast.ATOM_literal lit -> trans_lit lit.node + | Ast.ATOM_pexp _ -> bug () "Trans.trans_atom on ATOM_pexp" + and fixup_to_ptr_operand (imm_ok:bool) @@ -3583,6 +3588,10 @@ let trans_visitor dst_cell dst_ty src_cell src_ty + | (_, Ast.EXPR_atom (Ast.ATOM_pexp _)) -> + bug () "Trans.trans_copy on ATOM_pexp" + + and trans_init_direct_fn (dst_cell:Il.cell) (flv:Ast.lval) diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml index b576af86..4e737be2 100644 --- a/src/boot/me/type.ml +++ b/src/boot/me/type.ml @@ -624,6 +624,7 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) = match atom with Ast.ATOM_lval lval -> check_lval ~deref:deref lval | Ast.ATOM_literal lit_id -> check_literal lit_id.Common.node + | Ast.ATOM_pexp _ -> Common.bug () "Type.check_atom on ATOM_pexp" in let infer_slot (ty:Ast.ty) (slot_id:Common.node_id) : unit = diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml index 466e04fe..a88adcd2 100644 --- a/src/boot/me/typestate.ml +++ b/src/boot/me/typestate.ml @@ -258,6 +258,7 @@ and atom_slots (cx:ctxt) (a:Ast.atom) : node_id array = match a with Ast.ATOM_literal _ -> [| |] | Ast.ATOM_lval lv -> lval_slots cx lv + | Ast.ATOM_pexp _ -> bug () "Typestate.atom_slots on ATOM_pexp" ;; let lval_option_slots (cx:ctxt) (lv:Ast.lval option) : node_id array = diff --git a/src/boot/me/walk.ml b/src/boot/me/walk.ml index 7b89cbd8..552debdf 100644 --- a/src/boot/me/walk.ml +++ b/src/boot/me/walk.ml @@ -557,6 +557,7 @@ and walk_atom match a with Ast.ATOM_literal ls -> walk_lit v ls.node | Ast.ATOM_lval lv -> walk_lval v lv + | Ast.ATOM_pexp _ -> bug () "Walk.walk_atom on ATOM_pexp" and walk_opt_atom -- cgit v1.2.3