Finally make binding do nothing but binding.

No alias expansion or beta-reduction.

Noe one test fails, which I believe is because over
the top fixpoints are not adjusted after beta reduction.

Note also Felix *cannot* cope with recursions that go over
the top of an argument at the moment.

src/compiler/flx_bind/flx_bbind.ml

@@ -35,19 +35,15 @@ let hfind msg h k =
 let rec fix_typeofs state bsym_table t = 
   match t with
   | BTYP_typeof (symbol_index,expr) ->
-(*
-print_endline ("Found typeof to fix: " ^ Flx_btype.st t);
-*)
+print_endline ("fix_typeofs: Found typeof to fix: " ^ Flx_btype.st t ^ "=" ^ Flx_print.sbt bsym_table t);
     let env = Flx_lookup.build_env
       state.lookup_state bsym_table (Some symbol_index)
     in
     let be = Flx_lookup.bind_expression
       state.lookup_state bsym_table env expr
     in
     let typ = snd be in
-(*
-print_endline ("Fixed typeof : " ^ Flx_btype.st t ^ ", set to " ^ Flx_btype.st typ);
-*)
+print_endline ("fix_typeofs: Fixed typeof : " ^ Flx_btype.st t ^ ", set to " ^ Flx_btype.st typ);
     typ
   | _ -> Flx_btype.map ~f_btype:(fix_typeofs state bsym_table) t
 
@@ -69,7 +65,6 @@ print_endline ("\n====================\nPASS 1 PLAIN BINDING: Setting type alias
   let saved_env_cache = Hashtbl.copy state.lookup_state.Flx_lookup_state.env_cache in
   let saved_visited = Hashtbl.copy state.visited in
 
-  set_nominal_typedefs state;
   let counter = ref start_counter in
   while !counter < !ref_counter do
     let i = !counter in
@@ -170,7 +165,6 @@ if showpasses then
   print_endline ("\n===================\nSetting type aliases to structural\n=======================\n");
 
   (* PASS 1, TYPE ONLY *)
-  set_structural_typedefs state;
 
 if showpasses then
   print_endline ("\n===================\nFixing typeofs \n=======================\n");
@@ -180,17 +174,11 @@ if showpasses then
     let bbdcl = Flx_bsym.bbdcl bsym in
     let sr = Flx_bsym.sr bsym in
     match bbdcl with
-    | BBDCL_structural_type_alias (bvs,t) -> 
+    | BBDCL_type_alias (bvs,t) -> 
       let r = fix_typeofs state bsym_table t in 
-      let b = bbdcl_structural_type_alias (bvs, r) in 
+      let b = bbdcl_type_alias (bvs, r) in 
       Flx_bsym_table.update_bbdcl bsym_table bid b
 
-    | BBDCL_nominal_type_alias (bvs,t) -> 
-      let r = fix_typeofs state bsym_table t in 
-      let b = bbdcl_structural_type_alias (bvs, r) in 
-      Flx_bsym_table.update_bbdcl bsym_table bid b
-
-
     | BBDCL_type_function (bks,t) -> 
       let r = fix_typeofs state bsym_table t in 
       let b = bbdcl_type_function (bks, r) in 

src/compiler/flx_bind/flx_bbind_state.ml

@@ -36,9 +36,3 @@ let make_bbind_state
     visited = Hashtbl.create 97;
   }
 
-let set_nominal_typedefs (state:bbind_state_t) = state.lookup_state.Flx_lookup_state.treat_typedefs_as_structural <- false
-let set_structural_typedefs (state:bbind_state_t) = state.lookup_state.Flx_lookup_state.treat_typedefs_as_structural <- true 
-let get_structural_typedefs (state:bbind_state_t) = state.lookup_state.Flx_lookup_state.treat_typedefs_as_structural
-
-
-

src/compiler/flx_bind/flx_bind_expression.ml

