Remove effect system from src.

4 files changed, 12 insertions, 392 deletions

diff --git a/src/boot/me/dwarf.ml b/src/boot/me/dwarf.ml
index 51bd4184..ff3786af 100644
--- a/src/boot/me/dwarf.ml
+++ b/src/boot/me/dwarf.ml
@@ -1205,8 +1205,6 @@ let (abbrev_subprogram:abbrev) =
      (DW_AT_high_pc, DW_FORM_addr);
      (DW_AT_frame_base, DW_FORM_block1);
      (DW_AT_return_addr, DW_FORM_block1);
-     (DW_AT_mutable, DW_FORM_flag);
-     (DW_AT_pure, DW_FORM_flag);
      (DW_AT_rust_iterator, DW_FORM_flag);
    |])
 ;;
@@ -1389,8 +1387,6 @@ let (abbrev_subroutine_type:abbrev) =
   (DW_TAG_subroutine_type, DW_CHILDREN_yes,
    [|
      (DW_AT_type, DW_FORM_ref_addr); (* NB: output type. *)
-       (DW_AT_mutable, DW_FORM_flag);
-       (DW_AT_pure, DW_FORM_flag);
        (DW_AT_rust_iterator, DW_FORM_flag);
      |])
 ;;
@@ -1408,8 +1404,6 @@ let (abbrev_obj_subroutine_type:abbrev) =
      [|
        (DW_AT_name, DW_FORM_string);
        (DW_AT_type, DW_FORM_ref_addr); (* NB: output type. *)
-       (DW_AT_mutable, DW_FORM_flag);
-       (DW_AT_pure, DW_FORM_flag);
        (DW_AT_rust_iterator, DW_FORM_flag);
      |])
 ;;
@@ -1523,26 +1517,10 @@ let dwarf_visitor
           SUB ((M_POS fix), M_POS cu_info_section_fixup))
   in
 
-  let encode_effect eff =
-    (* Note: weird encoding: mutable+pure = unsafe. *)
-    let mut_byte, pure_byte =
-      match eff with
-          Ast.EFF_unsafe -> (1,1)
-        | Ast.EFF_impure -> (0,0)
-        | Ast.EFF_pure -> (0,1)
-    in
-      SEQ [|
-        (* DW_AT_mutable: DW_FORM_flag *)
-        BYTE mut_byte;
-        (* DW_AT_pure: DW_FORM_flag *)
-        BYTE pure_byte;
-      |]
-  in
-
-  let encode_layer eff =
+  let encode_layer lyr =
     (* Note: weird encoding: mutable+pure = gc. *)
     let mut_byte, pure_byte =
-      match eff with
+      match lyr with
           Ast.LAYER_value -> (0,1)
         | Ast.LAYER_state -> (1,0)
         | Ast.LAYER_gc -> (1,1)
@@ -1855,7 +1833,6 @@ let dwarf_visitor
                  uleb (get_abbrev_code abbrev_subroutine_type);
                  (* DW_AT_type: DW_FORM_ref_addr *)
                  (ref_slot_die tsig.Ast.sig_output_slot);
-                 encode_effect taux.Ast.fn_effect;
                  (* DW_AT_rust_iterator: DW_FORM_flag *)
                  BYTE (if taux.Ast.fn_is_iter then 1 else 0)
                |])
@@ -1876,7 +1853,6 @@ let dwarf_visitor
             ZSTRING ident;
             (* DW_AT_type: DW_FORM_ref_addr *)
             (ref_slot_die tsig.Ast.sig_output_slot);
-            encode_effect taux.Ast.fn_effect;
             (* DW_AT_rust_iterator: DW_FORM_flag *)
             BYTE (if taux.Ast.fn_is_iter then 1 else 0)
           |]
@@ -2295,7 +2271,6 @@ let dwarf_visitor
   let emit_subprogram_die
       (id:Ast.ident)
       (ret_slot:Ast.slot)
