ps
36 | %%
37 |
38 | prog:
39 | | cmd prog { $1::$2 }
40 | | EOF { [] }
41 |
42 | cmd:
43 | | LET var args EQ expr { Decl ($2,abs $3 $5) }
44 | | HYP var COL expr { Axiom ($2,$4) }
45 | | COH var args COL expr { Decl ($2,mk (Coh (var_name $2,PS.make $3,$5))) }
46 | | SET IDENT EQ IDENT { Set ($2,$4) }
47 | | CHECK expr { Check $2 }
48 | | EVAL expr { Eval $2 }
49 | | ENV { Env }
50 |
51 | var:
52 | | IDENT { VIdent $1 }
53 |
54 | args:
55 | | LPAR var COL expr RPAR args { ($2,$4)::$6 }
56 | | var args { ($1,fresh_evar ())::$2 }
57 | | { [] }
58 |
59 | ps:
60 | | args { PS.make $1 }
61 |
62 | simple_expr:
63 | | LPAR expr RPAR { $2 }
64 | | var { mk (Var $1) }
65 | | TYPE { mk Type }
66 | | HOMTYPE { mk HomType }
67 | | OBJ { mk Obj }
68 | | US { fresh_evar () }
69 |
70 | app_expr:
71 | | app_expr simple_expr { mk (App ($1,$2)) }
72 | | simple_expr { $1 }
73 |
74 | expr:
75 | | app_expr { $1 }
76 | | expr ARR expr { mk (Arr (fresh_evar (),$1,$3)) }
77 | | COH stringopt args COL simple_expr { mk (Coh ($2,PS.make $3,$5)) }
78 |
79 | stringopt:
80 | | STRING { $1 }
81 | | { "" }
82 |
--------------------------------------------------------------------------------
/src/extlib.ml:
--------------------------------------------------------------------------------
1 | module Enum = struct
2 | type 'a t = unit -> 'a
3 |
4 | exception End
5 |
6 | let empty : 'a t = fun () -> raise End
7 |
8 | let once x : 'a t =
9 | let dead = ref false in
10 | fun () -> if !dead then raise End else (dead := true; x)
11 |
12 | let get (e : 'a t) = e ()
13 |
14 | let map f e : 'a t = fun () -> f (get e)
15 |
16 | let rec may_map f e = fun () ->
17 | match f (get e) with
18 | | Some x -> x
19 | | None -> get (may_map f e)
20 |
21 | let rec filter f e = fun () ->
22 | let x = get e in
23 | if f x then x else get (filter f e)
24 |
25 | let append e1 e2 : 'a t =
26 | fun () ->
27 | try
28 | get e1
29 | with
30 | | End -> get e2
31 |
32 | let rec flatten e = fun () ->
33 | get (append (get e) (flatten e))
34 |
35 | let of_list l =
36 | let l = ref l in
37 | fun () ->
38 | match !l with
39 | | x::t -> l := t; x
40 | | [] -> raise End
41 |
42 | let rec to_list e =
43 | try
44 | let x = get e in
45 | x::(to_list e)
46 | with
47 | | End -> []
48 | end
49 |
50 | module List = struct
51 | include List
52 |
53 | let remove x l =
54 | filter (fun y -> y <> x) l
55 |
56 | let included l1 l2 =
57 | for_all (fun x -> mem x l2) l1
58 |
59 | let union l1 l2 =
60 | fold_left (fun l x -> if not (mem x l) then x::l else l) l2 l1
61 |
62 | let unionq l1 l2 =
63 | fold_left (fun l x -> if not (memq x l) then x::l else l) l2 l1
64 |
65 | let diff l1 l2 =
66 | filter (fun x -> not (mem x l2)) l1
67 |
68 | let diffq l1 l2 =
69 | filter (fun x -> not (memq x l2)) l1
70 |
71 | let bind f l =
72 | flatten (List.map f l)
73 |
74 | let bind_nd f =
75 | append (f true) (f false)
76 | end
77 |
78 | module Option = struct
79 | let map f = function
80 | | Some x -> Some (f x)
81 | | None -> None
82 |
83 | let default x = function
84 | | Some x -> x
85 | | None -> x
86 | end
87 |
88 | module String = struct
89 | include String
90 |
91 | let concat_map s f l =
92 | concat s (List.map f l)
93 | end
94 |
--------------------------------------------------------------------------------
/src/prover.ml:
--------------------------------------------------------------------------------
1 | (** Interaction with user. *)
2 |
3 | open Lang
4 | open LangExt
5 | open Common
6 |
7 | (** Parse a string. *)
8 | let parse s =
9 | let lexbuf = Lexing.from_string s in
10 | try
11 | Parser.prog Lexer.token lexbuf
12 | with
13 | | Failure s when s = "lexing: empty token" ->
14 | let pos = Lexing.lexeme_end_p lexbuf in
15 | Common.error
16 | "lexing error in file %s at line %d, character %d"
17 | pos.Lexing.pos_fname
18 | pos.Lexing.pos_lnum
19 | (pos.Lexing.pos_cnum - pos.Lexing.pos_bol)
20 | | Parsing.Parse_error ->
21 | let pos = (Lexing.lexeme_end_p lexbuf) in
22 | Common.error
23 | "parsing error in file %s at word \"%s\", line %d, character %d"
24 | pos.Lexing.pos_fname
25 | (Lexing.lexeme lexbuf)
26 | pos.Lexing.pos_lnum
27 | (pos.Lexing.pos_cnum - pos.Lexing.pos_bol - 1)
28 |
29 | (** Initialize the prover. *)
30 | let init () =
31 | print_string "=^.^= "
32 |
33 | (** Execute a command. *)
34 | let exec envs s =
35 | try
36 | if s = "exit" then
37 | exit 0
38 | (* else if s = "build" then *)
39 | (* let s = read_line () in *)
40 | (* let ps = Parser.ps Lexer.token (Lexing.from_string s) in *)
41 | (* PS.check ps; *)
42 | (* let ps = Subst.of_ps ps in *)
43 | (* let ps = ref ps in *)
44 | (* let loop = ref true in *)
45 | (* while !loop do *)
46 | (* print_string "=^o^= "; *)
47 | (* let s = read_line () in *)
48 | (* let ss = Subst.match_app (fst envs) !ps (mk (Var (VIdent s))) in *)
49 | (* print_endline ("len: "^string_of_int (List.length ss)) *)
50 | (* done; *)
51 | (* envs *)
52 | else
53 | Lang.exec envs (parse s)
54 | with
55 | | End_of_file -> print_newline () ; exit 0
56 | | Failure e -> print_endline ("Error: " ^ e ^ "."); envs
57 | | e -> print_endline ("Error: " ^ Printexc.to_string e); envs
58 |
59 | (** Interactive loop. *)
60 | let loop envs =
61 | (* Current environment. *)
62 | let envs = ref envs in
63 | while true do
64 | init ();
65 | let s = read_line () in
66 | envs := exec !envs s
67 | done
68 |
--------------------------------------------------------------------------------
/docs/ocamldoc/Prover.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 | Prover
16 |
17 |
18 |
21 |
22 |
23 | module Prover: sig .. end
24 | Interaction with user.
25 |
26 |
27 |
28 | val parse : string -> Lang.prog
29 | Parse a string.
30 |
31 |
32 | val init : unit -> unit
33 | Initialize the prover.
34 |
35 |
36 | val exec : Lang.Envs.t -> string -> Lang.Envs.t
37 | Execute a command.
38 |
39 |
40 | val loop : Lang.Envs.t -> unit
41 | Interactive loop.
42 |
43 |
--------------------------------------------------------------------------------
/src/common.ml:
--------------------------------------------------------------------------------
1 | (** Position in source code. *)
2 | module Pos = struct
3 | type t = Lexing.position * Lexing.position
4 |
5 | let dummy = Lexing.dummy_pos, Lexing.dummy_pos
6 |
7 | let union (p1,p2) (q1,q2) =
8 | assert (p1.Lexing.pos_fname = q1.Lexing.pos_fname);
9 | let r1 = if p1.Lexing.pos_cnum <= q1.Lexing.pos_cnum then p1 else q1 in
10 | let r2 = if p2.Lexing.pos_cnum >= q2.Lexing.pos_cnum then p2 else q2 in
11 | r1,r2
12 |
13 | (** String representation of a position. *)
14 | let to_string ((p1,p2):t) =
15 | let l1 = p1.Lexing.pos_lnum in
16 | let l2 = p2.Lexing.pos_lnum in
17 | let b1 = p1.Lexing.pos_bol in
18 | let b2 = p2.Lexing.pos_bol in
19 | let c1 = p1.Lexing.pos_cnum in
20 | let c2 = p2.Lexing.pos_cnum in
21 | let c1 = c1 - b1 in
22 | let c2 = c2 - b2 in
23 | (
24 | if p1.Lexing.pos_fname <> "" then
25 | Printf.sprintf "in file %s " p1.Lexing.pos_fname
26 | else
27 | ""
28 | ) ^
29 | if l1 = l2 then
30 | if c1 = c2 then
31 | Printf.sprintf "line %d character %d" l1 c1
32 | else
33 | Printf.sprintf "line %d characters %d-%d" l1 c1 c2
34 | else
35 | Printf.sprintf "from line %d character %d to line %d character %d" l1 c1 l2 c2
36 | end
37 |
38 | let print_string_fun = ref print_string
39 | let print_string s = !print_string_fun s
40 | let print_newline () = print_string "\n"
41 | let print_endline s = print_string s; print_newline ()
42 | let read_line_fun = ref read_line
43 | let read_line () = !read_line_fun ()
44 |
45 | let printf e = Printf.ksprintf print_string e
46 |
47 | let debug e = Printf.ksprintf (fun s -> printf "=D.D= %s.\n\n%!" s) e
48 |
49 | let info e = Printf.ksprintf (fun s -> printf "=I.I= %s.\n\n%!" s) e
50 |
51 | let command e = Printf.ksprintf (fun s -> printf "=^.^= %s\n\n%!" s) e
52 |
53 | (* let error e = Printf.ksprintf (fun s -> Printf.printf "[EE]: %s.\n%!" s; exit 1) e *)
54 |
55 | exception Error of string
56 |
57 | let error ?pos e =
58 | let pos =
59 | match pos with
60 | | None -> ""
61 | | Some pos when pos = Pos.dummy -> ""
62 | | Some pos -> Pos.to_string pos ^ ": "
63 | in
64 | Printf.ksprintf (fun s -> raise (Error (pos^s))) e
65 |
--------------------------------------------------------------------------------
/src/langExt.ml:
--------------------------------------------------------------------------------
1 | (** Extensions to the language. *)
2 |
3 | open Stdlib
4 | open Lang
5 |
6 | (*
7 | (** Substitutions. *)
8 | module Subst = struct
9 | (** A substitution: a list of terms with their type. *)
10 | type t = (expr * expr) list
11 |
12 | (** Create from a pasting scheme. *)
13 | let of_ps (ps:PS.t) : t =
14 | List.map (fun (x,t) -> mk (Var x), t) ps
15 |
16 | let dummy = Var (VIdent "?")
17 |
18 | (** Compute all the possible applications of a function to a substitution. *)
19 | let match_app env ps f =
20 | let rec aux f =
21 | match (unevar (infer_type env f)).desc with
22 | | Pi (x,t,u) ->
23 | Enum.flatten
24 | (Enum.may_map
25 | (fun (e,t) ->
26 | let f = mk (App (f,e)) in
27 | (* Printf.printf "try: %s\n" (to_string f); *)
28 | try
29 | ignore (infer_type env f);
30 | Some (aux f)
31 | with
32 | | Common.Error e ->
33 | (* print_endline ("rejected: " ^ e); *)
34 | None
35 | ) (Enum.of_list ps))
36 | | _ -> Enum.once f
37 | in
38 | Enum.to_list (aux f)
39 | (*
40 | let args =
41 | let rec aux = function
42 | | Pi (x,t,u) -> (x,t)::(aux u)
43 | | _ -> []
44 | in
45 | aux (infer_type env f)
46 | in
47 | let rec aux env' = function
48 | | (x,t)::args ->
49 | Enum.flatten
50 | (Enum.may_map
51 | (fun (e,u) ->
52 | (* Printf.printf "env: %s\n%!" (Env.to_string env); *)
53 | let t = subst env' t in
54 | Printf.printf "proposed: %s = %s : %s / %s\n%!" x (to_string e) (to_string t) (to_string u);
55 | let eq = try eq env t u with Common.Error s -> print_endline s; false in
56 | if not eq then (Printf.printf "rejected\n"; None) else
57 | let x' = fresh_var x in
58 | Printf.printf "OK\n%!";
59 | let env' = (x,e)::env' in
60 | let ans = aux env' args in
61 | let ans = Enum.map (fun ss -> (x,e)::ss) ans in
62 | Some ans
63 | ) (Enum.of_list ps)
64 | )
65 | | [] ->
66 | Enum.once []
67 | in
68 | let ss = aux [] args in
69 | Enum.to_list ss
70 | *)
71 | end
72 | *)
73 |
--------------------------------------------------------------------------------
/src/web.ml:
--------------------------------------------------------------------------------
1 | (** Interaction with a webpage. *)
2 |
3 | module Html = Dom_html
4 |
5 | let envs = ref Lang.Envs.empty
6 |
7 | let doc = Html.document
8 | let button txt action =
9 | let button_type = Js.string "button" in
10 | let b = Html.createInput ~_type:button_type doc in
11 | b##value <- Js.string txt;
12 | b##onclick <- Dom_html.handler (fun _ -> action (); Js._true);
13 | b
14 |
15 | let debug s =
16 | Firebug.console##debug (Js.string s)
17 |
18 | let loop s =
19 | envs := Prover.exec !envs s;
20 | Prover.init ()
21 |
22 | let run _ =
23 | let top =
24 | Js.Opt.get
25 | (doc##getElementById(Js.string "toplevel"))
26 | (fun () -> assert false)
27 | in
28 |
29 | let output = Html.createDiv doc in
30 | output##id <- Js.string "output";
31 | output##style##whiteSpace <- Js.string "pre";
32 | Dom.appendChild top output;
33 |
34 | let textbox = Html.createTextarea doc in
35 | textbox##id <- Js.string "input";
36 | textbox##cols <- 80;
37 | textbox##rows <- 25;
38 | (* textbox##value <- Js.string "# "; *)
39 |
40 | (* Current offset in textbox. *)
41 | let tb_off = ref 0 in
42 | let print s =
43 | let s = Js.to_string textbox##value ^ s in
44 | tb_off := String.length s;
45 | textbox##value <- Js.string s;
46 | (* Scroll down. *)
47 | Js.Unsafe.set textbox (Js.string "scrollTop") (Js.Unsafe.get textbox (Js.string "scrollHeight"))
48 | in
49 | let read () =
50 | let s = Js.to_string textbox##value in
51 | let cmd = String.sub s !tb_off (String.length s - !tb_off) in
52 | tb_off := String.length s;
53 | cmd
54 | in
55 |
56 | Common.print_string_fun := print;
57 | Prover.init ();
58 |
59 | let b =
60 | button
61 | "Send"
62 | (fun () ->
63 | let s = read () in
64 | let s =
65 | let s = ref s in
66 | let remove_last () =
67 | if !s = "" then false else
68 | let c = !s.[String.length !s - 1] in
69 | c = '\n' || c = '\r'
70 | in
71 | while remove_last () do
72 | (* remove trailing \n *)
73 | s := String.sub !s 0 (String.length !s - 1)
74 | done;
75 | !s
76 | in
77 | loop s;
78 | textbox##focus();
79 | doc##documentElement##scrollTop <- doc##body##scrollHeight)
80 | in
81 | b##id <- Js.string "send";
82 | Dom.appendChild top b;
83 | Dom.appendChild top textbox;
84 | Dom.appendChild top (Html.createBr doc);
85 | textbox##focus();
86 | textbox##select();
87 |
88 | ignore (Js.Unsafe.eval_string "init();");
89 |
90 | Js._false
91 |
92 | let () =
93 | Html.window##onload <- Html.handler run
94 |
--------------------------------------------------------------------------------
/docs/ocamldoc/style.css:
--------------------------------------------------------------------------------
1 | .keyword { font-weight : bold ; color : Red }
2 | .keywordsign { color : #C04600 }
3 | .comment { color : Green }
4 | .constructor { color : Blue }
5 | .type { color : #5C6585 }
6 | .string { color : Maroon }
7 | .warning { color : Red ; font-weight : bold }
8 | .info { margin-left : 3em; margin-right: 3em }
9 | .param_info { margin-top: 4px; margin-left : 3em; margin-right : 3em }
10 | .code { color : #465F91 ; }
11 | .typetable { border-style : hidden }
12 | .paramstable { border-style : hidden ; padding: 5pt 5pt}
13 | tr { background-color : White }
14 | td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}
15 | div.sig_block {margin-left: 2em}
16 | *:target { background: yellow; }
17 | body {font: 13px sans-serif; color: black; text-align: left; padding: 5px; margin: 0}
18 | h1 { font-size : 20pt ; text-align: center; }
19 | h2 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90BDFF ;padding: 2px; }
20 | h3 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90DDFF ;padding: 2px; }
21 | h4 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90EDFF ;padding: 2px; }
22 | h5 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90FDFF ;padding: 2px; }
23 | h6 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90BDFF ; padding: 2px; }
24 | div.h7 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #E0FFFF ; padding: 2px; }
25 | div.h8 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #F0FFFF ; padding: 2px; }
26 | div.h9 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #FFFFFF ; padding: 2px; }
27 | a {color: #416DFF; text-decoration: none}
28 | a:hover {background-color: #ddd; text-decoration: underline}
29 | pre { margin-bottom: 4px; font-family: monospace; }
30 | pre.verbatim, pre.codepre { }
31 | .indextable {border: 1px #ddd solid; border-collapse: collapse}
32 | .indextable td, .indextable th {border: 1px #ddd solid; min-width: 80px}
33 | .indextable td.module {background-color: #eee ; padding-left: 2px; padding-right: 2px}
34 | .indextable td.module a {color: 4E6272; text-decoration: none; display: block; width: 100%}
35 | .indextable td.module a:hover {text-decoration: underline; background-color: transparent}
36 | .deprecated {color: #888; font-style: italic}
37 | .indextable tr td div.info { margin-left: 2px; margin-right: 2px }
38 | ul.indexlist { margin-left: 0; padding-left: 0;}
39 | ul.indexlist li { list-style-type: none ; margin-left: 0; padding-left: 0; }
--------------------------------------------------------------------------------
/docs/ocamldoc/index_types.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 | Index of types
13 |
14 |
15 |
17 | Index of types
18 |
19 | C
20 | cmd [Lang ]
21 |
22 | A command.
23 |
24 |
25 | D
26 | desc [Lang ]
27 |
28 | Contents of an expression.
29 |
30 |
31 | E
32 | evar [Lang ]
33 |
34 | A meta-variable.
35 |
36 |
37 | expr [Lang ]
38 |
39 | An expression.
40 |
41 |
42 | P
43 | prog [Lang ]
44 |
45 | A program.
46 |
47 |
48 | ps [Lang ]
49 |
50 | A pasting scheme.
51 |
52 |
53 | S
54 | subst [Lang ]
55 |
56 | A substitution.
57 |
58 |
59 | T
60 | t [Lang.Envs ]
61 |
62 | A running environment.
63 |
64 |
65 | t [Lang.Env ]
66 |
67 | A typing environment assign to each variable, its value (when known, which
68 | should be in normal form) and its type.
69 |
70 |
71 | t [Lang.PS ]
72 |
73 | A pasting scheme.
74 |
75 |
76 | V
77 | var [Lang ]
78 |
79 | A variable.
80 |
81 |
82 |
83 |
84 |
--------------------------------------------------------------------------------
/docs/ocamldoc/type_Lang.Env.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 | Lang.Env
12 |
13 |
14 | sig
15 | type t = (Lang .var * (Lang .expr option * Lang .expr)) list
16 | val to_string : Lang .Env .t -> string
17 | val empty : Lang .Env .t
18 | val typ : Lang .Env .t -> Lang .var -> Lang .expr
19 | val value : Lang .Env .t -> Lang .var -> Lang .expr option
20 | val add :
21 | Lang .Env .t -> Lang .var -> ?value:Lang .expr -> Lang .expr -> Lang .Env .t
22 | val add_ps : Lang .Env .t -> (Lang .var * Lang .expr) list -> Lang .Env .t
23 | end
--------------------------------------------------------------------------------
/docs/ocamldoc/Lang.Env.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 | Lang.Env
17 |
18 |
19 |
23 |
24 |
25 | module Env: sig .. end
26 | Typing environments.
27 |
28 |
29 |
30 | type t = (Lang.var * (Lang.expr option * Lang.expr )) list
31 |
32 | A typing environment assign to each variable, its value (when known, which
33 | should be in normal form) and its type.
34 |
35 |
36 |
37 | val to_string : t -> string
38 | String representation.
39 |
40 |
41 | val empty : t
42 | Empty environment.
43 |
44 |
45 | val typ : t -> Lang.var -> Lang.expr
46 | Type of an expression in an environment.
47 |
48 |
49 | val value : t -> Lang.var -> Lang.expr option
50 | Value of an expression in an environment.
51 |
52 |
53 | val add : t -> Lang.var -> ?value:Lang.expr -> Lang.expr -> t
54 | val add_ps : t -> (Lang.var * Lang.expr ) list -> t
--------------------------------------------------------------------------------
/docs/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | CATT
5 |
6 |
7 |
8 |
18 |
19 |
20 | CATT =^.^=
21 |
22 | Coherences for weak ω-categories.
23 |
24 |
25 |
26 |
27 |
36 |
37 | Examples
38 |
39 | If you don't feel inspired, here is a sample session:
40 |
41 | # Identity
42 | coh id (x : *) : x -> x
43 |
44 | # Composition
45 | coh comp (x : *) (y : *) (f : x -> y) (z : *) (g : y -> z) : x -> z
46 |
47 | # Left unit
48 | coh unit-l (x : *) (y : *) (f : x -> y) : comp x x (id x) y f -> f
49 |
50 | # Right unit
51 | coh unit-r (x : *) (y : *) (f : x -> y) : comp x y f y (id y) -> f
52 |
53 | # Unitor
54 | coh unit-lr (x : *) : unit-l x x (id x) -> unit-r x x (id x)
55 |
56 | # Associativity
57 | coh assoc (x : *) (y : *) (f : x -> y) (z : *) (g : y -> z) (w : *) (h : z -> w) : comp x z (comp x y f z g) w h -> comp x y f w (comp y z g w h)
58 |
59 | Implicit arguments are available in order to shorten the coherences:
60 |
61 | # Composition
62 | coh comp (x : *) (y : *) (f : x -> y) (z : *) (g : y -> z) : x -> z
63 | let comp f g = comp _ _ f _ g
64 |
65 | # Associativiy
66 | coh assoc (x : *) (y : *) (f : x -> y) (z : *) (g : y -> z) (w : *) (h : z -> w) : comp (comp f g) h -> comp f (comp g h)
67 | let assoc f g h = assoc _ _ f _ g _ h
68 |
69 | Operations can be polymorphic wrt the type of objects:
70 |
71 | # Composition
72 | let comp (X : Hom) = coh (x : X) (y : X) (f : x -> y) (z : X) (g : y -> z) : (x -> z)
73 |
74 | # 1-composition
75 | let comp1 (x : *) (y : *) (f : x -> y) (z : *) (g : y -> z) = comp * x y f z g
76 |
77 | # 2-composition
78 | let comp2 (x : *) (y : *) (f : x -> y) (f' : x -> y) (a : f -> f') (f'' : x -> y) (b : f' -> f'') = comp (x -> y) f f' a f'' b
79 |
80 | For a more involved example, have a look at
81 | the definition
82 | of the Eckmann-Hilton morphism .
83 |
84 |
85 | More details
86 |
98 |
99 |
100 |
--------------------------------------------------------------------------------
/src/test.catt:
--------------------------------------------------------------------------------
1 | let comp (X : Hom) = coh "comp"
2 | (x : X)
3 | (y : X) (f : x -> y)
4 | (z : X) (g : y -> z)
5 | :
6 | (x -> z)
7 | let comp f g = comp _ _ _ f _ g
8 |
9 | let assoc (X : Hom) = coh "assoc"
10 | (x : X)
11 | (y : X) (f : x -> y)
12 | (z : X) (g : y -> z)
13 | (w : X) (h : z -> w)
14 | :
15 | (comp (comp f g) h -> comp f (comp g h))
16 | let assoc f g h = assoc _ _ _ f _ g _ h
17 |
18 | # let id = coh "id" (x : _) : (x -> x)
19 | # let unitl = coh "unitl" (x : _) (y : _) (f : x -> y) : (comp (id x) f -> f)
20 |
21 | let id (X : Hom) = coh "id" (x : X) : (x -> x)
22 | let id (x : _) = id _ x
23 |
24 | let unitl (X : Hom) = coh "unitl" (x : X) (y : X) (f : x -> y) : (comp (id x) f -> f)
25 | let unitl f = unitl _ _ _ f
26 |
27 | let unitl' (X : Hom) = coh "unitl'" (x : X) (y : X) (f : x -> y) : (f -> comp (id x) f)
28 | let unitl' f = unitl' _ _ _ f
29 |
30 | let unitr (X : Hom) = coh "unitr" (x : *) (y : *) (f : x -> y) : (comp f (id y) -> f)
31 | let unitr f = unitr _ _ _ f
32 | let unitr' (X : Hom) = coh "unitr'" (x : *) (y : *) (f : x -> y) : (f -> comp f (id y))
33 | let unitr' f = unitr' _ _ _ f
34 |
35 | coh comp12
36 | (x : *)
37 | (y : *) (f : x -> y)
38 | (z : *) (g : y -> z)
39 | (g' : y -> z) (a : g -> g')
40 | :
41 | comp f g -> comp f g'
42 | let comp12 f a = comp12 _ _ f _ _ _ a
43 |
44 | coh comp21
45 | (x : *)
46 | (y : *) (f : x -> y)
47 | (f' : x -> y) (a : f -> f')
48 | (z : *) (g : y -> z)
49 | :
50 | comp f g -> comp f' g
51 | let comp21 a g = comp21 _ _ _ _ a _ g
52 |
53 | coh unit12l
54 | (x : *)
55 | (y : *) (f : x -> y)
56 | (g : x -> y) (a : f -> g)
57 | :
58 | comp (unitl' f) (comp (comp12 (id x) a) (unitl g)) -> a
59 | let unit12l a = unit12l _ _ _ _ a
60 |
61 | coh unit12l'
62 | (x : *)
63 | (y : *) (f : x -> y)
64 | (g : x -> y) (a : f -> g)
65 | :
66 | a -> comp (unitl' f) (comp (comp12 (id x) a) (unitl g))
67 | let unit12l' a = unit12l' _ _ _ _ a
68 |
69 | coh unit21r
70 | (x : *)
71 | (y : *) (f : x -> y)
72 | (g : x -> y) (a : f -> g)
73 | :
74 | comp (unitr' f) (comp (comp21 a (id y)) (unitr g)) -> a
75 | let unit21 r a = unit21r _ _ _ _ a
76 |
77 | coh unit21r'
78 | (x : *)
79 | (y : *) (f : x -> y)
80 | (g : x -> y) (a : f -> g)
81 | :
82 | a -> comp (unitr' f) (comp (comp21 a (id y)) (unitr g))
83 | let unit21r' a = unit21r' _ _ _ _ a
84 |
85 | coh ich2
86 | (x : *)
87 | (y : *) (f : x -> y)
88 | (f' : x -> y) (a : f -> f')
89 | (z : *) (g : y -> z)
90 | (g' : y -> z) (b : g -> g')
91 | :
92 | comp (comp21 a g) (comp12 f' b) -> comp (comp12 f b) (comp21 a g')
93 | let ich2 a b = ich2 _ _ _ _ a _ _ _ b
94 |
95 | # MacLane's coherence theorem
96 | coh maclane
97 | (x : *)
98 | (y : *) (f : x -> y)
99 | (z : *) (g : y -> z)
100 | (v : *) (h : z -> v)
101 | (w : *) (i : v -> w)
102 | :
103 | comp (assoc (comp f g) h i) (assoc f g (comp h i))
104 | ->
105 | comp (comp21 (assoc f g h) i) (comp (assoc f (comp g h) i) (comp12 f (assoc g h i)))
106 |
107 | coh comp32
108 | (x : *)
109 | (y : *) (f : x -> y)
110 | (g : x -> y) (a : f -> g)
111 | (b : f -> g) (F : a -> b)
112 | (h : x -> y) (c : g -> h)
113 | :
114 | comp a c -> comp b c
115 | let comp32 F a = comp32 _ _ _ _ _ _ F _ a
116 |
117 | coh comp23
118 | (x : *)
119 | (y : *) (f : x -> y)
120 | (g : x -> y) (a : f -> g)
121 | (h : x -> y) (b : g -> h)
122 | (c : g -> h) (F : b -> c)
123 | :
124 | comp a b -> comp a c
125 | let comp23 a F = comp23 _ _ _ _ a _ _ _ F
126 |
127 | let comp3_1 F G = comp (comp32 F _) (comp23 _ G)
128 |
129 | let eh1 (x : *) (a : id x -> id x) (b : id x -> id x) =
130 | comp3_1 (unit21r' a) (unit12l' b)
131 |
132 | # let eh2 (a : id -> id) (b : id -> id) =
133 | # comp23 () (ich2 a b)
134 |
135 | # let eh (a : id -> id) (b : id -> id) =
136 | # comp3 (eh1 a b) (eh2 a b)
137 |
138 | # let eckmann-hilton (a : id -> id) (b : id -> id) =
139 | # comp2 (comp21 a id) (comp12 id b)
140 |
141 |
142 |
143 |
144 | # hyp x : *
145 | # hyp y : *
146 | # hyp z : *
147 | # hyp f : x -> y
148 | # hyp g : y -> z
149 | # eval (comp f g)
150 |
151 |
152 | # set groupoid = true
153 |
154 | # coh inv (x : *) (y : *) (f : x -> y) : y -> x
155 |
--------------------------------------------------------------------------------
/docs/ocamldoc/Lang.PS.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 | Lang.PS
16 |
17 |
18 |
21 |
22 |
23 | module PS: sig .. end
24 | Pasting schemes.
25 |
26 |
27 |
28 | type t = Lang.ps
29 |
30 | A pasting scheme.
31 |
32 |
33 |
34 | val to_string : Lang.ps -> string
35 | String representation.
36 |
37 |
38 | val marker : Lang.ps -> Lang.var * Lang.expr
39 | Dangling variable.
40 |
41 |
42 | val free_vars : Lang.ps -> Lang.var list
43 | Free variables.
44 |
45 |
46 | val make : (Lang.var * Lang.expr ) list -> t
47 | Create from a context.
48 |
49 |
50 | val height : Lang.ps -> int
51 | Height of a pasting scheme.
52 |
53 |
54 | val dim : Lang.ps -> int
55 | Dimension of a pasting scheme.
56 |
57 |
58 | val source : int -> Lang.ps -> Lang.ps
59 | Source of a pasting scheme.
60 |
61 |
62 | val target : int -> Lang.ps -> Lang.ps
63 | Target of a pasting scheme.
64 |
65 |
66 | val exists : (Lang.var * Lang.expr -> bool) -> Lang.ps -> bool
67 | val map : (Lang.var * Lang.expr -> Lang.var * Lang.expr ) -> Lang.ps -> Lang.ps
68 | val fold_left : ('a -> Lang.var * Lang.expr -> 'a) -> 'a -> Lang.ps -> 'a
69 | val fold_left2 : ('a -> Lang.var * Lang.expr -> Lang.var * Lang.expr -> 'a) -> 'a -> Lang.ps -> Lang.ps -> 'a
70 | val fold_right : (Lang.var * Lang.expr -> 'a -> 'a) -> Lang.ps -> 'a -> 'a
--------------------------------------------------------------------------------
/docs/ocamldoc/type_Lang.PS.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 | Lang.PS
12 |
13 |
14 | sig
15 | type t = Lang .ps
16 | val to_string : Lang .ps -> string
17 | val marker : Lang .ps -> Lang .var * Lang .expr
18 | val free_vars : Lang .ps -> Lang .var list
19 | val make : (Lang .var * Lang .expr) list -> Lang .PS .t
20 | val height : Lang .ps -> int
21 | val dim : Lang .ps -> int
22 | val source : int -> Lang .ps -> Lang .ps
23 | val target : int -> Lang .ps -> Lang .ps
24 | val exists : (Lang .var * Lang .expr -> bool) -> Lang .ps -> bool
25 | val map :
26 | (Lang .var * Lang .expr -> Lang .var * Lang .expr) -> Lang .ps -> Lang .ps
27 | val fold_left : (' a -> Lang .var * Lang .expr -> ' a) -> ' a -> Lang .ps -> ' a
28 | val fold_left2 :
29 | (' a -> Lang .var * Lang .expr -> Lang .var * Lang .expr -> ' a) ->
30 | ' a -> Lang .ps -> Lang .ps -> ' a
31 | val fold_right : (Lang .var * Lang .expr -> ' a -> ' a) -> Lang .ps -> ' a -> ' a
32 | end
--------------------------------------------------------------------------------
/src/eh.catt:
--------------------------------------------------------------------------------
1 | ## The Eckmann-Hilton morphism
2 |
3 | set show-instances = false
4 |
5 | # Identity
6 |
7 | let id (X : Hom) = coh "id" (x : X) : (x -> x)
8 | let id (x : _) = id _ x
9 |
10 | # Composition
11 |
12 | let comp (X : Hom) = coh "comp"
13 | (x : X)
14 | (y : X) (f : x -> y)
15 | (z : X) (g : y -> z)
16 | :
17 | (x -> z)
18 | let comp f g = comp _ _ _ f _ g
19 |
20 | let comp1 f = f
21 | let comp2 = comp
22 | let comp3 f3 f2 f1 = comp f3 (comp f2 f1)
23 | let comp4 f4 f3 f2 f1 = comp f4 (comp3 f3 f2 f1)
24 | let comp5 f5 f4 f3 f2 f1 = comp f5 (comp4 f4 f3 f2 f1)
25 | let comp6 f6 f5 f4 f3 f2 f1 = comp f6 (comp5 f5 f4 f3 f2 f1)
26 | let comp7 f7 f6 f5 f4 f3 f2 f1 = comp f7 (comp6 f6 f5 f4 f3 f2 f1)
27 | let comp8 f8 f7 f6 f5 f4 f3 f2 f1 = comp f8 (comp7 f7 f6 f5 f4 f3 f2 f1)
28 | let comp9 f9 f8 f7 f6 f5 f4 f3 f2 f1 = comp f9 (comp8 f8 f7 f6 f5 f4 f3 f2 f1)
29 | let comp10 f10 f9 f8 f7 f6 f5 f4 f3 f2 f1 = comp f10 (comp9 f9 f8 f7 f6 f5 f4 f3 f2 f1)
30 | let comp11 f11 f10 f9 f8 f7 f6 f5 f4 f3 f2 f1 = comp f11 (comp10 f10 f9 f8 f7 f6 f5 f4 f3 f2 f1)
31 |
32 | let compl' (X : Hom) = coh "compl'"
33 | (x : X)
34 | (y : X) (f : x -> y)
35 | (z : X) (g : y -> z)
36 | (g' : y -> z) (a : g -> g')
37 | :
38 | (comp f g -> comp f g')
39 | let compl' f a = compl' _ _ _ f _ _ _ a
40 |
41 | let compl2' f g a = compl' f (compl' g a)
42 |
43 | let compr' (X : Hom) = coh "compr'"
44 | (x : X)
45 | (y : X) (f : x -> y)
46 | (f' : x -> y) (a : f -> f')
47 | (z : X) (g : y -> z)
48 | :
49 | (comp f g -> comp f' g)
50 | let compr' a g = compr' _ _ _ _ _ a _ g
51 |
52 | let complr' f a g = compl' f (compr' a g)
53 | let compl2r' f1 f2 a g = compl2' f1 f2 (compr' a g)
54 |
55 | let comp' a b = comp (compr' a _) (compl' _ b)
56 | let comp2' = comp'
57 | let comp3' a b c = comp' a (comp' b c)
58 |
59 | let compl'' (X : Hom) = coh "compl''"
60 | (x : X)
61 | (y : X) (f : x -> y)
62 | (z : X) (g : y -> z)
63 | (g' : y -> z) (a : g -> g')
64 | (b : g -> g') (F : a -> b)
65 | :
66 | (compl' f a -> compl' f b)
67 | let compl'' f F = compl'' _ _ _ f _ _ _ _ _ F
68 |
69 | let compr'' (X : Hom) = coh "compr''"
70 | (x : X)
71 | (y : X) (f : x -> y)
72 | (f' : x -> y) (a : f -> f')
73 | (b : f -> f') (F : a -> b)
74 | (z : X) (g : y -> z)
75 | :
76 | (compr' a g -> compr' b g)
77 | let compr'' F g = compr'' _ _ _ _ _ _ _ F _ g
78 |
79 | let comp'' F G = comp' (compl'' _ F) (compr'' F _)
80 |
81 | # Associativity
82 |
83 | let assoc (X : Hom) = coh "assoc"
84 | (x : X)
85 | (y : X) (f : x -> y)
86 | (z : X) (g : y -> z)
87 | (w : X) (h : z -> w)
88 | :
89 | (comp (comp f g) h -> comp f (comp g h))
90 | let assoc f g h = assoc _ _ _ f _ g _ h
91 |
92 | let assoc1 f = f
93 | let assoc2 = assoc
94 | let assoc3 f3 f2 f1 g =
95 | comp
96 | (assoc f3 (comp f2 f1) g)
97 | (compl' f3 (assoc f2 f1 g))
98 | let assoc4 f4 f3 f2 f1 g =
99 | comp
100 | (assoc f4 (comp3 f3 f2 f1) g)
101 | (compl' f4 (assoc3 f3 f2 f1 g))
102 |
103 | let assoc- (X : Hom) = coh "assoc"
104 | (x : X)
105 | (y : X) (f : x -> y)
106 | (z : X) (g : y -> z)
107 | (w : X) (h : z -> w)
108 | :
109 | (comp f (comp g h) -> comp (comp f g) h)
110 | let assoc- f g h = assoc- _ _ _ f _ g _ h
111 |
112 | let assoc3- f3 f2 f1 g =
113 | comp
114 | (compl' f3 (assoc- f2 f1 g))
115 | (assoc- f3 _ g)
116 | # (assoc- f3 (comp f2 f1) g)
117 |
118 | # Units
119 |
120 | let unitl (X : Hom) = coh "unitl"
121 | (x : X)
122 | (y : X) (f : x -> y)
123 | :
124 | (comp (id x) f -> f)
125 | let unitl f = unitl _ _ _ f
126 |
127 | let unitl- (X : Hom) = coh "unitl-"
128 | (x : X)
129 | (y : X) (f : x -> y)
130 | :
131 | (f -> comp (id x) f)
132 | let unitl- f = unitl- _ _ _ f
133 |
134 | let unitr (X : Hom) = coh "unitr"
135 | (x : X)
136 | (y : X) (f : x -> y)
137 | :
138 | (comp f (id y) -> f)
139 | let unitr f = unitr _ _ _ f
140 |
141 | let unitr- (X : Hom) = coh "unitr-"
142 | (x : X)
143 | (y : X) (f : x -> y)
144 | :
145 | (f -> comp f (id y))
146 | let unitr- f = unitr- _ _ _ f
147 |
148 | let unitlr (X : Hom) = coh "unitlr"
149 | (x : X)
150 | :
151 | (unitl (id x) -> unitr (id x))
152 | let unitlr x = unitlr _ x
153 |
154 | let unitrl (X : Hom) = coh "unitrl"
155 | (x : X)
156 | :
157 | (unitr (id x) -> unitl (id x))
158 | let unitrl x = unitrl _ x
159 |
160 | let unitlr- (X : Hom) = coh "unitlr-"
161 | (x : X)
162 | :
163 | (unitl- (id x) -> unitr- (id x))
164 | let unitlr- x = unitlr- _ x
165 |
166 | let unitrl- (X : Hom) = coh "unitrl-"
167 | (x : X)
168 | :
169 | (unitr- (id x) -> unitl- (id x))
170 | let unitrl- x = unitrl- _ x
171 |
172 | let unitr+- (X : Hom) = coh "unitr+-"
173 | (x : X)
174 | (y : X) (f : x -> y)
175 | :
176 | (comp (unitr f) (unitr- f) -> id (comp f (id y)))
177 | let unitr+- f = unitr+- _ _ _ f
178 |
179 | let unitr+-- (X : Hom) = coh "unitr+--"
180 | (x : X)
181 | (y : X) (f : x -> y)
182 | :
183 | (id (comp f (id y)) -> comp (unitr f) (unitr- f))
184 | let unitr+-- f = unitr+-- _ _ _ f
185 |
186 | let unitl' (X : Hom) = coh "unitl'"
187 | (x : X)
188 | (y : X) (f : x -> y)
189 | (g : x -> y) (a : f -> g)
190 | :
191 | (
192 | comp3
193 | (unitl- f)
194 | (compl' (id x) a)
195 | (unitl g)
196 | ->
197 | a
198 | )
199 | let unitl' a = unitl' _ _ _ _ _ a
200 |
201 | let unitl'- (X : Hom) = coh "unitl'-"
202 | (x : X)
203 | (y : X) (f : x -> y)
204 | (g : x -> y) (a : f -> g)
205 | :
206 | (
207 | a
208 | ->
209 | comp3
210 | (unitl- f)
211 | (compl' (id x) a)
212 | (unitl g)
213 | )
214 | let unitl'- a = unitl'- _ _ _ _ _ a
215 |
216 | let unitr' (X : Hom) = coh "unitr'-"
217 | (x : X)
218 | (y : X) (f : x -> y)
219 | (g : x -> y) (a : f -> g)
220 | :
221 | (
222 | comp3
223 | (unitr- f)
224 | (compr' a (id y))
225 | (unitr g)
226 | ->
227 | a
228 | )
229 | let unitr' a = unitr' _ _ _ _ _ a
230 |
231 | let unitr'- (X : Hom) = coh "unitr'-"
232 | (x : X)
233 | (y : X) (f : x -> y)
234 | (g : x -> y) (a : f -> g)
235 | :
236 | (
237 | a
238 | ->
239 | comp3
240 | (unitr- f)
241 | (compr' a (id y))
242 | (unitr g)
243 | )
244 | let unitr'- a = unitr'- _ _ _ _ _ a
245 |
246 | # Exchange law
247 |
248 | let ich (X : Hom) = coh "ich"
249 | (x : X)
250 | (y : X) (f : x -> y)
251 | (f' : x -> y) (a : f -> f')
252 | (z : X) (g : y -> z)
253 | (g' : y -> z) (b : g -> g')
254 | :
255 | (
256 | comp (compl' f b) (compr' a g')
257 | ->
258 | comp (compr' a g) (compl' f' b)
259 | )
260 | let ich a b = ich _ _ _ _ _ a _ _ _ b
261 |
262 | let ich- (X : Hom) = coh "ich-"
263 | (x : X)
264 | (y : X) (f : x -> y)
265 | (f' : x -> y) (a : f -> f')
266 | (z : X) (g : y -> z)
267 | (g' : y -> z) (b : g -> g')
268 | :
269 | (
270 | comp (compr' a g) (compl' f' b)
271 | ->
272 | comp (compl' f b) (compr' a g')
273 | )
274 | let ich- a b = ich- _ _ _ _ _ a _ _ _ b
275 |
276 | # Eckmann-Hilton
277 |
278 | let eh (X : Hom) (x : X)
279 | (a : id x -> id x)
280 | (b : id x -> id x)
281 | =
282 | comp11
283 | (comp'
284 | (unitl'- a)
285 | (unitr'- b)
286 | )
287 | (assoc3 _ _ _ _)
288 | (compl2r' _ _ (unitlr x) _)
289 | (compl2' _ _
290 | (comp3
291 | (assoc- _ _ _)
292 | (comp' (unitr+- (id x)) (id _))
293 | (unitl _)
294 | )
295 | )
296 | (compl' _ (assoc- _ _ _))
297 | (complr' _ (ich b a) _)
298 | (complr' _ (compr' (comp (unitr- _) (compl' _ (unitr+-- _))) _) _)
299 | (comp (complr' _ (assoc3 _ _ _ _) _) (compl' _ (assoc4 _ _ _ _ _)))
300 | (comp' (unitlr- x) (compl' _ (compl' _ (comp' (unitrl- x) (compl' _ (unitrl x))))))
301 | (assoc3- _ _ _ _)
302 | (comp' (unitr' b) (unitl' a))
303 |
304 | check eh
--------------------------------------------------------------------------------
/docs/ocamldoc/index_values.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 | Index of values
13 |
14 |
15 |
17 | Index of values
18 |
268 |
269 |
--------------------------------------------------------------------------------
/docs/ocamldoc/Lang.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 | Lang
23 |
24 |
25 |
29 |
30 |
31 | module Lang: sig .. end
32 | Core part of the language.
33 |
34 |
35 |
36 | Global options
37 |
38 | val groupoid : bool Pervasives.ref
39 | Do we want the theory of groupoids?
40 |
41 |
42 | val unsafe_evars : bool Pervasives.ref
43 | Do we allow unsafe uses of meta-variables?
44 |
45 |
46 | val parametric_schemes : bool Pervasives.ref
47 | Do we allow parametric pasting schemes?
48 |
49 |
50 | val show_instances : bool Pervasives.ref
51 | Do we show instance numbers in strings?
52 |
53 |
54 | Data types
55 |
56 | type var =
57 |
58 |
59 | |
60 |
61 | VIdent of string
62 |
63 |
64 |
65 |
66 | |
67 |
68 | VFresh of string * int
69 |
70 |
71 |
72 |
73 | A variable.
74 |
75 |
76 |
77 | type expr = {
78 |
79 |
80 |
81 |
82 | desc : desc ;
83 |
84 |
85 |
86 |
87 |
88 |
89 | pos : Common.Pos.t;
90 |
91 |
92 | }
93 |
94 |
95 | An expression.
96 |
97 |
98 |
99 | type desc =
100 |
101 |
102 | |
103 |
104 | Var of var
105 |
109 |
110 |
111 |
112 | |
113 |
114 | EVar of (evar Pervasives.ref * subst )
115 |
119 |
120 |
121 |
122 | |
123 |
124 | Type
125 |
126 |
127 |
128 |
129 | |
130 |
131 | HomType
132 |
136 |
137 |
138 |
139 | |
140 |
141 | Obj
142 |
146 |
147 |
148 |
149 | |
150 |
151 | Arr of expr * expr * expr
152 |
156 |
157 |
158 |
159 | |
160 |
161 | Pi of var * expr * expr
162 |
163 |
164 |
165 |
166 | |
167 |
168 | Abs of var * expr * expr
169 |
170 |
171 |
172 |
173 | |
174 |
175 | App of expr * expr
176 |
177 |
178 |
179 |
180 | |
181 |
182 | Coh of string * ps * expr
183 |
187 |
188 |
189 |
190 | Contents of an expression.
191 |
192 |
193 |
194 | type ps =
195 |
196 |
197 | |
198 |
199 | PNil of (var * expr )
200 |
204 |
205 |
206 |
207 | |
208 |
209 | PCons of ps * (var * expr ) * (var * expr )
210 |
214 |
215 |
216 |
217 | |
218 |
219 | PDrop of ps
220 |
224 |
225 |
226 |
227 | A pasting scheme.
228 |
229 |
230 |
231 | type subst = (var * expr ) list
232 |
233 | A substitution.
234 |
235 |
236 |
237 | type evar =
238 |
239 |
240 | |
241 |
242 | ENone of int * expr
243 |
247 |
248 |
249 |
250 | |
251 |
252 | ESome of expr
253 |
257 |
258 |
259 |
260 | A meta-variable.
261 |
262 |
263 |
264 | val mk : ?pos:Common.Pos.t -> desc -> expr
265 | Create an expression from its contents.
266 |
267 |
268 | String representation
269 |
270 | val string_of_var : var -> string
271 | String representation of a variable.
272 |
273 |
274 | val to_string : ?pa:bool -> expr -> string
275 | String representation of an expression.
276 |
277 |
278 | val string_of_evar : ?pa:bool -> evar -> string
279 | String representation of a meta-variable.
280 |
281 |
282 | val string_of_ps : ps -> string
283 | String representation of a pasting scheme.
284 |
285 |
286 | val string_of_evarref : evar Pervasives.ref -> string
287 | val string_of_expr : ?pa:bool -> expr -> string
288 | module PS : sig .. end
289 | Pasting schemes.
290 |
291 |
292 | Variables
293 |
294 | val fresh_var : var -> var
295 | Generate a fresh variable name.
296 |
297 |
298 | val fresh_inevar : ?t:expr -> unit -> evar Pervasives.ref
299 | val fresh_evar : ?pos:Common.Pos.t -> ?t:expr -> unit -> expr
300 | Generate a fresh meta-variable.
301 |
302 |
303 | val occurs_evar : expr -> expr -> bool
304 | Whether a meta-variable occurs in a term.
305 |
306 |
307 | val subst : subst -> expr -> expr
308 | Apply a parallel substitution.
309 |
310 |
311 | val unevar : expr -> expr
312 | Ensure that linked evars do not occur at toplevel.
313 |
314 |
315 | val free_evar : expr -> evar Pervasives.ref list
316 | Free meta-variables.
317 |
318 |
319 | val instantiate : expr -> expr
320 | Replace EVars by fresh ones.
321 |
322 |
323 | val free_vars : expr -> var list
324 | Free variables.
325 |
326 |
327 | module Env : sig .. end
328 | Typing environments.
329 |
330 |
331 | Reduction and typing
332 |
333 | val normalize : Env.t -> expr -> expr
334 | Normalize a value.
335 |
336 |
337 | val infer_type : Env.t -> expr -> expr
338 | Type inference.
339 |
340 |
341 | val check_type : Env.t -> expr -> expr -> unit
342 | Check that an expression has given type.
343 |
344 |
345 | val leq : Env.t -> expr -> expr -> bool
346 | Subtype relation between expressions.
347 |
348 |
349 | Programs
350 |
351 | type cmd =
352 |
353 |
354 | |
355 |
356 | Decl of var * expr
357 |
361 |
362 |
363 |
364 | |
365 |
366 | Axiom of var * expr
367 |
371 |
372 |
373 |
374 | |
375 |
376 | Check of expr
377 |
381 |
382 |
383 |
384 | |
385 |
386 | Eval of expr
387 |
391 |
392 |
393 |
394 | |
395 |
396 | Env
397 |
401 |
402 |
403 |
404 | |
405 |
406 | Set of string * string
407 |
411 |
412 |
413 |
414 | A command.
415 |
416 |
417 |
418 | val string_of_cmd : cmd -> string
419 | String representation of a command.
420 |
421 |
422 | type prog = cmd list
423 |
424 | A program.
425 |
426 |
427 |
428 | module Envs : sig .. end
429 | Running environment.
430 |
431 |
432 | val exec_cmd : Envs.t -> cmd -> Envs.t
433 | Execute a command.
434 |
435 |
436 | val exec : Envs.t -> cmd list -> Envs.t
437 | Execute a program.
438 |
439 |
--------------------------------------------------------------------------------
/src/lang.ml:
--------------------------------------------------------------------------------
1 | (** Core part of the language. *)
2 |
3 | open Extlib
4 | open Common
5 |
6 | (** {2 Global options} *)
7 |
8 | (** Do we want the theory of groupoids? *)
9 | let groupoid = ref false
10 | (** Do we allow unsafe uses of meta-variables? *)
11 | let unsafe_evars = ref false
12 | (** Do we allow parametric pasting schemes? *)
13 | let parametric_schemes = ref true
14 | (** Do we show instance numbers in strings? *)
15 | let show_instances = ref true
16 |
17 | (** {2 Data types} *)
18 |
19 | (** A variable. *)
20 | type var =
21 | | VIdent of string
22 | | VFresh of string * int
23 |
24 | (** An expression. *)
25 | type expr =
26 | {
27 | desc : desc;
28 | pos : Pos.t;
29 | }
30 |
31 | (** Contents of an expression. *)
32 | and desc =
33 | | Var of var (** type variable *)
34 | | EVar of (evar ref * subst) (** meta-variable (expression, substition) *)
35 | | Type
36 | | HomType (** a type of hom set *)
37 | | Obj (** type of 0-cells *)
38 | | Arr of expr * expr * expr (** arrow type *)
39 | | Pi of var * expr * expr
40 | | Abs of var * expr * expr
41 | | App of expr * expr
42 | | Coh of string * ps * expr (** coherence (name, source, target) *)
43 |
44 | (** A pasting scheme. *)
45 | and ps =
46 | | PNil of (var * expr) (** start *)
47 | | PCons of ps * (var * expr) * (var * expr) (** extend *)
48 | | PDrop of ps (** drop *)
49 |
50 | (** A substitution. *)
51 | and subst = (var * expr) list
52 |
53 | (** A meta-variable. *)
54 | and evar =
55 | | ENone of int * expr (** unknown variable with given number and type *)
56 | | ESome of expr (** instantiated variable *)
57 |
58 | (** Create an expression from its contents. *)
59 | let mk ?pos desc =
60 | let pos = Option.default Pos.dummy pos in
61 | { desc; pos }
62 |
63 | (** {2 String representation} *)
64 |
65 | (** String representation of a variable. *)
66 | let string_of_var = function
67 | | VIdent x -> x
68 | | VFresh (x,n) -> x ^ (if !show_instances then "." ^ string_of_int n else "")
69 |
70 | (** String representation of an expression. *)
71 | let rec to_string ?(pa=false) e =
72 | let to_string pa e = to_string ~pa e in
73 | let string_of_evar x = string_of_evar ~pa x in
74 | let pa s = if pa then "("^s^")" else s in
75 | match e.desc with
76 | | Var x -> string_of_var x
77 | | EVar (x,_) -> string_of_evar !x
78 | | Type -> "Type"
79 | | HomType -> "HomType"
80 | | Obj -> "*"
81 | | Arr (t,f,g) -> pa (Printf.sprintf "%s | %s -> %s" (to_string false t) (to_string false f) (to_string false g))
82 | | Coh (c,ps,t) ->
83 | if c = "" then
84 | Printf.sprintf "coh (%s => %s)" (string_of_ps ps) (to_string false t)
85 | else
86 | c
87 | | Pi (x,t,u) -> pa (Printf.sprintf "(%s : %s) => %s" (string_of_var x) (to_string false t) (to_string false u))
88 | | Abs (x,t,e) -> pa (Printf.sprintf "\\(%s : %s) => %s" (string_of_var x) (to_string false t) (to_string false e))
89 | | App (f,e) -> pa (to_string false f ^ " " ^ to_string true e)
90 |
91 | (** String representation of a meta-variable. *)
92 | and string_of_evar ?(pa=false) = function
93 | | ENone(n,t) ->
94 | if !show_instances then "?"^string_of_int n else "_"
95 | (* Printf.sprintf "(?%d:%s)" n (to_string t) *)
96 | | ESome x -> to_string ~pa x
97 | (* "[" ^ to_string false x ^ "]" *)
98 |
99 | (** String representation of a pasting scheme. *)
100 | and string_of_ps = function
101 | | PNil (x,t) -> Printf.sprintf "(%s : %s)" (string_of_var x) (to_string t)
102 | | PCons (ps,(x,t),(y,u)) -> Printf.sprintf "%s (%s : %s) (%s : %s)" (string_of_ps ps) (string_of_var x) (to_string t) (string_of_var y) (to_string u)
103 | | PDrop ps -> string_of_ps ps ^ " ! "
104 |
105 | let string_of_evarref x = string_of_evar !x
106 |
107 | let string_of_expr = to_string
108 |
109 | (** Pasting schemes. *)
110 | module PS = struct
111 | (** A pasting scheme. *)
112 | type t = ps
113 |
114 | (** String representation. *)
115 | let to_string = string_of_ps
116 |
117 | exception Invalid
118 |
119 | (** Dangling variable. *)
120 | let rec marker ps =
121 | (* Printf.printf "marker: %s\n%!" (to_string ps); *)
122 | match ps with
123 | | PNil (x,t) -> x,t
124 | | PCons (ps,_,f) -> f
125 | | PDrop ps ->
126 | let f,tf = marker ps in
127 | match tf.desc with
128 | | Arr (_,x,{desc = Var y}) ->
129 | let t =
130 | let rec aux = function
131 | | PNil (x,t) -> assert (x = y); t
132 | | PCons (ps,(y',ty),(f,tf)) ->
133 | if y' = y then ty
134 | else if f = y then tf
135 | else aux ps
136 | | PDrop ps -> aux ps
137 | in
138 | aux ps
139 | in
140 | y,t
141 | | _ -> raise Invalid
142 |
143 | (** Free variables. *)
144 | let rec free_vars = function
145 | | PNil (x,t) -> [x]
146 | | PCons (ps,(y,_),(f,_)) -> f::y::(free_vars ps)
147 | | PDrop ps -> free_vars ps
148 |
149 | (** Create from a context. *)
150 | let make l : t =
151 | (* Printf.printf "make: %s\n%!" (String.concat_map " " (fun (x,t) -> Printf.sprintf "(%s : %s)" (string_of_var x) (string_of_expr t)) l); *)
152 | let x0,t0,l =
153 | match l with
154 | | (x,t)::l ->
155 | if not !parametric_schemes then assert (t.desc = Obj);
156 | x,t,l
157 | | [] -> error "pasting scheme cannot be empty"
158 | in
159 | let rec aux ps = function
160 | | (y,ty)::(f,tf)::l ->
161 | begin
162 | try
163 | match tf.desc with
164 | | Arr (_, {desc = Var fx}, {desc = Var fy}) ->
165 | (* Printf.printf "check: %s:?->%s\n%!" (string_of_var f) (string_of_var y); *)
166 | if (y <> fy) then error ~pos:tf.pos "not a pasting scheme (following types do not match)";
167 | let x,tx = marker ps in
168 | if x = fx then
169 | let fvps = free_vars ps in
170 | assert (not (List.mem f fvps));
171 | assert (not (List.mem y fvps));
172 | let ps = PCons (ps,(y,ty),(f,tf)) in
173 | aux ps l
174 | else
175 | aux (PDrop ps) ((y,ty)::(f,tf)::l)
176 | | _ -> error ~pos:tf.pos "not a pasting scheme (types do not match)"
177 | with
178 | | Invalid ->
179 | (* TODO: better position *)
180 | error ~pos:tf.pos "not a pasting scheme"
181 | end
182 | | [x,tx] -> error ~pos:tx.pos "not a pasting scheme (invalid parity)"
183 | | [] -> ps
184 | in
185 | aux (PNil(x0,t0)) l
186 |
187 | (** Height of a pasting scheme. *)
188 | let rec height = function
189 | | PNil _ -> 0
190 | | PCons (ps,_,_) -> height ps + 1
191 | | PDrop ps -> height ps - 1
192 |
193 | (** Dimension of a pasting scheme. *)
194 | let rec dim = function
195 | | PNil _ -> 0
196 | | PCons (ps,_,_) -> max (dim ps) (height ps + 1)
197 | | PDrop ps -> dim ps
198 |
199 | (** Source of a pasting scheme. *)
200 | let source i ps =
201 | assert (i >= 0);
202 | let rec aux = function
203 | | PNil _ as ps -> ps
204 | | PCons (ps,_,_) when height ps >= i -> aux ps
205 | | PCons (ps,y,f) -> PCons (aux ps,y,f)
206 | | PDrop ps when height ps > i -> aux ps
207 | | PDrop ps -> PDrop (aux ps)
208 | in
209 | aux ps
210 |
211 | (** Target of a pasting scheme. *)
212 | let target i ps =
213 | assert (i >= 0);
214 | let replace g = function
215 | | PNil x -> PNil g
216 | | PCons (ps,y,f) -> PCons (ps,y,g)
217 | | _ -> assert false
218 | in
219 | let rec aux = function
220 | | PNil _ as ps -> ps
221 | | PCons (ps,_,_) when height ps > i -> aux ps
222 | | PCons (ps,y,f) when height ps = i -> replace y (aux ps)
223 | | PCons (ps,y,f) -> PCons (aux ps,y,f)
224 | | PDrop ps when height ps > i -> aux ps
225 | | PDrop ps -> PDrop (aux ps)
226 | in
227 | aux ps
228 |
229 | let rec exists f = function
230 | | PNil x -> f x
231 | | PCons (ps,x,y) -> exists f ps || f x || f y
232 | | PDrop ps -> exists f ps
233 |
234 | let rec map f = function
235 | | PNil x -> PNil (f x)
236 | | PCons (ps,x,y) ->
237 | let ps = map f ps in
238 | let x = f x in
239 | let y = f y in
240 | PCons (ps,x,y)
241 | | PDrop ps -> PDrop (map f ps)
242 |
243 | let rec fold_left f s = function
244 | | PNil x -> f s x
245 | | PCons (ps,x,y) ->
246 | let s = fold_left f s ps in
247 | let s = f s x in
248 | f s y
249 | | PDrop ps -> fold_left f s ps
250 |
251 | let rec fold_left2 f s ps1 ps2 =
252 | match ps1, ps2 with
253 | | PNil x1, PNil x2 -> f s x1 x2
254 | | PCons (ps1,y1,f1), PCons(ps2,y2,f2) ->
255 | let s = fold_left2 f s ps1 ps2 in
256 | let s = f s y1 y2 in
257 | f s f1 f2
258 | | PDrop ps1, PDrop ps2 -> fold_left2 f s ps1 ps2
259 | | (PNil _ | PCons _ | PDrop _), _ -> assert false
260 |
261 | let rec fold_right f ps s =
262 | match ps with
263 | | PNil x -> f x s
264 | | PCons (ps,x,y) ->
265 | let s = f y s in
266 | let s = f x s in
267 | fold_right f ps s
268 | | PDrop ps -> fold_right f ps s
269 | end
270 |
271 | (** {2 Variables} *)
272 |
273 | (** Generate a fresh variable name. *)
274 | let fresh_var =
275 | let count = ref [] in
276 | (fun x ->
277 | let x =
278 | match x with
279 | | VIdent x -> x
280 | | VFresh (x,_) -> x
281 | in
282 | let n =
283 | try
284 | let n = List.assoc x !count in
285 | count := List.remove_assoc x !count;
286 | count := (x,n+1) :: !count;
287 | n
288 | with
289 | | Not_found ->
290 | count := (x,1) :: !count;
291 | 0
292 | in
293 | VFresh (x,n))
294 |
295 | let fresh_inevar =
296 | let n = ref (-1) in
297 | fun ?t () ->
298 | let t =
299 | match t with
300 | | Some t -> t
301 | | None -> mk (EVar (ref (ENone ((incr n; !n), mk Type)), []))
302 | in
303 | ref (ENone ((incr n; !n), t))
304 |
305 | (** Generate a fresh meta-variable. *)
306 | let fresh_evar ?pos ?t () =
307 | mk ?pos (EVar (fresh_inevar ?t (), []))
308 |
309 | (** Whether a meta-variable occurs in a term. *)
310 | let occurs_evar v e =
311 | let x =
312 | match v.desc with
313 | | EVar ({contents = ENone _} as x, _) -> x
314 | | _ -> assert false
315 | in
316 | let rec aux e =
317 | match e.desc with
318 | | Var _ -> false
319 | | EVar (x', _) -> x' == x
320 | | Type -> false
321 | | Abs (x,t,e) -> aux t || aux e
322 | | App (f,e) -> aux f || aux e
323 | | Pi (x,t,u) -> aux t || aux u
324 | | HomType -> false
325 | | Obj -> false
326 | | Arr (t,f,g) -> aux t || aux f || aux g
327 | | Coh (_,ps,e) -> PS.exists (fun (x,t) -> aux t) ps || aux e
328 | in
329 | aux e
330 |
331 | (** Apply a parallel substitution. *)
332 | let rec subst (s:subst) e =
333 | (* Printf.printf "subst: %s[%s]\n%!" (to_string e) (String.concat "," (List.map (fun (x,e) -> to_string e ^ "/" ^ x) s)); *)
334 | let desc =
335 | match e.desc with
336 | | Var x ->
337 | begin
338 | try
339 | (List.assoc x s).desc
340 | with
341 | | Not_found -> e.desc
342 | end
343 | | EVar (x,s') -> (match !x with ENone _ -> EVar (x,s'@s) | ESome e -> (subst (s'@s) e).desc)
344 | | Type -> Type
345 | | HomType -> HomType
346 | | Obj -> Obj
347 | | Arr (t,x,y) -> Arr (subst s t, subst s x, subst s y)
348 | | Coh (c,ps,t) ->
349 | let s = ref s in
350 | let ps =
351 | PS.map
352 | (fun (x,t) ->
353 | let x' = fresh_var x in
354 | let t = subst !s t in
355 | s := (x,mk (Var x')) :: !s;
356 | x',t
357 | ) ps
358 | in
359 | let t = subst !s t in
360 | Coh (c,ps,t)
361 | | App (f,x) -> App (subst s f, subst s x)
362 | | Abs (x,t,e) ->
363 | let t = subst s t in
364 | let x' = fresh_var x in
365 | let s = (x,mk ~pos:e.pos (Var x'))::s in
366 | let e = subst s e in
367 | Abs (x',t,e)
368 | | Pi (x,t,u) ->
369 | let t = subst s t in
370 | let x' = fresh_var x in
371 | let s = (x,mk ~pos:e.pos (Var x'))::s in
372 | let u = subst s u in
373 | Pi (x',t,u)
374 | in
375 | mk ~pos:e.pos desc
376 |
377 | (** Ensure that linked evars do not occur at toplevel. *)
378 | let rec unevar e =
379 | match e.desc with
380 | | EVar ({contents = ESome e}, s) -> unevar (subst s e)
381 | | _ -> e
382 |
383 | (** Free meta-variables. *)
384 | (* Note we could compare contents, but it is safer to compare evars by comparing
385 | their references. *)
386 | let rec free_evar e =
387 | match (unevar e).desc with
388 | | EVar (x,_) -> [x]
389 | | Var _ | Type | HomType | Obj -> []
390 | | Abs (_,t,e) -> List.diffq (free_evar e) (free_evar t)
391 | | App (e1,e2) -> List.unionq (free_evar e1) (free_evar e2)
392 | | Arr (t, f, g) -> List.unionq (free_evar t) (List.unionq (free_evar f) (free_evar g))
393 | | Pi (_,t,u) -> List.unionq (free_evar t) (free_evar u)
394 | | Coh (_,ps,t) -> PS.fold_left (fun l (x,t) -> List.unionq (free_evar t) l) (free_evar t) ps
395 |
396 | (** Replace EVars by fresh ones. *)
397 | (* TODO: use levels? *)
398 | let instantiate e =
399 | let g = ref [] in
400 | let rec aux e =
401 | let desc =
402 | let e = unevar e in
403 | match e.desc with
404 | | Var _ -> e.desc
405 | | EVar (x, s) ->
406 | let x' =
407 | try
408 | List.assq x !g
409 | with
410 | | Not_found ->
411 | let x' = fresh_inevar () in
412 | g := (x,x') :: !g;
413 | x'
414 | in
415 | EVar (x', s)
416 | | Type -> Type
417 | | Abs (x,t,e) -> Abs (x, aux t, aux e)
418 | | App (f,e) -> App (aux f, aux e)
419 | | Pi (x,t,u) -> Pi (x, aux t, aux u)
420 | | HomType | Obj as e -> e
421 | | Coh (c,ps,t) ->
422 | let ps = PS.map (fun (x,t) -> x,aux t) ps in
423 | let t = aux t in
424 | Coh (c,ps,t)
425 | | Arr (t,f,g) -> Arr (aux t, aux f, aux g)
426 | in
427 | mk ~pos:e.pos desc
428 | in
429 | aux e
430 |
431 | (** Free variables. *)
432 | let rec free_vars e =
433 | (* Printf.printf "free_vars: %s\n%!" (to_string e); *)
434 | match (unevar e).desc with
435 | | Var x -> [x]
436 | | EVar (x,s) ->
437 | if !parametric_schemes then [] else
438 | error ~pos:e.pos "don't know how to compute free variables in meta-variables"
439 | | Type | HomType | Obj -> []
440 | | Arr (t,f,g) -> (free_vars t)@(free_vars f)@(free_vars g)
441 | | App (f,x) -> (free_vars f)@(free_vars x)
442 | | Pi (x,t,u) -> (free_vars t)@(List.remove x (free_vars u))
443 | | Abs (x,t,e) -> (free_vars t)@(List.remove x (free_vars e))
444 | | Coh (c,ps,t) -> PS.fold_right (fun (x,t) l -> (free_vars t)@List.remove x l) ps (free_vars t)
445 |
446 | (** Typing environments. *)
447 | module Env = struct
448 | (** A typing environment assign to each variable, its value (when known, which should be in normal form) and its type. *)
449 | type t = (var * (expr option * expr)) list
450 |
451 | (** String representation. *)
452 | let to_string (env:t) =
453 | let f (x, (e, t)) =
454 | let x = string_of_var x in
455 | match e with
456 | | Some e ->
457 | let pad = String.make (String.length x) ' ' in
458 | Printf.sprintf "%s = %s\n%s : %s\n" x (to_string e) pad (to_string t)
459 | | None ->
460 | Printf.sprintf "%s : %s\n" x (to_string t)
461 | in
462 | String.concat "\n" (List.map f (List.rev env))
463 |
464 | (** Empty environment. *)
465 | let empty : t = []
466 |
467 | (** Type of an expression in an environment. *)
468 | let typ (env:t) x = snd (List.assoc x env)
469 |
470 | (** Value of an expression in an environment. *)
471 | let value (env:t) x = fst (List.assoc x env)
472 |
473 | let add (env:t) x ?value t : t = (x,(value,t))::env
474 |
475 | let add_ps env ps = List.fold_left (fun env (x,t) -> add env x t) env ps
476 | end
477 |
478 | (** {2 Reduction and typing} *)
479 |
480 | (** Normalize a value. *)
481 | let rec normalize env e =
482 | (* Printf.printf "normalize: %s\n%!" (to_string e); *)
483 | let desc =
484 | match (unevar e).desc with
485 | | Var x ->
486 | begin
487 | try
488 | match Env.value env x with
489 | | Some e -> (normalize env (instantiate e)).desc
490 | | None -> Var x
491 | with
492 | | Not_found -> error ~pos:e.pos "unknown identifier %s" (string_of_var x)
493 | end
494 | | EVar (x,s) as e -> (match !x with ENone _ -> e | ESome e -> assert false)
495 | | App (f, e) ->
496 | let f = normalize env f in
497 | let e = normalize env e in
498 | begin
499 | match f.desc with
500 | | Abs (x,t,f) -> (subst [x,e] f).desc (* TODO: use environment? *)
501 | | _ -> App (f, e)
502 | end
503 | | Type -> Type
504 | | HomType -> HomType
505 | | Pi (x,t,u) ->
506 | let t = normalize env t in
507 | let u = normalize (Env.add env x t) u in
508 | Pi (x,t,u)
509 | | Abs (x,t,e) ->
510 | let t = normalize env t in
511 | let e = normalize (Env.add env x t) e in
512 | Abs (x,t,e)
513 | | Obj -> Obj
514 | | Coh (c,ps,t) ->
515 | let env = ref env in
516 | let ps =
517 | PS.map
518 | (fun (x,t) ->
519 | let t = normalize !env t in
520 | env := Env.add !env x t;
521 | x,t
522 | ) ps
523 | in
524 | let t = normalize !env t in
525 | Coh (c,ps,t)
526 | | Arr (t,f,g) ->
527 | let t = normalize env t in
528 | let f = normalize env f in
529 | let g = normalize env g in
530 | Arr (t,f,g)
531 | in
532 | mk ~pos:e.pos desc
533 |
534 | (** Type inference. *)
535 | let rec infer_type env e =
536 | (* Printf.printf "env: %s\n" (String.concat " " (List.map fst env)); *)
537 | (* Printf.printf "infer_type: %s\n%!" (to_string e); *)
538 | (* let infer_type env e = *)
539 | (* let t = infer_type env e in *)
540 | (* Printf.printf "infer_type: %s : %s\n%!" (to_string e) (to_string t); *)
541 | (* t *)
542 | (* in *)
543 | match e.desc with
544 | | Var x ->
545 | begin
546 | try
547 | let t = Env.typ env x in
548 | if Env.value env x <> None then instantiate t else t
549 | with
550 | | Not_found -> error ~pos:e.pos "unknown identifier %s" (string_of_var x)
551 | end
552 | | EVar (x,s) -> (match !x with ENone (n,t) -> t | ESome e -> infer_type env (subst s e))
553 | | Type -> mk Type
554 | | Pi (x,t,u) ->
555 | check_type env t (mk Type);
556 | check_type (Env.add env x t) u (mk Type);
557 | mk Type
558 | | Abs (x,t,e) ->
559 | check_type env t (mk Type);
560 | let u = infer_type (Env.add env x t) e in
561 | mk (Pi (x,t,u))
562 | | App (f,e) ->
563 | let t = infer_type env f in
564 | let x,t,u =
565 | match (unevar t).desc with
566 | | Pi (x,t,u) -> x,t,u
567 | | _ -> error ~pos:f.pos "got %s : %s, but a function is expected" (to_string f) (to_string t)
568 | in
569 | let te = infer_type env e in
570 | if not (leq env te t) then error ~pos:e.pos "got %s, but %s is expected" (to_string te) (to_string t);
571 | subst [x,e] u
572 | | HomType -> mk Type
573 | | Obj -> mk HomType
574 | | Coh (c,ps,t) ->
575 | (* Normalize types in order to reveal hidden variables. *)
576 | let env = ref env in
577 | let ps =
578 | PS.map
579 | (fun (x,t) ->
580 | let t = normalize !env t in
581 | check_type !env t (mk HomType);
582 | env := Env.add !env x t;
583 | x,t
584 | ) ps
585 | in
586 | let env = !env in
587 | let t = normalize env t in
588 | check_type env t (mk HomType);
589 | (* Printf.printf "COH: %s\n%!" (to_string (mk (Coh(c,ps,t)))); *)
590 | (* Printf.printf "env:\n\n%s\n%!" (Env.to_string env); *)
591 | (* Printf.printf "type: %s\n%!" (to_string t); *)
592 | (* Printf.printf "type: %s\n%!" (to_string (normalize env t)); *)
593 | (* debug "check pasting scheme %s" (PS.to_string ps); *)
594 | if not !groupoid then
595 | begin
596 | let f,g =
597 | match (unevar t).desc with
598 | | Arr (_,f,g) -> f,g
599 | | _ -> assert false
600 | in
601 | let fv = PS.free_vars ps in
602 | let rec close_vars f =
603 | match (unevar (infer_type env f)).desc with
604 | | Arr (_,x,y) -> List.union (close_vars x) (List.union (close_vars y) (free_vars f))
605 | | t ->
606 | if not !parametric_schemes then assert (t = Obj);
607 | free_vars f
608 | in
609 | let fvf = close_vars f in
610 | let fvg = close_vars g in
611 | if not (List.included fv fvf && List.included fv fvg) then
612 | begin
613 | let i = PS.dim ps in
614 | (* debug "checking decompositions"; *)
615 | let pss = PS.source (i-1) ps in
616 | let pst = PS.target (i-1) ps in
617 | (* Printf.printf "ps : %s\n%!" (PS.to_string ps); *)
618 | (* Printf.printf "dim: %d\n%!" i; *)
619 | (* Printf.printf "src: %s\n%!" (PS.to_string pss); *)
620 | (* Printf.printf "tgt: %s\n%!" (PS.to_string pst); *)
621 | let fvs = PS.free_vars pss in
622 | let fvt = PS.free_vars pst in
623 | if i < 1
624 | || not (List.included fvs fvf)
625 | || not (List.included fvt fvg)
626 | then
627 | let bad = List.union (List.diff fvs fvf) (List.diff fvt fvg) in
628 | let bad = String.concat ", " (List.map string_of_var bad) in
629 | error ~pos:t.pos "not algebraic: %s not used in %s" bad (to_string (mk (Coh (c,ps,t))));
630 | end;
631 | end;
632 | PS.fold_right (fun (x,t) u -> mk (Pi (x,t,u))) ps t
633 | | Arr (t,f,g) ->
634 | check_type env t (mk HomType);
635 | check_type env f t;
636 | check_type env g t;
637 | mk HomType
638 |
639 | (** Check that an expression has given type. *)
640 | and check_type env e t =
641 | let te = infer_type env e in
642 | if not (leq env te t) then error ~pos:e.pos "got %s, but %s is expected" (to_string te) (to_string t)
643 |
644 | (** Subtype relation between expressions. *)
645 | and leq env e1 e2 =
646 | let rec leq e1 e2 =
647 | (* Printf.printf "leq\n%s\n%s\n\n" (to_string e1) (to_string e2); *)
648 | let e1 = unevar e1 in
649 | let e2 = unevar e2 in
650 | match e1.desc, e2.desc with
651 | | Var x1, Var x2 -> x1 = x2
652 | | Pi (x1,t1,u1), Pi (x2,t2,u2) -> leq t2 t1 && leq u1 (subst [x2,mk (Var x1)] u2)
653 | | Abs (x1,t1,e1), Abs (x2,t2,e2) -> leq t2 t1 && leq e1 (subst [x2,mk (Var x1)] e2)
654 | | App (f1,e1), App (f2,e2) -> leq f1 f2 && leq e1 e2
655 | | Type, Type -> true
656 | | HomType, HomType -> true
657 | | HomType, Type -> true
658 | | Obj, Obj -> true
659 | | Coh(_,ps1,t1), Coh(_,ps2,t2) ->
660 | (*
661 | let rec aux l1 s l2 =
662 | match l1,l2 with
663 | | [],[] -> leq t1 (subst s t2)
664 | | (x1,t1)::l1, (x2,t2)::l2 ->
665 | let t2 = subst s t2 in
666 | let s = (x2,mk (Var x1))::s in
667 | leq t1 t2 && aux l1 s l2
668 | | _ -> false
669 | in
670 | aux ps1 [] ps2
671 | *)
672 | let s = ref [] in
673 | let ans =
674 | PS.fold_left2
675 | (fun ans (x1,t1) (x2,t2) ->
676 | let t2 = subst !s t2 in
677 | s := (x2,mk (Var x1)) :: !s;
678 | ans && leq t1 t2
679 | ) true ps1 ps2
680 | in
681 | ans && leq t1 (subst !s t2)
682 | | Arr (t1,f1,g1), Arr (t2,f2,g2) -> leq t1 t2 && leq f1 f2 && leq g1 g2
683 | | EVar (x1, _), EVar (x2, _) when x1 == x2 -> true
684 | (* | EVar ({contents = ESome t}, s), _ -> leq (subst s t) t2 *)
685 | (* | _, EVar ({contents = ESome t}, s) -> leq t1 (subst s t) *)
686 | | EVar ({contents = ENone (n,t)} as x, s), _ ->
687 | if occurs_evar e1 e2 then false
688 | else if not (leq (infer_type env e2) t) then false
689 | else (x := ESome e2; leq e1 e2)
690 | | _, EVar({contents = ENone (n,t)} as x, s) ->
691 | if occurs_evar e2 e1 then false
692 | else if not (leq (infer_type env e1) t) then false
693 | else (x := ESome e1; leq e1 e2)
694 | | (Var _ | Abs _ | App _ | Type | HomType | Pi _ | Obj | Arr _ | Coh _), _ -> false
695 | | EVar _, _ -> assert false
696 | in
697 | leq (normalize env e1) (normalize env e2)
698 |
699 | (** {2 Programs} *)
700 |
701 | (** A command. *)
702 | type cmd =
703 | | Decl of var * expr (** Declare a variable. *)
704 | | Axiom of var * expr (** Declare an axiom of given type. *)
705 | | Check of expr (** Check the type of an expression. *)
706 | | Eval of expr (** Evaluate an expression. *)
707 | | Env (** Display the environment. *)
708 | | Set of string * string (** Set an option. *)
709 |
710 | (** String representation of a command. *)
711 | let string_of_cmd = function
712 | | Decl (x,e) -> Printf.sprintf "let %s = %s" (string_of_var x) (to_string e)
713 | | Axiom (x,e) -> Printf.sprintf "ax %s : %s" (string_of_var x) (to_string e)
714 | | Check e -> Printf.sprintf "check %s" (to_string e)
715 | | Eval e -> Printf.sprintf "eval %s" (to_string e)
716 | | Set (x,v) -> Printf.sprintf "set %s = %s" x v
717 | | Env -> "env"
718 |
719 | (** A program. *)
720 | type prog = cmd list
721 |
722 | (** Running environment. *)
723 | module Envs = struct
724 | (** A running environment. *)
725 | type t = Env.t * subst
726 |
727 | (** Empty running environment. *)
728 | let empty : t = Env.empty, []
729 | end
730 |
731 | (** Execute a command. *)
732 | let exec_cmd ((env,s):Envs.t) cmd : Envs.t =
733 | command "%s" (string_of_cmd cmd);
734 | match cmd with
735 | | Decl (x,e) ->
736 | let e = subst s e in
737 | let t = infer_type env e in
738 | (* let e = normalize env e in *)
739 | (* let t = infer_type env e in *)
740 | let x' = fresh_var x in
741 | info "%s = %s\n : %s" (string_of_var x') (to_string e) (to_string t);
742 | (* Try to resolve meta-variables. *)
743 | let mv = free_evar e in
744 | let mv = List.filter (fun x -> match !x with ENone (n,t) -> (unevar t).desc <> HomType | ESome _ -> assert false) mv in
745 | if not !unsafe_evars && mv <> [] then
746 | (
747 | let s x = string_of_evarref x in
748 | (* let s x = *)
749 | (* let t = *)
750 | (* match !x with *)
751 | (* | ENone (_,t) -> t *)
752 | (* | _ -> assert false *)
753 | (* in *)
754 | (* string_of_evarref x ^ " : " ^ to_string t *)
755 | (* in *)
756 | let mv = String.concat ", " (List.map s mv) in
757 | error ~pos:e.pos "expression %s has meta-variables %s" (to_string e) mv
758 | );
759 | let env = Env.add env x' ~value:e t in
760 | let s = (x,mk (Var x'))::s in
761 | env,s
762 | | Axiom (x,t) ->
763 | let t = subst s t in
764 | let x' = fresh_var x in
765 | check_type env t (mk Type);
766 | let env = Env.add env x' t in
767 | let s = (x,mk (Var x'))::s in
768 | env,s
769 | | Check e ->
770 | let e = subst s e in
771 | let t = infer_type env e in
772 | printf "%s\n%!" (to_string t);
773 | env,s
774 | | Eval e ->
775 | let e = subst s e in
776 | let e0 = e in
777 | let e = normalize env e in
778 | let t = infer_type env e in
779 | printf " %s\n = %s\n : %s\n%!" (to_string e0) (to_string e) (to_string t);
780 | env,s
781 | | Env ->
782 | print_endline ("\n" ^ Env.to_string env);
783 | env,s
784 | | Set (o,v) ->
785 | let bool () =
786 | if v = "true" then true
787 | else if v = "false" then false
788 | else error "unknown value %s for option %s" v o
789 | in
790 | if o = "groupoid" then
791 | (* Switch groupoid mode. *)
792 | groupoid := bool ()
793 | else if o = "unsafe-evars" then
794 | unsafe_evars := bool ()
795 | else if o = "show-instances" then
796 | show_instances := bool ()
797 | else if o = "exit" then
798 | exit 0
799 | else
800 | error "unknown option %s" o;
801 | env,s
802 |
803 | (** Execute a program. *)
804 | let exec envs prog =
805 | List.fold_left exec_cmd envs prog
806 |
--------------------------------------------------------------------------------
/src/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/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/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 $*
1179 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $(FIRST_DOC_FILE)`; \
1180 | if [ -z "$$pp" ]; then \
1181 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -html -d $< $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \
1182 | $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -html -d $< $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \
1183 | else \
1184 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -pp \"$$pp $(PPFLAGS)\" -html -d $< $(OCAMLDOCFLAGS) \
1185 | $(INCFLAGS) $(DOC_FILES); \
1186 | $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -pp "$$pp $(PPFLAGS)" -html -d $< $(OCAMLDOCFLAGS) \
1187 | $(INCFLAGS) $(DOC_FILES); \
1188 | fi
1189 |
1190 | $(DOC_DIR)/$(RESULT)/latex:
1191 | mkdir -p $@
1192 |
1193 | $(DOC_DIR)/$(RESULT)/latex/doc.tex: $(DOC_DIR)/$(RESULT)/latex $(DOC_FILES)
1194 | rm -rf $*
1195 | $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $(FIRST_DOC_FILE)`; \
1196 | if [ -z "$$pp" ]; then \
1197 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) \
1198 | $(DOC_FILES) -o $@; \
1199 | $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES) \
1200 | -o $@; \
1201 | else \
1202 | $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -pp \"$$pp $(PPFLAGS)\" -latex $(OCAMLDOCFLAGS) \
1203 | $(INCFLAGS) $(DOC_FILES) -o $@; \
1204 | $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -pp "$$pp $(PPFLAGS)" -latex $(OCAMLDOCFLAGS) \
1205 | $(INCFLAGS) $(DOC_FILES) -o $@; \
1206 | fi
1207 |
1208 | $(DOC_DIR)/$(RESULT)/latex/doc.ps: $(DOC_DIR)/$(RESULT)/latex/doc.tex
1209 | cd $(DOC_DIR)/$(RESULT)/latex && \
1210 | $(LATEX) doc.tex && \
1211 | $(LATEX) doc.tex && \
1212 | $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F)
1213 |
1214 | $(DOC_DIR)/$(RESULT)/latex/doc.pdf: $(DOC_DIR)/$(RESULT)/latex/doc.ps
1215 | cd $(DOC_DIR)/$(RESULT)/latex && $(PS2PDF) $(