5.12. Compile time exceptions

Start ocaml section to src/flx_exceptions.ml[1 /1 ]
     1: # 5480 "./lpsrc/flx_types.ipk"
     2: 
     3: # 5480 "./lpsrc/flx_types.ipk"
     4: open Flx_ast
     5: # 5480 "./lpsrc/flx_types.ipk"
     6: open Flx_types
     7: # 5480 "./lpsrc/flx_types.ipk"
     8: exception RDP_match_fail of range_srcref * range_srcref * string
     9: # 5480 "./lpsrc/flx_types.ipk"
    10: exception RDP_alternatives_exhausted of range_srcref * string
    11: # 5480 "./lpsrc/flx_types.ipk"
    12: exception SyntaxError of string
    13: # 5480 "./lpsrc/flx_types.ipk"
    14: exception ParseError of string
    15: # 5480 "./lpsrc/flx_types.ipk"
    16: exception LexError of string
    17: # 5480 "./lpsrc/flx_types.ipk"
    18: exception TokenError of string
    19: # 5480 "./lpsrc/flx_types.ipk"
    20: exception ClientErrorn of range_srcref list * string
    21: # 5480 "./lpsrc/flx_types.ipk"
    22: exception ClientError of range_srcref * string
    23: # 5480 "./lpsrc/flx_types.ipk"
    24: exception ClientError2 of range_srcref * range_srcref * string
    25: # 5480 "./lpsrc/flx_types.ipk"
    26: exception SystemError of range_srcref * string
    27: # 5480 "./lpsrc/flx_types.ipk"
    28: exception Exit of int
    29: # 5480 "./lpsrc/flx_types.ipk"
    30: exception Bad_recursion
    31: # 5480 "./lpsrc/flx_types.ipk"
    32: exception Expr_recursion of expr_t
    33: # 5480 "./lpsrc/flx_types.ipk"
    34: exception Free_fixpoint of btypecode_t
    35: # 5480 "./lpsrc/flx_types.ipk"
    36: exception Unresolved_return of range_srcref * string
    37: # 5480 "./lpsrc/flx_types.ipk"
    38: 
    39: let clierrn srs s = raise (ClientErrorn (srs,s))
    40: let clierr2 sr sr2 s = raise (ClientError2 (sr,sr2,s))
    41: let clierr sr s = raise (ClientError (sr,s))
    42: let syserr sr s = raise (SystemError (sr,s))
    43: let catch s f = try f() with _ -> failwith s
    44: let rdp_match_fail sr1 sr2 s = raise (RDP_match_fail (sr1,sr2,s))
    45: let rdp_alternatives_exhausted sr s = raise (RDP_alternatives_exhausted (sr,s))
    46: 
