├── .merlin ├── .gitignore ├── Makefile ├── .vscode └── tasks.json ├── src ├── haxeAst.ml └── main.ml └── OCamlMakefile /.merlin: -------------------------------------------------------------------------------- 1 | S src/** 2 | B src/** 3 | PKG compiler-libs 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /._d 2 | /main.exe 3 | /test.ml 4 | /Test.hx 5 | *.cmi 6 | *.cmo 7 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | SOURCES = src/haxeAst.ml src/main.ml 2 | RESULT = main 3 | PACKS = compiler-libs 4 | LIBS = ocamlcommon ocamloptcomp 5 | OCAMLFLAGS = -color never 6 | 7 | all: byte-code 8 | ./main.exe test.ml 9 | 10 | -include OCamlMakefile 11 | -------------------------------------------------------------------------------- /.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "2.0.0", 3 | "tasks": [ 4 | { 5 | "label": "Build", 6 | "type": "shell", 7 | "command": "make", 8 | "group": { 9 | "kind": "build", 10 | "isDefault": true 11 | } 12 | } 13 | ] 14 | } -------------------------------------------------------------------------------- /src/haxeAst.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | let indent_string = "\t" 3 | 4 | type field_kind = 5 | | FVar 6 | | FFinal 7 | 8 | type type_hint = 9 | | TPath of string list * string * type_hint list 10 | | TAnonymous of (field_kind * string * type_hint) list 11 | | TFunction of type_hint list * type_hint 12 | | TTuple of type_hint list 13 | 14 | type constant = 15 | | CString of string 16 | | CInt of int32 17 | | CFloat of string 18 | 19 | type expr = 20 | | EIdent of string 21 | | EConst of constant 22 | | EBlock of expr list 23 | | EVar of string * type_hint option * expr option 24 | | EIf of expr * expr * expr option 25 | | ECall of expr * expr list 26 | | EObjectDecl of (string * expr) list 27 | | EField of expr * string 28 | | EBinop of binop * expr * expr 29 | | EUnop of unop * expr 30 | | EFunction of func 31 | | ESwitch of expr * case list 32 | | ETry of expr * catch list 33 | | ETuple of expr list 34 | | ETupleAccess of expr * int 35 | | EWhile of expr * expr 36 | | EFor of string * expr * expr 37 | | EInterval of expr * expr 38 | | EThrow of expr 39 | 40 | and case = pattern * expr option * expr 41 | 42 | and catch = string * type_hint * expr 43 | 44 | and pattern = 45 | | PAny 46 | | PVar of string 47 | | PAlias of string * pattern 48 | | PTuple of pattern list 49 | | PEnumCtor of string * pattern list 50 | | PFields of (string * pattern) list 51 | | POr of pattern * pattern 52 | | PArray of pattern list 53 | | PConst of expr 54 | 55 | and func = { 56 | args : (string * type_hint) list; 57 | ret : type_hint; 58 | expr : expr; 59 | } 60 | 61 | and binop = 62 | | OpAssign 63 | | OpEq 64 | | OpNeq 65 | | OpGt 66 | | OpGte 67 | | OpLt 68 | | OpLte 69 | | OpAnd 70 | | OpOr 71 | | OpAdd 72 | | OpSub 73 | | OpMul 74 | | OpDiv 75 | | OpMod 76 | | OpBitAnd 77 | | OpBitOr 78 | | OpBitXor 79 | | OpShiftLeft 80 | | OpShiftRight 81 | | OpShiftRightUnsigned 82 | 83 | and unop = 84 | | OpNot 85 | | OpBitNeg 86 | | OpIncr 87 | | OpDecr 88 | 89 | type type_decl = { 90 | td_name : string; 91 | td_kind : type_decl_kind; 92 | } 93 | 94 | and type_decl_kind = 95 | | TDEnum of (string * (string * type_hint) list) list 96 | | TDTypedef of type_hint 97 | | TDClass of class_field list 98 | 99 | and class_field = { 100 | cf_name : string; 101 | cf_expr : expr; 102 | } 103 | 104 | let rec s_type_hint ?(format_anon=false) t = 105 | match t with 106 | | TPath (sl, s, pl) -> 107 | (if sl = [] then s else (String.concat "." sl) ^ "." ^ s) ^ 108 | (if pl = [] then "" else sprintf "<%s>" (String.concat ", " (List.map (fun t -> s_type_hint t) pl))) 109 | | TAnonymous fields -> 110 | let fields = List.map (fun (k,n,t) -> 111 | sprintf "%s %s:%s;" (match k with FVar -> "var" | FFinal -> "final") n (s_type_hint t) 112 | ) fields in 113 | if format_anon then 114 | sprintf "{\n%s%s\n}" indent_string (String.concat ("\n" ^ indent_string) fields) 115 | else 116 | sprintf "{%s}" (String.concat " " fields) 117 | | TFunction (args,ret) -> 118 | (match args with 119 | | [t] -> sprintf "%s->%s" (s_type_hint t) (s_type_hint ret) 120 | | _ -> sprintf "(%s)->%s" (String.concat "," (List.map (fun t -> s_type_hint t) args)) (s_type_hint ret) 121 | ) 122 | | TTuple tl -> 123 | let name = sprintf "Tuple%d" (List.length tl) in 124 | s_type_hint (TPath ([],name,tl)) 125 | 126 | let s_enum name ctors = 127 | let ctors = List.map (fun (n,args) -> 128 | if args = [] then n ^ ";" 129 | else sprintf "%s(%s);" n (String.concat "," (List.map (fun (n,t) -> sprintf "%s:%s" n (s_type_hint t)) args)) 130 | ) ctors in 131 | sprintf "enum %s {\n%s%s\n}" name indent_string (String.concat ("\n" ^ indent_string) ctors) 132 | 133 | let s_typedef name t = 134 | sprintf "typedef %s = %s;" name (s_type_hint ~format_anon:true t) 135 | 136 | let s_const = function 137 | | CString s -> sprintf "%S" s 138 | | CInt i -> sprintf "%ld" i 139 | | CFloat f -> f 140 | 141 | let s_binop = function 142 | | OpAssign -> "=" 143 | | OpEq -> "==" 144 | | OpNeq -> "!=" 145 | | OpGt -> ">" 146 | | OpGte -> ">=" 147 | | OpLt -> "<" 148 | | OpLte -> "<=" 149 | | OpAnd -> "&&" 150 | | OpOr -> "||" 151 | | OpAdd -> "+" 152 | | OpSub -> "-" 153 | | OpMul -> "*" 154 | | OpDiv -> "/" 155 | | OpMod -> "%" 156 | | OpBitAnd -> "&" 157 | | OpBitOr -> "|" 158 | | OpBitXor -> "^" 159 | | OpShiftLeft -> "<<" 160 | | OpShiftRight -> ">>" 161 | | OpShiftRightUnsigned -> ">>>" 162 | 163 | let s_unop = function 164 | | OpNot -> "!" 165 | | OpBitNeg -> "~" 166 | | OpIncr -> "++" 167 | | OpDecr -> "--" 168 | 169 | let rec s_expr ind = function 170 | | EIdent s -> s 171 | | EConst c -> s_const c 172 | | EBlock el -> 173 | let ind2 = ind ^ indent_string in 174 | let el = List.map (fun e -> sprintf "%s%s;" ind2 (s_expr ind2 e)) el in 175 | sprintf "{\n%s\n%s}"(String.concat "\n" el) ind 176 | | EVar (n,t,e) -> 177 | let t = match t with None -> "" | Some t -> s_type_hint t in 178 | let e = match e with None -> "" | Some e -> sprintf " = %s" (s_expr ind e) in 179 | sprintf "var %s%s%s" n t e 180 | | EField (e,f) -> (s_expr ind e) ^ "." ^ f 181 | | EIf (econd,ethen,None) -> 182 | sprintf "if (%s) %s" (s_expr ind econd) (s_expr ind ethen) 183 | | EIf (econd,ethen,Some eelse) -> 184 | sprintf "if (%s) %s else %s" (s_expr ind econd) (s_expr ind ethen) (s_expr ind eelse) 185 | | ECall (e, args) -> 186 | sprintf "%s(%s)" (s_expr ind e) (String.concat ", " (List.map (s_expr ind) args)) 187 | | EBinop (op, a, b) -> 188 | sprintf "%s %s %s" (s_expr ind a) (s_binop op) (s_expr ind b) 189 | | EUnop (op, e) -> 190 | sprintf "%s(%s)" (s_unop op) (s_expr ind e) 191 | | EObjectDecl fl -> 192 | let ind2 = ind ^ indent_string in 193 | let fl = List.map (fun (n,e) -> sprintf "%s%s: %s," ind2 n (s_expr ind2 e)) fl in 194 | sprintf "{\n%s\n%s}" (String.concat "\n" fl) ind 195 | | EFunction f -> 196 | let args = List.map (fun (n,t) -> 197 | sprintf "%s:%s" n (s_type_hint t) 198 | ) f.args in 199 | sprintf "function(%s):%s return %s" (String.concat ", " args) (s_type_hint f.ret) (s_expr ind f.expr) 200 | | ESwitch (e,cases) -> 201 | let ind2 = ind ^ indent_string in 202 | let cases = List.map (fun (pat,guard,e) -> 203 | let guard = match guard with None -> "" | Some e -> sprintf " if (%s)" (s_expr ind e) in 204 | sprintf "%scase %s%s: %s;" ind2 (s_pattern pat) guard (s_expr ind2 e) 205 | ) cases in 206 | sprintf "switch %s {\n%s\n%s}" (s_expr ind e) (String.concat "\n" cases) ind 207 | | ETuple el -> 208 | let fl = List.mapi (fun i e -> sprintf "_%d: %s" i (s_expr ind e)) el in 209 | sprintf "{%s}" (String.concat ", " fl) 210 | | ETupleAccess (e,n) -> 211 | s_expr ind (EField (e, sprintf "_%d" n)) 212 | | EThrow e -> "throw " ^ (s_expr ind e) 213 | | EWhile (cond,body) -> 214 | sprintf "while (%s) %s" (s_expr ind cond) (s_expr ind body) 215 | | ETry (body,catches) -> 216 | let catches = List.map (fun (n,t,e) -> sprintf "catch (%s:%s) %s" n (s_type_hint t) (s_expr ind e)) catches in 217 | sprintf "try %s %s" (s_expr ind body) (String.concat " " catches) 218 | | EFor (n,iter,body) -> 219 | let ind2 = ind ^ indent_string in 220 | sprintf "for (%s in %s)\n%s%s" n (s_expr ind iter) ind2 (s_expr ind2 body) 221 | | EInterval (estart,eend) -> 222 | sprintf "%s...%s" (s_expr ind estart) (s_expr ind eend) 223 | 224 | and s_pattern = function 225 | | PAny -> "_" 226 | | PVar s -> s 227 | | PAlias (n, p) -> sprintf "%s = %s" n (s_pattern p) 228 | | PTuple pl -> 229 | let fl = List.mapi (fun i p -> sprintf "_%d" i, p) pl in 230 | s_pattern (PFields fl) 231 | | PFields fl -> 232 | let fl = List.map (fun (n,p) -> sprintf "%s: %s" n (s_pattern p)) fl in 233 | sprintf "{%s}" (String.concat ", " fl) 234 | | PEnumCtor (n,pl) -> 235 | if pl = [] then n 236 | else sprintf "%s(%s)" n (String.concat ", " (List.map s_pattern pl)) 237 | | PArray pl -> sprintf "[%s]" (String.concat ", " (List.map s_pattern pl)) 238 | | POr (a,b) -> sprintf "%s | %s" (s_pattern a) (s_pattern b) 239 | | PConst e -> s_expr "" e 240 | 241 | let s_class name fl = 242 | let fields = List.map (fun f -> 243 | let indent2 = indent_string ^ indent_string in 244 | sprintf "%svar %s = {\n%s%s;\n%s}" indent_string f.cf_name indent2 (s_expr indent2 f.cf_expr) indent_string 245 | ) fl in 246 | sprintf "class %s {\n%s\n}" name (String.concat "\n\n" fields) 247 | 248 | let s_type_decl td = 249 | match td.td_kind with 250 | | TDEnum ctors -> s_enum td.td_name ctors 251 | | TDTypedef t -> s_typedef td.td_name t 252 | | TDClass fl -> s_class td.td_name fl 253 | -------------------------------------------------------------------------------- /src/main.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Asttypes 3 | open Types 4 | open Typedtree 5 | open Path 6 | open HaxeAst 7 | 8 | exception Error of Location.t * string 9 | 10 | let error loc msg = raise (Error (loc, msg)) 11 | 12 | let s_typepath path = 13 | match Path.name path with 14 | | "int" -> "Int" 15 | | "string" -> "String" 16 | | "bool" -> "Bool" 17 | | "unit" -> "Unit" 18 | | other -> other 19 | 20 | let mk_param_ident env param t loc = 21 | let param_name = Ident.name param in 22 | let param_longident = { txt = Longident.Lident param_name; loc = loc} in 23 | { 24 | exp_desc = Texp_ident (Pident param, param_longident, { 25 | val_type = t; 26 | val_kind = Val_reg; 27 | val_loc = loc; 28 | val_attributes = []; 29 | }); 30 | exp_loc = loc; 31 | exp_extra = []; 32 | exp_type = t; 33 | exp_env = env; 34 | exp_attributes = []; 35 | } 36 | 37 | let mk_lets bindings expr = 38 | if bindings = [] then expr else 39 | { 40 | exp_desc = Texp_let (Nonrecursive,bindings,expr); 41 | exp_loc = expr.exp_loc; 42 | exp_extra = []; 43 | exp_type = expr.exp_type; 44 | exp_env = expr.exp_env; 45 | exp_attributes = []; 46 | } 47 | 48 | (* 49 | Functions are represented in OCaml differently than in Haxe: 50 | * they are always curried, meaning function always take single argument, so multi-arg functions are really nested Texp_functions 51 | * functions always use pattern-matching and can several cases 52 | 53 | We traverse the function and rewrite it so: 54 | * argument patterns become let bindings (since haxe doesn't support patterns in arguments) 55 | * multiple cases become a match expression 56 | 57 | In the end this function returns a list of flattened arguments, return type and a modified expression so one 58 | can construct Haxe-looking function from this. 59 | *) 60 | let rewrite_func f env loc = 61 | let rec loop args_acc let_acc (arg_label, param, cases, partial) = 62 | match cases with 63 | | [c] -> (* single-case function - most common *) 64 | let let_acc = { 65 | vb_pat = c.c_lhs; 66 | vb_expr = mk_param_ident env param c.c_lhs.pat_type loc; 67 | vb_attributes = []; 68 | vb_loc = loc; 69 | } :: let_acc in 70 | (match c with 71 | | { c_rhs = { exp_desc = Texp_function f} } -> (* curried function - collect args until we get some real expression *) 72 | loop ((arg_label, param, c.c_lhs.pat_type) :: args_acc) let_acc (f.arg_label, f.param, f.cases, f.partial) 73 | | _ -> (* actual function body after flattening curried functions \o/ *) 74 | (arg_label, param, c.c_lhs.pat_type) :: args_acc, c.c_rhs.exp_type, let_acc, c.c_rhs) 75 | | _ -> (* multi-case function - transform into single-case + match *) 76 | let c = List.hd cases in 77 | let param_ident = mk_param_ident env param c.c_lhs.pat_type loc in 78 | let expr = { 79 | exp_desc = Texp_match (param_ident, cases, [], partial); 80 | exp_loc = loc; 81 | exp_extra = []; 82 | exp_type = c.c_rhs.exp_type; 83 | exp_env = env; 84 | exp_attributes = []; 85 | } in 86 | (arg_label, param, c.c_lhs.pat_type) :: args_acc, c.c_rhs.exp_type, let_acc, expr 87 | in 88 | let args, t, lets, expr = loop [] [] f in 89 | List.rev args, t, mk_lets (List.rev lets) expr 90 | 91 | let rec follow t = 92 | match t.desc with 93 | | Tlink t -> follow t 94 | | _ -> t 95 | 96 | let rec type_expr t = 97 | let t = follow t in 98 | match t.desc with 99 | | Tvar _ -> TPath ([], "T" ^ (string_of_int t.id), []) 100 | | Tarrow (_,a,b,_) -> 101 | let rec loop acc t = 102 | let t = follow t in 103 | match t.desc with 104 | | Tarrow (_,a,b,_) -> loop (a :: acc) b 105 | | _ -> TFunction (List.map type_expr (List.rev acc), type_expr t) 106 | in 107 | loop [a] b 108 | | Ttuple tl -> TTuple (List.map type_expr tl) 109 | | Tconstr (path,pl,_) -> TPath ([], s_typepath path, List.map type_expr pl) 110 | | Tobject _ -> failwith "Tobject" 111 | | Tfield _ -> failwith "Tfield" 112 | | Tnil -> failwith "Tnil" 113 | | Tlink _ -> assert false 114 | | Tsubst _ -> failwith "Tsubst" 115 | | Tvariant _ -> failwith "Tvariant" 116 | | Tunivar _ -> failwith "Tunivar" 117 | | Tpoly (t,pl) -> type_expr t (* TODO *) 118 | | Tpackage _ -> failwith "Tpackage" 119 | 120 | let core_type t = type_expr t.ctyp_type 121 | 122 | let mk_structure label_declarations = 123 | let fields = List.map (fun l -> 124 | (match l.ld_mutable with Immutable -> FFinal | Mutable -> FVar), 125 | l.ld_name.txt, 126 | core_type l.ld_type 127 | ) label_declarations in 128 | TAnonymous fields 129 | 130 | let type_declaration t = 131 | let name = t.typ_name.txt in 132 | let kind = 133 | match t.typ_kind with 134 | | Ttype_variant cl -> 135 | let ctors = List.map (fun c -> 136 | let name = c.cd_name.txt in 137 | let args = 138 | match c.cd_args with 139 | | Cstr_tuple tl -> 140 | let c = ref (Char.code 'a') in 141 | List.map (fun t -> String.make 1 (Char.chr !c), core_type t) tl 142 | | Cstr_record ll -> 143 | [("v", mk_structure ll)] 144 | in 145 | name, args 146 | ) cl in 147 | TDEnum ctors 148 | | Ttype_record ll -> 149 | TDTypedef (mk_structure ll) 150 | | Ttype_open -> 151 | failwith "TODO: Ttype_open" 152 | | Ttype_abstract -> 153 | match t.typ_manifest with 154 | | None -> failwith "TODO: Ttype_abstract" 155 | | Some t -> TDTypedef (core_type t) 156 | in 157 | { td_name = name; td_kind = kind } 158 | 159 | let constant = function 160 | | Const_int v -> EConst (CInt (Int32.of_int v)) 161 | | Const_char v -> EField (EConst (CString (String.make 1 v)), "code") 162 | | Const_string (v,_) -> EConst (CString v) 163 | | Const_float v -> EConst (CFloat v) 164 | | Const_int32 v -> EConst (CInt v) 165 | | Const_int64 v -> failwith "TODO: Const_int64" 166 | | Const_nativeint v -> failwith "TODO: Const_nativeint" 167 | 168 | let rec pattern p = 169 | match p.pat_desc with 170 | | Tpat_any -> PAny 171 | | Tpat_var (_, n) -> PVar n.txt 172 | | Tpat_alias (pat,_,n) -> PAlias (n.txt, pattern pat) 173 | | Tpat_constant c -> PConst (constant c) 174 | | Tpat_tuple pl -> PTuple (List.map pattern pl) 175 | | Tpat_construct (_,ctor,pl) -> 176 | (match ctor.cstr_res.desc with 177 | | Tconstr (p, _, _) when Path.same p Predef.path_list -> 178 | (match ctor.cstr_name, pl with 179 | | "[]", [] -> PEnumCtor ("Tl", []) 180 | | "::", [hd; tl] -> PEnumCtor ("Hd", [pattern hd; pattern tl]) 181 | | _ -> assert false) 182 | | _ -> 183 | PEnumCtor (ctor.cstr_name, List.map pattern pl)) 184 | | Tpat_variant _ -> failwith "TODO: Tpat_variant" 185 | | Tpat_record (fields,_) -> PFields (List.map (fun (_,l,p) -> l.lbl_name, pattern p) fields) 186 | | Tpat_array pl -> PArray (List.map pattern pl) 187 | | Tpat_or (a,b,_) -> POr (pattern a, pattern b) 188 | | Tpat_lazy _ -> failwith "TODO: Tpat_lazy" 189 | 190 | let rec mk_ident p = match p with 191 | | Pident i -> EIdent i.name 192 | | Pdot (p,f,_) -> EField (mk_ident p, f) 193 | | Papply _ -> assert false 194 | 195 | let rec expression e = 196 | let inner e = 197 | match e.exp_desc with 198 | | Texp_ident (path, ident, desc) -> mk_ident path 199 | | Texp_constant c -> constant c 200 | | Texp_let (_,bindings,expr) -> 201 | (match value_bindings bindings with 202 | | [] -> 203 | expression expr 204 | | parts -> 205 | let tail = match expression expr with 206 | | EBlock el -> el 207 | | e -> [ e ] 208 | in 209 | EBlock (parts @ tail); 210 | ) 211 | | Texp_function f -> texp_function (f.arg_label, f.param, f.cases, f.partial) e.exp_env e.exp_loc 212 | | Texp_apply (e, args) -> 213 | texp_apply e args 214 | | Texp_match (expr,cases,exccases,partial) -> 215 | if exccases <> [] then failwith "exception match is not supported"; 216 | switch (expression expr) cases partial 217 | | Texp_try (e,cases) -> 218 | let catches = List.map (fun c -> 219 | assert (c.c_guard = None); 220 | match c.c_lhs.pat_desc with 221 | | Tpat_construct (_,ctor,pl) -> 222 | assert (not (List.exists (fun p -> p.pat_desc <> Tpat_any) pl)); 223 | (* TODO: full path how? *) 224 | "_", TPath ([],ctor.cstr_name,[]), expression c.c_rhs 225 | | _ -> assert false 226 | ) cases in 227 | ETry (expression e, catches) 228 | | Texp_tuple exprs -> 229 | ETuple (List.map expression exprs) 230 | | Texp_construct (_,ctor,args) -> 231 | (match (follow e.exp_type).desc with 232 | | Tconstr (p, _, _) when Path.same p Predef.path_unit -> 233 | EIdent "Unit" 234 | | Tconstr (p, _, _) when Path.same p Predef.path_list -> 235 | (match ctor.cstr_name, args with 236 | | "[]", [] -> EIdent "Tl" 237 | | "::", [hd; tl] -> ECall (EIdent "Hd", [expression hd; expression tl]) 238 | | _ -> assert false) 239 | | _ -> 240 | let ector = EIdent ctor.cstr_name in 241 | if args = [] then ector 242 | else ECall (ector, List.map expression args) 243 | ) 244 | | Texp_variant _ -> failwith "TODO: Texp_variant" 245 | | Texp_record { fields = fields; extended_expression = extends } -> 246 | let fields = Array.to_list fields in 247 | (match extends with 248 | | None -> 249 | let fields = List.map (fun (d,r) -> 250 | let v = match r with 251 | | Kept _ -> assert false 252 | | Overridden (_,e) -> expression e 253 | in 254 | d.lbl_name, v 255 | ) fields in 256 | EObjectDecl fields 257 | | Some expr -> 258 | let fields = List.map (fun (d,r) -> 259 | let v = match r with 260 | | Kept _ -> EField (EIdent "__obj", d.lbl_name) 261 | | Overridden (_,e) -> expression e 262 | in 263 | d.lbl_name, v 264 | ) fields in 265 | EBlock [ 266 | EVar ("__obj", None, Some (expression expr)); 267 | EObjectDecl fields; 268 | ]; 269 | ) 270 | | Texp_field (eobj,_,label) -> 271 | EField (expression eobj, label.lbl_name) 272 | | Texp_setfield (eobj,_,label,evalue) -> 273 | EBinop (OpAssign, EField (expression eobj, label.lbl_name), expression evalue) 274 | | Texp_array _ -> failwith "TODO: Texp_array" 275 | | Texp_ifthenelse (econd,ethen,eelse) -> 276 | EIf (expression econd, expression ethen, match eelse with None -> None | Some e -> Some (expression e)) 277 | | Texp_sequence _ -> assert false 278 | | Texp_while (econd,ebody) -> EWhile (expression econd, expression ebody) 279 | | Texp_for (i,_,estart,eend,dir,ebody) -> 280 | let estart = expression estart in 281 | let eend = expression eend in 282 | let eiter = match dir with 283 | | Upto -> EInterval (estart, EBinop (OpAdd, eend, EConst (CInt (Int32.of_int 1)))) 284 | | Downto -> ECall (EIdent "downto", [estart; eend]) 285 | in 286 | EFor (Ident.name i,eiter,expression ebody) 287 | | Texp_send _ -> EConst (CString "TODO: Texp_send") 288 | | Texp_new _ -> EConst (CString "TODO: Texp_new") 289 | | Texp_instvar _ -> EConst (CString "TODO: Texp_instvar") 290 | | Texp_setinstvar _ -> EConst (CString "TODO: Texp_setinstvar") 291 | | Texp_override _ -> EConst (CString "TODO: Texp_override") 292 | | Texp_letmodule _ -> EConst (CString "TODO: Texp_letmodule") 293 | | Texp_letexception _ -> EConst (CString "TODO: Texp_letexception") 294 | | Texp_assert expr -> ECall (EIdent "assert", [expression expr]) 295 | | Texp_lazy _ -> EConst (CString "TODO: Texp_lazy") 296 | | Texp_object _ -> EConst (CString "TODO: Texp_object") 297 | | Texp_pack _ -> EConst (CString "TODO: Texp_pack") 298 | | Texp_unreachable -> EConst (CString "TODO: Texp_unreachable") 299 | | Texp_extension_constructor _ -> EConst (CString "TODO: Texp_extension_constructor") 300 | in 301 | let rec loop acc e = 302 | match e.exp_desc with 303 | | Texp_sequence (a,b) -> 304 | loop (loop acc a) b 305 | | _ -> inner e :: acc 306 | in 307 | match loop [] e with 308 | | [e] -> e 309 | | el -> EBlock (List.rev el) 310 | 311 | and switch sexpr cases partial = 312 | let cases = List.map (fun c -> 313 | let pattern = pattern c.c_lhs in 314 | let guard = match c.c_guard with None -> None | Some e -> Some (expression e) in 315 | let e = expression c.c_rhs in 316 | pattern, guard, e 317 | ) cases in 318 | let cases = 319 | if partial = Partial then 320 | cases @ [(PAny, None, EThrow (EConst (CString "match failure")))] 321 | else 322 | cases 323 | in 324 | ESwitch (sexpr, cases) 325 | 326 | and texp_function f env loc = 327 | let args, ret_type, expr = rewrite_func f env loc in 328 | let args = List.map (fun (label, param, t) -> 329 | (* assert (label = Nolabel); *) 330 | Ident.name param, type_expr t 331 | ) args in 332 | EFunction { 333 | args = args; 334 | ret = type_expr ret_type; 335 | expr = expression expr; 336 | } 337 | 338 | and texp_apply e args = 339 | let i = ref 0 in 340 | let args = List.map (fun (l, e2) -> 341 | if l <> Nolabel then (* error e.exp_loc *) prerr_endline "Labeled arguments are not yet supported"; 342 | incr i; 343 | match e2 with 344 | | None -> failwith "Arguments without expression are not yet supported"; 345 | | Some e -> expression e 346 | ) args in 347 | let se = expression e in 348 | if !i = (Ctype.arity e.exp_type) then 349 | match se with 350 | | EField (EIdent "Pervasives", field) -> 351 | (match field, args with 352 | | "not", [e] -> EUnop (OpNot, e) 353 | | "&&", [a; b] -> EBinop (OpAnd, a, b) 354 | | "||", [a; b] -> EBinop (OpOr, a, b) 355 | | "==", [a; b] -> EBinop (OpEq, a, b) 356 | | "!=", [a; b] -> EBinop (OpNeq, a, b) 357 | | "=", [a; b] -> ECall (EIdent "structEq", [a; b]) 358 | | "<>", [a; b] -> EUnop (OpNot, ECall (EIdent "structEq", [a; b])) 359 | 360 | | ">", [a; b] -> EBinop (OpGt, a, b) 361 | | "<", [a; b] -> EBinop (OpLt, a, b) 362 | | ">=", [a; b] -> EBinop (OpGte, a, b) 363 | | "<=", [a; b] -> EBinop (OpLte, a, b) 364 | 365 | | ("+" | "+."), [a; b] -> EBinop (OpAdd, a, b) 366 | | ("-" | "-."), [a; b] -> EBinop (OpSub, a, b) 367 | | ("*" | "*."), [a; b] -> EBinop (OpMul, a, b) 368 | | "/", [a; b] -> ECall (EField (EIdent "Std", "int"), [EBinop (OpDiv, a, b)]) 369 | | "/.", [a; b] -> EBinop (OpDiv, a, b) 370 | | "**", [a; b] -> ECall (EField (EIdent "Math", "pow"), [a; b]) 371 | | "mod", [a; b] -> EBinop (OpMod, a, b) 372 | | "land", [a; b] -> EBinop (OpBitAnd, a, b) 373 | | "lor", [a; b] -> EBinop (OpBitOr, a, b) 374 | | "lxor", [a; b] -> EBinop (OpBitXor, a, b) 375 | | "lnot", [e] -> EUnop (OpBitNeg, e) 376 | | "lsl", [a; b] -> EBinop (OpShiftLeft, a, b) 377 | | "asr", [a; b] -> EBinop (OpShiftRight, a, b) 378 | | "lsr", [a; b] -> EBinop (OpShiftRightUnsigned, a, b) 379 | | "^", [a; b] -> EBinop (OpAdd, a, b) 380 | 381 | | "fst", [e] -> ETupleAccess (e, 0) 382 | | "snd", [e] -> ETupleAccess (e, 1) 383 | 384 | (* TODO: analyze whether ref is not used outside of the function and use normal mutable var *) 385 | | "ref", [e] -> ECall (EIdent "ref", [e]) 386 | | ":=", [a; b] -> EBinop (OpAssign, EField (a, "value"), b) 387 | | "!", [e] -> EField (e, "value") 388 | | "incr", [e] -> EUnop (OpIncr, (EField (e, "value"))) 389 | | "decr", [e] -> EUnop (OpDecr, (EField (e, "value"))) 390 | | _ -> ECall (se, args)) 391 | | _ -> 392 | ECall (se, args) 393 | else 394 | ECall (EField (se,"bind"), args) 395 | 396 | and value_binding v = 397 | match v.vb_pat.pat_desc with 398 | | Tpat_any -> None 399 | | Tpat_var (_, name) -> 400 | (match v.vb_expr.exp_desc with 401 | | Texp_ident (p,_,_) when Path.name p = name.txt -> None (* don't generate `var a = a` *) 402 | | _ -> Some (EVar (name.txt, None, (Some (expression v.vb_expr)))) 403 | ) 404 | | Tpat_alias _ -> prerr_endline "TODO: Tpat_alias"; None 405 | | Tpat_constant _ -> prerr_endline "TODO: Tpat_constant"; None 406 | | Tpat_tuple _ -> prerr_endline "TODO: Tpat_tuple"; None 407 | | Tpat_construct (_,ctor,pl) -> 408 | (match (follow v.vb_pat.pat_type).desc with 409 | | Tconstr (p, _, _) when Path.same p Predef.path_unit -> 410 | None 411 | | _ -> 412 | prerr_endline "TODO: Tpat_construct"; None) 413 | | Tpat_variant _ -> prerr_endline "TODO: Tpat_variant"; None 414 | | Tpat_record _ -> prerr_endline "TODO: Tpat_record"; None 415 | | Tpat_array _ -> prerr_endline "TODO: Tpat_array"; None 416 | | Tpat_or _ -> prerr_endline "TODO: Tpat_or"; None 417 | | Tpat_lazy _ -> prerr_endline "TODO: Tpat_lazy"; None 418 | 419 | and value_bindings vl = 420 | let vl = List.map value_binding vl in 421 | List.fold_left (fun acc v -> match v with 422 | | None -> acc 423 | | Some v -> v :: acc 424 | ) [] vl 425 | 426 | type structitem = 427 | | SType of type_decl 428 | | SExpr of expr 429 | 430 | let structure_item item = 431 | match item.str_desc with 432 | | Tstr_type (_, dl) -> 433 | List.map (fun d -> SType (type_declaration d)) dl 434 | | Tstr_value (_, vl) -> 435 | List.map (fun v -> SExpr v) (value_bindings vl) 436 | | Tstr_eval (e,_) -> 437 | [SExpr (expression e)] 438 | | Tstr_primitive _ -> [SExpr (EConst (CString "TODO: Tstr_primitive"))] 439 | | Tstr_typext _ -> [SExpr (EConst (CString "TODO: Tstr_typext"))] 440 | | Tstr_exception _ -> [SExpr (EConst (CString "TODO: Tstr_exception"))] 441 | | Tstr_module _ -> [SExpr (EConst (CString "TODO: Tstr_module"))] 442 | | Tstr_recmodule _ -> [SExpr (EConst (CString "TODO: Tstr_recmodule"))] 443 | | Tstr_modtype _ -> [SExpr (EConst (CString "TODO: Tstr_modtype"))] 444 | | Tstr_open _ -> [SExpr (EConst (CString "TODO: Tstr_open"))] 445 | | Tstr_class _ -> [SExpr (EConst (CString "TODO: Tstr_class"))] 446 | | Tstr_class_type _ -> [SExpr (EConst (CString "TODO: Tstr_class_type"))] 447 | | Tstr_include _ -> [SExpr (EConst (CString "TODO: Tstr_include"))] 448 | | Tstr_attribute _ -> [SExpr (EConst (CString "TODO: Tstr_attribute"))] 449 | 450 | 451 | let implementation imp = 452 | let rec loop acc = function 453 | | [] -> acc 454 | | item :: rest -> 455 | structure_item item @ loop acc rest 456 | in 457 | loop [] imp.str_items 458 | 459 | let tool_name = "ml2hx" 460 | let ppf = Format.err_formatter 461 | 462 | let mk_module_class items = 463 | let fields = List.map (fun e -> { cf_name = "_"; cf_expr = e }) items in 464 | { td_name = "MODULE"; td_kind = TDClass fields } 465 | 466 | let print_ast items = 467 | let decls, fields = List.fold_left (fun (decls, fields) item -> 468 | match item with 469 | | SType t -> t :: decls, fields 470 | | SExpr e -> decls, e :: fields 471 | ) ([], []) items in 472 | let decls = if items = [] then decls else (mk_module_class (List.rev fields)) :: decls in 473 | String.concat "\n\n" (List.map s_type_decl (List.rev decls)) 474 | 475 | let main () = 476 | Clflags.color := Some Never; 477 | Location.register_error_of_exn (function 478 | | Error (loc, err) -> Some (Location.error ~loc err) 479 | | _ -> None); 480 | 481 | (* sorry, i have no idea how to properly use Arg module *) 482 | let file = ref None in 483 | let anon s = 484 | if !file <> None then raise (Arg.Bad "file already specified"); 485 | file := Some s; 486 | in 487 | let incl s = Clflags.include_dirs := s :: !Clflags.include_dirs in 488 | let filename = 489 | try 490 | Arg.parse [ 491 | ("-I", Arg.String incl, "Include directory") 492 | ] anon "Usage: main.exe "; 493 | match !file with Some f -> f | None -> raise (Arg.Bad " is required") 494 | with Arg.Bad msg -> begin 495 | prerr_endline msg; 496 | exit 2 497 | end 498 | in 499 | 500 | let outputprefix = Compenv.output_prefix filename in 501 | let modulename = Compenv.module_of_filename ppf filename outputprefix in 502 | Compmisc.init_path true; 503 | Env.set_unit_name modulename; 504 | let env = Compmisc.initial_env() in 505 | Compilenv.reset modulename; 506 | let items = 507 | try 508 | let ast = Pparse.parse_implementation ppf ~tool_name filename in 509 | let typedtree, _ = Typemod.type_implementation filename outputprefix modulename env ast in 510 | (* Printtyped.implementation ppf typedtree; *) 511 | implementation typedtree 512 | with x -> 513 | Location.report_exception ppf x; 514 | exit 2 515 | in 516 | let out = print_ast items in 517 | let f = open_out (modulename ^ ".hx") in 518 | output_string f out; 519 | close_out f 520 | 521 | let _ = main () 522 | -------------------------------------------------------------------------------- /OCamlMakefile: -------------------------------------------------------------------------------- 1 | ########################################################################### 2 | # OCamlMakefile 3 | # Copyright (C) 1999- Markus Mottl 4 | # 5 | # For updates see: 6 | # http://www.ocaml.info/home/ocaml_sources.html 7 | # 8 | ########################################################################### 9 | 10 | # Modified by damien for .glade.ml compilation 11 | 12 | # Set these variables to the names of the sources to be processed and 13 | # the result variable. Order matters during linkage! 14 | 15 | ifndef SOURCES 16 | SOURCES := foo.ml 17 | endif 18 | export SOURCES 19 | 20 | ifndef RES_CLIB_SUF 21 | RES_CLIB_SUF := _stubs 22 | endif 23 | export RES_CLIB_SUF 24 | 25 | ifndef RESULT 26 | RESULT := foo 27 | endif 28 | export RESULT := $(strip $(RESULT)) 29 | 30 | export LIB_PACK_NAME 31 | 32 | ifndef DOC_FILES 33 | DOC_FILES := $(filter %.mli, $(SOURCES)) 34 | endif 35 | export DOC_FILES 36 | FIRST_DOC_FILE := $(firstword $(DOC_FILES)) 37 | 38 | export BCSUFFIX 39 | export NCSUFFIX 40 | 41 | ifndef TOPSUFFIX 42 | TOPSUFFIX := .top 43 | endif 44 | export TOPSUFFIX 45 | 46 | # Eventually set include- and library-paths, libraries to link, 47 | # additional compilation-, link- and ocamlyacc-flags 48 | # Path- and library information needs not be written with "-I" and such... 49 | # Define THREADS if you need it, otherwise leave it unset (same for 50 | # USE_CAMLP4)! 51 | 52 | export THREADS 53 | export VMTHREADS 54 | export ANNOTATE 55 | export USE_CAMLP4 56 | 57 | export INCDIRS 58 | export LIBDIRS 59 | export EXTLIBDIRS 60 | export RESULTDEPS 61 | export OCAML_DEFAULT_DIRS 62 | 63 | export LIBS 64 | export CLIBS 65 | export CFRAMEWORKS 66 | 67 | export OCAMLFLAGS 68 | export OCAMLNCFLAGS 69 | export OCAMLBCFLAGS 70 | 71 | export OCAMLLDFLAGS 72 | export OCAMLNLDFLAGS 73 | export OCAMLBLDFLAGS 74 | 75 | export OCAMLMKLIB_FLAGS 76 | 77 | ifndef OCAMLCPFLAGS 78 | OCAMLCPFLAGS := a 79 | endif 80 | export OCAMLCPFLAGS 81 | 82 | ifndef DOC_DIR 83 | DOC_DIR := doc 84 | endif 85 | export DOC_DIR 86 | 87 | export PPFLAGS 88 | 89 | export LFLAGS 90 | export YFLAGS 91 | export IDLFLAGS 92 | 93 | export OCAMLDOCFLAGS 94 | 95 | export OCAMLFIND_INSTFLAGS 96 | 97 | export DVIPSFLAGS 98 | 99 | export STATIC 100 | 101 | # Add a list of optional trash files that should be deleted by "make clean" 102 | export TRASH 103 | 104 | ECHO := echo 105 | 106 | ifdef REALLY_QUIET 107 | export REALLY_QUIET 108 | ECHO := true 109 | LFLAGS := $(LFLAGS) -q 110 | YFLAGS := $(YFLAGS) -q 111 | endif 112 | 113 | #################### variables depending on your OCaml-installation 114 | 115 | SYSTEM := $(shell ocamlc -config 2>/dev/null | grep system | sed 's/system: //') 116 | # This may be 117 | # - mingw 118 | # - mingw64 119 | # - win32 120 | # - cygwin 121 | # - some other string means Unix 122 | # - empty means ocamlc does not support -config 123 | 124 | ifeq ($(SYSTEM),$(filter $(SYSTEM),mingw mingw64)) 125 | MINGW=1 126 | endif 127 | ifeq ($(SYSTEM),win32) 128 | MSVC=1 129 | endif 130 | 131 | ifdef MINGW 132 | export MINGW 133 | WIN32 := 1 134 | # The default value 'cc' makes 'ocamlc -cc "cc"' raises the error 'The 135 | # NTVDM CPU has encountered an illegal instruction'. 136 | ifndef CC 137 | MNO_CYGWIN := $(shell gcc -Wextra -v --help 2>/dev/null | grep -q '\-mno-cygwin'; echo $$?) 138 | CC := gcc 139 | else 140 | MNO_CYGWIN := $(shell $$CC -Wextra -v --help 2>/dev/null | grep -q '\-mno-cygwin'; echo $$?) 141 | endif 142 | # We are compiling with cygwin tools: 143 | ifeq ($(MNO_CYGWIN),0) 144 | CFLAGS_WIN32 := -mno-cygwin 145 | endif 146 | # The OCaml C header files use this flag: 147 | CFLAGS += -D__MINGW32__ 148 | endif 149 | ifdef MSVC 150 | export MSVC 151 | WIN32 := 1 152 | ifndef STATIC 153 | CPPFLAGS_WIN32 := -DCAML_DLL 154 | endif 155 | CFLAGS_WIN32 += -nologo 156 | EXT_OBJ := obj 157 | EXT_LIB := lib 158 | ifeq ($(CC),gcc) 159 | # work around GNU Make default value 160 | ifdef THREADS 161 | CC := cl -MT 162 | else 163 | CC := cl 164 | endif 165 | endif 166 | ifeq ($(CXX),g++) 167 | # work around GNU Make default value 168 | CXX := $(CC) 169 | endif 170 | CFLAG_O := -Fo 171 | endif 172 | ifdef WIN32 173 | EXT_CXX := cpp 174 | EXE := .exe 175 | endif 176 | 177 | ifndef EXT_OBJ 178 | EXT_OBJ := o 179 | endif 180 | ifndef EXT_LIB 181 | EXT_LIB := a 182 | endif 183 | ifndef EXT_CXX 184 | EXT_CXX := cc 185 | endif 186 | ifndef EXE 187 | EXE := # empty 188 | endif 189 | ifndef CFLAG_O 190 | CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! 191 | endif 192 | 193 | export CC 194 | export CXX 195 | export CFLAGS 196 | export CXXFLAGS 197 | export LDFLAGS 198 | export CPPFLAGS 199 | 200 | ifndef RPATH_FLAG 201 | ifdef ELF_RPATH_FLAG 202 | RPATH_FLAG := $(ELF_RPATH_FLAG) 203 | else 204 | RPATH_FLAG := -R 205 | endif 206 | endif 207 | export RPATH_FLAG 208 | 209 | ifndef MSVC 210 | ifndef PIC_CFLAGS 211 | PIC_CFLAGS := -fPIC 212 | endif 213 | ifndef PIC_CPPFLAGS 214 | PIC_CPPFLAGS := -DPIC 215 | endif 216 | endif 217 | 218 | export PIC_CFLAGS 219 | export PIC_CPPFLAGS 220 | 221 | BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) 222 | NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) 223 | TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) 224 | 225 | ifndef OCAMLFIND 226 | OCAMLFIND := ocamlfind 227 | endif 228 | export OCAMLFIND 229 | 230 | ifndef OCAML 231 | OCAML := ocaml 232 | endif 233 | export OCAML 234 | 235 | ifndef OCAMLC 236 | OCAMLC := ocamlc 237 | endif 238 | export OCAMLC 239 | 240 | ifndef OCAMLOPT 241 | OCAMLOPT := ocamlopt 242 | endif 243 | export OCAMLOPT 244 | 245 | ifndef OCAMLMKTOP 246 | OCAMLMKTOP := ocamlmktop 247 | endif 248 | export OCAMLMKTOP 249 | 250 | ifndef OCAMLCP 251 | OCAMLCP := ocamlcp 252 | endif 253 | export OCAMLCP 254 | 255 | ifndef OCAMLDEP 256 | OCAMLDEP := ocamldep 257 | endif 258 | export OCAMLDEP 259 | 260 | ifndef OCAMLLEX 261 | OCAMLLEX := ocamllex 262 | endif 263 | export OCAMLLEX 264 | 265 | ifndef OCAMLYACC 266 | OCAMLYACC := ocamlyacc 267 | endif 268 | export OCAMLYACC 269 | 270 | ifndef OCAMLMKLIB 271 | OCAMLMKLIB := ocamlmklib 272 | endif 273 | export OCAMLMKLIB 274 | 275 | ifndef OCAML_GLADECC 276 | OCAML_GLADECC := lablgladecc2 277 | endif 278 | export OCAML_GLADECC 279 | 280 | ifndef OCAML_GLADECC_FLAGS 281 | OCAML_GLADECC_FLAGS := 282 | endif 283 | export OCAML_GLADECC_FLAGS 284 | 285 | ifndef CAMELEON_REPORT 286 | CAMELEON_REPORT := report 287 | endif 288 | export CAMELEON_REPORT 289 | 290 | ifndef CAMELEON_REPORT_FLAGS 291 | CAMELEON_REPORT_FLAGS := 292 | endif 293 | export CAMELEON_REPORT_FLAGS 294 | 295 | ifndef CAMELEON_ZOGGY 296 | CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo 297 | endif 298 | export CAMELEON_ZOGGY 299 | 300 | ifndef CAMELEON_ZOGGY_FLAGS 301 | CAMELEON_ZOGGY_FLAGS := 302 | endif 303 | export CAMELEON_ZOGGY_FLAGS 304 | 305 | ifndef OXRIDL 306 | OXRIDL := oxridl 307 | endif 308 | export OXRIDL 309 | 310 | ifndef CAMLIDL 311 | CAMLIDL := camlidl 312 | endif 313 | export CAMLIDL 314 | 315 | ifndef CAMLIDLDLL 316 | CAMLIDLDLL := camlidldll 317 | endif 318 | export CAMLIDLDLL 319 | 320 | ifndef NOIDLHEADER 321 | MAYBE_IDL_HEADER := -header 322 | endif 323 | export NOIDLHEADER 324 | 325 | export NO_CUSTOM 326 | 327 | ifndef CAMLP4 328 | CAMLP4 := camlp4 329 | endif 330 | export CAMLP4 331 | 332 | ifndef REAL_OCAMLFIND 333 | ifdef PACKS 334 | ifndef CREATE_LIB 335 | ifdef THREADS 336 | PACKS += threads 337 | endif 338 | endif 339 | empty := 340 | space := $(empty) $(empty) 341 | comma := , 342 | ifdef PREDS 343 | PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS)) 344 | PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS)) 345 | OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES) 346 | # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES) 347 | OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) 348 | OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) 349 | else 350 | OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS)) 351 | OCAML_DEP_PACKAGES := 352 | endif 353 | OCAML_FIND_LINKPKG := -linkpkg 354 | REAL_OCAMLFIND := $(OCAMLFIND) 355 | endif 356 | endif 357 | 358 | export OCAML_FIND_PACKAGES 359 | export OCAML_DEP_PACKAGES 360 | export OCAML_FIND_LINKPKG 361 | export REAL_OCAMLFIND 362 | 363 | ifndef OCAMLDOC 364 | OCAMLDOC := ocamldoc 365 | endif 366 | export OCAMLDOC 367 | 368 | ifndef LATEX 369 | LATEX := latex 370 | endif 371 | export LATEX 372 | 373 | ifndef DVIPS 374 | DVIPS := dvips 375 | endif 376 | export DVIPS 377 | 378 | ifndef PS2PDF 379 | PS2PDF := ps2pdf 380 | endif 381 | export PS2PDF 382 | 383 | ifndef OCAMLMAKEFILE 384 | OCAMLMAKEFILE := OCamlMakefile 385 | endif 386 | export OCAMLMAKEFILE 387 | 388 | ifndef OCAMLLIBPATH 389 | OCAMLLIBPATH := \ 390 | $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml) 391 | endif 392 | export OCAMLLIBPATH 393 | 394 | ifndef OCAML_LIB_INSTALL 395 | OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib 396 | endif 397 | export OCAML_LIB_INSTALL 398 | 399 | ########################################################################### 400 | 401 | #################### change following sections only if 402 | #################### you know what you are doing! 403 | 404 | # delete target files when a build command fails 405 | .PHONY: .DELETE_ON_ERROR 406 | .DELETE_ON_ERROR: 407 | 408 | # for pedants using "--warn-undefined-variables" 409 | export MAYBE_IDL 410 | export REAL_RESULT 411 | export CAMLIDLFLAGS 412 | export THREAD_FLAG 413 | export RES_CLIB 414 | export MAKEDLL 415 | export ANNOT_FLAG 416 | export C_OXRIDL 417 | export SUBPROJS 418 | export CFLAGS_WIN32 419 | export CPPFLAGS_WIN32 420 | 421 | INCFLAGS := 422 | 423 | SHELL := /bin/sh 424 | 425 | MLDEPDIR := ._d 426 | BCDIDIR := ._bcdi 427 | NCDIDIR := ._ncdi 428 | 429 | FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.m %.$(EXT_CXX) %.rep %.zog %.glade 430 | 431 | FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) 432 | SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) 433 | 434 | FILTERED_REP := $(filter %.rep, $(FILTERED)) 435 | DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) 436 | AUTO_REP := $(FILTERED_REP:.rep=.ml) 437 | 438 | FILTERED_ZOG := $(filter %.zog, $(FILTERED)) 439 | DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) 440 | AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) 441 | 442 | FILTERED_GLADE := $(filter %.glade, $(FILTERED)) 443 | DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d) 444 | AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml) 445 | 446 | FILTERED_ML := $(filter %.ml, $(FILTERED)) 447 | DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) 448 | 449 | FILTERED_MLI := $(filter %.mli, $(FILTERED)) 450 | DEP_MLI := $(FILTERED_MLI:.mli=.di) 451 | 452 | FILTERED_MLL := $(filter %.mll, $(FILTERED)) 453 | DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) 454 | AUTO_MLL := $(FILTERED_MLL:.mll=.ml) 455 | 456 | FILTERED_MLY := $(filter %.mly, $(FILTERED)) 457 | DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) 458 | AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) 459 | 460 | FILTERED_IDL := $(filter %.idl, $(FILTERED)) 461 | DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) 462 | C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) 463 | ifndef NOIDLHEADER 464 | C_IDL += $(FILTERED_IDL:.idl=.h) 465 | endif 466 | OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) 467 | AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) 468 | 469 | FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED)) 470 | DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di) 471 | AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL) 472 | 473 | FILTERED_C_CXX := $(filter %.c %.m %.$(EXT_CXX), $(FILTERED)) 474 | OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) 475 | OBJ_C_CXX := $(OBJ_C_CXX:.m=.$(EXT_OBJ)) 476 | OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) 477 | 478 | PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE) 479 | 480 | ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE) 481 | 482 | MLDEPS := $(filter %.d, $(ALL_DEPS)) 483 | MLIDEPS := $(filter %.di, $(ALL_DEPS)) 484 | BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) 485 | NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) 486 | 487 | ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED)) 488 | 489 | IMPLO_INTF := $(ALLML:%.mli=%.mli.__) 490 | IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ 491 | $(basename $(file)).cmi $(basename $(file)).cmo) 492 | IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) 493 | IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) 494 | 495 | IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) 496 | 497 | INTF := $(filter %.cmi, $(IMPLO_INTF)) 498 | IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) 499 | IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) 500 | IMPL_ASM := $(IMPL_CMO:.cmo=.asm) 501 | IMPL_S := $(IMPL_CMO:.cmo=.s) 502 | 503 | OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) 504 | OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) 505 | 506 | EXECS := $(addsuffix $(EXE), \ 507 | $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) 508 | ifdef WIN32 509 | EXECS += $(BCRESULT).dll $(NCRESULT).dll 510 | endif 511 | 512 | CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) 513 | ifneq ($(strip $(OBJ_LINK)),) 514 | RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) 515 | endif 516 | 517 | ifdef WIN32 518 | DLLSONAME := dll$(CLIB_BASE).dll 519 | else 520 | DLLSONAME := dll$(CLIB_BASE).so 521 | endif 522 | 523 | NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \ 524 | $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \ 525 | $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \ 526 | $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).$(EXT_OBJ) \ 527 | $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \ 528 | $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx \ 529 | $(LIB_PACK_NAME).$(EXT_OBJ) 530 | 531 | ifndef STATIC 532 | NONEXECS += $(DLLSONAME) 533 | endif 534 | 535 | ifndef LIBINSTALL_FILES 536 | LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ 537 | $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB) 538 | ifndef STATIC 539 | ifneq ($(strip $(OBJ_LINK)),) 540 | LIBINSTALL_FILES += $(DLLSONAME) 541 | endif 542 | endif 543 | endif 544 | 545 | export LIBINSTALL_FILES 546 | 547 | ifdef WIN32 548 | # some extra stuff is created while linking DLLs 549 | NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib 550 | endif 551 | 552 | TARGETS := $(EXECS) $(NONEXECS) 553 | 554 | # If there are IDL-files 555 | ifneq ($(strip $(FILTERED_IDL)),) 556 | MAYBE_IDL := -cclib -lcamlidl 557 | endif 558 | 559 | ifdef USE_CAMLP4 560 | CAMLP4PATH := \ 561 | $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4) 562 | INCFLAGS := -I $(CAMLP4PATH) 563 | CINCFLAGS := -I$(CAMLP4PATH) 564 | endif 565 | 566 | INCFLAGS := $(INCFLAGS) $(INCDIRS:%=-I %) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) 567 | CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) 568 | 569 | ifndef MSVC 570 | CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ 571 | $(EXTLIBDIRS:%=-L%) $(OCAML_DEFAULT_DIRS:%=-L%) 572 | 573 | ifeq ($(ELF_RPATH), yes) 574 | CLIBFLAGS += $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%) 575 | endif 576 | endif 577 | 578 | ifndef PROFILING 579 | INTF_OCAMLC := $(OCAMLC) 580 | else 581 | ifndef THREADS 582 | INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) 583 | else 584 | # OCaml does not support profiling byte code 585 | # with threads (yet), therefore we force an error. 586 | ifndef REAL_OCAMLC 587 | $(error Profiling of multithreaded byte code not yet supported by OCaml) 588 | endif 589 | INTF_OCAMLC := $(OCAMLC) 590 | endif 591 | endif 592 | 593 | ifndef MSVC 594 | COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ 595 | $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \ 596 | $(EXTLIBDIRS:%=-ccopt -Wl $(OCAML_DEFAULT_DIRS:%=-ccopt -L%)) 597 | 598 | ifeq ($(ELF_RPATH),yes) 599 | COMMON_LDFLAGS += $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%) 600 | endif 601 | else 602 | COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \ 603 | $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \ 604 | $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) " 605 | endif 606 | 607 | CLIBS_OPTS := $(CLIBS:%=-cclib -l%) $(CFRAMEWORKS:%=-cclib '-framework %') 608 | ifdef MSVC 609 | ifndef STATIC 610 | # MSVC libraries do not have 'lib' prefix 611 | CLIBS_OPTS := $(CLIBS:%=-cclib %.lib) 612 | endif 613 | endif 614 | 615 | ifneq ($(strip $(OBJ_LINK)),) 616 | ifdef CREATE_LIB 617 | OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) 618 | else 619 | OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) 620 | endif 621 | else 622 | OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) 623 | endif 624 | 625 | ifdef LIB_PACK_NAME 626 | FOR_PACK_NAME := $(shell echo $(LIB_PACK_NAME) | awk '{print toupper(substr($$0,1,1))substr($$0,2)}') 627 | endif 628 | 629 | # If we have to make byte-code 630 | ifndef REAL_OCAMLC 631 | BYTE_OCAML := y 632 | 633 | # EXTRADEPS is added dependencies we have to insert for all 634 | # executable files we generate. Ideally it should be all of the 635 | # libraries we use, but it's hard to find the ones that get searched on 636 | # the path since I don't know the paths built into the compiler, so 637 | # just include the ones with slashes in their names. 638 | EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) 639 | 640 | 641 | ifndef LIB_PACK_NAME 642 | SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) 643 | else 644 | SPECIAL_OCAMLFLAGS := -for-pack $(FOR_PACK_NAME) $(OCAMLBCFLAGS) 645 | endif 646 | 647 | REAL_OCAMLC := $(INTF_OCAMLC) 648 | 649 | REAL_IMPL := $(IMPL_CMO) 650 | REAL_IMPL_INTF := $(IMPLO_INTF) 651 | IMPL_SUF := .cmo 652 | 653 | DEPFLAGS := 654 | MAKE_DEPS := $(MLDEPS) $(BCDEPIS) 655 | 656 | ifdef CREATE_LIB 657 | override CFLAGS := $(PIC_CFLAGS) $(CFLAGS) 658 | override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) 659 | ifndef STATIC 660 | ifneq ($(strip $(OBJ_LINK)),) 661 | MAKEDLL := $(DLLSONAME) 662 | ALL_LDFLAGS := -dllib $(DLLSONAME) 663 | endif 664 | endif 665 | endif 666 | 667 | ifndef NO_CUSTOM 668 | ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS) $(CFRAMEWORKS))" "" 669 | ALL_LDFLAGS += -custom 670 | endif 671 | endif 672 | 673 | ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ 674 | $(COMMON_LDFLAGS) $(LIBS:%=%.cma) 675 | CAMLIDLDLLFLAGS := 676 | 677 | ifdef THREADS 678 | ifdef VMTHREADS 679 | THREAD_FLAG := -vmthread 680 | else 681 | THREAD_FLAG := -thread 682 | endif 683 | ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) 684 | ifndef CREATE_LIB 685 | ifndef REAL_OCAMLFIND 686 | ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS) 687 | endif 688 | endif 689 | endif 690 | 691 | # we have to make native-code 692 | else 693 | EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) 694 | ifndef PROFILING 695 | SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) 696 | PLDFLAGS := 697 | else 698 | SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) 699 | PLDFLAGS := -p 700 | endif 701 | 702 | ifndef LIB_PACK_NAME 703 | SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) 704 | else 705 | SPECIAL_OCAMLFLAGS := -for-pack $(FOR_PACK_NAME) $(OCAMLNCFLAGS) 706 | endif 707 | REAL_IMPL := $(IMPL_CMX) 708 | REAL_IMPL_INTF := $(IMPLX_INTF) 709 | IMPL_SUF := .cmx 710 | 711 | override CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS) 712 | 713 | DEPFLAGS := -native 714 | MAKE_DEPS := $(MLDEPS) $(NCDEPIS) 715 | 716 | ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ 717 | $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) 718 | CAMLIDLDLLFLAGS := -opt 719 | 720 | ifndef CREATE_LIB 721 | ALL_LDFLAGS += $(LIBS:%=%.cmxa) 722 | else 723 | override CFLAGS := $(PIC_CFLAGS) $(CFLAGS) 724 | override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) 725 | endif 726 | 727 | ifdef THREADS 728 | THREAD_FLAG := -thread 729 | ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) 730 | ifndef CREATE_LIB 731 | ifndef REAL_OCAMLFIND 732 | ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS) 733 | endif 734 | endif 735 | endif 736 | endif 737 | 738 | export MAKE_DEPS 739 | 740 | ifdef ANNOTATE 741 | ANNOT_FLAG := -annot 742 | else 743 | endif 744 | 745 | ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \ 746 | $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) 747 | 748 | ifdef make_deps 749 | -include $(MAKE_DEPS) 750 | PRE_TARGETS := 751 | endif 752 | 753 | ########################################################################### 754 | # USER RULES 755 | 756 | # Call "OCamlMakefile QUIET=" to get rid of all of the @'s. 757 | QUIET=@ 758 | 759 | # generates byte-code (default) 760 | byte-code: $(PRE_TARGETS) 761 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ 762 | REAL_RESULT="$(BCRESULT)" make_deps=yes 763 | bc: byte-code 764 | 765 | byte-code-nolink: $(PRE_TARGETS) 766 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ 767 | REAL_RESULT="$(BCRESULT)" make_deps=yes 768 | bcnl: byte-code-nolink 769 | 770 | top: $(PRE_TARGETS) 771 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ 772 | REAL_RESULT="$(BCRESULT)" make_deps=yes 773 | 774 | # generates native-code 775 | 776 | native-code: $(PRE_TARGETS) 777 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ 778 | REAL_RESULT="$(NCRESULT)" \ 779 | REAL_OCAMLC="$(OCAMLOPT)" \ 780 | make_deps=yes 781 | nc: native-code 782 | 783 | native-code-nolink: $(PRE_TARGETS) 784 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ 785 | REAL_RESULT="$(NCRESULT)" \ 786 | REAL_OCAMLC="$(OCAMLOPT)" \ 787 | make_deps=yes 788 | ncnl: native-code-nolink 789 | 790 | # generates byte-code libraries 791 | byte-code-library: $(PRE_TARGETS) 792 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 793 | $(RES_CLIB) $(BCRESULT).cma \ 794 | REAL_RESULT="$(BCRESULT)" \ 795 | CREATE_LIB=yes \ 796 | make_deps=yes 797 | bcl: byte-code-library 798 | 799 | # generates native-code libraries 800 | native-code-library: $(PRE_TARGETS) 801 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 802 | $(RES_CLIB) $(NCRESULT).cmxa \ 803 | REAL_RESULT="$(NCRESULT)" \ 804 | REAL_OCAMLC="$(OCAMLOPT)" \ 805 | CREATE_LIB=yes \ 806 | make_deps=yes 807 | ncl: native-code-library 808 | 809 | ifdef WIN32 810 | # generates byte-code dll 811 | byte-code-dll: $(PRE_TARGETS) 812 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 813 | $(RES_CLIB) $(BCRESULT).dll \ 814 | REAL_RESULT="$(BCRESULT)" \ 815 | make_deps=yes 816 | bcd: byte-code-dll 817 | 818 | # generates native-code dll 819 | native-code-dll: $(PRE_TARGETS) 820 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 821 | $(RES_CLIB) $(NCRESULT).dll \ 822 | REAL_RESULT="$(NCRESULT)" \ 823 | REAL_OCAMLC="$(OCAMLOPT)" \ 824 | make_deps=yes 825 | ncd: native-code-dll 826 | endif 827 | 828 | # generates byte-code with debugging information 829 | debug-code: $(PRE_TARGETS) 830 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ 831 | REAL_RESULT="$(BCRESULT)" make_deps=yes \ 832 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 833 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 834 | dc: debug-code 835 | 836 | debug-code-nolink: $(PRE_TARGETS) 837 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ 838 | REAL_RESULT="$(BCRESULT)" make_deps=yes \ 839 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 840 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 841 | dcnl: debug-code-nolink 842 | 843 | # generates byte-code with debugging information (native code) 844 | debug-native-code: $(PRE_TARGETS) 845 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ 846 | REAL_RESULT="$(NCRESULT)" make_deps=yes \ 847 | REAL_OCAMLC="$(OCAMLOPT)" \ 848 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 849 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 850 | dnc: debug-native-code 851 | 852 | debug-native-code-nolink: $(PRE_TARGETS) 853 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ 854 | REAL_RESULT="$(NCRESULT)" make_deps=yes \ 855 | REAL_OCAMLC="$(OCAMLOPT)" \ 856 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 857 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 858 | dncnl: debug-native-code-nolink 859 | 860 | # generates byte-code libraries with debugging information 861 | debug-code-library: $(PRE_TARGETS) 862 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 863 | $(RES_CLIB) $(BCRESULT).cma \ 864 | REAL_RESULT="$(BCRESULT)" make_deps=yes \ 865 | CREATE_LIB=yes \ 866 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 867 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 868 | dcl: debug-code-library 869 | 870 | # generates byte-code libraries with debugging information (native code) 871 | debug-native-code-library: $(PRE_TARGETS) 872 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 873 | $(RES_CLIB) $(NCRESULT).cmxa \ 874 | REAL_RESULT="$(NCRESULT)" make_deps=yes \ 875 | REAL_OCAMLC="$(OCAMLOPT)" \ 876 | CREATE_LIB=yes \ 877 | OCAMLFLAGS="-g $(OCAMLFLAGS)" \ 878 | OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" 879 | dncl: debug-native-code-library 880 | 881 | # generates byte-code for profiling 882 | profiling-byte-code: $(PRE_TARGETS) 883 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ 884 | REAL_RESULT="$(BCRESULT)" PROFILING="y" \ 885 | make_deps=yes 886 | pbc: profiling-byte-code 887 | 888 | # generates native-code 889 | 890 | profiling-native-code: $(PRE_TARGETS) 891 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ 892 | REAL_RESULT="$(NCRESULT)" \ 893 | REAL_OCAMLC="$(OCAMLOPT)" \ 894 | PROFILING="y" \ 895 | make_deps=yes 896 | pnc: profiling-native-code 897 | 898 | # generates byte-code libraries 899 | profiling-byte-code-library: $(PRE_TARGETS) 900 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 901 | $(RES_CLIB) $(BCRESULT).cma \ 902 | REAL_RESULT="$(BCRESULT)" PROFILING="y" \ 903 | CREATE_LIB=yes \ 904 | make_deps=yes 905 | pbcl: profiling-byte-code-library 906 | 907 | # generates native-code libraries 908 | profiling-native-code-library: $(PRE_TARGETS) 909 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 910 | $(RES_CLIB) $(NCRESULT).cmxa \ 911 | REAL_RESULT="$(NCRESULT)" PROFILING="y" \ 912 | REAL_OCAMLC="$(OCAMLOPT)" \ 913 | CREATE_LIB=yes \ 914 | make_deps=yes 915 | pncl: profiling-native-code-library 916 | 917 | # packs byte-code objects 918 | pack-byte-code: $(PRE_TARGETS) 919 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ 920 | REAL_RESULT="$(BCRESULT)" \ 921 | PACK_LIB=yes make_deps=yes 922 | pabc: pack-byte-code 923 | 924 | # packs native-code objects 925 | pack-native-code: $(PRE_TARGETS) 926 | $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ 927 | $(NCRESULT).cmx $(NCRESULT).$(EXT_OBJ) \ 928 | REAL_RESULT="$(NCRESULT)" \ 929 | REAL_OCAMLC="$(OCAMLOPT)" \ 930 | PACK_LIB=yes make_deps=yes 931 | panc: pack-native-code 932 | 933 | # generates HTML-documentation 934 | htdoc: $(DOC_DIR)/$(RESULT)/html/index.html 935 | 936 | # generates Latex-documentation 937 | ladoc: $(DOC_DIR)/$(RESULT)/latex/doc.tex 938 | 939 | # generates PostScript-documentation 940 | psdoc: $(DOC_DIR)/$(RESULT)/latex/doc.ps 941 | 942 | # generates PDF-documentation 943 | pdfdoc: $(DOC_DIR)/$(RESULT)/latex/doc.pdf 944 | 945 | # generates all supported forms of documentation 946 | doc: htdoc ladoc psdoc pdfdoc 947 | 948 | ########################################################################### 949 | # LOW LEVEL RULES 950 | 951 | $(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS) 952 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) \ 953 | $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ 954 | $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@$(EXE) \ 955 | $(REAL_IMPL) 956 | 957 | nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) 958 | 959 | ifdef WIN32 960 | $(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) 961 | $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ 962 | -o $@ $(REAL_IMPL) 963 | endif 964 | 965 | %$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) 966 | $(REAL_OCAMLFIND) $(OCAMLMKTOP) \ 967 | $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ 968 | $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@$(EXE) \ 969 | $(REAL_IMPL) 970 | 971 | .SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ 972 | .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .m .$(EXT_CXX) .h .so \ 973 | .rep .zog .glade 974 | 975 | ifndef STATIC 976 | ifdef MINGW 977 | # From OCaml 3.11.0, ocamlmklib is available on windows 978 | OCAMLMLIB_EXISTS = $(shell which $(OCAMLMKLIB)) 979 | ifeq ($(strip $(OCAMLMLIB_EXISTS)),) 980 | $(DLLSONAME): $(OBJ_LINK) 981 | $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \ 982 | $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \ 983 | '$(OCAMLLIBPATH)/ocamlrun.a' \ 984 | -Wl,--whole-archive \ 985 | -Wl,--export-all-symbols \ 986 | -Wl,--allow-multiple-definition \ 987 | -Wl,--enable-auto-import 988 | else 989 | $(DLLSONAME): $(OBJ_LINK) 990 | $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ 991 | -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) \ 992 | $(CFRAMEWORKS:%=-framework %) \ 993 | $(OCAMLMKLIB_FLAGS) 994 | endif 995 | else 996 | ifdef MSVC 997 | $(DLLSONAME): $(OBJ_LINK) 998 | link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \ 999 | $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \ 1000 | '$(OCAMLLIBPATH)/ocamlrun.lib' 1001 | 1002 | else 1003 | $(DLLSONAME): $(OBJ_LINK) 1004 | $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ 1005 | -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) $(CFRAMEWORKS:%=-framework %) \ 1006 | $(OCAMLMKLIB_FLAGS) 1007 | endif 1008 | endif 1009 | endif 1010 | 1011 | ifndef LIB_PACK_NAME 1012 | $(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) 1013 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@ $(REAL_IMPL) 1014 | 1015 | $(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS) 1016 | $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@ $(REAL_IMPL) 1017 | else 1018 | # Packing a bytecode library 1019 | LIB_PACK_NAME_MLI = $(wildcard $(LIB_PACK_NAME).mli) 1020 | ifeq ($(LIB_PACK_NAME_MLI),) 1021 | LIB_PACK_NAME_CMI = $(LIB_PACK_NAME).cmi 1022 | else 1023 | # $(LIB_PACK_NAME).mli exists, it likely depends on other compiled interfaces 1024 | LIB_PACK_NAME_CMI = 1025 | $(LIB_PACK_NAME).cmi: $(REAL_IMPL_INTF) 1026 | endif 1027 | ifdef BYTE_OCAML 1028 | $(LIB_PACK_NAME_CMI) $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF) 1029 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(OCAMLLDFLAGS) $(REAL_IMPL) 1030 | # Packing into a unit which can be transformed into a library 1031 | # Remember the .ml's must have been compiled with -for-pack $(LIB_PACK_NAME) 1032 | else 1033 | $(LIB_PACK_NAME_CMI) $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF) 1034 | $(REAL_OCAMLFIND) $(OCAMLOPT) -pack -o $(LIB_PACK_NAME).cmx $(OCAMLLDFLAGS) $(REAL_IMPL) 1035 | endif 1036 | 1037 | $(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) 1038 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(OBJS_LIBS) $(ALL_LDFLAGS) -o $@ $(LIB_PACK_NAME).cmo 1039 | 1040 | $(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS) 1041 | $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(OBJS_LIBS) $(filter-out -custom, $(ALL_LDFLAGS)) -o $@ $(LIB_PACK_NAME).cmx 1042 | endif 1043 | 1044 | $(RES_CLIB): $(OBJ_LINK) 1045 | ifndef MSVC 1046 | ifneq ($(strip $(OBJ_LINK)),) 1047 | $(AR) rcs $@ $(OBJ_LINK) 1048 | endif 1049 | else 1050 | ifneq ($(strip $(OBJ_LINK)),) 1051 | lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK) 1052 | endif 1053 | endif 1054 | 1055 | %.cmi: %.mli $(EXTRADEPS) 1056 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ 1057 | if [ -z "$$pp" ]; then \ 1058 | $(ECHO) $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1059 | -c $(THREAD_FLAG) $(ANNOT_FLAG) \ 1060 | $(OCAMLFLAGS) $(INCFLAGS) $<; \ 1061 | $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1062 | -c $(THREAD_FLAG) $(ANNOT_FLAG) \ 1063 | $(OCAMLFLAGS) $(INCFLAGS) $<; \ 1064 | else \ 1065 | $(ECHO) $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1066 | -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \ 1067 | $(OCAMLFLAGS) $(INCFLAGS) $<; \ 1068 | $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1069 | -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \ 1070 | $(OCAMLFLAGS) $(INCFLAGS) $<; \ 1071 | fi 1072 | 1073 | %.cmi: %$(IMPL_SUF); 1074 | 1075 | %$(IMPL_SUF) %.$(EXT_OBJ): %.ml $(EXTRADEPS) 1076 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ 1077 | if [ -z "$$pp" ]; then \ 1078 | $(ECHO) $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1079 | -c $(ALL_OCAMLCFLAGS) $<; \ 1080 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1081 | -c $(ALL_OCAMLCFLAGS) $<; \ 1082 | else \ 1083 | $(ECHO) $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1084 | -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \ 1085 | $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ 1086 | -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \ 1087 | fi 1088 | 1089 | .PRECIOUS: %.ml 1090 | %.ml: %.mll 1091 | $(OCAMLLEX) $(LFLAGS) $< 1092 | 1093 | .PRECIOUS: %.ml %.mli 1094 | %.ml %.mli: %.mly 1095 | $(OCAMLYACC) $(YFLAGS) $< 1096 | $(QUIET)pp=`sed -n -e 's/.*(\*pp \([^*]*\) \*).*/\1/p;q' $<`; \ 1097 | if [ ! -z "$$pp" ]; then \ 1098 | mv $*.ml $*.ml.temporary; \ 1099 | echo "(*pp $$pp $(PPFLAGS)*)" > $*.ml; \ 1100 | cat $*.ml.temporary >> $*.ml; \ 1101 | rm $*.ml.temporary; \ 1102 | mv $*.mli $*.mli.temporary; \ 1103 | echo "(*pp $$pp $(PPFLAGS)*)" > $*.mli; \ 1104 | cat $*.mli.temporary >> $*.mli; \ 1105 | rm $*.mli.temporary; \ 1106 | fi 1107 | 1108 | 1109 | .PRECIOUS: %.ml 1110 | %.ml: %.rep 1111 | $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< 1112 | 1113 | .PRECIOUS: %.ml 1114 | %.ml: %.zog 1115 | $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ 1116 | 1117 | .PRECIOUS: %.ml 1118 | %.ml: %.glade 1119 | $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@ 1120 | 1121 | .PRECIOUS: %.ml %.mli 1122 | %.ml %.mli: %.oxridl 1123 | $(OXRIDL) $< 1124 | 1125 | .PRECIOUS: %.ml %.mli %_stubs.c %.h 1126 | %.ml %.mli %_stubs.c %.h: %.idl 1127 | $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ 1128 | $(CAMLIDLFLAGS) $< 1129 | $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi 1130 | 1131 | %.$(EXT_OBJ): %.c 1132 | $(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \ 1133 | $(CPPFLAGS) $(CPPFLAGS_WIN32) \ 1134 | $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $< 1135 | 1136 | %.$(EXT_OBJ): %.m 1137 | $(CC) -c $(CFLAGS) $(CINCFLAGS) $(CPPFLAGS) \ 1138 | -I'$(OCAMLLIBPATH)' \ 1139 | $< $(CFLAG_O)$@ 1140 | 1141 | %.$(EXT_OBJ): %.$(EXT_CXX) 1142 | $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \ 1143 | -I'$(OCAMLLIBPATH)' \ 1144 | $< $(CFLAG_O)$@ 1145 | 1146 | $(MLDEPDIR)/%.d: %.ml 1147 | $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi 1148 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ 1149 | if [ -z "$$pp" ]; then \ 1150 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ 1151 | $(INCFLAGS) $< \> $@; \ 1152 | $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ 1153 | $(INCFLAGS) $< > $@; \ 1154 | else \ 1155 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ 1156 | -pp \"$$pp $(PPFLAGS)\" $(INCFLAGS) $< \> $@; \ 1157 | $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ 1158 | -pp "$$pp $(PPFLAGS)" $(INCFLAGS) $< > $@; \ 1159 | fi 1160 | 1161 | $(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli 1162 | $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi 1163 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ 1164 | if [ -z "$$pp" ]; then \ 1165 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(INCFLAGS) $< \> $@; \ 1166 | $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(INCFLAGS) $< > $@; \ 1167 | else \ 1168 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ 1169 | -pp \"$$pp $(PPFLAGS)\" $(INCFLAGS) $< \> $@; \ 1170 | $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ 1171 | -pp "$$pp $(PPFLAGS)" $(INCFLAGS) $< > $@; \ 1172 | fi 1173 | 1174 | $(DOC_DIR)/$(RESULT)/html: 1175 | mkdir -p $@ 1176 | 1177 | $(DOC_DIR)/$(RESULT)/html/index.html: $(DOC_DIR)/$(RESULT)/html $(DOC_FILES) 1178 | rm -rf $