Indexed type function terms like f<k> front and

back but as yet uncoupled.

src/compiler/flx_bind/flx_bind_type.ml

@@ -593,8 +593,10 @@ print_endline ("Binding `TYP_name " ^s^ " via params to " ^ sbt bsym_table t);
      btyp_instancetype sr
 
   | `TYP_name _
+  | `TYP_fname _
   | `TYP_case_tag _
   | `TYP_lookup _
+  | `TYP_flookup _
   | `TYP_callback _ as x ->
       let x =
         match qualified_name_of_typecode x with

src/compiler/flx_bind/flx_guess_meta_type.ml

@@ -44,6 +44,28 @@ TODO!
 (* THIS IS USED in Flx_bind_type_index to bind a btyp_inst during the
 replacement of a typedef with a type expression which is NOT mapped to a structural or
 nominal type alias BBDCL entry by a common index, in other words, a simple typedef
+
+FIXME: it's impossible now to guess the type of a typedef without examining
+the typedef. So it follows you cannot guess the type of a reference to the
+typedef, i.e. the name without lookup. The RIGHT solution here is, if we can't
+be sure, to put a kind variable in.
+
+Later, the kind variable can be fixed by kind inference. In particular when
+we actually lookup a typedef, we can calculate the correct kind from the
+definition.
+
+The problem is, Felix has to provide a bound kind for every type reference,
+so routines which do NOT do lookup but need the kind have one.
+
+During binding, all the types are bound first, so there is now a place
+where the kind variables can be computed (when the refered to type
+is bound, the kind variable for that type can be computed.
+
+So .. this code WILL BREAK in advanced scenarios. So the way forward
+is simple: get rid of the routine entirely, and just always put a kind
+variable. After binding, do a kind unification pass to replace them
+with the correct kinds.
+
 *) 
 let rec guess_metatype sr t : kind =
   match t with
@@ -88,6 +110,14 @@ print_endline (" ** BOUND mata type is " ^ Flx_kind.sk bmt);
   | `TYP_index _
   | `TYP_lookup _ 
   | `TYP_name _ -> (* print_endline "A type name?"; *) kind_type
+
+  (* FIXME: these two cases are OBVIOUSLY WRONG *)
+  (* but without lookup there's no way to fix it *)
+  | `TYP_fname _ -> (* print_endline "A type name?"; *) kind_type
+  | `TYP_flookup _ -> (* print_endline "A type name?"; *) kind_type
+
+
+
   | `TYP_as _ -> print_endline "A type as (recursion)?"; assert false
 
   (* usually actual types! *)

src/compiler/flx_bind/flx_lookup.ml

@@ -130,6 +130,9 @@ and lookup_qn_in_env2'
   print_endline ("[lookup_qn_in_env2] qn=" ^ string_of_qualified_name qn);
   *)
   match qn with
+  | `AST_fname _ -> assert false (* only for type names *)
+  | `AST_flookup _ -> assert false (* only for type names *)
+
   | `AST_callback (sr,qn) -> clierrx "[flx_bind/flx_lookup.ml:317: E83] " sr "[lookup_qn_in_env2] qualified name is callback [not implemented yet]"
 (*
   | `AST_void sr -> clierrx "[flx_bind/flx_lookup.ml:318: E84] " sr "[lookup_qn_in_env2] qualified name is void"

src/compiler/flx_bind/flx_lookup_qn_with_sig.ml

@@ -317,6 +317,9 @@ print_endline ("LOOKUP 1: varname " ^ si index);
       )
     end
 
