5.16.1. Header

Start data section to src/flx_parse.mly[1 /33 ] Next Last
     1: %{
     2: (* parser header *)
     3: exception EndOfInput
     4: open Flx_ast
     5: open Flx_mtypes1
     6: open Flx_typing
     7: open Flx_typing2
     8: open Flx_srcref
     9: open Flx_print
    10: open Flx_charset
    11: open Flx_exceptions
    12: open List
    13: open Flx_util
    14: 
    15: let list_last lst = List.hd (List.rev lst)
    16: let generated = ("Generated by Parser",0,0,0,0)
    17: let parse_error (s : string) =
    18:   raise (Flx_exceptions.ParseError "Error parsing input")
    19: 
    20: (* model infix operator as function call *)
    21: let apl2 (sri:srcref) (fn : string) (tup:expr_t list) =
    22:   let sr = rslist tup in
    23:   `AST_apply
    24:   (
    25:     sr,
    26:     (
    27:       `AST_name (slift sri,fn,[]),
    28:       `AST_tuple (sr,tup)
    29:     )
    30:   )
    31: 
    32: (* model prefix operator as function call *)
    33: let apl (sri:srcref) (fn : string) (arg:expr_t):expr_t =
    34:   let sr = src_of_expr arg in
    35:   `AST_apply
    36:   (
    37:     sr,
    38:     (
    39:       `AST_name (slift sri, fn,[]),
    40:       arg
    41:     )
    42:   )
    43: 
    44: (* model unary operator as procedure call *)
    45: let call1 (op:string) (sr:range_srcref) (sri:srcref) l =
    46:   `AST_call
    47:   (
    48:     sr, `AST_name (slift sri, op,[]), l
    49:   )
    50: 
    51: (* model unary operator as procedure call *)
    52: let call2 (op:string) (sr:range_srcref) (sri:srcref) l r =
    53:   `AST_call
    54:   (
    55:     sr,
    56:     `AST_name (slift sri, op,[]),
    57:     `AST_tuple(sr,[l;r])
    58:   )
    59: 
    60: let mkcurry sr name vs args return_type kind body =
    61:   `AST_curry (sr,name,vs,args,return_type,kind,body)
    62: 
    63: (* handle curried type functions *)
    64: (* type functions cannot have constraints yet .. so just ignore them *)
    65: let mktypefun sr name vs args return_type body =
    66:   let argtyp t = match t with
    67:     | [] -> failwith "Lambda abstraction requires nonunit parameter"
    68:     | [x] -> x
    69:     | x -> `TYP_type_tuple x
    70:   in
    71:   let body =
    72:     let p = ref (List.rev args) in
    73:     let r = ref return_type in
    74:     let b = ref body in
    75:     while !p <> [] do
    76:       let arg = List.hd !p in
    77:       p := List.tl !p;
    78:       b := `TYP_typefun (fst arg, !r, !b);
    79:       r := `TYP_function(argtyp (List.map snd (fst arg)),!r)
    80:     done;
    81:     !b
    82:   in
    83:   `AST_type_alias
    84:   (
    85:     sr,
    86:     name,
    87:     vs,
    88:     body
    89:   )
    90: 
    91: %}
    92: 
End data section to src/flx_parse.mly[1]