-      (effect:Ast.effect)
       (iter:bool)
       (fix:fixup)
       : unit =
@@ -2315,7 +2290,6 @@ let dwarf_visitor
          dw_form_block1 [| DW_OP_reg abi.Abi.abi_dwarf_fp_reg |];
          (* DW_AT_return_addr *)
          dw_form_block1 [| DW_OP_fbreg (Asm.IMM retpc); |];
-         encode_effect effect;
          (* DW_AT_rust_iterator: DW_FORM_flag *)
          BYTE (if iter then 1 else 0)
        |])
@@ -2429,7 +2403,7 @@ let dwarf_visitor
                   (Array.length item.node.Ast.decl_params);
                 emit_subprogram_die
                   id tsig.Ast.sig_output_slot
-                  taux.Ast.fn_effect taux.Ast.fn_is_iter
+                  taux.Ast.fn_is_iter
                   (Hashtbl.find cx.ctxt_fn_fixups item.id);
                 emit_type_param_decl_dies item.node.Ast.decl_params;
             end
@@ -2900,15 +2874,6 @@ let rec extract_mod_items
       | _ -> bug () "unexpected non-flag form for %s" (dw_at_to_string attr)
   in
 
-  let get_effect die =
-    match (get_flag die DW_AT_mutable, get_flag die DW_AT_pure) with
-        (* Note: weird encoding: mutable+pure = unsafe. *)
-        (true, true) -> Ast.EFF_unsafe
-      | (false, false) -> Ast.EFF_impure
-      | (false, true) -> Ast.EFF_pure
-      | _ -> failwith "bad effect encoding"
-  in
-
   let get_layer die =
     match (get_flag die DW_AT_mutable, get_flag die DW_AT_pure) with
         (* Note: weird encoding: mutable+pure = gc. *)
@@ -3123,7 +3088,6 @@ let rec extract_mod_items
             else None
         end
     in
-    let effect = get_effect die in
     let iter = get_flag die DW_AT_rust_iterator in
     let tsig =
       { Ast.sig_input_slots = ins;
@@ -3131,8 +3095,7 @@ let rec extract_mod_items
         Ast.sig_output_slot = out; }
     in
     let taux =
-      { Ast.fn_is_iter = iter;
-        Ast.fn_effect = effect }
+      { Ast.fn_is_iter = iter; }
     in
       (tsig, taux)
   in
