Rework binding to get type functions working.

src/compiler/flx_bind/flx_bbind.ml

@@ -309,7 +309,7 @@ print_endline ("[flx_bbind] bind_symbol " ^ sym.Flx_sym.id ^ "??");
           print_endline ("Type of function " ^ string_of_int i ^ " is " ^ sbt bsym_table ft);
 *)
           match ft with
-          | BTYP_function (BTYP_inst (dom,[],_),BTYP_inst (cod,[],_)) ->
+          | BTYP_function (BTYP_inst (`Nominal, dom,[],_),BTYP_inst (`Nominal, cod,[],_)) ->
 (*
             print_endline ("Domain index = " ^ string_of_int dom ^ " codomain index = " ^ string_of_int cod);
 *)
@@ -353,7 +353,7 @@ print_endline ("[flx_bbind] bind_symbol " ^ sym.Flx_sym.id ^ "??");
           print_endline ("Type of function " ^ string_of_int i ^ " is " ^ sbt bsym_table ft);
 *)
           match ft with
-          | BTYP_function (BTYP_inst (dom,[],_),BTYP_inst (cod,[],_)) ->
+          | BTYP_function (BTYP_inst (`Nominal, dom,[],_),BTYP_inst (`Nominal, cod,[],_)) ->
 (*
             print_endline ("Domain index = " ^ string_of_int dom ^ " codomain index = " ^ string_of_int cod);
 *)

src/compiler/flx_bind/flx_bind_apply.ml