@@ -534,6 +534,7 @@ print_endline ("Bound tuple head " ^ sbe bsym_table x ^ " has type " ^ sbt bsym_
 print_endline ("Find field name " ^ name ^ " of " ^ string_of_expr e');
 *)
     let e'',t'' as x2 = be e' in
+    let t'' = Flx_beta.beta_reduce "Flx_bind_expression: get named variable" state.counter bsym_table sr t'' in
     begin match t'' with
     | BTYP_polyrecord (es,s,v) ->
       begin try 
@@ -2004,13 +2005,14 @@ print_endline ("AST_name(BTYP_inst): "^name^"=T<"^string_of_int i^">");
               bind_type' state bsym_table env' rsground sr vt bvs mkenv,
               bind_type' state bsym_table env' rsground sr vct bvs mkenv
             in
+            let vt = rt vt in
+            let vct = rt vct in 
 (*
           print_endline ("-----+++>>");
           print_endline ("Bound polymorphic ctor arg type = " ^ sbt bsym_table vt); 
           print_endline ("Bound polymorphic ctor result type = " ^ sbt bsym_table vct); 
           print_endline ("Bound polymorphic union value type = " ^ sbt bsym_table ut);
           print_endline ("-----+++>>");
-
 *)
 (*
 print_endline ("Unification of result type with union value type\n");

src/compiler/flx_bind/flx_bind_interfaces.ml

@@ -84,6 +84,7 @@ let bind_interface (state:bbind_state_t) bsym_table = function
         sbt bsym_table t
       )
       else
+        let t = Flx_beta.beta_reduce "Bind Interfaces" state.counter bsym_table sr t in
         BIFACE_export_type (sr, t, cpp_name)
 
   | sr, IFACE_export_struct (name), parent ->
@@ -123,7 +124,11 @@ let bind_interface (state:bbind_state_t) bsym_table = function
       let env = Flx_lookup.build_env state.lookup_state bsym_table parent in
       let bt t = Flx_lookup.bind_type state.lookup_state bsym_table env sr t in
       let breqs = bind_reqs bt state bsym_table env sr reqs in
+      let breqs = List.rev (
+        List.map (fun (idx, ts) -> 
+           idx, List.map (Flx_beta.beta_reduce "Global beta reduction" state.counter bsym_table  sr) ts
+        ) breqs (* breqs *)
+      ) (* rev *)
+      in
       BIFACE_export_requirement (sr,breqs)
 
-
-

src/compiler/flx_bind/flx_bind_state.ml

@@ -51,9 +51,3 @@ let make_bind_state syms sym_table =
     bbind_state = bbind_state;
   }
 
-
-let set_nominal_typedefs (state:bind_state_t) = state.lookup_state.Flx_lookup_state.treat_typedefs_as_structural <- false
-let set_structural_typedefs (state:bind_state_t) = state.lookup_state.Flx_lookup_state.treat_typedefs_as_structural <-true 
-let get_structural_typedefs (state:bind_state_t) = state.lookup_state.Flx_lookup_state.treat_typedefs_as_structural
-
-

src/compiler/flx_bind/flx_bind_symbol.ml

@@ -826,58 +826,26 @@ print_endline (" &&&&&& SYMDEF_instance calling BBIND_SYMBOL");
     add_bsym None (bbdcl_newtype (bvs, t))
 
   | SYMDEF_type_function (ks,t) -> 
-(*
-print_endline ("Binding type function .. " ^ sym.Flx_sym.id);
-*)
-    if get_structural_typedefs state then begin 
-(*
-print_endline ("NOT **** Adding typefun " ^ sym.Flx_sym.id ^"<"^ si symbol_index ^ "> = " ^ Flx_print.string_of_typecode t ^ " to bsym_table");
-*)
-       () 
-    end else begin
-(*
-print_endline ("TRYING TO BIND typefun " ^ sym.Flx_sym.id ^"<"^ si symbol_index ^ "> = " ^ Flx_print.string_of_typecode t );
-*)
     let t = 
       try bt t 
       with exn ->
         print_endline ("BINDING typedef " ^ sym.Flx_sym.id ^"<"^ si symbol_index ^ "> = " ^ 
           Flx_print.string_of_typecode t ^ "  FAILED with " ^ Printexc.to_string exn);
         raise exn
     in
-(*
-print_endline ("Adding typefun " ^ sym.Flx_sym.id ^"<"^ si symbol_index ^ "> = " ^ Flx_btype.st t ^ " to bsym_table");
-*)
     let bks = List.map (fun (name, index, srt) -> name, index, Flx_kind.bind_sortcode srt) ks in
     add_bsym None (bbdcl_type_function (bks, t))
-   end
 
 
   | SYMDEF_type_alias t ->
-(*
-print_endline ("Binding type alias .. ");
-*)
-    if get_structural_typedefs state then begin 
-(*
-print_endline ("NOT **** Adding typedef " ^ sym.Flx_sym.id ^"<"^ si symbol_index ^ "> = " ^ Flx_print.string_of_typecode t ^ " to bsym_table");
-*)
-       () 
-    end else begin
-(*
-print_endline ("TRYING TO BIND typedef " ^ sym.Flx_sym.id ^"<"^ si symbol_index ^ "> = " ^ Flx_print.string_of_typecode t );
-*)
     let t = 
       try bt t 
       with exn ->
         print_endline ("BINDING typedef " ^ sym.Flx_sym.id ^"<"^ si symbol_index ^ "> = " ^ 
           Flx_print.string_of_typecode t ^ "  FAILED with " ^ Printexc.to_string exn);
         raise exn
     in
-(*
-print_endline ("Adding typedef " ^ sym.Flx_sym.id ^"<"^ si symbol_index ^ "> = " ^ Flx_btype.st t ^ " to bsym_table");
-*)
-    add_bsym None (bbdcl_nominal_type_alias (bvs, t))
-   end
+    add_bsym None (bbdcl_type_alias (bvs, t))
 
   | SYMDEF_instance_type t ->
     let t = bt t in