+  | `AST_fname (sr,name,ts) -> assert false (* only for type names .. *)
+  | `AST_flookup _ -> assert false (* only for type names .. *)
+
   | `AST_name (sr,name,ts) ->
 (*
 print_endline ("lookup_qn_with_sig' [AST_name] " ^ name ^ ", sigs=" ^ catmap "," (sbt bsym_table) signs);

src/compiler/flx_bind/flx_lookup_type_name_itdws.ml

@@ -50,7 +50,6 @@ print_endline ("Handle type " ^ name ^ " ... bound type is " ^ sbt bsym_table t)
 
   | SYMDEF_type_function _ -> assert false
 
-  | SYMDEF_type_function _ 
   | SYMDEF_type_alias _ ->
 (*
 print_endline ("Lookup_type_name_in_table_dirs_with_sig: Handle type alias " ^ name ^ " ... binding type index " ^ string_of_int index);

src/compiler/flx_bind/flx_lookup_type_qn_with_sig.ml

@@ -24,6 +24,11 @@ open Flx_btype_subst
 open Flx_bid
 open Flx_name_lookup
 
+(* NOTE: how the heck can a type name have a sig? Sure, there are
+type functions, which take types as arguments, but we never do
+overloading or inference on type functions. At least not yet.
+*)
+
 let debug = false
 
 let rec lookup_type_qn_with_sig'
@@ -59,7 +64,7 @@ let lookup_type_qn_with_sig'
   bsym_table
   sra srn
   env rs
-  qn
+  (qn:Flx_ast.qualified_name_t)
   signs
 in
 
@@ -135,7 +140,15 @@ print_endline ("Lookup type qn with sig, name = " ^ string_of_qualified_name qn)
   in
   match qn with
   | `AST_callback (sr,qn) ->
-    failwith "[lookup_qn_with_sig] Callbacks not implemented yet"
+    failwith "[lookup_type_qn_with_sig] Callbacks not implemented yet"
+
+  | `AST_fname _ ->
+    failwith "[lookup_type_qn_with_sig] `AST_fname not implemented yet"
+
+  | `AST_flookup _ ->
+    failwith "[lookup_type_qn_with_sig] `AST_flookup not implemented yet"
+
+
 
 (*
   | `AST_void _ -> clierrx "[flx_bind/flx_lookup.ml:2796: E142] " sra "qualified-name is void"

src/compiler/flx_core/flx_ast.ml

@@ -23,9 +23,11 @@ type qualified_name_t =
   [
   (* | `AST_void of Flx_srcref.t *)
   | `AST_name of Flx_srcref.t * Flx_id.t * typecode_t list
+  | `AST_fname of Flx_srcref.t * Flx_id.t * kindcode_t list
   | `AST_case_tag of Flx_srcref.t * int
   | `AST_typed_case of Flx_srcref.t * int * typecode_t
   | `AST_lookup of Flx_srcref.t * (expr_t * Flx_id.t * typecode_t list)
+  | `AST_flookup of Flx_srcref.t * (expr_t * Flx_id.t * kindcode_t list)
   | `AST_index of Flx_srcref.t * string * index_t
   | `AST_callback of Flx_srcref.t * qualified_name_t
   ]
