Commit 39dea23e authored by Heiko Becker's avatar Heiko Becker

Fix some comments

parent 3911c0af
...@@ -58,6 +58,8 @@ You can then run Daisy on an input file as follows: ...@@ -58,6 +58,8 @@ You can then run Daisy on an input file as follows:
$ ./daisy testcases/rosa/Doppler.scala $ ./daisy testcases/rosa/Doppler.scala
``` ```
## Checking Interval Arithmetic Certificates
If you want to produce certificates to check them in either of the supported backends, If you want to produce certificates to check them in either of the supported backends,
you have to call Daisy as with you have to call Daisy as with
```bash ```bash
......
(** (**
This file contains the coq implementation of the error bound validator as well as its soundness proof. This file contains the coq implementation of the error bound validator as well
It is explained in section 5 of the paper. as its soundness proof. The function validErrorbound is the Error bound
The validator is used in the file CertificateChecker.v to build the complete checker. validator from the certificate checking process. Under the assumption that a
valid range arithmetic result has been computed, it can validate error bounds
encoded in the analysis result. The validator is used in the file
CertificateChecker.v to build the complete checker.
**) **)
Require Import Coq.QArith.QArith Coq.QArith.Qminmax Coq.QArith.Qabs Coq.QArith.Qreals Coq.Lists.List. Require Import Coq.QArith.QArith Coq.QArith.Qminmax Coq.QArith.Qabs Coq.QArith.Qreals Coq.Lists.List.
Require Import Coq.micromega.Psatz Coq.Reals.Reals. Require Import Coq.micromega.Psatz Coq.Reals.Reals.
......
(** (**
Interval arithmetic checker and its soundness proof Interval arithmetic checker and its soundness proof.
Explained in section 4 of the paper, used in CertificateChecker.v to build full checker, The function validIntervalbounds checks wether the given analysis result is
a valid range arithmetic for each sub term of the given expression e.
The computation is done using our formalized interval arithmetic.
The function is used in CertificateChecker.v to build the full checker.
**) **)
Require Import Coq.QArith.QArith Coq.QArith.Qreals QArith.Qminmax Coq.Lists.List. Require Import Coq.QArith.QArith Coq.QArith.Qreals QArith.Qminmax Coq.Lists.List.
Require Import Daisy.Infra.Abbrevs Daisy.Infra.RationalSimps Daisy.Infra.RealRationalProps. Require Import Daisy.Infra.Abbrevs Daisy.Infra.RationalSimps Daisy.Infra.RealRationalProps.
......
(** (**
This file contains the HOL-Light implementation of the error bound validator as well as its soundness proof. This file contains the coq implementation of the error bound validator as well
It is explained in section 5 of the paper. as its soundness proof. The function validErrorbound is the Error bound
The validator is used in the file CertificateChecker.hl to build the complete checker. validator from the certificate checking process. Under the assumption that a
valid range arithmetic result has been computed, it can validate error bounds
encoded in the analysis result. The validator is used in the file
CertificateChecker.hl to build the complete checker.
**) **)
needs "Infra/ExpressionAbbrevs.hl";; needs "Infra/ExpressionAbbrevs.hl";;
needs "IntervalValidation.hl";; needs "IntervalValidation.hl";;
......
(** (**
Interval arithmetic checker and its soundness proof Interval arithmetic checker and its soundness proof.
Explained in section 4 of the paper, used in CertificateChecker.hl to build full checker, The function validIntervalbounds checks wether the given analysis result is
a valid range arithmetic for each sub term of the given expression e.
The computation is done using our formalized interval arithmetic.
The function is used in CertificateChecker.hl to build the full checker.
**) **)
needs "Infra/tactics.hl";; needs "Infra/tactics.hl";;
needs "Infra/Abbrevs.hl";; needs "Infra/Abbrevs.hl";;
......
e (intros "!e1 e1R e1F e2 e2R e2F vR vF cenv err1 err2; e1_real e1_float e2_real e2_float plus_real plus_float abs_e1 abs_e2");;
e (USE_THEN "plus_real"
(fun th -> LABEL_TAC "plus_real_inv"
(MP (SPECL [`&0:real`;`cenv:num->real`; `Sub:binop`;`e1:(real)exp`; `e2:(real)exp`; `vR:real`] binop_inv) th)));;
e (destruct "plus_real_inv" "@delta. @v1. @v2. vR_eq eval_e1_v1 eval_e2_v2 abs_0");;
e (ASM_SIMP_TAC[]
THEN (USE_THEN "abs_0"
(fun th -> REWRITE_TAC [MP (SPECL [`vR:real`; `delta:real`] perturb_0_val) th])));;
(* FIXME: UGLY REWRITES *)
e (LABEL_TAC "eval_e1_0_det"
(SPECL [`e1:(real)exp`; `v1:real`; `e1R:real`; `cenv:num->real`] eval_0_det));;
e (SUBGOAL_TAC "eval_e1_conj" `eval_exp (&0) cenv e1 v1 /\ eval_exp (&0) cenv e1 e1R` [split THEN auto]);;
e (mp_spec "eval_e1_0_det" "eval_e1_conj");;
e (LABEL_TAC "eval_e2_0_det" (SPECL [`e2:(real)exp`; `v2:real`; `e2R:real`; `cenv:num->real`] eval_0_det));;
e (SUBGOAL_TAC "eval_e2_conj" `eval_exp (&0) cenv e2 v2 /\ eval_exp (&0) cenv e2 e2R` [split THEN auto]);;
e (mp_spec "eval_e2_0_det" "eval_e2_conj");;
e (ASM_SIMP_TAC[eval_binop]);;
e (clear ["eval_e2_0_det"; "eval_e2_conj"; "eval_e1_0_det"; "eval_e1_conj"; "eval_e1_v1"; "eval_e2_v2"]);;
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
e (USE_THEN "plus_float"
(fun th -> LABEL_TAC "plus_float_inv"
(MP (SPECL [`machineEpsilon:real`;
`(updEnv:num->real->(num->real)->num->real) 2 (e2F:real)
((updEnv:num->real->(num->real)->num->real) 1 (e1F:real)
(cenv:num->real))`;
`Sub:binop`;`(Var 1):(real)exp`; `(Var 2):(real)exp`; `vF:real`] binop_inv) th)));;
e (destruct "plus_float_inv" "@delta2. @v1F. @v2F. vF_eq eval_e1_v1F eval_e2_v2F abs_mEps");;
e (USE_THEN "eval_e1_v1F"
(fun th -> LABEL_TAC "v1F_inv"
(MP (SPECL [`machineEpsilon:real`;
`(updEnv:num->real->(num->real)->num->real) 2 (e2F:real)
((updEnv:num->real->(num->real)->num->real) 1 (e1F:real)
(cenv:num->real))`;
`1:num`; `v1F:real`] var_inv) th)));;
e (USE_THEN "eval_e2_v2F"
(fun th -> LABEL_TAC "v2F_inv"
(MP (SPECL [`machineEpsilon:real`;
`(updEnv:num->real->(num->real)->num->real) 2 (e2F:real)
((updEnv:num->real->(num->real)->num->real) 1 (e1F:real)
(cenv:num->real))`;
`2:num`; `v2F:real`] var_inv) th)));;
e (ASM_REWRITE_TAC[updEnv; eval_binop; perturb]);;
(* TODO: Find out how to evaluate the conditional here! *)
e (SUBGOAL_TAC "1_neq_2" `1:num = 2:num <=> F` [ARITH_TAC]);;
e (ASM_REWRITE_TAC[]);;
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
e (clear ["1_neq_2"; "v2F_inv"; "v1F_inv"; "eval_e2_v2F"; "eval_e1_v1F"; "vF_eq"; "vR_eq"; "e1_real"; "e2_real"; "plus_real"; "plus_float"]);;
e (REWRITE_TAC [REAL_ADD_LDISTRIB; REAL_MUL_RID; real_sub]);;
e (SUBGOAL_TAC "bounds_simplify" `((e1R:real) + e2R) + -- ((e1F + e2F) + (e1F + e2F) * delta2) =
((e1R:real) + -- e1F) + (e2R + -- e2F) + -- ((e1F + e2F) * delta2)` [REAL_ARITH_TAC]);;
e (ASM_SIMP_TAC[]);;
e (mp REAL_LE_TRANS);;
e (EXISTS_TAC `abs (((e1R:real) + --(e1F:real))) + abs (((e2R:real) + --(e2F:real)) + --(((e1F:real) + (e2F:real)) * (delta2:real)))`);;
e (split);;
e (REWRITE_TAC[REAL_ABS_TRIANGLE]);;
e (mp REAL_LE_ADD2);;
e (split THENL [REWRITE_TAC[GSYM real_sub] THEN auto; ALL_TAC]);;
e (mp REAL_LE_TRANS);;
e (EXISTS_TAC `abs (((e2R:real) + --(e2F:real))) + abs (--(((e1F:real) + (e2F:real)) * (delta2:real)))`);;
e (split THENL [REWRITE_TAC [REAL_ABS_TRIANGLE]; ALL_TAC]);;
e (mp REAL_LE_ADD2);;
e (split THENL [REWRITE_TAC[GSYM real_sub] THEN auto; REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_MUL]]);;
e (mp REAL_LE_LMUL);;
e (split THENL [REWRITE_TAC[REAL_ABS_POS]; auto]);;
;;; hol-light.el --- Caml mode for (X)Emacs. -*- coding: latin-1 -*-
;; Copyright © 1997-2008 Albert Cohen, all rights reserved.
;; Licensed under the GNU General Public License.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;; Commentary:
;;; Code:
(require 'cl)
(require 'easymenu)
(defconst hol-light-mode-version "HOL Light Version 1.45.6"
" Copyright © 1997-2008 Albert Cohen, all rights reserved.
Copying is covered by the GNU General Public License.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Emacs versions support
(defconst hol-light-with-xemacs (featurep 'xemacs))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Compatibility functions
(defalias 'hol-light-match-string
(if (fboundp 'match-string-no-properties)
'match-string-no-properties
'match-string))
(if (not (fboundp 'read-shell-command))
(defun read-shell-command (prompt &optional initial-input history)
"Read a string from the minibuffer, using `shell-command-history'."
(read-from-minibuffer prompt initial-input nil nil
(or history 'shell-command-history))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Import types and help features
(defvar hol-light-with-caml-mode-p
(condition-case nil
(and (require 'caml-types) (require 'caml-help))
(error nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User customizable variables
;; Use the standard `customize' interface or `hol-light-mode-hook' to
;; Configure these variables
(require 'custom)
(defgroup hol-light nil
"Support for the Objective Caml language."
:group 'languages)
;; Comments
(defcustom hol-light-indent-leading-comments t
"*If true, indent leading comment lines (starting with `(*') like others."
:group 'hol-light :type 'boolean)
(defcustom hol-light-indent-comments t
"*If true, automatically align multi-line comments."
:group 'hol-light :type 'boolean)
(defcustom hol-light-comment-end-extra-indent 0
"*How many spaces to indent a leading comment end `*)'.
If you expect comments to be indented like
(*
...
*)
even without leading `*', use `hol-light-comment-end-extra-indent' = 1."
:group 'hol-light
:type '(radio :extra-offset 8
:format "%{Comment End Extra Indent%}:
Comment alignment:\n%v"
(const :tag "align with `(' in comment opening" 0)
(const :tag "align with `*' in comment opening" 1)
(integer :tag "custom alignment" 0)))
(defcustom hol-light-support-leading-star-comments t
"*Enable automatic intentation of comments of the form
(*
* ...
*)
Documentation comments (** *) are not concerned by this variable
unless `hol-light-leading-star-in-doc' is also set.
If you do not set this variable and still expect comments to be
indented like
(*
...
*)
\(without leading `*'), set `hol-light-comment-end-extra-indent' to 1."
:group 'hol-light :type 'boolean)
(defcustom hol-light-leading-star-in-doc nil
"*Enable automatic intentation of documentation comments of the form
(**
* ...
*)"
:group 'hol-light :type 'boolean)
;; Indentation defaults
(defcustom hol-light-default-indent 2
"*Default indentation.
Global indentation variable (large values may lead to indentation overflows).
When no governing keyword is found, this value is used to indent the line
if it has to."
:group 'hol-light :type 'integer)
(defcustom hol-light-lazy-paren nil
"*If true, indent parentheses like a standard keyword."
:group 'hol-light :type 'boolean)
(defcustom hol-light-support-camllight nil
"*If true, handle Caml Light character syntax (incompatible with labels)."
:group 'hol-light :type 'boolean
:set '(lambda (var val)
(setq hol-light-support-camllight val)
(if (boundp 'hol-light-mode-syntax-table)
(modify-syntax-entry ?` (if val "\"" ".")
hol-light-mode-syntax-table))))
(defcustom hol-light-support-metaocaml nil
"*If true, handle MetaOCaml character syntax."
:group 'hol-light :type 'boolean
:set '(lambda (var val)
(setq hol-light-support-metaocaml val)
(if (boundp 'hol-light-font-lock-keywords)
(hol-light-install-font-lock))))
(defcustom hol-light-let-always-indent t
"*If true, enforce indentation is at least `hol-light-let-indent' after a `let'.
As an example, set it to false when you have `hol-light-with-indent' set to 0,
and you want `let x = match ... with' and `match ... with' indent the
same way."
:group 'hol-light :type 'boolean)
(defcustom hol-light-|-extra-unindent hol-light-default-indent
"*Extra backward indent for Caml lines starting with the `|' operator.
It is NOT the variable controlling the indentation of the `|' itself:
this value is automatically added to `function', `with', `parse' and
some cases of `type' keywords to leave enough space for `|' backward
indentation.
For exemple, setting this variable to 0 leads to the following indentation:
match ... with
X -> ...
| Y -> ...
| Z -> ...
To modify the indentation of lines lead by `|' you need to modify the
indentation variables for `with', `function' and `parse', and possibly
for `type' as well. For example, setting them to 0 (and leaving
`hol-light-|-extra-unindent' to its default value) yields:
match ... with
X -> ...
| Y -> ...
| Z -> ..."
:group 'hol-light :type 'integer)
(defcustom hol-light-class-indent hol-light-default-indent
"*How many spaces to indent from a `class' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-sig-struct-align t
"*Align `sig' and `struct' keywords with `module'."
:group 'hol-light :type 'boolean)
(defcustom hol-light-sig-struct-indent hol-light-default-indent
"*How many spaces to indent from a `sig' or `struct' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-method-indent hol-light-default-indent
"*How many spaces to indent from a `method' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-begin-indent hol-light-default-indent
"*How many spaces to indent from a `begin' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-for-while-indent hol-light-default-indent
"*How many spaces to indent from a `for' or `while' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-do-indent hol-light-default-indent
"*How many spaces to indent from a `do' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-fun-indent hol-light-default-indent
"*How many spaces to indent from a `fun' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-function-indent hol-light-default-indent
"*How many spaces to indent from a `function' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-if-then-else-indent hol-light-default-indent
"*How many spaces to indent from an `if', `then' or `else' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-let-indent hol-light-default-indent
"*How many spaces to indent from a `let' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-in-indent hol-light-default-indent
"*How many spaces to indent from a `in' keyword.
A lot of people like formatting `let' ... `in' expressions whithout
indentation:
let x = 0 in
blah x
Set this variable to 0 to get this behaviour.
However, nested declarations are always correctly handled:
let x = 0 in let x = 0
let y = 0 in or in let y = 0
let z = 0 ... in let z = 0 ..."
:group 'hol-light :type 'integer)
(defcustom hol-light-match-indent hol-light-default-indent
"*How many spaces to indent from a `match' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-try-indent hol-light-default-indent
"*How many spaces to indent from a `try' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-with-indent hol-light-default-indent
"*How many spaces to indent from a `with' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-rule-indent hol-light-default-indent
"*How many spaces to indent from a `rule' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-parse-indent hol-light-default-indent
"*How many spaces to indent from a `parse' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-parser-indent hol-light-default-indent
"*How many spaces to indent from a `parser' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-type-indent hol-light-default-indent
"*How many spaces to indent from a `type' keyword."
:group 'hol-light :type 'integer)
(defcustom hol-light-val-indent hol-light-default-indent
"*How many spaces to indent from a `val' keyword."
:group 'hol-light :type 'integer)
;; Automatic indentation
;; Using abbrev-mode and electric keys
(defcustom hol-light-use-abbrev-mode t
"*Non-nil means electrically indent lines starting with leading keywords.
Leading keywords are such as `end', `done', `else' etc.
It makes use of `abbrev-mode'.
Many people find eletric keywords irritating, so you can disable them by
setting this variable to nil."
:group 'hol-light :type 'boolean
:set '(lambda (var val)
(setq hol-light-use-abbrev-mode val)
(abbrev-mode val)))
(defcustom hol-light-electric-indent t
"*Non-nil means electrically indent lines starting with `|', `)', `]' or `}'.
Many people find eletric keys irritating, so you can disable them in
setting this variable to nil."
:group 'hol-light :type 'boolean)
(defcustom hol-light-electric-close-vector t
"*Non-nil means electrically insert `|' before a vector-closing `]' or
`>' before an object-closing `}'.
Many people find eletric keys irritating, so you can disable them in
setting this variable to nil. You should probably have this on,
though, if you also have `hol-light-electric-indent' on."
:group 'hol-light :type 'boolean)
;; HOL Light-Interactive
;; Configure via `hol-light-mode-hook'
(defcustom hol-light-skip-after-eval-phrase t
"*Non-nil means skip to the end of the phrase after evaluation in the
Caml toplevel."
:group 'hol-light :type 'boolean)
(defcustom hol-light-interactive-read-only-input nil
"*Non-nil means input sent to the Caml toplevel is read-only."
:group 'hol-light :type 'boolean)
(defcustom hol-light-interactive-echo-phrase t
"*Non-nil means echo phrases in the toplevel buffer when sending
them to the Caml toplevel."
:group 'hol-light :type 'boolean)
(defcustom hol-light-interactive-input-font-lock t
"*Non nil means Font-Lock for toplevel input phrases."
:group 'hol-light :type 'boolean)
(defcustom hol-light-interactive-output-font-lock t
"*Non nil means Font-Lock for toplevel output messages."
:group 'hol-light :type 'boolean)
(defcustom hol-light-interactive-error-font-lock t
"*Non nil means Font-Lock for toplevel error messages."
:group 'hol-light :type 'boolean)
(defcustom hol-light-display-buffer-on-eval t
"*Non nil means pop up the Caml toplevel when evaluating code."
:group 'hol-light :type 'boolean)
(setq local-doc '"/usr/share/doc/ocaml-doc/docs/ocaml.html/index.html")
(defcustom hol-light-manual-url
(if (file-readable-p local-doc)
(concat "file:" local-doc)
"http://pauillac.inria.fr/ocaml/htmlman/index.html")
"*URL to the Caml reference manual."
:group 'hol-light :type 'string)
(defcustom hol-light-browser 'hol-light-netscape-manual
"*Name of function that displays the Caml reference manual.
Valid names are `hol-light-netscape-manual', `hol-light-mmm-manual'
and `hol-light-xemacs-w3-manual' (XEmacs only)."
:group 'hol-light)
(defcustom hol-light-library-path "/usr/lib/ocaml/"
"*Path to the Caml library."
:group 'hol-light :type 'string)
(defcustom hol-light-definitions-max-items 30
"*Maximum number of items a definitions menu can contain."
:group 'hol-light :type 'integer)
(defvar hol-light-options-list
'(("Lazy parentheses indentation" . 'hol-light-lazy-paren)
("Force indentation after `let'" . 'hol-light-let-always-indent)
"---"
("Automatic indentation of leading keywords" . 'hol-light-use-abbrev-mode)
("Electric indentation of ), ] and }" . 'hol-light-electric-indent)
("Electric matching of [| and {<" . 'hol-light-electric-close-vector)
"---"
("Indent body of comments" . 'hol-light-indent-comments)
("Indent first line of comments" . 'hol-light-indent-leading-comments)
("Leading-`*' comment style" . 'hol-light-support-leading-star-comments))
"*List of menu-configurable HOL Light options.")
(defvar hol-light-interactive-options-list
'(("Skip phrase after evaluation" . 'hol-light-skip-after-eval-phrase)
("Echo phrase in interactive buffer" . 'hol-light-interactive-echo-phrase)
"---"
("Font-lock interactive input" . 'hol-light-interactive-input-font-lock)
("Font-lock interactive output" . 'hol-light-interactive-output-font-lock)
("Font-lock interactive error" . 'hol-light-interactive-error-font-lock)
"---"
("Read only input" . 'hol-light-interactive-read-only-input))
"*List of menu-configurable HOL Light options.")
;;Modified by Heiko: Was "hol_light"
(defvar hol-light-interactive-program "ocaml"
"*Default program name for invoking a Caml toplevel from Emacs.")
;; Could be interesting to have this variable buffer-local
;; (e.g., ocaml vs. metaocaml buffers)
;; (make-variable-buffer-local 'hol-light-interactive-program)
;; Backtrack to custom parsing and caching by default, until stable
;;(defvar hol-light-use-syntax-ppss (fboundp 'syntax-ppss)
(defconst hol-light-use-syntax-ppss nil
"*If nil, use our own parsing and caching.")
(defgroup hol-light-faces nil
"Special faces for the HOL Light mode."
:group 'hol-light)
(defconst hol-light-faces-inherit-p
(if (boundp 'face-attribute-name-alist)
(assq :inherit face-attribute-name-alist)))
(defface hol-light-font-lock-governing-face
(if hol-light-faces-inherit-p
'((t :inherit font-lock-keyword-face))
'((((background light)) (:foreground "darkorange3" :bold t))
(t (:foreground "orange" :bold t))))
"Face description for governing/leading keywords."
:group 'hol-light-faces)
(defvar hol-light-font-lock-governing-face
'hol-light-font-lock-governing-face)
(defface hol-light-font-lock-multistage-face
'((((background light))
(:foreground "darkblue" :background "lightgray" :bold t))
(t (:foreground "steelblue" :background "darkgray" :bold t)))
"Face description for MetaOCaml staging operators."
:group 'hol-light-faces)
(defvar hol-light-font-lock-multistage-face
'hol-light-font-lock-multistage-face)
(defface hol-light-font-lock-operator-face
(if hol-light-faces-inherit-p
'((t :inherit font-lock-keyword-face))
'((((background light)) (:foreground "brown"))
(t (:foreground "khaki"))))
"Face description for all operators."
:group 'hol-light-faces)
(defvar hol-light-font-lock-operator-face
'hol-light-font-lock-operator-face)
(defface hol-light-font-lock-error-face
'((t (:foreground "yellow" :background "red" :bold t)))
"Face description for all errors reported to the source."
:group 'hol-light-faces)
(defvar hol-light-font-lock-error-face
'hol-light-font-lock-error-face)
(defface hol-light-font-lock-interactive-output-face
'((((background light))
(:foreground "blue4"))
(t (:foreground "cyan")))
"Face description for all toplevel outputs."
:group 'hol-light-faces)
(defvar hol-light-font-lock-interactive-output-face
'hol-light-font-lock-interactive-output-face)
(defface hol-light-font-lock-interactive-error-face
(if hol-light-faces-inherit-p
'((t :inherit font-lock-warning-face))
'((((background light)) (:foreground "red3"))
(t (:foreground "red2"))))
"Face description for all toplevel errors."
:group 'hol-light-faces)
(defvar hol-light-font-lock-interactive-error-face
'hol-light-font-lock-interactive-error-face)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support definitions
(defun hol-light-leading-star-p ()
(and hol-light-support-leading-star-comments
(save-excursion ; this function does not make sense outside of a comment
(hol-light-beginning-of-literal-or-comment)
(and (or hol-light-leading-star-in-doc
(not (looking-at "(\\*[Tt][Ee][Xx]\\|(\\*\\*")))
(progn
(forward-line 1)
(back-to-indentation)
(looking-at "\\*[^)]"))))))
(defun hol-light-auto-fill-insert-leading-star (&optional leading-star)
(let ((point-leading-comment (looking-at "(\\*")) (return-leading nil))
(save-excursion
(back-to-indentation)
(if hol-light-electric-indent
(progn
(if (and (hol-light-in-comment-p)
(or leading-star
(hol-light-leading-star-p)))
(progn
(if (not (looking-at "(?\\*"))
(insert-before-markers "* "))
(setq return-leading t)))
(if (not point-leading-comment)
;; Use optional argument to break recursion
(hol-light-indent-command t)))))
return-leading))
(defun hol-light-auto-fill-function ()
(if (hol-light-in-literal-p) ()
(let ((leading-star
(if (not (char-equal ?\n last-command-char))