@@ -3223,11 +3186,9 @@ let rec extract_mod_items
           (* FIXME (issue #74): finish this. *)
           let ident = get_name die in
           let oslot = get_referenced_slot die in
-          let effect = get_effect die in
           let iter = get_flag die DW_AT_rust_iterator in
           let (params, islots) = get_formals die in
-          let taux = { Ast.fn_effect = effect;
-                       Ast.fn_is_iter = iter }
+          let taux = { Ast.fn_is_iter = iter }
           in
           let tfn = { Ast.fn_input_slots = form_header_slots islots;
                        Ast.fn_input_constrs = [| |];
diff --git a/src/boot/me/effect.ml b/src/boot/me/effect.ml
deleted file mode 100644
index b3e81864..00000000
--- a/src/boot/me/effect.ml
+++ /dev/null
@@ -1,317 +0,0 @@
-open Semant;;
-open Common;;
-
-let log cx = Session.log "effect"
-  (should_log cx cx.ctxt_sess.Session.sess_log_effect)
-  cx.ctxt_sess.Session.sess_log_out
-;;
-
-let iflog cx thunk =
-  if (should_log cx cx.ctxt_sess.Session.sess_log_effect)
-  then thunk ()
-  else ()
-;;
-
-let effect_calculating_visitor
-    (item_effect:(node_id, Ast.effect) Hashtbl.t)
-    (cx:ctxt)
-    (inner:Walk.visitor)
-    : Walk.visitor =
-  (* 
-   * This visitor calculates the effect of each function according to
-   * its statements:
-   * 
-   *    - Communication statements lower to 'impure'
-   *    - Writing to anything other than a local slot lowers to 'impure'
-   *    - Native calls lower to 'unsafe'
-   *    - Calling a function with effect e lowers to e.
-   *)
-  let curr_fn = Stack.create () in
-
-  let visit_mod_item_pre n p i =
-    begin
-      match i.node.Ast.decl_item with
-          Ast.MOD_ITEM_fn _ -> Stack.push i.id curr_fn
-        | _ -> ()
-    end;
-    inner.Walk.visit_mod_item_pre n p i
-  in
-
-  let visit_mod_item_post n p i =
-    inner.Walk.visit_mod_item_post n p i;
-    match i.node.Ast.decl_item with
-        Ast.MOD_ITEM_fn _ -> ignore (Stack.pop curr_fn)
-      | _ -> ()
-  in
-
-  let visit_obj_fn_pre o i fi =
-    Stack.push fi.id curr_fn;
-    inner.Walk.visit_obj_fn_pre o i fi
-  in
-
-  let visit_obj_fn_post o i fi =
-    inner.Walk.visit_obj_fn_post o i fi;
-    ignore (Stack.pop curr_fn)
-  in
-
-  let visit_obj_drop_pre o b =
-    Stack.push b.id curr_fn;
-    inner.Walk.visit_obj_drop_pre o b
-  in
-
-  let visit_obj_drop_post o b =
-    inner.Walk.visit_obj_drop_post o b;
-    ignore (Stack.pop curr_fn);
-  in
-
-  let lower_to s ne =
-    let fn_id = Stack.top curr_fn in
-    let e =
-      match htab_search item_effect fn_id with
-          None -> Ast.EFF_pure
-        | Some e -> e
-    in
-    let ne = lower_effect_of ne e in
-      if ne <> e
-      then
-        begin
-          iflog cx
-            begin
-              fun _ ->
-                let name = Hashtbl.find cx.ctxt_all_item_names fn_id in
-                  log cx "lowering calculated effect on '%a': '%a' -> '%a'"
-                    Ast.sprintf_name name
-                    Ast.sprintf_effect e
-                    Ast.sprintf_effect ne;
-                  log cx "at stmt %a" Ast.sprintf_stmt s
-            end;
-          Hashtbl.replace item_effect fn_id ne
-        end;
-  in
-
-  let note_write s dst =
-    (* FIXME (issue #182): this is too aggressive; won't permit writes to
-     * interior components of records or tuples. It should at least do that,
-     * possibly handle escape analysis on the pointee for things like vecs as
-     * well.  *)
-    if lval_base_is_slot cx dst
-    then
-      let base_slot = lval_base_slot cx dst in
-        match dst, base_slot.Ast.slot_mode with
-            (Ast.LVAL_base _, Ast.MODE_local) -> ()
-          | _ -> lower_to s Ast.EFF_impure
-  in
-
-  let visit_stmt_pre s =
-    begin
-      match s.node with
-          Ast.STMT_send _
-        | Ast.STMT_recv _ -> lower_to s Ast.EFF_impure
-
-        | Ast.STMT_call (lv_dst, fn, _) ->
-            note_write s lv_dst;
-            let lower_to_callee_ty t =
-              match simplified_ty t with
-                  Ast.TY_fn (_, taux) ->
-                    lower_to s taux.Ast.fn_effect;
-                | _ -> bug () "non-fn callee"
-            in
-              if lval_base_is_slot cx fn
-              then
-                lower_to_callee_ty (lval_ty cx fn)
-              else
-                begin
-                  let item = lval_item cx fn in
-                  let t = Hashtbl.find cx.ctxt_all_item_types item.id in
-                    lower_to_callee_ty t;
-                    match htab_search cx.ctxt_required_items item.id with
-                        None -> ()
-                      | Some (REQUIRED_LIB_rust _, _) -> ()
-                      | Some _ -> lower_to s Ast.EFF_unsafe
-                end
-
-        | Ast.STMT_copy (lv_dst, _)
-        | Ast.STMT_spawn (lv_dst, _, _, _, _)
-        | Ast.STMT_bind (lv_dst, _, _)
-        | Ast.STMT_new_rec (lv_dst, _, _)
-        | Ast.STMT_new_tup (lv_dst, _)
-        | Ast.STMT_new_vec (lv_dst, _, _)
-        | Ast.STMT_new_str (lv_dst, _)
-        | Ast.STMT_new_port lv_dst
-        | Ast.STMT_new_chan (lv_dst, _)
-        | Ast.STMT_new_box (lv_dst, _, _) ->
-            note_write s lv_dst
-
-        | _ -> ()
-    end;
-    inner.Walk.visit_stmt_pre s
-  in
-
-    { inner with
-        Walk.visit_mod_item_pre = visit_mod_item_pre;
-        Walk.visit_mod_item_post = visit_mod_item_post;
-        Walk.visit_obj_fn_pre = visit_obj_fn_pre;
-        Walk.visit_obj_fn_post = visit_obj_fn_post;
-        Walk.visit_obj_drop_pre = visit_obj_drop_pre;
-        Walk.visit_obj_drop_post = visit_obj_drop_post;
-        Walk.visit_stmt_pre = visit_stmt_pre }
-;;
-
-
-let effect_checking_visitor
-    (item_auth:(node_id, Ast.effect) Hashtbl.t)
-    (item_effect:(node_id, Ast.effect) Hashtbl.t)
-    (cx:ctxt)
-    (inner:Walk.visitor)
-    : Walk.visitor =
-  (*
-   * This visitor checks that each fn declares
-   * effects consistent with what we calculated.
-   *)
-  let auth_stack = Stack.create () in
-  let visit_mod_item_pre n p i =
-    begin
-      match htab_search item_auth i.id with
-          None -> ()
-        | Some e ->
-            let curr =
-              if Stack.is_empty auth_stack
-              then Ast.EFF_pure
-              else Stack.top auth_stack
-            in
-              Stack.push e auth_stack;
-              iflog cx
-                begin
-                  fun _ ->
-                    let name = Hashtbl.find cx.ctxt_all_item_names i.id in
-                      log cx
-                        "entering '%a', adjusting auth effect: '%a' -> '%a'"
-                        Ast.sprintf_name name
-                        Ast.sprintf_effect curr
-                        Ast.sprintf_effect e
-                end
-    end;
-    let report_mismatch declared_effect calculated_effect =
-      let name = Hashtbl.find cx.ctxt_all_item_names i.id in
-        err (Some i.id)
-          "%a claims effect '%a' but calculated effect is '%a'%s"
-          Ast.sprintf_name name
-          Ast.sprintf_effect declared_effect
-          Ast.sprintf_effect calculated_effect
-          begin
-            if Stack.is_empty auth_stack
-            then ""
-            else
-              Printf.sprintf " (auth effects are '%s')"
-                (stk_fold
-                   auth_stack
-                   (fun e s ->
-                      if s = ""
-                      then
-                        Printf.sprintf "%a"
-                          Ast.sprintf_effect e
-                      else
-                        Printf.sprintf "%s, %a" s
-                          Ast.sprintf_effect e) "")
-          end
-    in
-    begin
-      match i.node.Ast.decl_item with
-          Ast.MOD_ITEM_fn f
-            when htab_search cx.ctxt_required_items i.id = None ->
-            let calculated_effect =
-              match htab_search item_effect i.id with
-                None -> Ast.EFF_pure
-              | Some e -> e
-            in
-            let declared_effect = f.Ast.fn_aux.Ast.fn_effect in
-              if calculated_effect <> declared_effect
-              then
-                (* Something's fishy in this case. If the calculated effect
-                 * is equal to one auth'ed by an enclosing scope -- not just
-                 * a lower one -- we accept this mismatch; otherwise we
-                 * complain.
-                 * 
-                 * FIXME: this choice of "what constitutes an error" in
-                 * auth/effect mismatches is subjective and could do
-                 * with some discussion.  *)
-                begin
-                  match
-                    stk_search auth_stack
-                      (fun e ->
-                         if e = calculated_effect then Some e else None)
-                  with
-                      Some _ -> ()
-                    | None ->
-                        report_mismatch declared_effect calculated_effect
-                end
-        | _ -> ()
-    end;
-    inner.Walk.visit_mod_item_pre n p i
-  in
-  let visit_mod_item_post n p i =
-    inner.Walk.visit_mod_item_post n p i;
-    match htab_search item_auth i.id with
-        None -> ()
-      | Some _ ->
-          let curr = Stack.pop auth_stack in
-          let next =
-            if Stack.is_empty auth_stack
-            then Ast.EFF_pure
-            else Stack.top auth_stack
-          in
-            iflog cx
-              begin
-                fun _ ->
-                  let name = Hashtbl.find cx.ctxt_all_item_names i.id in
-                    log cx
-                      "leaving '%a', restoring auth effect: '%a' -> '%a'"
-                      Ast.sprintf_name name
-                      Ast.sprintf_effect curr
-                      Ast.sprintf_effect next
-              end
-  in
-    { inner with
-        Walk.visit_mod_item_pre = visit_mod_item_pre;
-        Walk.visit_mod_item_post = visit_mod_item_post; }
-;;
-
-
-let process_crate
-    (_cx:ctxt)
-    (_crate:Ast.crate)
-    : unit = (*
-  let item_auth = Hashtbl.create 0 in
-  let item_effect = Hashtbl.create 0 in
-  let passes =
-    [|
-      (effect_calculating_visitor item_effect cx
-         Walk.empty_visitor);
-      (effect_checking_visitor item_auth item_effect cx
-         Walk.empty_visitor);
-    |]
-  in
-  let root_scope = [ SCOPE_crate crate ] in
-  let auth_effect name eff =
-    match lookup_by_name cx [] root_scope name with
-        RES_failed _ -> ()
-      | RES_ok (_, id) ->
-          if defn_id_is_item cx id
-          then htab_put item_auth id eff
-          else err (Some id) "auth clause in crate refers to non-item"
-  in
-    Hashtbl.iter auth_effect crate.node.Ast.crate_auth;
-    run_passes cx "effect" passes
-      cx.ctxt_sess.Session.sess_log_effect log crate
-  *)
-  ()
-;;
-
-(*
- * Local Variables:
- * fill-column: 78;
- * indent-tabs-mode: nil
- * buffer-file-coding-system: utf-8-unix
- * compile-command: "make -k -C $RBUILD 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
- * End:
- *)
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 6a7de314..a877f2d0 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -1010,13 +1010,11 @@ let rec pretty_ty_str (cx:ctxt) (fallback:(Ast.ty -> string)) (ty:Ast.ty) =
                 None -> Common.bug () "no ty in slot"
               | Some ty' -> prefix ^ (pretty_ty_str cx fallback ty')
           in
-          let effect = aux.Ast.fn_effect in
-          let qual = Fmt.sprintf_fmt Ast.fmt_effect_qual () effect in
           let keyword = if aux.Ast.fn_is_iter then "iter" else "fn" in
           let fn_args = Array.map format_slot fnsig.Ast.sig_input_slots in
           let fn_args_str = String.concat ", " (Array.to_list fn_args) in
           let fn_rv_str = format_slot fnsig.Ast.sig_output_slot in
-          Printf.sprintf "%s%s(%s) -> %s" qual keyword fn_args_str fn_rv_str
+          Printf.sprintf "%s(%s) -> %s" keyword fn_args_str fn_rv_str
       | Ast.TY_tag { Ast.tag_id = tag_id; Ast.tag_args = _ }
               when Hashtbl.mem cx.ctxt_user_tag_names tag_id ->
           let name = Hashtbl.find cx.ctxt_user_tag_names tag_id in
@@ -1156,8 +1154,7 @@ let generic_fn_ty =
                Ast.sig_output_slot =
                  { Ast.slot_mode = Ast.MODE_local;
                    Ast.slot_ty = Some Ast.TY_nil }; },
-             { Ast.fn_is_iter = false;
-               Ast.fn_effect = Ast.EFF_pure })
+             { Ast.fn_is_iter = false })
 ;;
 
 let rec get_genericized_ty ty =