@@ -35,9 +37,11 @@ and suffixed_name_t =
   [
   (* | `AST_void of Flx_srcref.t *)
   | `AST_name of Flx_srcref.t * Flx_id.t * typecode_t list
+  | `AST_fname of Flx_srcref.t * Flx_id.t * kindcode_t list
   | `AST_case_tag of Flx_srcref.t * int
   | `AST_typed_case of Flx_srcref.t * int * typecode_t
   | `AST_lookup of Flx_srcref.t * (expr_t * Flx_id.t * typecode_t list)
+  | `AST_flookup of Flx_srcref.t * (expr_t * Flx_id.t * kindcode_t list)
   | `AST_index of Flx_srcref.t * string * index_t
   | `AST_callback of Flx_srcref.t * qualified_name_t
   | `AST_suffix of Flx_srcref.t * (qualified_name_t * typecode_t)
@@ -78,8 +82,10 @@ and typecode_t = [
   | `TYP_label 
   | `TYP_void of Flx_srcref.t                   (** void type *)
   | `TYP_name of Flx_srcref.t * Flx_id.t * typecode_t list
+  | `TYP_fname of Flx_srcref.t * Flx_id.t * kindcode_t list
   | `TYP_case_tag of Flx_srcref.t * int
   | `TYP_lookup of Flx_srcref.t * (expr_t * Flx_id.t * typecode_t list)
+  | `TYP_flookup of Flx_srcref.t * (expr_t * Flx_id.t * kindcode_t list)
   | `TYP_index of Flx_srcref.t * string * index_t
   | `TYP_callback of Flx_srcref.t * qualified_name_t
   | `TYP_suffix of Flx_srcref.t * (qualified_name_t * typecode_t)
@@ -745,9 +751,11 @@ type compilation_unit_t = statement_t list
 let src_of_qualified_name (e : qualified_name_t) = match e with
   (* | `AST_void s *)
   | `AST_name  (s,_,_)
+  | `AST_fname  (s,_,_)
   | `AST_case_tag (s,_)
   | `AST_typed_case (s,_,_)
   | `AST_lookup (s,_)
+  | `AST_flookup (s,_)
   | `AST_index (s,_,_)
   | `AST_callback (s,_)
   -> s
@@ -761,6 +769,7 @@ let src_of_typecode = function
   | `TYP_typeop (s,_,_,_)
   | `TYP_void s
   | `TYP_name  (s,_,_)
+  | `TYP_fname  (s,_,_)
   | `TYP_case_tag (s,_)
   | `TYP_lookup (s,_)
   | `TYP_index (s,_,_)
@@ -1016,8 +1025,10 @@ let typecode_of_qualified_name = function
   | `AST_void sr -> `TYP_void sr
 *)
   | `AST_name (sr,name,ts) -> `TYP_name (sr,name,ts)
+  | `AST_fname (sr,name,ts) -> `TYP_fname (sr,name,ts)
   | `AST_case_tag (sr,v) -> `TYP_case_tag (sr,v)
   | `AST_lookup (sr,(e,name,ts)) -> `TYP_lookup (sr,(e,name,ts))
+  | `AST_flookup (sr,(e,name,ts)) -> `TYP_flookup (sr,(e,name,ts))
   | `AST_index (sr,name,index) -> `TYP_index (sr,name,index)
   | `AST_callback (sr,name) -> `TYP_callback (sr,name)
 
@@ -1026,8 +1037,10 @@ let qualified_name_of_typecode = function
   | `TYP_void sr -> Some (`AST_void sr)
 *)
   | `TYP_name (sr,name,ts) -> Some (`AST_name (sr,name,ts))
+  | `TYP_fname (sr,name,ts) -> Some (`AST_fname (sr,name,ts))
   | `TYP_case_tag (sr,v) -> Some (`AST_case_tag (sr,v))
   | `TYP_lookup (sr,(e,name,ts)) -> Some (`AST_lookup (sr,(e,name,ts)))
+  | `TYP_flookup (sr,(e,name,ts)) -> Some (`AST_flookup (sr,(e,name,ts)))
   | `TYP_index (sr,name,index) -> Some (`AST_index (sr,name,index))
   | `TYP_callback (sr,name) -> Some (`AST_callback (sr,name))
   | _ -> None

src/compiler/flx_core/flx_maps.ml

@@ -13,7 +13,9 @@ let map_type f (t:typecode_t):typecode_t = match t with
   | `TYP_rptsum (i,t) -> `TYP_rptsum (f i, f t)
   | `TYP_compactrptsum (i,t) -> `TYP_compactrptsum (f i, f t)
   | `TYP_name (sr,name,ts) -> `TYP_name (sr, name, List.map f ts)
+  | `TYP_fname (sr,name,ks) -> `TYP_fname (sr, name, ks)
   | `TYP_lookup (sr,(e,name,ts)) -> `TYP_lookup (sr, (e, name, List.map f ts))
+  | `TYP_flookup (sr,(e,name,ks)) -> `TYP_flookup (sr, (e, name, ks))
   | `TYP_suffix (sr,(qn,t)) -> `TYP_suffix (sr, (qn, f t))
   | `TYP_tuple ts -> `TYP_tuple (List.map f ts)
   | `TYP_intersect ts -> `TYP_intersect (List.map f ts)

src/compiler/flx_core/flx_print.ml

@@ -50,6 +50,12 @@ let rec string_of_qualified_name (n:qualified_name_t) =
         if List.length ts = 0 then ""
         else "[" ^ catmap ", " string_of_typecode ts ^ "]"
       )
