├── src ├── catt.css ├── catt.html ├── .gitignore ├── simple.catt ├── Makefile ├── old.catt ├── lexer.mll ├── catt.ml ├── parser.mly ├── extlib.ml ├── prover.ml ├── common.ml ├── langExt.ml ├── web.ml ├── test.catt ├── eh.catt ├── lang.ml └── OCamlMakefile ├── Makefile ├── .gitignore ├── docs ├── Makefile ├── catt.css ├── ocamldoc │ ├── type_Catt.html │ ├── type_Lang.html │ ├── type_Prover.html │ ├── index_classes.html │ ├── index_exceptions.html │ ├── index_extensions.html │ ├── index_class_types.html │ ├── index_methods.html │ ├── index_module_types.html │ ├── index_attributes.html │ ├── type_Lang.Envs.html │ ├── index.html │ ├── Catt.html │ ├── Lang.Envs.html │ ├── index_modules.html │ ├── Prover.html │ ├── style.css │ ├── index_types.html │ ├── type_Lang.Env.html │ ├── Lang.Env.html │ ├── Lang.PS.html │ ├── type_Lang.PS.html │ ├── index_values.html │ └── Lang.html └── index.html ├── README.md └── catt-mode.el /src/catt.css: -------------------------------------------------------------------------------- 1 | ../docs/catt.css -------------------------------------------------------------------------------- /src/catt.html: -------------------------------------------------------------------------------- 1 | ../docs/index.html -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | $(MAKE) -C src 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.annot 3 | *.cmi 4 | *.cmx 5 | *.o 6 | ._d 7 | ._ncdi 8 | -------------------------------------------------------------------------------- /src/.gitignore: -------------------------------------------------------------------------------- 1 | catt 2 | catt.js 3 | lexer.ml 4 | parser.ml 5 | parser.mli 6 | parser.conflicts 7 | ._bcdi 8 | *.cmo -------------------------------------------------------------------------------- /docs/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | 3 | update: js ocamldoc 4 | 5 | js: 6 | $(MAKE) -C ../src web 7 | chmod a+w catt.js 8 | cp ../src/catt.js . 9 | chmod a-w catt.js 10 | 11 | ocamldoc: 12 | $(MAKE) -C ../src htdoc 13 | mkdir -p ocamldoc 14 | cp ../src/doc/catt/html/* ocamldoc/ 15 | -git add ocamldoc/*.html 16 | 17 | ci: update 18 | git ci . -m "Update website." 19 | git push 20 | 21 | .PHONY: ocamldoc 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Catt - An infinity-categorical coherence typechecker 2 | 3 | Catt is an implementation of a type system for coherence in 4 | [Grothendieck-Maltsiniotis infinity categories](http://arxiv.org/abs/1009.2331). 5 | 6 | In order to test it, you can try [the web version](https://smimram.github.io/catt/). 7 | 8 | This typechecker is written in OCaml, in the case you would rather like elegant 9 | Haskell, please have a look at [Eric Finster's 10 | implementation](https://github.com/ericfinster/catt/). 11 | -------------------------------------------------------------------------------- /src/simple.catt: -------------------------------------------------------------------------------- 1 | coh id (x : *) : x -> x 2 | 3 | coh id2 (x : *) (y : *) (f : x -> y) : f -> f 4 | 5 | coh comp (x : *) (y : *) (f : x -> y) (z : *) (g : y -> z) : x -> z 6 | 7 | coh comp2 (x : *) (y : *) (f : x -> y) (g : x -> y) (a : f -> g) (h : x -> y) (b : g -> h) : f -> h 8 | 9 | coh unitl (x : *) (y : *) (f : x -> y) : comp x x (id x) y f -> f 10 | 11 | coh unitL (x : *) (y : *) (f : x -> y) : f -> comp x x (id x) y f 12 | 13 | coh unitLl (x : *) (y : *) (f : x -> y) : comp2 x y _ _ (unitL x y f) _ (unitl x y f) -> id2 x y f -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | SOURCES = extlib.ml common.ml lang.ml langExt.ml parser.mly lexer.mll prover.ml catt.ml 2 | RESULT = catt 3 | ANNOTATE = true 4 | 5 | DOC_FILES = lang.ml prover.ml catt.ml 6 | OCAMLDOCFLAGS := -sort 7 | 8 | all: dnc 9 | ./catt test.catt 10 | ./catt eh.catt 11 | ./catt simple.catt 12 | 13 | web: web.ml dc 14 | $(OCAMLC) -annot -I `ocamlfind query js_of_ocaml` -pp "camlp4o -I `ocamlfind query js_of_ocaml` pa_js.cmo" -c web.ml 15 | $(OCAMLC) -I `ocamlfind query js_of_ocaml` js_of_ocaml.cma $(IMPL_CMO) web.cmo -o $(RESULT) 16 | js_of_ocaml $(RESULT) 17 | 18 | conflicts: 19 | rm -f parser.conflicts 20 | menhir --explain parser.mly 21 | less parser.conflicts 22 | 23 | include OCamlMakefile 24 | -------------------------------------------------------------------------------- /src/old.catt: -------------------------------------------------------------------------------- 1 | coh hcomp 2 | (x : *) 3 | (y : *) (f : x -> y) 4 | (f' : x -> y) (a : f -> f') 5 | (z : *) (g : y -> z) 6 | (g' : y -> z) (b : g -> g') 7 | : 8 | comp f g -> comp f' g' 9 | let hcomp (a : _ -> _) (b : _ -> _) = hcomp _ _ _ _ a _ _ _ b 10 | let hcomp a b = comp2 (comp21 a _) (comp12 _ b) 11 | 12 | coh ichg 13 | (x : *) 14 | (y : *) (f : x -> y) 15 | (g : x -> y) (a : f -> g) 16 | (h : x -> y) (b : g -> h) 17 | (z : *) (l : y -> z) 18 | (m : y -> z) (c : l -> m) 19 | (n : y -> z) (d : m -> n) 20 | : 21 | hcomp (vcomp a b) (vcomp c d) -> vcomp (hcomp a c) (hcomp b d) 22 | let ichg (a : _ -> _) (b : _ -> _) (c : _ -> _) (d : _ -> _) = ichg _ _ _ _ a _ b _ _ _ c _ d 23 | -------------------------------------------------------------------------------- /docs/catt.css: -------------------------------------------------------------------------------- 1 | body { 2 | margin: 2% 10%; 3 | font-family: sans-serif; 4 | font-size: 11pt; 5 | } 6 | 7 | a { 8 | color: darkblue; 9 | text-decoration: none; 10 | } 11 | 12 | a:hover { 13 | text-decoration: underline; 14 | } 15 | 16 | h1 { 17 | text-align: center; 18 | } 19 | 20 | #send { 21 | visibility: hidden; 22 | } 23 | 24 | #toplevel { 25 | text-align: center; 26 | } 27 | 28 | textarea { 29 | color: lightgreen; 30 | background-color: black; 31 | width: 100%; 32 | font-size: 11pt; 33 | font-weight: bold; 34 | } 35 | 36 | pre { 37 | color: darkred; 38 | background: whitesmoke; 39 | font-size: 11pt; 40 | width: 100%; 41 | overflow-x: scroll; 42 | overflow-y: visible; 43 | } 44 | -------------------------------------------------------------------------------- /src/lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Parser 3 | } 4 | 5 | let space = ' ' | '\t' | '\r' 6 | 7 | rule token = parse 8 | | "coh" { COH } 9 | | "let" { LET } 10 | | "set" { SET } 11 | | "hyp" { HYP } 12 | | "check" { CHECK } 13 | | "eval" { EVAL } 14 | | "env" { ENV } 15 | | "Type" { TYPE } 16 | | "Hom" { HOMTYPE } 17 | | "(" { LPAR } 18 | | ")" { RPAR } 19 | | ":" { COL } 20 | | "->" { ARR } 21 | | "=>" { ARROW } 22 | | "*" { OBJ } 23 | | "=" { EQ } 24 | | "_" { US } 25 | | (['_''a'-'z''A'-'Z']['-''+''a'-'z''A'-'Z''0'-'9''_']*['\'''-''+''!']* as str) { IDENT str } 26 | | space+ { token lexbuf } 27 | | "#"[^'\n']* { token lexbuf } 28 | | '"'([^'"']* as s)'"' { STRING s } 29 | | "\n" { Lexing.new_line lexbuf; token lexbuf } 30 | | eof { EOF } 31 | -------------------------------------------------------------------------------- /docs/ocamldoc/type_Catt.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | Catt 12 | 13 | 14 | sig  end -------------------------------------------------------------------------------- /docs/ocamldoc/type_Lang.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | Lang 12 | 13 | 14 | sig  end -------------------------------------------------------------------------------- /docs/ocamldoc/type_Prover.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | Prover 12 | 13 | 14 | sig  end -------------------------------------------------------------------------------- /docs/ocamldoc/index_classes.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | Index of classes 13 | 14 | 15 | 17 |

Index of classes

18 | 19 |
20 | 21 | -------------------------------------------------------------------------------- /docs/ocamldoc/index_exceptions.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | Index of exceptions 13 | 14 | 15 | 17 |

Index of exceptions

18 | 19 |
20 | 21 | -------------------------------------------------------------------------------- /docs/ocamldoc/index_extensions.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | Index of extensions 13 | 14 | 15 | 17 |

Index of extensions

18 | 19 |
20 | 21 | -------------------------------------------------------------------------------- /docs/ocamldoc/index_class_types.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | Index of class types 13 | 14 | 15 | 17 |

Index of class types

18 | 19 |
20 | 21 | -------------------------------------------------------------------------------- /docs/ocamldoc/index_methods.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | Index of class methods 13 | 14 | 15 | 17 |

Index of class methods

18 | 19 |
20 | 21 | -------------------------------------------------------------------------------- /docs/ocamldoc/index_module_types.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | Index of module types 13 | 14 | 15 | 17 |

Index of module types

18 | 19 |
20 | 21 | -------------------------------------------------------------------------------- /docs/ocamldoc/index_attributes.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | Index of class attributes 13 | 14 | 15 | 17 |

Index of class attributes

18 | 19 |
20 | 21 | -------------------------------------------------------------------------------- /docs/ocamldoc/type_Lang.Envs.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | Lang.Envs 12 | 13 | 14 | sig type t = Lang.Env.t * Lang.subst val empty : Lang.Envs.t end -------------------------------------------------------------------------------- /catt-mode.el: -------------------------------------------------------------------------------- 1 | ;; catt-mode.el -- CATT major emacs mode 2 | 3 | (defvar catt-font-lock-keywords 4 | '( 5 | ("#.*" . 'font-lock-comment-face) 6 | ("\\<\\(let\\|check\\|set\\|coh\\|hyp\\|eval\\|env\\)\\>\\|:\\|=" . font-lock-keyword-face) 7 | ("\\<\\(Hom\\|Type\\)\\>\\|->" . font-lock-builtin-face) 8 | ;; ("\\<\\(\\)\\>" . font-lock-constant-face) 9 | ("\\" st) 20 | st) 21 | "Syntax table for CATT major mode.") 22 | 23 | (defvar catt-tab-width 4) 24 | 25 | (define-derived-mode catt-mode fundamental-mode 26 | "CATT" "Major mode for CATT files." 27 | :syntax-table catt-mode-syntax-table 28 | (set (make-local-variable 'comment-start) "#") 29 | (set (make-local-variable 'comment-start-skip) "#+\\s-*") 30 | (set (make-local-variable 'font-lock-defaults) '(catt-font-lock-keywords)) 31 | (setq mode-name "CATT") 32 | ) 33 | 34 | (provide 'catt-mode) 35 | 36 | ;;;###autoload 37 | (add-to-list 'auto-mode-alist '("\\.catt\\'" . catt-mode)) 38 | -------------------------------------------------------------------------------- /src/catt.ml: -------------------------------------------------------------------------------- 1 | (** Main for CATT. *) 2 | 3 | let parse_file f = 4 | let sin = 5 | let fi = open_in f in 6 | let flen = in_channel_length fi in 7 | let buf = Bytes.create flen in 8 | really_input fi buf 0 flen; 9 | close_in fi; 10 | buf 11 | in 12 | Prover.parse (Bytes.to_string sin) 13 | 14 | let usage = "catt [options] [file]" 15 | let interactive = ref false 16 | 17 | let () = 18 | Printexc.record_backtrace true; 19 | let file_in = ref [] in 20 | Arg.parse 21 | [ 22 | "-i", Arg.Set interactive, " Interactive mode." 23 | ] 24 | (fun s -> file_in := s::!file_in) 25 | usage; 26 | let envs = Lang.Envs.empty in 27 | let envs = 28 | match !file_in with 29 | | [f] -> Lang.exec envs (parse_file f) 30 | | _ -> envs 31 | in 32 | 33 | (* let ps = Parser.ps Lexer.token (Lexing.from_string "(x:*\)(y:*\)(f:x->y)(z:*\)(g:y->z)") in *) 34 | (* Lang.PS.check ps; *) 35 | (* let envps = Lang.Env.add_ps (fst envs) ps in *) 36 | (* let ps = LangExt.Subst.of_ps ps in *) 37 | (* let ss = LangExt.Subst.match_app envps ps (Lang.subst (snd envs) (Lang.Var (Lang.VIdent "id2"))) in *) 38 | (* print_endline ("len: "^string_of_int (List.length ss)); *) 39 | (* List.iter (fun ps -> print_endline (Lang.to_string ps)) ss; *) 40 | 41 | if !interactive then Prover.loop envs 42 | -------------------------------------------------------------------------------- /docs/ocamldoc/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 |

17 | 22 |

23 | 24 | 28 | 32 | 36 |
Catt
25 | Main for CATT. 26 |
27 |
Lang
29 | Core part of the language. 30 |
31 |
Prover
33 | Interaction with user. 34 |
35 |
37 | 38 | -------------------------------------------------------------------------------- /docs/ocamldoc/Catt.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | Catt 16 | 17 | 18 | 21 |

Module Catt

22 | 23 |
module Catt: sig .. end
24 | Main for CATT.
25 |
26 |
27 | 28 |
val parse_file : string -> Lang.prog
29 |
val usage : string
30 |
val interactive : bool Pervasives.ref
-------------------------------------------------------------------------------- /docs/ocamldoc/Lang.Envs.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | Lang.Envs 16 | 17 | 18 | 21 |

Module Lang.Envs

22 | 23 |
module Envs: sig .. end
24 | Running environment.
25 |
26 |
27 | 28 |
type t = Lang.Env.t * Lang.subst 
29 |
30 | A running environment.
31 |
32 | 33 | 34 |
val empty : t
35 | Empty running environment.
36 |
37 | -------------------------------------------------------------------------------- /docs/ocamldoc/index_modules.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | Index of modules 13 | 14 | 15 | 17 |

Index of modules

18 | 19 | 20 | 21 | 25 | 26 | 27 | 31 | 32 | 36 | 37 | 38 | 42 | 43 | 44 | 48 | 49 | 53 |

C
Catt
22 | Main for CATT. 23 |
24 |

E
Env [Lang]
28 | Typing environments. 29 |
30 |
Envs [Lang]
33 | Running environment. 34 |
35 |

L
Lang
39 | Core part of the language. 40 |
41 |

P
PS [Lang]
45 | Pasting schemes. 46 |
47 |
Prover
50 | Interaction with user. 51 |
52 |
54 | 55 | -------------------------------------------------------------------------------- /src/parser.mly: -------------------------------------------------------------------------------- 1 | %{ 2 | open Extlib 3 | open Lang 4 | 5 | let defpos () = Parsing.symbol_start_pos (), Parsing.symbol_end_pos () 6 | 7 | let mk ?pos e = 8 | let pos = Option.default (defpos ()) pos in 9 | mk ~pos e 10 | 11 | let fresh_evar ?pos () = 12 | let pos = Option.default (defpos ()) pos in 13 | fresh_evar ~pos () 14 | 15 | let rec abs ?pos args e = 16 | match args with 17 | | (x,t)::args -> mk ?pos (Abs(x,t,abs args e)) 18 | | [] -> e 19 | 20 | let var_name = function 21 | | VIdent x -> x 22 | | _ -> assert false 23 | %} 24 | 25 | %token COH LET SET ARR ARROW OBJ TYPE HOMTYPE 26 | %token LPAR RPAR LACC RACC COL EQ US 27 | %token IDENT STRING 28 | %token CHECK EVAL HYP ENV 29 | %token EOF 30 | 31 | %right ARR ARROW 32 | 33 | %start prog ps 34 | %type prog 35 | %type 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 |

Module Prover

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 | 20 | 21 | 25 | 26 | 27 | 31 | 32 | 33 | 37 | 38 | 42 | 43 | 44 | 48 | 49 | 53 | 54 | 55 | 59 | 60 | 61 | 65 | 66 | 71 | 72 | 76 | 77 | 78 | 82 |

C
cmd [Lang]
22 | A command. 23 |
24 |

D
desc [Lang]
28 | Contents of an expression. 29 |
30 |

E
evar [Lang]
34 | A meta-variable. 35 |
36 |
expr [Lang]
39 | An expression. 40 |
41 |

P
prog [Lang]
45 | A program. 46 |
47 |
ps [Lang]
50 | A pasting scheme. 51 |
52 |

S
subst [Lang]
56 | A substitution. 57 |
58 |

T
t [Lang.Envs]
62 | A running environment. 63 |
64 |
t [Lang.Env]
67 | A typing environment assign to each variable, its value (when known, which 68 | should be in normal form) and its type. 69 |
70 |
t [Lang.PS]
73 | A pasting scheme. 74 |
75 |

V
var [Lang]
79 | A variable. 80 |
81 |
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 |

Module Lang.Env

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 |

Module Lang.PS

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 : ('-> Lang.var * Lang.expr -> 'a) -> '-> Lang.ps -> 'a
28 |   val fold_left2 :
29 |     ('-> Lang.var * Lang.expr -> Lang.var * Lang.expr -> 'a) ->
30 |     '-> Lang.ps -> Lang.ps -> 'a
31 |   val fold_right : (Lang.var * Lang.expr -> '-> 'a) -> Lang.ps -> '-> '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 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 30 | 31 | 32 | 36 | 37 | 38 | 42 | 43 | 47 | 48 | 52 | 53 | 57 | 58 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 76 | 77 | 81 | 82 | 86 | 87 | 91 | 92 | 93 | 94 | 98 | 99 | 100 | 104 | 105 | 106 | 110 | 111 | 112 | 116 | 117 | 121 | 122 | 126 | 127 | 128 | 129 | 130 | 134 | 135 | 139 | 140 | 141 | 145 | 146 | 147 | 148 | 152 | 153 | 157 | 158 | 159 | 163 | 164 | 165 | 169 | 170 | 171 | 175 | 176 | 180 | 181 | 182 | 183 | 184 | 188 | 189 | 193 | 194 | 198 | 199 | 203 | 204 | 205 | 206 | 207 | 208 | 212 | 213 | 217 | 218 | 222 | 223 | 224 | 228 | 229 | 233 | 234 | 238 | 239 | 243 | 244 | 248 | 249 | 250 | 254 | 255 | 259 | 260 | 261 | 262 | 263 | 267 |

A
add [Lang.Env]
add_ps [Lang.Env]

C
check_type [Lang]
27 | Check that an expression has given type. 28 |
29 |

D
dim [Lang.PS]
33 | Dimension of a pasting scheme. 34 |
35 |

E
empty [Lang.Envs]
39 | Empty running environment. 40 |
41 |
empty [Lang.Env]
44 | Empty environment. 45 |
46 |
exec [Prover]
49 | Execute a command. 50 |
51 |
exec [Lang]
54 | Execute a program. 55 |
56 |
exec_cmd [Lang]
59 | Execute a command. 60 |
61 |
exists [Lang.PS]

F
fold_left [Lang.PS]
fold_left2 [Lang.PS]
fold_right [Lang.PS]
free_evar [Lang]
73 | Free meta-variables. 74 |
75 |
free_vars [Lang.PS]
78 | Free variables. 79 |
80 |
free_vars [Lang]
83 | Free variables. 84 |
85 |
fresh_evar [Lang]
88 | Generate a fresh meta-variable. 89 |
90 |
fresh_inevar [Lang]
fresh_var [Lang]
95 | Generate a fresh variable name. 96 |
97 |

G
groupoid [Lang]
101 | Do we want the theory of groupoids? 102 |
103 |

H
height [Lang.PS]
107 | Height of a pasting scheme. 108 |
109 |

I
infer_type [Lang]
113 | Type inference. 114 |
115 |
init [Prover]
118 | Initialize the prover. 119 |
120 |
instantiate [Lang]
123 | Replace EVars by fresh ones. 124 |
125 |
interactive [Catt]

L
leq [Lang]
131 | Subtype relation between expressions. 132 |
133 |
loop [Prover]
136 | Interactive loop. 137 |
138 |

M
make [Lang.PS]
142 | Create from a context. 143 |
144 |
map [Lang.PS]
marker [Lang.PS]
149 | Dangling variable. 150 |
151 |
mk [Lang]
154 | Create an expression from its contents. 155 |
156 |

N
normalize [Lang]
160 | Normalize a value. 161 |
162 |

O
occurs_evar [Lang]
166 | Whether a meta-variable occurs in a term. 167 |
168 |

P
parametric_schemes [Lang]
172 | Do we allow parametric pasting schemes? 173 |
174 |
parse [Prover]
177 | Parse a string. 178 |
179 |
parse_file [Catt]

S
show_instances [Lang]
185 | Do we show instance numbers in strings? 186 |
187 |
source [Lang.PS]
190 | Source of a pasting scheme. 191 |
192 |
string_of_cmd [Lang]
195 | String representation of a command. 196 |
197 |
string_of_evar [Lang]
200 | String representation of a meta-variable. 201 |
202 |
string_of_evarref [Lang]
string_of_expr [Lang]
string_of_ps [Lang]
209 | String representation of a pasting scheme. 210 |
211 |
string_of_var [Lang]
214 | String representation of a variable. 215 |
216 |
subst [Lang]
219 | Apply a parallel substitution. 220 |
221 |

T
target [Lang.PS]
225 | Target of a pasting scheme. 226 |
227 |
to_string [Lang.Env]
230 | String representation. 231 |
232 |
to_string [Lang.PS]
235 | String representation. 236 |
237 |
to_string [Lang]
240 | String representation of an expression. 241 |
242 |
typ [Lang.Env]
245 | Type of an expression in an environment. 246 |
247 |

U
unevar [Lang]
251 | Ensure that linked evars do not occur at toplevel. 252 |
253 |
unsafe_evars [Lang]
256 | Do we allow unsafe uses of meta-variables? 257 |
258 |
usage [Catt]

V
value [Lang.Env]
264 | Value of an expression in an environment. 265 |
266 |
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 |

Module Lang

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 | 60 | 62 | 63 | 64 | 65 | 67 | 69 | 70 |
59 | | 61 | VIdent of string
66 | | 68 | VFresh of string * int
71 | 72 |
73 | A variable.
74 |
75 | 76 | 77 |
type expr = {
78 | 79 | 81 | 83 | 84 | 85 | 86 | 88 | 90 | 91 |
80 |    82 | desc : desc;
87 |    89 | pos : Common.Pos.t;
92 | } 93 | 94 |
95 | An expression.
96 |
97 | 98 | 99 |
type desc = 
100 | 101 | 103 | 105 | 109 | 110 | 111 | 113 | 115 | 119 | 120 | 121 | 123 | 125 | 126 | 127 | 128 | 130 | 132 | 136 | 137 | 138 | 140 | 142 | 146 | 147 | 148 | 150 | 152 | 156 | 157 | 158 | 160 | 162 | 163 | 164 | 165 | 167 | 169 | 170 | 171 | 172 | 174 | 176 | 177 | 178 | 179 | 181 | 183 | 187 |
102 | | 104 | Var of var(*
106 | type variable
107 |
108 |
*)
112 | | 114 | EVar of (evar Pervasives.ref * subst)(*
116 | meta-variable (expression, substition)
117 |
118 |
*)
122 | | 124 | Type
129 | | 131 | HomType(*
133 | a type of hom set
134 |
135 |
*)
139 | | 141 | Obj(*
143 | type of 0-cells
144 |
145 |
*)
149 | | 151 | Arr of expr * expr * expr(*
153 | arrow type
154 |
155 |
*)
159 | | 161 | Pi of var * expr * expr
166 | | 168 | Abs of var * expr * expr
173 | | 175 | App of expr * expr
180 | | 182 | Coh of string * ps * expr(*
184 | coherence (name, source, target)
185 |
186 |
*)
188 | 189 |
190 | Contents of an expression.
191 |
192 | 193 | 194 |
type ps = 
195 | 196 | 198 | 200 | 204 | 205 | 206 | 208 | 210 | 214 | 215 | 216 | 218 | 220 | 224 |
197 | | 199 | PNil of (var * expr)(*
201 | start
202 |
203 |
*)
207 | | 209 | PCons of ps * (var * expr) * (var * expr)(*
211 | extend
212 |
213 |
*)
217 | | 219 | PDrop of ps(*
221 | drop
222 |
223 |
*)
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 | 241 | 243 | 247 | 248 | 249 | 251 | 253 | 257 |
240 | | 242 | ENone of int * expr(*
244 | unknown variable with given number and type
245 |
246 |
*)
250 | | 252 | ESome of expr(*
254 | instantiated variable
255 |
256 |
*)
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 | 355 | 357 | 361 | 362 | 363 | 365 | 367 | 371 | 372 | 373 | 375 | 377 | 381 | 382 | 383 | 385 | 387 | 391 | 392 | 393 | 395 | 397 | 401 | 402 | 403 | 405 | 407 | 411 |
354 | | 356 | Decl of var * expr(*
358 | Declare a variable.
359 |
360 |
*)
364 | | 366 | Axiom of var * expr(*
368 | Declare an axiom of given type.
369 |
370 |
*)
374 | | 376 | Check of expr(*
378 | Check the type of an expression.
379 |
380 |
*)
384 | | 386 | Eval of expr(*
388 | Evaluate an expression.
389 |
390 |
*)
394 | | 396 | Env(*
398 | Display the environment.
399 |
400 |
*)
404 | | 406 | Set of string * string(*
408 | Set an option.
409 |
410 |
*)
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 $