End ocaml section to src/flx_exceptions.ml[1]
Start ocaml section to src/flx_exceptions.mli[1 /1 ]
     1: # 5491 "./lpsrc/flx_types.ipk"
     2: 
     3: # 5491 "./lpsrc/flx_types.ipk"
     4: open Flx_ast
     5: # 5491 "./lpsrc/flx_types.ipk"
     6: open Flx_types
     7: # 5491 "./lpsrc/flx_types.ipk"
     8: exception RDP_match_fail of range_srcref * range_srcref * string
     9: # 5491 "./lpsrc/flx_types.ipk"
    10: exception RDP_alternatives_exhausted of range_srcref * string
    11: # 5491 "./lpsrc/flx_types.ipk"
    12: exception SyntaxError of string
    13: # 5491 "./lpsrc/flx_types.ipk"
    14: exception ParseError of string
    15: # 5491 "./lpsrc/flx_types.ipk"
    16: exception LexError of string
    17: # 5491 "./lpsrc/flx_types.ipk"
    18: exception TokenError of string
    19: # 5491 "./lpsrc/flx_types.ipk"
    20: exception ClientErrorn of range_srcref list * string
    21: # 5491 "./lpsrc/flx_types.ipk"
    22: exception ClientError of range_srcref * string
    23: # 5491 "./lpsrc/flx_types.ipk"
    24: exception ClientError2 of range_srcref * range_srcref * string
    25: # 5491 "./lpsrc/flx_types.ipk"
    26: exception SystemError of range_srcref * string
    27: # 5491 "./lpsrc/flx_types.ipk"
    28: exception Exit of int
    29: # 5491 "./lpsrc/flx_types.ipk"
    30: exception Bad_recursion
    31: # 5491 "./lpsrc/flx_types.ipk"
    32: exception Expr_recursion of expr_t
    33: # 5491 "./lpsrc/flx_types.ipk"
    34: exception Free_fixpoint of btypecode_t
    35: # 5491 "./lpsrc/flx_types.ipk"
    36: exception Unresolved_return of range_srcref * string
    37: # 5491 "./lpsrc/flx_types.ipk"
    38: 
    39: val clierrn: range_srcref list -> string -> 'a
    40: val clierr: range_srcref -> string -> 'a
    41: val clierr2: range_srcref -> range_srcref -> string -> 'a
    42: val syserr: range_srcref -> string -> 'a
    43: val catch: string -> (unit -> 'a) -> 'a
    44: val rdp_match_fail: range_srcref -> range_srcref -> string -> 'a
    45: val rdp_alternatives_exhausted: range_srcref -> string -> 'a
    46: 
End ocaml section to src/flx_exceptions.mli[1]
Start ocaml section to src/flx_typing.mli[1 /1 ]
     1: # 5502 "./lpsrc/flx_types.ipk"
     2: open Flx_ast
     3: open Flx_types
     4: exception UnificationError of btypecode_t * btypecode_t
     5: val flx_bool : typecode_t
     6: val flx_bbool : btypecode_t
     7: 
     8: val is_unitsum: btypecode_t -> bool
     9: val int_of_unitsum : btypecode_t -> int
    10: val all_units0 : b0typecode_t list -> bool
    11: val all_units : btypecode_t list -> bool
    12: val all_voids : btypecode_t list -> bool
    13: 
    14: val cmp_literal: literal_t -> literal_t -> bool
    15: val cmp_tbexpr: tbexpr_t -> tbexpr_t -> bool
    16: 
    17: val type_of_argtypes :
    18:   typecode_t list ->
    19:   typecode_t
    20: 
    21: val funparamtype : 'a * 'b * 't -> 't
    22: 
    23: val typeoflist:
    24:   btypecode_t list ->
    25:   btypecode_t
    26: 
    27: val typeofbps_traint: bparams_t -> btypecode_t list
    28: val typeofbps: bparameter_t list-> btypecode_t list
    29: 
    30: val lift:
    31:   btypecode_t -> btypecode_t
    32: 
    33: val lower:
    34:   btypecode_t -> btypecode_t
    35: 
    36: val qualified_name_of_expr:
    37:   expr_t -> qualified_name_t
    38: 
    39: module FuntypeSet : Set.S with type elt = typecode_t
    40: 
    41: module FunInstSet : Set.S with type elt = bid_t * btypecode_t list
    42: 
    43: val sye: entry_kind_t -> int
    44: 
End ocaml section to src/flx_typing.mli[1]
Start ocaml section to src/flx_typing.ml[1 /1 ]
     1: # 5547 "./lpsrc/flx_types.ipk"
     2: open Flx_ast
     3: open Flx_types
     4: open Flx_srcref
     5: open List
     6: 
     7: let sye {base_sym=i} = i
     8: 
     9: let all_voids ls =
    10:     fold_left
    11:     (fun acc t -> acc && (t = `BTYP_void))
    12:     true ls
    13: 
    14: let all_units0 ls =
    15:     fold_left
    16:     (fun acc t -> acc && (t = `BTYP_tuple []))
    17:     true ls
    18: 
    19: let all_units ls = all_units0 ls
    20: 
    21: let is_unitsum (t:btypecode_t) = match t with
    22:   | `BTYP_unitsum _ -> true
    23:   | `BTYP_sum ls ->  all_units ls
    24:   | _ -> false
    25: 
    26: 
    27: let int_of_unitsum t = match t with
    28:   | `BTYP_void -> 0
    29:   | `BTYP_tuple [] -> 1
    30:   | `BTYP_unitsum k -> k
    31:   | `BTYP_sum [] ->  0
    32:   | `BTYP_sum ls ->
    33:     if all_units ls then length ls
    34:     else raise Not_found
    35: 
    36:   | _ -> raise Not_found
    37: 
    38: exception UnificationError of btypecode_t * btypecode_t
    39: 
    40: (* unbound type *)
    41: let type_of_argtypes ls = match ls with
    42:  | [x] -> x
    43:  | _ -> `TYP_tuple ls
    44: 
    45: let funparamtype (_,_,t) = t
    46: 
    47: module FuntypeSet = Set.Make(
    48:   struct type t=typecode_t let compare = compare end
    49: )
    50: 
    51: module FunInstSet = Set.Make(
    52:   struct
    53:     type t= bid_t * btypecode_t list
    54:     let compare = compare
    55:   end
    56: )
    57: 
    58: 
    59: let typeofbps bps =
    60:   map
    61:   (fun {ptyp=t; pkind=k} ->
    62:     match k with
    63:     | `PRef -> `BTYP_pointer t
    64:     | `PFun -> `BTYP_function (`BTYP_tuple [],t)
    65:     | _ ->t
    66:   )
    67:   bps
    68: 
    69: let typeofbps_traint (bps,_) = typeofbps bps
    70: 
    71: (* bound type! *)
    72: let typeoflist typlist = match typlist with
    73:   | [] -> `BTYP_tuple []
    74:   | [t] -> t
    75:   | h :: t ->
    76:     try
    77:       iter
    78:       (fun t -> if t <> h then raise Not_found)
    79:       t;
    80:       `BTYP_array (h,`BTYP_unitsum (length typlist))
    81:     with Not_found ->
    82:       `BTYP_tuple typlist
    83: 
    84: let lift t = t
    85: let lower t = t (* CHANGE THIS WHEN ABSTRACT TYPES IMPLEMENTED *)
    86: 
    87: let flx_bool = `TYP_unitsum 2
    88: let flx_bbool = `BTYP_unitsum 2
    89: 
    90: let qualified_name_of_expr e =
    91:   match e with
    92:   | #qualified_name_t as x -> x
    93:   | _ ->
    94:     failwith
    95:     (
    96:       "Qualified name expected in\n" ^
    97:       short_string_of_src (src_of_expr e)
    98:     )
    99: 
   100: (* Note floats are equal iff they're textually identical,
   101:    we don't make any assumptions about the target machine FP model.
   102:    OTOH, int comparisons are infinite precision, for the same
   103:    int kind, even if the underlying machine model is not
   104: *)
   105: 
   106: let cmp_literal (l:literal_t) (l':literal_t) = match l, l' with
   107:   | `AST_int (a,b), `AST_int (a',b') -> a = a' && Big_int.eq_big_int b b'
   108:   | `AST_float (a,b), `AST_float (a',b') -> a = a' && b = b'
   109:   | `AST_string s, `AST_string s' -> s = s'
   110:   | `AST_cstring s, `AST_cstring s' -> s = s'
   111:   | `AST_wstring s, `AST_wstring s' -> s = s'
   112:   | `AST_ustring s, `AST_ustring s' -> s = s'
   113:   | _ -> false
   114: 
   115: (* Note that we don't bother comparing the type subterm:
   116:   this had better be equal for equal expressions: the value
   117:   is merely the cached result of a synthetic context
   118:   independent type calculation
   119: *)
   120: 
   121: let rec cmp_tbexpr (a,_) (b,_) =
   122:   let ecmp = cmp_tbexpr in match a,b with
   123:   | `BEXPR_parse (e,ii), `BEXPR_parse (e',ii') ->
   124:     ecmp e e' && ii = ii'
   125: 
   126:   | `BEXPR_coerce (e,t),`BEXPR_coerce (e',t') ->
   127:     (* not really right .. *)
   128:     ecmp e e'
   129: 
   130:   | `BEXPR_record ts,`BEXPR_record ts' ->
   131:     length ts = length ts' &&
   132:     let rcmp (s,t) (s',t') = compare s s' in
   133:     let ts = sort rcmp ts in
   134:     let ts' = sort rcmp ts' in
   135:     map fst ts = map fst ts' &&
   136:     fold_left2 (fun r a b -> r && a = b) true (map snd ts) (map snd ts')
   137: 
   138:   | `BEXPR_variant (s,e),`BEXPR_variant (s',e') ->
   139:     s = s' && ecmp e e'
   140: 
   141:   | `BEXPR_deref e,`BEXPR_deref e' -> ecmp e e'
   142: 
   143:   | `BEXPR_name (i,ts),`BEXPR_name (i',ts')
   144:   | `BEXPR_ref (i,ts),`BEXPR_ref (i',ts')
   145:   | `BEXPR_closure (i,ts),`BEXPR_closure (i',ts') ->
   146:      i = i' &&
   147:      fold_left2 (fun r a b -> r && a = b) true ts ts'
   148: 
   149:   (* Note any two distinct new expressions are distinct ...
   150:     not sure what is really needed here
   151:   *)
   152:   | `BEXPR_new e1,`BEXPR_new e2 -> false
   153: 
   154:   | `BEXPR_method_closure (e,i,ts),`BEXPR_method_closure (e',i',ts') ->
   155:      ecmp e e' &&
   156:      i = i' &&
   157:      fold_left2 (fun r a b -> r && a = b) true ts ts'
   158: 
   159:   | `BEXPR_literal a,`BEXPR_literal a' -> cmp_literal a a'
   160: 
   161:   | `BEXPR_apply (a,b),`BEXPR_apply (a',b') ->  ecmp a a' && ecmp b b'
   162: 
   163:   | `BEXPR_apply_prim (i,ts,b),`BEXPR_apply_prim (i',ts',b')
   164:   | `BEXPR_apply_direct (i,ts,b),`BEXPR_apply_direct (i',ts',b')
   165:   | `BEXPR_apply_struct (i,ts,b),`BEXPR_apply_struct (i',ts',b')
   166:   | `BEXPR_apply_stack (i,ts,b),`BEXPR_apply_stack (i',ts',b') ->
   167:      i = i' &&
   168:      fold_left2 (fun r a b -> r && a = b) true ts ts' &&
   169:      ecmp b b'
   170: 
   171:   | `BEXPR_apply_method_direct (e,i,ts,b),`BEXPR_apply_method_direct (e',i',ts',b') ->
   172:      ecmp e e' &&
   173:      i = i' &&
   174:      fold_left2 (fun r a b -> r && a = b) true ts ts' &&
   175:      ecmp b b'
   176: 
   177:   | `BEXPR_apply_method_stack (e,i,ts,b),`BEXPR_apply_method_stack (e',i',ts',b') ->
   178:      ecmp e e' &&
   179:      i = i' &&
   180:      fold_left2 (fun r a b -> r && a = b) true ts ts' &&
   181:      ecmp b b'
   182: 
   183:   | `BEXPR_tuple ls,`BEXPR_tuple ls' ->
   184:      fold_left2 (fun r a b -> r && ecmp a b) true ls ls'
   185: 
   186:   | `BEXPR_case_arg (i,e),`BEXPR_case_arg (i',e')
   187: 
   188:   | `BEXPR_match_case (i,e),`BEXPR_match_case (i',e')
   189:   | `BEXPR_get_n (i,e),`BEXPR_get_n (i',e') ->
   190:     i = i' && ecmp e e'
   191: 
   192:   (* this is probably wrong: says x.y = x'.y' iff x = x && y = y',
   193:   however, x.y should unify with a simple value .. oh well..
   194:   hmm .. this should REALLY be a pointer to member, that is,
   195:   an actual projection function
   196:   *)
   197:   | `BEXPR_get_named (i,e),`BEXPR_get_named (i',e') ->
   198:     i = i' && ecmp e e'
   199: 
   200:   | `BEXPR_case_index e,`BEXPR_case_index e' -> ecmp e e'
   201: 
   202:   | `BEXPR_case (i,t),`BEXPR_case (i',t') -> i = i' && t = t'
   203:   | `BEXPR_expr (s,t),`BEXPR_expr (s',t') -> s = s' && t = t'
   204:   | `BEXPR_range_check (e1,e2,e3), `BEXPR_range_check (e1',e2',e3') ->
   205:     ecmp e1 e1' && ecmp e2 e2' && ecmp e3 e3'
   206: 
   207:   | _ -> false
   208: 
   209: 
End ocaml section to src/flx_typing.ml[1]
Start ocaml section to src/flx_typing2.mli[1 /1 ]
     1: # 5757 "./lpsrc/flx_types.ipk"
     2: open Flx_ast
     3: val typecode_of_expr:
     4:   expr_t -> typecode_t
     5: 
     6: val typeof_list:
     7:   typecode_t list -> typecode_t
     8: 
     9: val paramtype:
    10:   (param_kind_t * string * typecode_t) list -> typecode_t
    11: 
    12: 
End ocaml section to src/flx_typing2.mli[1]
Start ocaml section to src/flx_typing2.ml[1 /1 ]
     1: # 5770 "./lpsrc/flx_types.ipk"
     2: open Flx_ast
     3: open Flx_types
     4: open Flx_print
     5: open Flx_srcref
     6: open Flx_exceptions
     7: open List
     8: 
     9: let typeof_list = function
    10:   | [x] -> x
    11:   | x -> `TYP_tuple x
    12: 
    13: let paramtype params =
    14:   let typlist params =
    15:     map
    16:     (fun (k,_,t) ->
    17:       match k with
    18:       | `PRef -> `TYP_pointer t
    19:       | `PFun -> `TYP_function (`TYP_tuple [],t)
    20:       | _ -> t
    21:     )
    22:     params
    23:   in
    24:   typeof_list (typlist params)
    25: 
    26: let all_tunits ts =
    27:   try
    28:     iter
    29:     (fun t ->
    30:       if t <> `TYP_tuple []
    31:       then raise Not_found
    32:     )
    33:     ts;
    34:     true
    35:   with Not_found -> false
    36: 
    37: let rec typecode_of_expr (e:expr_t) :typecode_t =
    38:   let te e = typecode_of_expr e in
    39:   match e with
    40:   | `AST_case (sr,e1,ls,e2) -> `TYP_case (te e1, ls, te e2)
    41:   | `AST_name (_,"TYPE",[]) -> `TYP_type
    42:   | `AST_name (sr,"_",[]) -> `AST_patany sr
    43:   | `AST_ellipsis _ -> `TYP_ellipsis
    44:   | #suffixed_name_t as x -> (x:>typecode_t)
    45:   | `AST_tuple (sr,ls) ->
    46:     `TYP_type_tuple (map te ls)
    47:   | `AST_record_type (sr,es) -> `TYP_record es
    48:   | `AST_variant_type (sr,es) -> `TYP_variant es
    49: 
    50:   | `AST_product (_,ts) -> `TYP_tuple (map te ts)
    51:   | `AST_setintersection (_,ts) -> `TYP_setintersection (map te ts)
    52:   | `AST_setunion (_,ts) -> `TYP_setunion (map te ts)
    53:   | `AST_arrow (_,(a,b)) -> `TYP_function (te a, te b)
    54:   | `AST_longarrow (_,(a,b)) -> `TYP_cfunction (te a, te b)
    55:   | `AST_superscript (_,(a,b)) -> `TYP_array (te a, te b)
    56:   | `AST_lvalue (sr,e) -> `TYP_lvalue (te e)
    57:   | `AST_ref (sr,e) -> `TYP_pointer (te e)
    58:   | `AST_sum (_,ts) ->
    59:     let ts = map te ts in
    60:     if all_tunits ts then
    61:       `TYP_unitsum (length ts)
    62:     else
    63:       `TYP_sum ts
    64: 
    65:   | `AST_lift (sr,e) -> `TYP_lift (te e)
    66: 
    67:   | `AST_orlist (sr,ts) ->
    68:     begin match ts with
    69:     | [] -> assert false
    70:     | [x] -> assert false
    71:     | h :: t ->
    72:       let llor = `AST_name (sr,"lor",[]) in
    73:       fold_left (fun sum t -> `TYP_apply (llor,`TYP_type_tuple[sum; te t])) (te h) t
    74:     end
    75: 
    76:   | `AST_andlist (sr,ts) ->
    77:     begin match ts with
    78:     | [] -> assert false
    79:     | [x] -> assert false
    80:     | h :: t ->
    81:       let lland = `AST_name (sr,"land",[]) in
    82:       fold_left (fun sum t -> `TYP_apply (lland,`TYP_type_tuple [sum; te t])) (te h) t
    83:     end
    84: 
    85:   | `AST_typeof (_,e) -> `TYP_typeof e
    86:   | `AST_as (sr,(t,x)) -> `TYP_as (te t,x)
    87: 
    88:   | `AST_literal (sr,`AST_int (enc,v)) ->
    89:     if enc <> "int"
    90:     then
    91:       clierr sr
    92:       (
    93:         "Only plain integer can be used as a type, code= '" ^
    94:         enc ^
    95:         "'"
    96:       )
    97:     else
    98:     let v = ref
    99:       begin try Big_int.int_of_big_int v
   100:       with _ -> clierr sr "Integer used as type out of range"
   101:       end
   102:     in
   103:       if !v <0 then clierr sr "Negative int not allowed as type"
   104:       else if !v = 0 then ((`AST_void sr) :> typecode_t)
   105:       else if !v = 1 then `TYP_tuple[]
   106:       else `TYP_unitsum !v
   107: 
   108:   (* NOTE SPECIAL NAME HANDLING HACKS!! *)
   109:   | `AST_apply(sr,(e1,e2)) ->
   110:     begin match e1 with
   111:     | `AST_name (_,name,[]) ->
   112:       let name' = name ^ "          " (* 10 chars *) in
   113:       if name = "typeof" then `TYP_typeof e2
   114:       else let arg = typecode_of_expr e2 in
   115:       if name = "_isin" then
   116:       begin
   117:         match arg with
   118:         | `TYP_type_tuple [memt; sett] ->
   119:            `TYP_isin (memt, sett)
   120:         | _ ->
   121:           (* this can be fixed by taking projections but I can't be bothered atm *)
   122:           failwith
   123:            "Implementation limitation, 'isin' operator requires two explicit arguments"
   124:       end
   125:       else if name = "typesetof" then
   126:       begin
   127:         match arg with
   128:         | `TYP_type_tuple ls -> `TYP_typeset ls
   129:         | x -> `TYP_typeset [x]
   130:       end
   131:       else if name = "compl" then `TYP_dual arg
   132:       else if String.sub name' 0 5 = "proj_"
   133:       then
   134:         begin
   135:           let acc = ref 0 in
   136:           for i = 5 to String.length name - 1 do
   137:           if name.[i] <= '9' && name.[i] >='0'
   138:           then acc := 10 * !acc + Char.code (name.[i]) - Char.code '0'
   139:           else
   140:             clierr sr
   141:             (
   142:               "Digits expected in name '" ^ name ^ "' in\n" ^
   143:               short_string_of_src sr
   144:             )
   145:           done;
   146:           `TYP_proj (!acc, arg)
   147:          end
   148: 
   149:       else if String.sub name' 0 9 = "case_arg_"
   150:       then
   151:         begin
   152:           let acc = ref 0 in
   153:           for i = 9 to String.length name - 1 do
   154:           if name.[i] <= '9' && name.[i] >='0'
   155:           then acc := 10 * !acc + Char.code (name.[i]) - Char.code '0'
   156:           else
   157:             clierr sr
   158:             (
   159:               "Digits expected in name '" ^ name ^ "' in\n" ^
   160:               short_string_of_src sr
   161:             )
   162:           done;
   163:           `TYP_case_arg (!acc, arg)
   164:          end
   165:       else
   166:         `TYP_apply (typecode_of_expr e1,arg)
   167: 
   168:     | _ ->
   169:       `TYP_apply (typecode_of_expr e1,typecode_of_expr e2)
   170:     end
   171: 
   172:   | `AST_lambda (sr,(vs,paramss,ret,body)) ->
   173:      begin match paramss with
   174:      | [params,traint] ->
   175:        (* constraint is ignored for now!! *)
   176:        begin match body with
   177:        | [`AST_fun_return (_,e)] ->
   178:          begin
   179:            try
   180:              let t = typecode_of_expr e in
   181:              match paramss,ret with
   182:              (* special case, allows {t} to mean 1 -> t *)
   183:              | [[],None],`TYP_none ->
   184:               `TYP_function (`TYP_tuple [],t)
   185:              | _ ->
   186:              let params = map (fun (x,y,z)-> y,z) params in
   187:              `TYP_typefun
   188:              (
   189:                params,
   190:                ret,
   191:                t
   192:              )
   193:            with _ ->
   194:              clierr sr
   195:              "Type lambda must return type expression"
   196:          end
   197: 
   198:        | _ ->
   199:          clierr sr
   200:          "Type lambda must just be 'return type_expr'"
   201:        end
   202:      | _ ->
   203:        clierr sr
   204:        "Type lambda only allowed one argument (arity=1)"
   205:      end
   206: 
   207:   | `AST_type_match (sr,(e,ps)) ->
   208:     `TYP_type_match (e,ps)
   209: 
   210:   | `AST_noexpand (sr,e) -> te e
   211: 
   212:   | `AST_patvar _ as e -> e
   213:   | `AST_patany _ as e -> e
   214:   | #expr_t ->
   215:     let sr = src_of_expr e in
   216:     clierr sr ("Type expression expected, got " ^ string_of_expr e)
   217: 
End ocaml section to src/flx_typing2.ml[1]