+  | `AST_fname (_,name,ts) ->
+      string_of_id name ^
+      (
+        if List.length ts = 0 then ""
+        else "[" ^ catmap ", " str_of_kindcode ts ^ "]"
+      )
   | `AST_case_tag (_,v) -> "case " ^ si v
   | `AST_typed_case (_,v,t) ->
     "(case " ^ si v ^
@@ -61,6 +67,12 @@ let rec string_of_qualified_name (n:qualified_name_t) =
         if length ts = 0 then "" else
         "[" ^ catmap ", " string_of_typecode ts ^ "]"
       )
+  | `AST_flookup (_,(e,name, ts)) ->
+      "(" ^ se e ^ ")::" ^ string_of_id name ^
+      (
+        if length ts = 0 then "" else
+        "[" ^ catmap ", " str_of_kindcode ts ^ "]"
+      )
   | `AST_callback (_,name) -> "callback " ^string_of_qualified_name name
 
 and string_of_suffixed_name (n:suffixed_name_t) =
@@ -393,6 +405,12 @@ and st prec tc : string =
           if List.length ts = 0 then ""
           else "[" ^ catmap ", " string_of_typecode ts ^ "]"
         )
+    | `TYP_fname (_,name,ts) ->
+        0, string_of_id name ^
+        (
+          if List.length ts = 0 then ""
+          else "<" ^ catmap ", " str_of_kindcode ts ^ ">"
+        )
     | `TYP_case_tag (_,v) -> 0, "case " ^ si v
 
     | `TYP_lookup (_,(e,name, ts)) ->
@@ -402,6 +420,13 @@ and st prec tc : string =
           if length ts = 0 then "" else
           "[" ^ catmap ", " string_of_typecode ts ^ "]"
         )
+    | `TYP_flookup (_,(e,name, ts)) ->
+        0,
+        "(" ^ string_of_expr e ^ ")::" ^ string_of_id name ^
+        (
+          if length ts = 0 then "" else
+          "<" ^ catmap ", " str_of_kindcode ts ^ ">"
+        )
     | `TYP_callback (_,name) -> 0, "callback " ^ string_of_qualified_name name
 
     | `TYP_suffix (_,(name,suf)) ->

src/compiler/flx_core/flx_typing2.ml

@@ -27,6 +27,8 @@ let expr_of_qualified_name e =
   | `AST_lookup (sr,(e,name,ts)) -> `EXPR_lookup (sr,(e,name,ts))
   | `AST_index (sr,name,index) -> `EXPR_index (sr,name,index)
   | `AST_callback (sr,name) -> `EXPR_callback (sr,name)
+  | `AST_fname _  -> assert false (* fname and flookup are only for types *)
+  | `AST_flookup _  -> assert false (* fname and flookup are only for types *)
 
 let expr_of_suffixed_name e =
   match e with
@@ -38,6 +40,8 @@ let expr_of_suffixed_name e =
   | `AST_index (sr,name,index) -> `EXPR_index (sr,name,index)
   | `AST_callback (sr,name) -> `EXPR_callback (sr,name)
   | `AST_suffix (sr,(name,ts)) -> `EXPR_suffix (sr,(name,ts))
+  | `AST_fname _  -> assert false (* fname and flookup are only for types *)
+  | `AST_flookup _  -> assert false (* fname and flookup are only for types *)
 
 let type_of_list = function
   | [x] -> x
@@ -71,8 +75,10 @@ let string_of_type_name (t:typecode_t) = match t with
   | `TYP_ellipsis -> "`TYP_ellipsis"
   | `TYP_void _ -> "`TYP_void"
   | `TYP_name _ -> " `TYP_name"
+  | `TYP_fname _ -> " `TYP_fname"
   | `TYP_case_tag _ -> " `TYP_case_tag"
   | `TYP_lookup _ -> " `TYP_lookup"
+  | `TYP_flookup _ -> " `TYP_flookup"
   | `TYP_index _ -> " `TYP_index"
   | `TYP_callback _ -> " `TYP_callback"
   | `TYP_suffix _ -> " `TYP_suffix"

src/compiler/flx_desugar/flx_sex2flx.ml

@@ -88,6 +88,7 @@ and xtype_t sr x : typecode_t =
 (*
 print_endline ("sex2flx:type] " ^ Sex_print.string_of_sex x);
 *)