@@ -243,7 +243,7 @@ print_endline ("  WITH TYPE " ^ Flx_print.sbt bsym_table (snd result));
             raise exn
           end
         (* NOTE THIS CASE HASN'T BEEN CHECKED FOR POLYMORPHISM YET *)
-        | BTYP_inst (i,ts',_) ->
+        | BTYP_inst (_,i,ts',_) ->
 (*
           print_endline (" ** Bound LHS of application and a nominal type");
 *)

src/compiler/flx_bind/flx_bind_circuit.ml

@@ -27,7 +27,7 @@ type device_descr_t = string * pin_descr_t list
 
 let cal_channel bsym_table (schannel,ischannel,oschannel) sr typ : int * string * Flx_btype.t =
   match typ with
-  | BTYP_inst (i,[t],_) ->
+  | BTYP_inst (`Nominal,i,[t],_) ->
      let direction = match i with
      | _ when i = schannel -> "io"
      | _ when i = oschannel -> "output"
@@ -64,14 +64,14 @@ let bind_circuit bsym_table (state : Flx_bexe_state.bexe_state_t) sr be (cs:Flx_
 print_endline ("Continuation starting function '_continuation_start' is " ^ Flx_print.sbe bsym_table start_continuation);
 *)
     let continuation_type_index = lun "cont" in
-    let continuation_type = Flx_btype.btyp_inst (continuation_type_index, [], Flx_kind.KIND_type) in 
+    let continuation_type = Flx_btype.btyp_inst (`Nominal, continuation_type_index, [], Flx_kind.KIND_type) in 
     let lmk name =
       let signs = [continuation_type] in
       let ts = [] in
       luf name ts signs
     in
     let fthread_type_index = lun "fthread" in
-    let fthread_type = Flx_btype.btyp_inst (fthread_type_index, [], Flx_kind.KIND_type) in
+    let fthread_type = Flx_btype.btyp_inst (`Nominal, fthread_type_index, [], Flx_kind.KIND_type) in
     let mk_thread = lmk "mk_thread" in
 (*
 print_endline ("Fthread constructor function 'mk_thread' is " ^ Flx_print.sbe bsym_table mk_thread);
@@ -395,7 +395,7 @@ print_endline ("SPawn Fthread svc call '_svc_fthread' is " ^ Flx_print.sbe bsym_
           vt,nw
       in
       let name = "pin_" ^ string_of_int index in
-      let stype = Flx_btype.btyp_inst (schannel, [vt], Flx_kind.KIND_type) in
+      let stype = Flx_btype.btyp_inst (`Nominal, schannel, [vt], Flx_kind.KIND_type) in
       let bbdcl = Flx_bbdcl.bbdcl_val (state.parent_vs,stype,`Val) in
       let bsym = Flx_bsym.create ~sr name bbdcl in 
       Flx_bsym_table.add bsym_table index state.parent bsym;
@@ -449,7 +449,7 @@ print_endline ("SPawn Fthread svc call '_svc_fthread' is " ^ Flx_print.sbe bsym_
           (* the type expected, ischannel,oschannel, or schannel, is NOT
             the actual variable type which is always just schannel
           *)
-          let ct = Flx_btype.btyp_inst (cast_schannelindex,[vt], Flx_kind.KIND_type) in
+          let ct = Flx_btype.btyp_inst (`Nominal, cast_schannelindex,[vt], Flx_kind.KIND_type) in
           let component = pin,(Flx_bexpr.bexpr_varname ct (vindex, parent_ts)) in
           component::acc
         )

src/compiler/flx_bind/flx_bind_expression.ml

@@ -46,6 +46,7 @@ let type_of_literal inner_bind_type state bsym_table env sr v =
   bt
 
 let handle_map sr (f,ft) (a,at) =
+(*
     let t =
       match ft with
       | BTYP_function (d,c) ->
@@ -65,6 +66,7 @@ let handle_map sr (f,ft) (a,at) =
       applies ((map[i] f) a) where map[i] denotes
       the map function generated for data structure i
       *)
+*)
       failwith "MAP NOT IMPLEMENTED"
 
 
@@ -245,13 +247,7 @@ print_endline ("flx_lookup.`EXPR_callback.bexpr_closure");
     be (Flx_strr.apl2 sri "pow" [a; b])
 
   | `EXPR_coercion (sr,(x,t)) ->
-(*
-print_endline ("Trying to bind explicit coercion" ^ string_of_expr e);
-*)
     let (e',t') as x' = be x in
-(*
-print_endline ("explicit coercioni argument bound " ^ string_of_expr x);
-*)
     let t'' = bt sr t in
     Flx_coerce.coerce state bsym_table sr x' t''
 
@@ -583,7 +579,7 @@ assert false
     let (e',t) as e  = be e in
     begin match t with
       | BTYP_type_var (_,k) 
-      | BTYP_inst (_,_,k)
+      | BTYP_inst (_,_,_,k)
         when Flx_kind.kind_ge2 Flx_kind.KIND_compactlinear k
         -> () 
       | BTYP_unitsum _
@@ -594,14 +590,14 @@ assert false
       | BTYP_tuple []
         -> ()
 
-      | BTYP_inst (i,_,_) when 
+      | BTYP_inst (_,i,_,_) when 
         begin match hfind "lookup" state.sym_table i with
         | { Flx_sym.symdef=SYMDEF_union _} -> true
         | _ -> false
         end  -> ()
       | BTYP_typeop (_,_,Flx_kind.KIND_compactlinear)
       | BTYP_type_apply (BTYP_type_function (_,Flx_kind.KIND_compactlinear,_),_)
-      | BTYP_type_apply (BTYP_inst(_,_,KIND_function (_,Flx_kind.KIND_compactlinear)),_)
+      | BTYP_type_apply (BTYP_inst(_,_,_,KIND_function (_,Flx_kind.KIND_compactlinear)),_)
         -> ()
       | _ -> clierrx "[Flx_bind_expression:595: E182] " sr ("Argument of caseno must be sum or union type, got " ^ sbt bsym_table t)
     end
@@ -1786,7 +1782,7 @@ print_endline ("`EXPR_variant_subtype_match_coercion");
       let ut = rt ut in
       let ut = match ut with | BTYP_uniq t -> t | t -> t in
       begin match ut with
-      | BTYP_inst (i,ts',_) ->
+      | BTYP_inst (_,i,ts',_) ->
         begin match hfind "lookup" state.sym_table i with
         | { Flx_sym.id=id; symdef=SYMDEF_union ls } ->
           let vidx =
@@ -1945,7 +1941,7 @@ print_endline ("match ho ctor, binding expr = " ^ string_of_expr e);
       print_endline ("ctor_arg: Constructor to extract: " ^ name ^ "[" ^ catmap "," string_of_typecode ts ^ "]"); 
 *)
       begin match ut with
-      | BTYP_inst (i,ts',_) ->
+      | BTYP_inst (_,i,ts',_) ->
         begin match hfind "lookup" state.sym_table i with
         | { Flx_sym.id=id; symdef=SYMDEF_union ls } ->
           let _,vs,_  = find_split_vs state.sym_table bsym_table i in

src/compiler/flx_bind/flx_bind_record_proj.ml

@@ -118,7 +118,7 @@ match unfold "flx_lookup" ta with
   end
 
 (* Instance type, possibly struct or cstruct.  *)
-| BTYP_inst (i,ts',_) ->
+| BTYP_inst (_,i,ts',_) ->
   begin try
   handle_field_name state bsym_table build_env env rs 
     be bt cal_apply bind_type' mkenv 
@@ -127,12 +127,12 @@ match unfold "flx_lookup" ta with
   end
 
 (* pointer to instance *)
-| BTYP_ptr (mode,(BTYP_inst (i,ts',_) as r),[]) ->
+| BTYP_ptr (mode,(BTYP_inst (_,i,ts',_) as r),[]) ->
 (* NOTE: This may not work, unfold doesn't penetrate into a struct!
 However, if the struct is complete but polymorphic, it should work
 by unfolding the ts values ..
 *)
-  begin match unfold "flx_bind_record_proj" r with | BTYP_inst (i,ts',_) ->
+  begin match unfold "flx_bind_record_proj" r with | BTYP_inst (_,i,ts',_) ->
     begin try
     handle_field_name state bsym_table build_env env rs 
       be bt cal_apply bind_type' mkenv 

src/compiler/flx_bind/flx_bind_symbol.ml

@@ -737,7 +737,7 @@ print_endline ("Flx_bbind: Adding type of index " ^ si symbol_index ^ " to cache
   | SYMDEF_union (cs) ->
     if state.print_flag then
       print_endline ("//Binding union " ^ si symbol_index ^ " --> " ^ sym.Flx_sym.id);
-    let ut = btyp_inst (
+    let ut = btyp_inst ( `Nominal,
       symbol_index, 
       List.map (fun (s,i,k) -> btyp_type_var (i,k)) bvs, 
       Flx_kind.KIND_type) 
@@ -807,7 +807,7 @@ print_endline (" &&&&&& SYMDEF_instance calling BBIND_SYMBOL");
 
   | SYMDEF_type_function (ks,t) -> 
 (*
-print_endline ("Binding type function .. ");
+print_endline ("Binding type function .. " ^ sym.Flx_sym.id);
 *)
     if get_structural_typedefs state then begin 
 (*
@@ -828,7 +828,8 @@ print_endline ("TRYING TO BIND typefun " ^ sym.Flx_sym.id ^"<"^ si symbol_index
 (*
 print_endline ("Adding typefun " ^ sym.Flx_sym.id ^"<"^ si symbol_index ^ "> = " ^ Flx_btype.st t ^ " to bsym_table");
 *)
-    add_bsym None (bbdcl_nominal_type_alias (bvs, t))
+    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
 
 

src/compiler/flx_bind/flx_bind_type.ml

@@ -224,7 +224,7 @@ print_endline ("Bound variant = " ^ Flx_btype.st t);
         match t with
         (* reverse the fields so the second one with a given name takes precedence *)
         | BTYP_record (fields) -> new_fields := List.rev fields @ (!new_fields)
-        | BTYP_inst (i,ts,_) -> (* should only happen during typedef binding in nominal type mode *)
+        | BTYP_inst (_,i,ts,_) -> (* should only happen during typedef binding in nominal type mode *)
           begin try
             let bsym = Flx_bsym_table.find bsym_table i in
             let bbdcl = Flx_bsym.bbdcl bsym in
@@ -579,7 +579,7 @@ print_endline ("Binding `TYP_name " ^s^ " via params to " ^ sbt bsym_table t);
             (fun (s,i,mt) -> btyp_type_var (i, Flx_btype.bmt "Flx_bind_type1" mt))
             (fst sym.Flx_sym.vs)
           in
-          btyp_inst (index,ts,Flx_kind.KIND_type)
+          btyp_inst (`Nominal,index,ts,Flx_kind.KIND_type)
       | SYMDEF_typevar _ ->
           print_endline ("Synthetic name "^name ^ " is a typevar!");
           syserr sr ("Synthetic name "^name ^ " is a typevar!")