@@ -1271,19 +1268,6 @@ let type_points_to_heap (cx:ctxt) (t:Ast.ty) : bool =
 
 (* Type qualifier analysis. *)
 
-let effect_le x y =
-  match (x,y) with
-      (Ast.EFF_unsafe, _) -> true
-    | (Ast.EFF_impure, Ast.EFF_pure) -> true
-    | (Ast.EFF_impure, Ast.EFF_impure) -> true
-    | (Ast.EFF_pure, Ast.EFF_pure) -> true
-    | _ -> false
-;;
-
-let lower_effect_of x y =
-  if effect_le x y then x else y
-;;
-
 let layer_le x y =
   match (x,y) with
       (Ast.LAYER_gc, _) -> true
@@ -1682,8 +1666,7 @@ let ty_of_mod_item (item:Ast.mod_item) : Ast.ty =
     | Ast.MOD_ITEM_mod _ -> bug () "Semant.ty_of_mod_item on mod"
     | Ast.MOD_ITEM_const (ty, _) -> ty
     | Ast.MOD_ITEM_obj ob ->
-        let taux = { Ast.fn_effect = Ast.EFF_pure;
-                     Ast.fn_is_iter = false }
+        let taux = { Ast.fn_is_iter = false }
         in
         let tobj = Ast.TY_obj (ty_obj_of_obj ob) in
         let tsig = { Ast.sig_input_slots = arg_slots ob.Ast.obj_state;
@@ -1705,8 +1688,7 @@ let ty_of_mod_item (item:Ast.mod_item) : Ast.ty =
           if Array.length hdr = 0
           then Ast.TY_tag ttag
           else
-            let taux = { Ast.fn_effect = Ast.EFF_pure;
-                         Ast.fn_is_iter = false }
+            let taux = { Ast.fn_is_iter = false }
             in
             let inputs = Array.map (fun (s, _) -> s.node) hdr in
             let tsig = { Ast.sig_input_slots = inputs;
@@ -2642,8 +2624,7 @@ let mk_ty_fn_or_iter
     (is_iter:bool)
     : Ast.ty =
   (* In some cases we don't care what aux or constrs are. *)
-  let taux = { Ast.fn_effect = Ast.EFF_pure;
-               Ast.fn_is_iter = is_iter; }
+  let taux = { Ast.fn_is_iter = is_iter; }
   in
   let tsig = { Ast.sig_input_slots = arg_slots;
                Ast.sig_input_constrs = [| |];
@@ -2816,6 +2797,6 @@ let glue_str (cx:ctxt) (g:glue) : string =
  * fill-column: 78;
  * indent-tabs-mode: nil
  * buffer-file-coding-system: utf-8-unix
- * compile-command: "make -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * compile-command: "make -C  $RBUILD 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
  * End:
  *)
diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml
index 58b2f673..fe6e8dca 100644
--- a/src/boot/me/typestate.ml
+++ b/src/boot/me/typestate.ml
@@ -122,12 +122,7 @@ let determine_constr_key
           then
             begin
               match Hashtbl.find cx.ctxt_all_item_types cid with
-                  Ast.TY_fn (_, taux) ->
-                    begin
-                      if taux.Ast.fn_effect = Ast.EFF_pure
-                      then cid
-                      else err (Some cid) "impure function used in constraint"
-                    end
+                  Ast.TY_fn _ -> cid
                 | _ -> bug () "bad type of predicate"
             end
           else