+  let ki x = kind_of_sex sr x in
   let ti t = xtype_t sr t in
   let ex e = xexpr_t sr e in
   match x with
@@ -108,14 +109,33 @@ print_endline ("sex2flx:type] " ^ Sex_print.string_of_sex x);
   | Id "typ_none" -> 
     `TYP_none
 
-  | Lst [Id "ast_name"; sr; id; Lst ts] -> 
-    let ts = map ti ts in
+  | Lst [Id "ast_name"; sr; id; indices] -> 
     let id = xid id in
-    `TYP_name (xsr sr, id, ts)
+    begin match indices with
+    | Lst []  -> `TYP_name (xsr sr, id, [])
+    | Lst [Id "texprs"; Lst ts] ->
+      let ts = map ti ts in
+      `TYP_name (xsr sr, id, ts)
+    | Lst [Id "kexprs"; Lst ks] ->
+      let ks = map ki ks in
+      `TYP_fname (xsr sr, id, ks)
+    | x -> err x "ast_name(typename)"
+    end
 
-  | Lst [Id "ast_lookup";  Lst [e; Str s; Lst ts]] -> 
+  | Lst [Id "ast_lookup";  Lst [e; Str s; indices]] -> 
    (* this is a hack should just process qualified names .. *)
-    `TYP_lookup (sr,(ex e, s,map ti ts))
+    begin match indices with
+    | Lst []  ->
+      `TYP_lookup (sr,(ex e, s, []))
+    | Lst [Id "texprs"; Lst ts] ->
+      let ts = map ti ts in
+      `TYP_lookup (sr,(ex e, s, ts))
+    | Lst [Id "kexprs"; Lst ks] ->
+      let ks = map ki ks in
+      `TYP_flookup (sr,(ex e, s, ks))
+    | x -> err x "ast_lookup(typename)"
+    end
+
   | Lst [Id "typ_typeset"; sr; Lst ts] ->
     `TYP_typeset (List.map ti ts)
 
@@ -336,10 +356,10 @@ print_endline ("sex2flx:expr] " ^ Sex_print.string_of_sex x);
   | Lst [Id "ast_vsprintf";  sr; Str s] -> `EXPR_vsprintf (xsr sr, s)
   | Lst [Id "ast_interpolate";  sr; Str s] -> `EXPR_interpolate (xsr sr, s)
   | Lst [Id "ast_noexpand"; sr; e] -> `EXPR_noexpand (xsr sr,ex e)
-  | Lst [Id "ast_name"; sr; id; Lst ts] -> 
-(*
-print_endline ("Processing ast_name "^xid id^" in xexpr");
-*)
+  | Lst [Id "ast_name"; sr; id; Lst []] -> 
+    let id = xid id in
+    `EXPR_name (xsr sr, id, [])
+  | Lst [Id "ast_name"; sr; id; Lst [Id "texprs"; Lst ts]] -> 
     let ts = map ti ts in
     let id = xid id in
     `EXPR_name (xsr sr, id, ts)
@@ -355,7 +375,10 @@ print_endline ("Processing ast_name "^xid id^" in xexpr");
   | Lst [Id "ast_projection";  sr; Int i; t] -> `EXPR_projection (xsr sr,ii i,ti t)
   | Lst [Id "ast_identity_function"; sr; t] -> `EXPR_identity_function (xsr sr, ti t)
   | Lst [Id "ast_array_projection";  sr; index; t] -> `EXPR_array_projection (xsr sr,xexpr_t (xsr sr) index,ti t)
-  | Lst [Id "ast_lookup";  Lst [e; Str s; Lst ts]] -> `EXPR_lookup (sr,(ex e, s,map ti ts))
+  | Lst [Id "ast_lookup";  Lst [e; Str s; Lst []]] -> 
+    `EXPR_lookup (sr,(ex e, s, []))
+  | Lst [Id "ast_lookup";  Lst [e; Str s; Lst [Id "texprs"; Lst ts]]] -> 
+    `EXPR_lookup (sr,(ex e, s,map ti ts))
 
   | Lst [Id "ast_apply";  sr; Lst [e1; e2]] -> 
     let sr = xsr sr in