diff --git a/.gitignore b/.gitignore
index b2857b2cc..7437e4076 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,19 +1,9 @@
*~
graphs
-compile/*.o
-compile/*.bin
-compile/tc*.c
-compile/tc*.out
-compile/tc.json
-compile/nr*.c
-compile/nr*.out
-compile/nr.json
-compile/cost
-compiled/
-ml-toy
papers
www/demo
demo.log
*.class
-cost
+infra/cost
previous
+*.swp
diff --git a/.travis.yml b/.travis.yml
index efda69ce8..d5657acb3 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -4,31 +4,22 @@ env:
global:
- RACKET_DIR=~/racket
TBENCHES="bench/tutorial.fpcore bench/hamming/"
- HERBIE_SEED="#(2749829514 1059579101 312104142 915324965 966790849 1349306526)"
- TSEED="racket $TRAVIS_BUILD_DIR/infra/travis.rkt --seed '${HERBIE_SEED}' $TBENCHES"
- TRAND="racket $TRAVIS_BUILD_DIR/infra/travis.rkt $TBENCHES"
- UTEST="raco test src"
+ HERBIE_SEED="0"
+ UNIT="raco test src/ infra/"
+ INTEGRATION="racket $TRAVIS_BUILD_DIR/infra/travis.rkt --seed '${HERBIE_SEED}' $TBENCHES"
+ STABILITY="racket $TRAVIS_BUILD_DIR/infra/travis.rkt $TBENCHES"
matrix:
# separate builds for travis benches and unit tests
- - RACKET_VERSION="6.7"
- JOB="${TSEED}"
- - RACKET_VERSION="6.9"
- JOB="${TSEED}"
- - RACKET_VERSION="6.11"
- JOB="${TSEED}"
- - RACKET_VERSION="6.7"
- JOB="${UTEST}"
- - RACKET_VERSION="6.9"
- JOB="${UTEST}"
- - RACKET_VERSION="6.11"
- JOB="${UTEST}"
+ - RACKET_VERSION="7.3" JOB="${UNIT}"
+ - RACKET_VERSION="7.0" JOB="${INTEGRATION}"
+ - RACKET_VERSION="7.2" JOB="${INTEGRATION}"
+ - RACKET_VERSION="7.3" JOB="${INTEGRATION}"
# remember to change the `allow_failures` key below!
- - RACKET_VERSION="6.11"
- JOB="${TRAND}"
+ - RACKET_VERSION="7.3" JOB="${STABILITY}"
matrix:
allow_failures:
- - env: RACKET_VERSION="6.11"
- JOB="${TRAND}"
+ - env: RACKET_VERSION="7.3" JOB="${STABILITY}"
+ fast_finish: true
before_install:
- git clone https://github.com/greghendershott/travis-racket.git ../travis-racket
- cat ../travis-racket/install-racket.sh | bash
diff --git a/Dockerfile b/Dockerfile
index 58a218809..aa2759bdb 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -1,4 +1,4 @@
-FROM jackfirth/racket:6.12
+FROM jackfirth/racket:7.3
MAINTAINER Pavel Panchekha
RUN apt-get update \
&& apt-get install -y libcairo2-dev libjpeg62 libpango1.0-dev \
diff --git a/EDITING.md b/EDITING.md
deleted file mode 100644
index 44b4b8006..000000000
--- a/EDITING.md
+++ /dev/null
@@ -1,25 +0,0 @@
-
-Editing
-=======
-
-You should use Emacs to edit Racket code; Dr. Racket, which ships with
-Racket, is a bit too limited an editor for the number of files and
-complexity of Herbie. You’ll want to use the `quack` and `geiser` Emacs
-packages to give you Racket-specific highlighting and a Racket REPL.
-The easiest way to install these is to run
-
- (require 'package)
- (add-to-list 'package-archives
- '("marmalade" . "http://marmalade-repo.org/packages/"))
- (package-initialize)
- (mapcar #'package-install '(quack geiser))
-
-This needs to be done once. You can now open a Racket file, like
-`herbie/main.rkt`, and the mode-line will read `Scheme Racket/A`,
-indicating that Quack, the Scheme mode, is running.
-
-If you hit `C-c C-a` in a Racket buffer, you’ll open up a REPL and
-“enter” that module, allowing you to refer to definitions in it. The
-same `C-c C-a` binding reloads the file, while `C-M-x` reloads
-individual definitions and `C-c C-e` executes individual
-S-expressions.
\ No newline at end of file
diff --git a/LICENSE.md b/LICENSE.md
index 65958a1da..72c48ee95 100644
--- a/LICENSE.md
+++ b/LICENSE.md
@@ -1,4 +1,4 @@
-Copyright (c) 2015 Herbie Project
+Copyright (c) 2015-2019 Herbie Project
Modified work Copyright 2016 Google Inc.
Permission is hereby granted, free of charge, to any person obtaining
diff --git a/Makefile b/Makefile
index dc77b0d3d..c8a39a5ae 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-.PHONY: all install update nightly index clean publish start-server package loc deploy
+.PHONY: all install update nightly index publish start-server package deploy
all:
@echo "Type 'make install' to install Herbie as a Racket package,"
@@ -23,28 +23,23 @@ herbie.zip herbie.zip.CHECKSUM:
mv src.zip herbie.zip
mv src.zip.CHECKSUM herbie.zip.CHECKSUM
-clean:
- rm -f cost
- rm -rf graphs/
-
publish:
bash infra/publish.sh upload graphs/
bash infra/publish.sh index
start-server:
- racket src/herbie.rkt web --seed '#(2775764126 3555076145 3898259844 1891440260 2599947619 1948460636)' --timeout 60 --num-iters 2 --demo --prefix /demo/ --port 4053 --save-session www/demo/ --log infra/server.log --quiet 2>&1
+ racket src/herbie.rkt web --seed 1 --timeout 150 --num-iters 2 \
+ --demo --public --prefix /demo/ --port 4053 --save-session www/demo/ \
+ --log infra/server.log --quiet 2>&1
package:
raco pkg
-loc:
- find herbie/ -type f -exec cat {} \; | wc -l
-
# This rule is run by herbie.uwplse.org on every commit to Github.
# It does not restart the demo server, but it does pull new static content
deploy:
cd $(shell ~/uwplse/getdir) && git pull
-cost: infra/cost.c
+infra/cost: infra/cost.c
$(CC) -O0 $^ -lm -o $@
diff --git a/README.md b/README.md
index 131a5e553..6221682d0 100644
--- a/README.md
+++ b/README.md
@@ -3,11 +3,11 @@
[![Build Status](https://travis-ci.org/uwplse/herbie.svg?branch=master)](https://travis-ci.org/uwplse/herbie)
-Herbie synthesizes floating-point programs from real-number programs,
-automatically handling simple numerical instabilities. Visit [our
-website](https://herbie.uwplse.org) for tutorials, documentation, and
-an online demo. Herbie has semi-regular releases twice a year,
-maintains backwards compatibility, and uses standardized formats.
+Herbie automatically improves the error of floating point expressions.
+Visit [our website](https://herbie.uwplse.org) for tutorials,
+documentation, and an online demo. Herbie has semi-regular releases
+once a year, maintains backwards compatibility, and uses standardized
+formats.
Installing
----------
@@ -15,10 +15,10 @@ Installing
For full details on installing Herbie, please see the
[tutorial](http://herbie.uwplse.org/doc/latest/installing.html).
-Herbie requires Racket 6.7 or later, and supports Windows, OS X, and
+Herbie requires Racket 7.0 or later, and supports Windows, macOS, and
Linux. Install it with:
- raco pkg install herbie
+ raco pkg install --auto herbie
This will install a `herbie` binary to somewhere in your home
directory. You can also run `src/herbie.rkt` directly instead of using
@@ -35,15 +35,14 @@ Herbie's input is a Scheme-based language called [FPCore](http://fpbench.org/spe
you can several examples in `bench/`.
For example, consider this simple expression:
- (FPCore (x)
- (- (+ 1 x) x))
+ (FPCore (x) (- (+ 1 x) x))
Run Herbie from the top-level directory of the repo, and enter the
cancellation test:
$ herbie shell
- Herbie 1.2 with seed #(349461420 3681359142 2680361770 2900531005 1939065059 1779362427)
- Find help on , exit with Ctrl-D
+ Herbie 1.3 with seed 1866513483
+ Find help on https://herbie.uwplse.org/, exit with Ctrl-D
herbie> (FPCore (x) (- (+ 1 x) x))
(FPCore (x) ... 1)
@@ -53,7 +52,7 @@ the constant `1`.
Besides the `shell`, Herbie also has a `web` interface, and can run on
files of FPCore expressions with the `improve` and `report` commands.
Consult the
-[documentation](http://herbie.uwplse.org/doc/latest/options.html).
+[documentation](http://herbie.uwplse.org/doc/latest/tutorial.html).
for more.
Helping Out
diff --git a/bench/hamming/complex.fpcore b/bench/hamming/complex.fpcore
index 4aa8508fa..520c09780 100644
--- a/bench/hamming/complex.fpcore
+++ b/bench/hamming/complex.fpcore
@@ -1,23 +1,22 @@
; -*- mode: scheme -*-
-; TODO: exp function unimplemented.
-#;(FPCore (xre xim)
+(FPCore (xre xim)
:name "exp with complex power real part (p55)"
(let ([x (complex xre xim)])
(re (/ (+ (exp x) (exp (- x))) (complex 2 0)))))
-#;(FPCore (xre xim)
+(FPCore (xre xim)
:name "exp with complex power imaginary part (p55)"
(let ([x (complex xre xim)])
(im (/ (+ (exp x) (exp (- x))) (complex 2 0)))))
-#;(FPCore (x y)
+(FPCore (x y)
:name "Euler formula real part (p55)"
(let ([a (/ (+ (exp x) (exp (- x))) 2)]
[b (/ (- (exp x) (exp (- x))) 2)])
(re (complex (* a (cos y)) (* b (sin y))))))
-#;(FPCore (x y)
+(FPCore (x y)
:name "Euler formula imaginary part (p55)"
(let ([a (/ (+ (exp x) (exp (- x))) 2)]
[b (/ (- (exp x) (exp (- x))) 2)])
diff --git a/bench/hamming/machine-decide.fpcore b/bench/hamming/machine-decide.fpcore
index bb84b7421..f2dd3aae1 100644
--- a/bench/hamming/machine-decide.fpcore
+++ b/bench/hamming/machine-decide.fpcore
@@ -2,6 +2,7 @@
(FPCore (a x)
:name "expax (section 3.5)"
+ :herbie-expected 14
:herbie-target
(if (< (fabs (* a x)) 1/10)
(* (* a x) (+ 1 (+ (/ (* a x) 2) (/ (pow (* a x) 2) 6))))
diff --git a/bench/haskell.fpcore b/bench/haskell.fpcore
index 7c923df13..f00d6c63b 100644
--- a/bench/haskell.fpcore
+++ b/bench/haskell.fpcore
@@ -945,7 +945,10 @@
(if (< z 7.636950090573675e+176)
(* 2.0 (sqrt (+ (* (+ x y) z) (* x y))))
(*
- (sqr
+ (*
+ (+
+ (* 1/4 (* (* (pow y -3/4) (* (pow z -3/4) x)) (+ y z)))
+ (* (pow z 1/4) (pow y 1/4)))
(+
(* 1/4 (* (* (pow y -3/4) (* (pow z -3/4) x)) (+ y z)))
(* (pow z 1/4) (pow y 1/4))))
diff --git a/bench/libraries/mathjs/arithmetic.fpcore b/bench/libraries/mathjs/arithmetic.fpcore
index c0be790ea..1604a66cf 100644
--- a/bench/libraries/mathjs/arithmetic.fpcore
+++ b/bench/libraries/mathjs/arithmetic.fpcore
@@ -11,12 +11,21 @@
(FPCore (x.re x.im)
:name "math.cube on complex, real part"
+ :herbie-target
+ (+ (* (* x.re x.re) (- x.re x.im))
+ (* (* x.re x.im) (- x.re (* 3 x.im))))
+
(-
(* (- (* x.re x.re) (* x.im x.im)) x.re)
(* (+ (* x.re x.im) (* x.im x.re)) x.im)))
(FPCore (x.re x.im)
:name "math.cube on complex, imaginary part"
+ :herbie-target
+ (+
+ (* (* x.re x.im) (* 2 x.re))
+ (* (* x.im (- x.re x.im)) (+ x.re x.im)))
+
(+
(* (- (* x.re x.re) (* x.im x.im)) x.im)
(* (+ (* x.re x.im) (* x.im x.re)) x.re)))
@@ -107,7 +116,7 @@
(FPCore (re im)
:name "math.sqrt on complex, imaginary part, im greater than 0 branch"
- (* 0.5 (sqrt (* 2.0 (+ (sqrt (- (* re re) (* im im))) re)))))
+ (* 0.5 (sqrt (* 2.0 (- (sqrt (+ (* re re) (* im im))) re)))))
(FPCore (re im)
:name "math.square on complex, real part"
diff --git a/bench/mathematics/excel.fpcore b/bench/mathematics/excel.fpcore
new file mode 100644
index 000000000..e15a2d3ce
--- /dev/null
+++ b/bench/mathematics/excel.fpcore
@@ -0,0 +1,5 @@
+(FPCore (x0 x1)
+ :name "(- (/ x0 (- 1 x1)) x0)"
+ :pre (or (and (== x0 1.855) (== x1 0.000209)) (and (== x0 2.985) (== x1 0.0186)))
+ :herbie-target (/ (* x0 x1) (- 1 x1))
+ (- (/ x0 (- 1 x1)) x0))
diff --git a/bench/mathematics/latlong.fpcore b/bench/mathematics/latlong.fpcore
index 265af14b0..815f3fee6 100644
--- a/bench/mathematics/latlong.fpcore
+++ b/bench/mathematics/latlong.fpcore
@@ -47,6 +47,7 @@
(lambdam (+ lambda1 (atan2 By (+ (cos phi1) Bx)))))
lambdam))))
+;; TODO: phi2 unused
(FPCore (lambda1 phi1 phi2 delta theta)
:name "Destination given bearing on a great circle"
(let ((phi2
diff --git a/bench/mathematics/sarnoff.fpcore b/bench/mathematics/sarnoff.fpcore
index bd6129821..2cf453406 100644
--- a/bench/mathematics/sarnoff.fpcore
+++ b/bench/mathematics/sarnoff.fpcore
@@ -25,25 +25,25 @@
(< 4.930380657631324e-32 c 2.028240960365167e31))
(/ (+ (- b) (sqrt (- (* b b) (* 4 a c)))) (* 2 a)))
-(FPCore (a b c d)
+(FPCore (a b c)
:name "Cubic critical"
(/ (+ (- b) (sqrt (- (* b b) (* 3 a c)))) (* 3 a)))
-(FPCore (a b c d)
+(FPCore (a b c)
:name "Cubic critical, narrow range"
:pre (and (< 1.0536712127723509e-8 a 9.490626562425156e7)
(< 1.0536712127723509e-8 b 9.490626562425156e7)
(< 1.0536712127723509e-8 c 9.490626562425156e7))
(/ (+ (- b) (sqrt (- (* b b) (* 3 a c)))) (* 3 a)))
-(FPCore (a b c d)
+(FPCore (a b c)
:name "Cubic critical, medium range"
:pre (and (< 1.1102230246251565e-16 a 9.007199254740992e15)
(< 1.1102230246251565e-16 b 9.007199254740992e15)
(< 1.1102230246251565e-16 c 9.007199254740992e15))
(/ (+ (- b) (sqrt (- (* b b) (* 3 a c)))) (* 3 a)))
-(FPCore (a b c d)
+(FPCore (a b c)
:name "Cubic critical, wide range"
:pre (and (< 4.930380657631324e-32 a 2.028240960365167e31)
(< 4.930380657631324e-32 b 2.028240960365167e31)
diff --git a/bench/numerics/great-debate.fpcore b/bench/numerics/great-debate.fpcore
new file mode 100644
index 000000000..794c508d9
--- /dev/null
+++ b/bench/numerics/great-debate.fpcore
@@ -0,0 +1,39 @@
+(FPCore (y)
+ :name "Kahan's Monster"
+ :pre (<= 1 y 9999) ; Integers only in Kahan's example but this is not essential
+ (let ([Qx (- (fabs (- y (sqrt (+ (* y y) 1))))
+ (/ 1 (+ y (sqrt (+ (* y y) 1)))))])
+ (let ([z (* Qx Qx)])
+ (if (== z 0) 1 (/ (- (exp z) 1) z)))))
+
+(FPCore (y)
+ :name "Kahan's Unum-Targeted Monster"
+ :pre (<= 1 y 9999) ; Integers only in Kahan's example but this is not essential
+ (let ([Qx (- (fabs (- y (sqrt (+ (* y y) 1)))) (/ 1 (+ y (sqrt (+ (* y y) 1)))))])
+ (let ([z (+ (* Qx Qx) (pow (pow 10 -300) (* 10000 (+ y 1))))])
+ (if (== z 0) 1 (/ (- (exp z) 1) z)))))
+
+(FPCore (x y)
+ :name "Kahan p9 Example"
+ :pre (and (< 0 x 1) (< y 1))
+ :herbie-target
+ (if (< 0.5 (fabs (/ x y)) 2)
+ (/ (* (- x y) (+ x y)) (+ (* x x) (* y y)))
+ (- 1 (/ 2 (+ 1 (* (/ x y) (/ x y))))))
+
+ (/ (* (- x y) (+ x y)) (+ (* x x) (* y y))))
+
+(FPCore (t)
+ :name "Kahan p13 Example 1"
+ (let ([u (/ (* 2 t) (+ 1 t))])
+ (/ (+ 1 (* u u)) (+ 2 (* u u)))))
+
+(FPCore (t)
+ :name "Kahan p13 Example 2"
+ (let ([v (- 2 (/ (/ 2 t) (+ 1 (/ 1 t))))])
+ (/ (+ 1 (* v v)) (+ 2 (* v v)))))
+
+(FPCore (t)
+ :name "Kahan p13 Example 3"
+ (let ([v (- 2 (/ (/ 2 t) (+ 1 (/ 1 t))))])
+ (- 1 (/ 1 (+ 2 (* v v))))))
diff --git a/bench/numerics/rump.fpcore b/bench/numerics/rump.fpcore
new file mode 100644
index 000000000..6a214b52c
--- /dev/null
+++ b/bench/numerics/rump.fpcore
@@ -0,0 +1,28 @@
+(FPCore (x y)
+ :name "Rump's expression from Stadtherr's award speech"
+ :pre (and (== x 77617) (== y 33096))
+ :spec -54767/66192
+ (+ (* 333.75 (pow y 6))
+ (* (* x x)
+ (- (* 11 x x y y)
+ (pow y 6)
+ (* 121 (pow y 4))
+ 2))
+ (* 5.5 (pow y 8))
+ (/ x (* 2 y))))
+
+;; From
+;; How Reliable are the Results of Computers
+;; Jahrbuch Uberblicke Mathematik (1983)
+
+(FPCore (x y)
+ :name "From Rump in a 1983 paper"
+ :pre (and (== x 10864) (== y 18817))
+ ;:pre (and (< 10500 x 11000) (< 18500 y 19000))
+ (+ (- (* 9 (pow x 4)) (pow y 4)) (* 2 (* y y))))
+
+(FPCore (x y)
+ :name "From Rump in a 1983 paper, rewritten"
+ :pre (and (== x 10864) (== y 18817))
+ ;:pre (and (< 10500 x 11000) (< 18500 y 19000))
+ (- (* 9 (pow x 4)) (* (* y y) (- (* y y) 2))))
diff --git a/bench/physics/sidey.fpcore b/bench/physics/sidey.fpcore
new file mode 100644
index 000000000..964eb76df
--- /dev/null
+++ b/bench/physics/sidey.fpcore
@@ -0,0 +1,14 @@
+;; Code courtesy of Sidey P. Timmins of NASA
+
+;; In the original, x was (- q r)
+(FPCore (p x)
+ :name "Given's Rotation SVD example"
+ :pre (< 1e-150 (fabs x) 1e150)
+ :herbie-target
+ (sqrt (+ 1/2 (/ (copysign 1/2 x) (hypot 1 (/ (* 2 p) x)))))
+ (sqrt (* 0.5 (+ 1 (/ x (sqrt (+ (* 4 p p) (* x x))))))))
+
+;; Here, I'm doing (1 - the above), and x here is (2p / x)
+(FPCore (x)
+ :name "Given's Rotation SVD example, simplified"
+ (- 1 (sqrt (* 1/2 (+ 1 (/ 1 (hypot 1 x)))))))
diff --git a/infra/all.sh b/infra/all.sh
deleted file mode 100755
index 52ce2d9d6..000000000
--- a/infra/all.sh
+++ /dev/null
@@ -1,15 +0,0 @@
-#!/bin/sh
-
-line () { tail $1 -n+$2 | head -n1; }
-
-for i in $1*.out; do
- line $i 1 | paste -d, - "$2/shortnames.csv"
-done > $1.names.csv
-for i in $1*.out; do line $i 2; done > $1.pf.csv
-for i in $1*.out; do line $i 3; done > $1.pd.csv
-for i in $1*.out; do line $i 5; done > $1.if.csv
-for i in $1*.out; do line $i 6; done > $1.id.csv
-for i in $1*.out; do line $i 7; done > $1.of.csv
-for i in $1*.out; do line $i 8; done > $1.od.csv
-for i in $1*.out; do line $i 9; done > $1.df.csv
-for i in $1*.out; do line $i 10; done > $1.dd.csv
diff --git a/infra/backfill-index.rkt b/infra/backfill-index.rkt
deleted file mode 100644
index f90e5c2ae..000000000
--- a/infra/backfill-index.rkt
+++ /dev/null
@@ -1,44 +0,0 @@
-#lang racket
-
-(require "../src/common.rkt")
-(require "../src/formats/datafile.rkt")
-(require "make-index.rkt")
-
-(define allowed-suites
- '("tutorial" "regression" "physics" "numerics" "mathematics" "libraries" "hamming" "haskell"))
-
-(define (write-report-info folder info)
- (let ([info-file (build-path report-output-path "reports" folder "results.json")])
- (write-datafile info-file info)))
-
-(define (same-tests? info1 info2)
- (and (report-info-tests info1) (report-info-tests info2)
- (set=?
- (map table-row-input (report-info-tests info1))
- (map table-row-input (report-info-tests info2)))))
-
-(define (backfill-index)
- (define dirs (directory-list (build-path report-output-path "reports/")))
-
- (define folders
- (map (λ (dir) (cons dir (read-report-info dir)))
- (remove-duplicates
- (sort (filter name->timestamp dirs) > #:key name->timestamp)
- #:key name->timestamp)))
-
- (define reps
- (for/list ([suite allowed-suites])
- (for/first ([(folder info) (in-dict folders)] #:when (equal? (report-info-note info) suite))
- info)))
-
- (for ([(folder info) (in-dict folders)])
- (define suite
- (for/first ([suite allowed-suites] [rep reps] #:when (and info rep (same-tests? info rep)))
- suite))
- (when (and suite (not (report-info-note info)))
- (eprintf "Updating ~a to ~a\n" folder suite)
- (set-report-info-note! info suite)
- (write-report-info folder info))))
-
-(module+ main
- (backfill-index))
diff --git a/infra/bash-pred-test.rkt b/infra/bash-pred-test.rkt
deleted file mode 100644
index dd10898d9..000000000
--- a/infra/bash-pred-test.rkt
+++ /dev/null
@@ -1,57 +0,0 @@
-#lang racket
-
-(require "../src/common.rkt")
-(require "../src/points.rkt")
-(require "../src/formats/test.rkt")
-(require "../src/main.rkt")
-(require "../src/alternative.rkt")
-(require "../src/programs.rkt")
-(require racket/engine)
-
-(define *seed* #f)
-(define *timeout* (* 1000 60 10))
-(define *lenient* #f)
-(define *reeval-pts* 8000)
-
-(define (bash-pred-test benchdir testname)
- (let* ([all-tests (load-tests benchdir)]
- [test (findf (λ (t) (string=? (test-name t) testname)) all-tests)])
- (if (not test) (begin (println "Couldn't find the test!") (exit 1))
- (let ([eng (engine (λ _ (improve (test-program test) (*num-iterations*)
- #:samplers (test-samplers test))))])
- (begin (engine-run *timeout* eng)
- (let ([result-alt (engine-result eng)])
- (cond
- [result-alt
- (define newcontext
- (parameterize ([*num-points* *reeval-pts*])
- (prepare-points (test-program test) (test-samplers test))))
- (match-define (list newpoints newexacts) (sorted-context-list newcontext 0))
- (let* ([start-errors (errors (test-program test) newcontext)]
- [end-errors (errors (alt-program result-alt) newcontext)]
- [start-score (errors-score start-errors)]
- [end-score (errors-score end-errors)])
- (if (not (test-output test)) (if (start-score . < . end-score) (exit 0) (exit 1))
- (let* ([target-errors (errors `(λ ,(program-variables (test-program test))
- ,(test-output test)) newcontext)]
- [target-score (errors-score target-errors)])
- (if (or *lenient* (target-score . <= . end-score)) (exit 0) (exit 1)))))]
- [#f (println "Timeout.") (exit 1)])))))))
-
-(command-line
- #:program "bash-pred-test"
- #:once-each
- [("-r") rs "The random seed vector to use in point generation."
- (set-seed! (read (open-input-string rs)))]
- [("-n") fu "The amount of 'fuel' to use"
- (*num-iterations* (string->number fu))]
- [("-s") points "The number of points to use during search"
- (*num-points* (string->number points))]
- [("-e") epoints "The number of points to use during eval"
- (set! *reeval-pts* epoints)]
- [("-t") timeout "The number of seconds to wait before killing the test."
- (set! *timeout* timeout)]
- [("-l") "Return true as long as we finish and are better than start program."
- (set! *lenient* #t)]
- #:args (benchdir testname)
- (bash-pred-test benchdir testname))
diff --git a/infra/bruteforce.c b/infra/bruteforce.c
deleted file mode 100644
index f4195943b..000000000
--- a/infra/bruteforce.c
+++ /dev/null
@@ -1,112 +0,0 @@
-#define _POSIX_C_SOURCE 199309L
-#include
-#include
-#include
-#include
-#include
-#include
-
-void setup_mpfr_f_im(void);
-void setup_mpfr_f_fm(void);
-void setup_mpfr_f_dm(void);
-double f_if(float);
-double f_id(double);
-double f_im(double);
-double f_of(float);
-double f_od(double);
-double f_om(double);
-extern char *name;
-
-typedef unsigned long long int u64;
-typedef unsigned int u32;
-
-unsigned int ulpf(float x, float y) {
- if (x == 0) x = fabsf(x); // -0 == 0
- if (y == 0) y = fabsf(y); // -0 == 0
-
- if (x != x && y != y) return 0;
- if (x != x) return INT_MIN; // Maximum error
- if (y != y) return INT_MIN; // Maximum error
-
- u32 xx = *((u32*) &x);
- xx = xx < 0 ? INT_MIN - xx : xx;
-
- u32 yy = *((u32*) &y);
- yy = yy < 0 ? INT_MIN - yy : yy;
-
- return xx >= yy ? xx - yy : yy - xx;
-}
-
-unsigned long long ulpd(double x, double y) {
- if (x == 0) x = fabs(x); // -0 == 0
- if (y == 0) y = fabs(y); // -0 == 0
-
- if (x != x && y != y) return 0;
- if (x != x) return LLONG_MIN; // Maximum error
- if (y != y) return LLONG_MIN; // Maximum error
-
- u64 xx = *((u64*) &x);
- xx = xx < 0 ? LLONG_MIN - xx : xx;
-
- u64 yy = *((u64*) &y);
- yy = yy < 0 ? LLONG_MIN - yy : yy;
-
- return xx >= yy ? xx - yy : yy - xx;
-}
-
-char ordinaryf(float x) {
- return 1 / x != 0 && x == x;
-}
-
-char ordinaryd(double x) {
- return 1 / x != 0 && x == x;
-}
-
-int main(int argc, char** argv) {
- u32 x = 0;
- u32 stop = 0;
- u32 parts, part;
- float xf = 0.0, exact = 0.0, approxi = 0.0, approxo;
- u32 ei = 0, eo = 0;
- u32 maxi = 0, maxo = 0, numbad = 0, maxbad = 0;
-
- setup_mpfr_f_im();
-
- if (argc < 3) {
- printf("Usage: bfN.bin [log2(parts)] [part]\n");
- exit(1);
- }
-
- parts = atoi(argv[1]);
- part = atoi(argv[2]);
-
- x = (part << (32 - parts));
- if (part == (1 << parts)) {
- stop = ~1u + 1u; // The last float is a NaN, so we don't care about it.
- } else {
- stop = (part + 1) << (32 - parts);
- }
-
- fprintf(stderr, "// %s, %08x to %08x\n", name, x, stop);
-
- for (; x != stop; x++) {
- if ((x & 0xffff) == 0) {
- fprintf(stderr, "%08x,%u,%u,%u,%u\n", x, maxi, maxo, numbad, maxbad);
- }
- xf = *(float*)(void*)&x;
- if (!ordinaryf(xf)) continue;
- exact = f_im(xf);
- if (!ordinaryf(exact)) continue;
- approxi = f_if(xf);
- approxo = f_of(xf);
- ei = ulpf(approxi, exact);
- eo = ulpf(approxo, exact);
- if (maxi < ei) maxi = ei;
- if (maxo < eo) maxo = eo;
- if (eo > ei) {
- numbad++;
- if (maxbad < eo - ei) maxbad = eo - ei;
- }
- }
- printf("%i,%u,%u,%u,%u\n", part, maxi, maxo, numbad, maxbad);
-}
diff --git a/infra/convergence.c b/infra/convergence.c
deleted file mode 100644
index 20bdf2544..000000000
--- a/infra/convergence.c
+++ /dev/null
@@ -1,197 +0,0 @@
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-
-#ifndef NARGS
-#define NARGS 1
-#endif
-
-#if NARGS == 1
-#define ARGS float
-#elif NARGS == 2
-#define ARGS float, float
-#elif NARGS == 3
-#define ARGS float, float, float
-#elif NARGS == 4
-#define ARGS float, float, float, float
-#elif NARGS == 5
-#define ARGS float, float, float, float, float
-#elif NARGS == 6
-#define ARGS float, float, float, float, float, float
-#else
-#define ARGS
-#endif
-
-void setup_mpfr_f_im(void);
-void setup_mpfr_f_om(void);
-double f_if(ARGS);
-double f_id(ARGS);
-double f_il(ARGS);
-double f_of(ARGS);
-double f_od(ARGS);
-double f_ol(ARGS);
-double f_im(ARGS);
-double f_om(ARGS);
-
-unsigned long long ulp(double x, double y) {
- if (x == 0) x = fabs(x); // -0 == 0
- if (y == 0) y = fabs(y); // -0 == 0
-
- if (x != x && y != y) return 0;
- if (x != x) return LLONG_MIN;
- if (y != y) return LLONG_MIN;
-
- long long xx = *((unsigned long long*) &x);
- xx = xx < 0 ? LLONG_MIN - xx : xx;
-
- long long yy = *((unsigned long long*)&y);
- yy = yy < 0 ? LLONG_MIN - yy : yy;
-
- return xx >= yy ? xx - yy : yy - xx;
-}
-
-float rand_float() {
- unsigned int c0 = rand()&0xffff;
- unsigned int c1 = rand()&0xffff;
- unsigned int c = ((c1<<16) | c0);
- return *(float*)&c;
-}
-
-float *get_random(int nums) {
- int i;
- float *arr = malloc(sizeof(float) * nums * NARGS);
- for (i = 0; i < nums * NARGS; i++) {
- arr[i] = rand_float();
- }
- return arr;
-}
-
-#define SETUP() \
- clock_t start, end, zero; \
- int i, j, k; \
- double total, r1, r2, r1old; \
- float *rands, *out, *correct; \
- int count, mcount; \
- srand(time(NULL)); \
- setup_mpfr_f_im();
-
-#define CALIBRATE(iter) \
- start = clock(); \
- for (i = 0; i < iter; i++) { \
- out[i] = 1 / rands[NARGS*i]; \
- } \
- end = clock(); \
- zero = end - start;
-
-#if NARGS == 1
-#define TEST(type, iter) \
- start = clock(); \
- for (i = 0; i < iter; i++) { \
- out[i] = f_##type (rands[i]); \
- } \
- end = clock();
-
-#elif NARGS == 2
-#define TEST(type, iter) \
- start = clock(); \
- for (i = 0; i < iter; i++) { \
- out[i] = f_##type (rands[2*i], rands[2*i + 1]); \
- } \
- end = clock();
-
-#elif NARGS == 3
-#define TEST(type, iter) \
- start = clock(); \
- for (i = 0; i < iter; i++) { \
- out[i] = f_##type (rands[3*i], rands[3*i + 1], rands[3*i + 2]); \
- } \
- end = clock();
-
-#elif NARGS == 4
-#define TEST(type, iter) \
- start = clock(); \
- for (i = 0; i < iter; i++) { \
- out[i] = f_##type (rands[4*i], rands[4*i + 1], rands[4*i + 2], rands[4*i + 3]); \
- } \
- end = clock();
-
-#elif NARGS == 5
-#define TEST(type, iter) \
- start = clock(); \
- for (i = 0; i < iter; i++) { \
- out[i] = f_##type (rands[5*i], rands[5*i + 1], rands[5*i + 2], \
- rands[5*i + 3], rands[5*i + 4]); \
- } \
- end = clock();
-
-#elif NARGS == 6
-#define TEST(type, iter) \
- start = clock(); \
- for (i = 0; i < iter; i++) { \
- out[i] = f_##type (rands[6*i], rands[6*i + 1], rands[6*i + 2], \
- rands[6*i + 3], rands[6*i + 4], rands[6*i + 5]); \
- } \
- end = clock();
-
-#else
-#define TEST(type, iter) abort();
-#endif
-
-#define SAMPLE(iter) \
- rands = get_random(iter); \
- out = malloc(sizeof(float) * iter);
-
-#define SAVE(iter) \
- correct = malloc(sizeof(float) * iter); \
- memcpy((void *) correct, (void *) out, sizeof(float) * iter); \
- count = 0; \
- for (i = 0; i < iter; i++) { \
- if (1 / correct[i] != 0 && correct[i] == correct[i]) { \
- count += 1; \
- } /*else { printf("Bad point %g\n", correct[i]); }*/ \
- }
-
-int main(int argc, char** argv) {
- SETUP();
-
- int iter, repet;
- iter = 1 << 15;
- repet = 100;
- if (argc > 1) iter = atoi(argv[1]);
- if (argc > 2) repet = atoi(argv[2]);
-
- printf("pts,repet,avg,se\n");
- for (j = 2; j < iter; j *= 2) {
- r1 = r2 = 0;
- mcount = -1;
- for (k = 0; k < repet; k++) {
- SAMPLE(j);
- TEST(im, j);
- SAVE(j);
-
- TEST(if, j);
- total = 0;
- for (i = 0; i < j; i++) {
- if (1 / correct[i] != 0 && correct[i] == correct[i]) {
- unsigned long long int error = ulp(out[i], correct[i]);
- total += log(error + 1.0) / log(2);
- }
- }
- r1old = r1;
- r1 += (total / count - r1) / (k + 1);
- r2 += (total / count - r1old) * (total / count - r1);
- if (mcount == -1 || count < mcount) mcount = count;
-
- free(rands);
- free(out);
- free(correct);
- }
- printf("%i,%i,%g,%g\n", mcount, repet,
- r1, sqrt(r2 / (repet - 1.5)) / sqrt(repet));
- }
-}
diff --git a/infra/convert.rkt b/infra/convert.rkt
deleted file mode 100644
index 1d3342938..000000000
--- a/infra/convert.rkt
+++ /dev/null
@@ -1,114 +0,0 @@
-#lang racket
-
-(require "../src/common.rkt")
-
-(provide convert)
-
-(define (args&body* args)
- (match args
- [(list (? keyword? name) value args* ...)
- (define out* (args&body* args*))
- (cons (car out*) (cons (cons name value) (cdr out*)))]
- [(list body args* ...)
- (define out* (args&body* args*))
- (assert (not (car out*)) #:extra-info (λ () (format "Two body expressions ~a and ~a" (car out*) body)))
- (cons body (cdr out*))]
- [(list)
- (cons #f '())]))
-
-(define (args&body args)
- (define out* (args&body* args))
- (assert (car out*) #:extra-info (λ () "No body expression"))
- out*)
-
-(define (var&dist expr)
- (match expr
- [(list var samp) (list var samp)]
- [var (list var 'default)]))
-
-; parse old herbie syntax into FPCore
-(define (convert expr)
- (define-values (vars* args*)
- (match expr
- [(list 'herbie-test (list vars ...) (? string? name) input)
- (values vars (list '#:name name input))]
- [(list 'herbie-test (list vars ...) (? string? name) input output)
- (values vars (list '#:name name '#:target output input))]
- [(list 'herbie-test (list vars ...) input output)
- (values vars (list '#:name "Unnamed Test" '#:target output input))]
- [(list 'lambda (list vars ...) args ...)
- (values vars args)]
- [(list 'define name (list vars ...) args ...)
- (values vars (list*'#:name name args))]))
- (match-define (list body args ...) (args&body args*))
- (match-define (list (list vars samps) ...) (map var&dist vars*))
-
- (define (translate-prop old-name new-name [transformer identity])
- (if (dict-has-key? args old-name)
- (list new-name (transformer (dict-ref args old-name)))
- (list)))
-
- (define (translate-samplers)
- (define-values (samplers pre)
- (reap [samplers pre]
- (for ([var vars] [samp samps])
- (define samp*
- (match samp
- [(list (and (or '> '< '<= '>=) op) (? number? lb) samp)
- (pre (list op lb var))
- samp]
- [(list (and (or '> '< '<= '>=) op) samp (? number? ub))
- (pre (list op var ub))
- samp]
- [(list (and (or '> '< '<= '>=) op) (? number? lb) samp (? number? ub))
- (pre (list op lb var))
- (pre (list op var ub))
- samp]
- [_ samp]))
- (unless (equal? samp* 'default)
- (samplers (list var samp*))))))
- (append
- (if (null? samplers) '() (list ':herbie-samplers samplers))
- (if (null? pre) '() (list ':pre (cons 'and pre)))))
-
- `(FPCore ,vars
- ,@(translate-samplers)
- ,@(translate-prop '#:name ':name)
- ,@(translate-prop '#:expected ':herbie-expected)
- ,@(translate-prop '#:target ':herbie-target (curryr search-replace vars))
- ,(search-replace body vars)))
-
-; we assume vars and vals are of the same length
-(define (expand-let* vars vals body)
- (if (and (null? vars) (null? vals))
- body
- `(let ([,(car vars) ,(car vals)])
- ,(expand-let* (cdr vars) (cdr vals) body))))
-
-(define (search-replace expr bound)
- (match expr
- [`(let* ([,vars ,vals] ...) ,body)
- (define vals*
- (let loop ([vars vars] [vals vals] [bound bound])
- (if (null? vars)
- '()
- (cons (search-replace (car vals) bound)
- (loop (cdr vars) (cdr vals) (cons (car vars) bound))))))
- (expand-let* vars vals* (search-replace body (append vars bound)))]
- [(list (and (or 'abs 'expt 'mod) f) elements ...)
- (define replacements '((abs . fabs) (expt . pow) (mod . fmod)))
- (cons (dict-ref replacements f) (map (curryr search-replace bound) elements))]
- [(list elements ...)
- (map (curryr search-replace bound) elements)]
- [(or 'e 'pi)
- (define replacements '((e . E) (pi . PI)))
- (if (member expr bound) expr (dict-ref replacements expr))]
- [_ expr]))
-
-(module+ main
- (command-line
- #:program "herbie-to-fpcore"
- #:args (file)
- (for ([test (in-port read (open-input-file file))])
- (pretty-print (convert test) (current-output-port) 1))))
-
diff --git a/infra/index.css b/infra/index.css
index 39565ab0e..5d74ce81f 100644
--- a/infra/index.css
+++ b/infra/index.css
@@ -14,19 +14,20 @@ a:hover {text-decoration: underline; color: #295785}
figure { margin: 0; overflow: auto; }
-#graph { float: left; }
-#graph text { text-anchor: end; }
-#graph .guide { stroke: rgb(60%, 60%, 60%); stroke-width: 1px; }
-#graph .gridline { stroke: black; stroke-width: 3px; }
-#graph .arrow {pointer-events: all; stroke-width: 7px; cursor: pointer;}
-#graph:hover .arrow {stroke-opacity: .7; fill-opacity: 0.7;}
-#graph:hover .arrow:hover { stroke-opacity: 1.0; fill-opacity: 1.0; }
+svg { float: left; }
+svg text { text-anchor: end; }
+svg text.guide { fill: rgb(30%, 30%, 30%); }
+svg line.guide { stroke: rgb(60%, 60%, 60%); stroke-width: 1px; }
+svg .gridline { stroke: black; stroke-width: 3px; }
+svg .arrow {pointer-events: all; stroke-width: 7px; cursor: pointer;}
+svg:hover .arrow {stroke-opacity: .7; fill-opacity: 0.7;}
+svg:hover .arrow:hover { stroke-opacity: 1.0; fill-opacity: 1.0; }
figure ul { margin: 0; padding: 0; list-style-type: none; list-style-position: inside; text-align: center; }
figure li { padding: .5ex; display: inline-block; margin: .1em; }
figure li:hover { background: #e4e4e4; }
figure li.selected { background: #d3d3d3; }
figure a { color: black; text-decoration: none; display: block; }
-#graph .no-data { text-anchor: middle; font-size: 18px; fill: rgb(60%, 60%, 60%)}
+svg .no-data { text-anchor: middle; font-size: 18px; fill: rgb(60%, 60%, 60%)}
#toc {
clear: both;
@@ -43,8 +44,8 @@ figure a { color: black; text-decoration: none; display: block; }
#reports tr.crash { color: red; }
#reports td { text-align: right; padding: .5em; overflow: hidden; font-size: 15pt; }
#reports tbody tr:hover {background-color: #e0f8d8; cursor: pointer;}
-#reports td:nth-child(2), #reports th:nth-child(2) { text-align: center; display: none; }
-#reports td:nth-child(3) { text-align: center; }
+#reports td:nth-child(3), #reports th:nth-child(2) { text-align: center; display: none; }
+#reports td:nth-child(4) { text-align: center; }
#reports thead { border-bottom: 1px solid black; height: 5em; vertical-align: bottom; }
#reports a {
position: absolute; left: 0; right: 0; z-index: 100;
diff --git a/infra/make-index.rkt b/infra/make-index.rkt
index 46a405588..95540cd1e 100644
--- a/infra/make-index.rkt
+++ b/infra/make-index.rkt
@@ -1,15 +1,12 @@
#lang racket
+
(require racket/runtime-path)
(require (only-in xml write-xexpr) json)
-(define-runtime-path report-json-path "../previous/")
-
-
-(require racket/date)
-(require "../src/common.rkt")
-(require "../src/formats/datafile.rkt")
-
+(require racket/date "../src/common.rkt" "../src/formats/datafile.rkt")
(provide directory-jsons name->timestamp)
+(define-runtime-path report-json-path "../previous/")
+
(define (name->timestamp path)
(define rpath (find-relative-path (simple-form-path report-json-path) path))
(define folder (path-element->string (first (explode-path rpath))))
@@ -52,7 +49,8 @@
(or/c string? false) '(note)
exact-nonnegative-integer? '(date-unix tests-passed tests-available tests-crashed)
(listof string?) '(options)
- (and/c real? (curryr >= 0)) '(bits-improved bits-available)))
+ (and/c real? (curryr >= 0)) '(bits-available)
+ real? '(bits-improved)))
(define cache-row?
(apply and/c hash?
@@ -82,9 +80,12 @@
(define total-crashed
(count (compose (curry equal? "crash") table-row-status) (or tests '())))
+ (define speed (apply + (map table-row-time (or tests '()))))
+
(hash 'date-full (format "~a:~a on ~a" (date-hour date) (~r (date-minute date) #:min-width 2 #:pad-string "0") (date->string date))
'date-short (date->string/short date)
'date-unix (date->seconds date)
+ 'speed speed
'folder (path->string folder)
'hostname hostname
'commit commit
@@ -108,7 +109,7 @@
(define (print-rows infos #:name name)
`((thead ((id ,(format "reports-~a" name)) (data-branch ,name))
- (th "Date") (th "Branch") (th "Collection") (th "Tests") (th "Bits"))
+ (th "Date") (th "Speed") (th "Branch") (th "Collection") (th "Tests") (th "Bits"))
(tbody
,@(for/list ([info infos])
(define field (curry dict-ref info))
@@ -118,6 +119,7 @@
;; but Racket doesn't make that easy.
(td ([title ,(field 'date-full)])
(time ([data-unix ,(~a (field 'date-unix))]) ,(field 'date-short)))
+ (td (time ([data-ms ,(~a (field 'speed))]) ,(format-time (field 'speed))))
(td ([title ,(field 'commit)]) ,(field 'branch))
(td ([title ,(string-join (field 'options) " ")]
[class ,(if (field 'note) "note" "")])
@@ -125,7 +127,7 @@
(td ,(if (> (field 'tests-available) 0) (format "~a/~a" (field 'tests-passed) (field 'tests-available)) ""))
(td ,(if (field 'bits-improved) (format "~a/~a" (round* (field 'bits-improved)) (round* (field 'bits-available))) ""))
(td ([title ,(format "At ~a\nOn ~a\nFlags ~a" (field 'date-full) (field 'hostname) (string-join (field 'options) " "))])
- (a ([href ,(format "./~a/report.html" (field 'folder))]) "»")))))))
+ (a ([href ,(format "./~a/results.html" (field 'folder))]) "»")))))))
(define (make-index-page)
(when (file-exists? (build-path report-json-path "index.cache"))
@@ -136,7 +138,9 @@
(define dirs (directory-jsons report-json-path))
(define folders
- (map read-row (sort (filter name->timestamp dirs) > #:key name->timestamp)))
+ (filter
+ (λ (x) (< (- (current-seconds) (dict-ref x 'date-unix)) (* 60 60 24 30)))
+ (map read-row (sort (filter name->timestamp dirs) > #:key name->timestamp))))
(define branch-infos*
(sort
@@ -147,10 +151,14 @@
(partition (λ (x) (set-member? '("master" "develop") (dict-ref (first x) 'branch)))
branch-infos*))
+ (define crashes
+ (filter (λ (x) (> (dict-ref x 'tests-crashed) 0)) (apply append mainline-infos)))
(define last-crash
- (argmax (curryr dict-ref 'date-unix) (apply append mainline-infos)))
+ (if (null? crashes)
+ #f
+ (argmax (curryr dict-ref 'date-unix) crashes)))
(define since-last-crash
- (/ (- (date->seconds (current-date)) (dict-ref last-crash 'date-unix)) (* 60 60 24)))
+ (and last-crash (/ (- (date->seconds (current-date)) (dict-ref last-crash 'date-unix)) (* 60 60 24))))
(write-file "index.html"
(printf "\n")
@@ -164,22 +172,24 @@
(script ((src "regression-chart.js")))
(script ((src "report.js"))))
(body
- ((onload "index()"))
(div
((id "large"))
(div "Reports: " (span ((class "number")) ,(~a (length folders))))
(div "Mainline: " (span ((class "number")) ,(~a (length (apply append mainline-infos)))))
(div "Branches: " (span ((class "number")) ,(~a (length branch-infos*))))
- (div "Crash-free: " (span ((class "number")) ,(~a (inexact->exact (round since-last-crash))) "d")))
+ (div "Crash-free: " (span ((class "number")) ,(if since-last-crash
+ (format "~ad" (inexact->exact (round since-last-crash)))
+ "∞"))))
(ul ((id "toc"))
,@(for/list ([rows (append mainline-infos other-infos)])
(define branch (dict-ref (first rows) 'branch))
`(li (a ((href ,(format "#reports-~a" branch))) ,branch))))
(figure
(ul ((id "classes")))
- (svg ((id "graph") (width "800")))
+ (svg ((id "accuracy-graph") (width "400")))
+ (svg ((id "speed-graph") (width "400")))
(ul ((id "suites")))
- (script "window.addEventListener('load', function(){draw_results(d3.select('#graph'))})"))
+ (script "window.addEventListener('load', function(){draw_results(d3.select('#accuracy-graph'), d3.select('#speed-graph'))})"))
(table
((id "reports"))
,@(apply
diff --git a/infra/makejson.py b/infra/makejson.py
deleted file mode 100644
index d1a0a6460..000000000
--- a/infra/makejson.py
+++ /dev/null
@@ -1,39 +0,0 @@
-#!/bin/python
-
-import sys
-
-if len(sys.argv) < 2:
- print("USAGE: makejson.py [prefix]")
- sys.exit()
-else:
- PREFIX = sys.argv[1]
-
-import csv
-
-def rows(file):
- with open(file) as csvfile:
- return list(csv.reader(csvfile))
-
-with open(PREFIX + ".names.csv") as namefile:
- NAMES = [line[3:-1] for line in namefile]
-
-def read(base, type, col):
- IDROWS = rows("{}.i{}.csv".format(base, type))
- IDERRS = [float(row[col]) for row in IDROWS]
-
- ODROWS = rows("{}.o{}.csv".format(base, type))
- ODERRS = [float(row[col]) for row in ODROWS]
- return zip(IDERRS, ODERRS)
-
-import json
-
-with open(PREFIX + ".json", "w") as jsonfile:
- DOUBLEAVG = read(PREFIX, "d", 3)
- DOUBLEMAX = read(PREFIX, "d", 2)
- SINGLEAVG = read(PREFIX, "f", 3)
- SINGLEMAX = read(PREFIX, "f", 2)
-
- json.dump(
- [ { "name": name, "doubleAvg": da, "doubleMax": dm, "singleAvg": sa, "singleMax": sm }
- for name, da, dm, sa, sm
- in zip(NAMES, DOUBLEAVG, DOUBLEMAX, SINGLEAVG, SINGLEMAX)], jsonfile)
diff --git a/infra/max-error-hour.c b/infra/max-error-hour.c
deleted file mode 100644
index 839c161fc..000000000
--- a/infra/max-error-hour.c
+++ /dev/null
@@ -1,181 +0,0 @@
-#define _POSIX_C_SOURCE 199309L
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-
-#ifndef NARGS
-#define NARGS 1
-#endif
-
-
-#if NARGS == 1
-#define ARGS(t) t
-#define INVOKE(f,args) f(args[0])
-#define RANDARGS(argsName) argsName[0] = rand_double()
-#elif NARGS == 2
-#define ARGS(t) t, t
-#define INVOKE(f,args) f(args[0], args[1])
-#define RANDARGS(argsName) \
- argsName[0] = rand_double();\
- argsName[1] = rand_double()
-#elif NARGS == 3
-#define ARGS(t) t, t, t
-#define INVOKE(f,args) f(args[0], args[1], args[2])
-#define RANDARGS(argsName) \
- argsName[0] = rand_double();\
- argsName[1] = rand_double();\
- argsName[2] = rand_double()
-#elif NARGS == 4
-#define ARGS(t) t, t, t, t
-#define INVOKE(f,args) f(args[0], args[1], args[2], args[3])
-#define RANDARGS(argsName) \
- argsName[0] = rand_double();\
- argsName[1] = rand_double();\
- argsName[2] = rand_double();\
- argsName[3] = rand_double()
-#elif NARGS == 5
-#define ARGS(t) t, t, t, t, t
-#define INVOKE(f,args) f(args[0], args[1], args[2], args[3], args[4])
-#define RANDARGS() \
- argsName[0] = rand_double();\
- argsName[1] = rand_double();\
- argsName[2] = rand_double();\
- argsName[3] = rand_double();\
- argsName[4] = rand_double()
-#elif NARGS == 6
-#define ARGS(t) t, t, t, t, t, t
-#define INVOKE(f,args) f(args[0], args[1], args[2], args[3], args[4], args[5])
-#define RANDARGS() \
- argsName[0] = rand_double();\
- argsName[1] = rand_double();\
- argsName[2] = rand_double();\
- argsName[3] = rand_double();\
- argsName[4] = rand_double();\
- argsName[5] = rand_double()
-#else
-#define ARGS(t) abort()
-#define INVOKE(f,args) abort()
-#define RANDARGS() abort()
-#endif
-
-void setup_mpfr_f_im(void);
-double f_id(ARGS(double));
-double f_im(ARGS(double));
-double f_od(ARGS(double));
-double f_om(ARGS(double));
-extern char *name;
-
-unsigned long long ulpd(double x, double y) {
- if (x == 0) x = fabs(x); // -0 == 0
- if (y == 0) y = fabs(y); // -0 == 0
-
- if (x != x && y != y) return 0;
- if (x != x) return LLONG_MIN; // Maximum error
- if (y != y) return LLONG_MIN; // Maximum error
-
- long long xx = *((long long*) &x);
- xx = xx < 0 ? LLONG_MIN - xx : xx;
-
- long long yy = *((long long*) &y);
- yy = yy < 0 ? LLONG_MIN - yy : yy;
-
- return xx >= yy ? xx - yy : yy - xx;
-}
-double rand_double() {
- long long c0 = rand()&0xffff;
- long long c1 = rand()&0xffff;
- long long c2 = rand()&0xffff;
- long long c3 = rand()&0xffff;
- long long c = ((c3 << 48) | (c2 << 32) | (c1<<16) | c0);
- return *(double*)&c;
-}
-char ordinaryd(double x) {
- return 1 / x != 0 && x == x;
-}
-unsigned int maxOrigErr, maxImprErr, numUnimproved, maxUnimproved;
-unsigned long long pointsTested;
-void finish(){
- printf("%u,%u,%u,%u,%llu\n", maxOrigErr, maxImprErr, numUnimproved, maxUnimproved, pointsTested);
- exit(0);
-}
-
-int main(int argc, char** argv){
- struct timespec start, cur;
- double args[NARGS];
- double exact, origApprox, improvedApprox;
- bool ordinaryArgs;
- int i;
- unsigned int origErr, imprErr, unimprovement;
-
- time_t timeout = 10;
- if (argc > 1){
- timeout = atoi(argv[1]);
- }
-
- // Set up the initial time variables
- clock_gettime(CLOCK_MONOTONIC, &start);
- cur = start;
-
- // Set up mpfr
- setup_mpfr_f_im();
-
- // Handle interrupts properly.
- struct sigaction sigIntHandler;
- sigIntHandler.sa_handler = finish;
- sigemptyset(&sigIntHandler.sa_mask);
- sigIntHandler.sa_flags = 0;
- sigaction(SIGINT, &sigIntHandler, NULL);
-
- // While the allotted time hasn't passed
- while(cur.tv_sec - start.tv_sec < timeout){
- // Get some randome arguments
- RANDARGS(args);
-
- // See if they're all normal floats
- ordinaryArgs = true;
- for(i = 0; i < NARGS; ++i){
- if (!ordinaryd(args[i])){
- ordinaryArgs = false;
- break;
- }
- }
- // If not, skip them.
- if(!ordinaryArgs)
- continue;
-
- // Get the exact result from those args
- exact = INVOKE(f_im, args);
-
- // If that isn't exact, skip it.
- if(!ordinaryd(exact))
- continue;
-
- // Get the approxmiate answers with the input and output programs
- origApprox = INVOKE(f_id, args);
- improvedApprox = INVOKE(f_od, args);
-
- // Get the errors for both.
- origErr = ulpd(origApprox, exact);
- imprErr = ulpd(improvedApprox, exact);
-
- // Update the maxes
- if (maxOrigErr < origErr) maxOrigErr = origErr;
- if (maxImprErr < imprErr) maxImprErr = imprErr;
-
- // Update unimprovement numbers
- if (origErr < imprErr){
- numUnimproved++;
- unimprovement = imprErr - origErr;
- if (maxUnimproved < unimprovement) maxUnimproved = unimprovement;
- }
- clock_gettime(CLOCK_MONOTONIC, &cur);
- ++pointsTested;
- }
- finish();
-}
diff --git a/infra/nightly.sh b/infra/nightly.sh
index 4eefd8302..7990e5212 100644
--- a/infra/nightly.sh
+++ b/infra/nightly.sh
@@ -6,26 +6,19 @@ function run {
bench=$1; shift
name=$1; shift
+ echo "Running $name test with flags $@"
racket "src/herbie.rkt" report \
--note "$name" \
--profile \
+ --debug \
--threads $CORES \
"$@" \
"$bench" "reports/$name"
bash infra/publish.sh upload "reports/$name"
}
-function runEach {
- for bench in bench/*; do
- name=$(basename "$bench" .fpcore)
- # add cases to skip large or misbehaving benchmarks
- case $name in
- haskell) ;;
- random) ;;
- *) run "$bench" "$name" "$@" ;;
- esac
- done
-}
-
mkdir -p reports
-runEach --seed $(date "+%Y%j") "$@"
+for bench in bench/*; do
+ name=$(basename "$bench" .fpcore)
+ run "$bench" "$name" --seed $(date "+%Y%j") "$@"
+done
diff --git a/infra/overhead.c b/infra/overhead.c
deleted file mode 100644
index 8721a1657..000000000
--- a/infra/overhead.c
+++ /dev/null
@@ -1,277 +0,0 @@
-#define _POSIX_C_SOURCE 199309L
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-
-#ifdef __MACH__
-#include
-#include
-#endif
-
-#define ITERS 1000000
-
-#ifndef NARGS
-#define NARGS 1
-#endif
-
-#if NARGS == 1
-#define ARGMAP(f, ...) f(0, __VA_ARGS__)
-#elif NARGS == 2
-#define ARGMAP(f, ...) f(0, __VA_ARGS__), f(1, __VA_ARGS__)
-#elif NARGS == 3
-#define ARGMAP(f, ...) f(0, __VA_ARGS__), f(1, __VA_ARGS__), f(2, __VA_ARGS__)
-#elif NARGS == 4
-#define ARGMAP(f, ...) f(0, __VA_ARGS__), f(1, __VA_ARGS__), f(2, __VA_ARGS__), f(3, __VA_ARGS__)
-#elif NARGS == 5
-#define ARGMAP(f, ...) f(0, __VA_ARGS__), f(1, __VA_ARGS__), f(2, __VA_ARGS__), f(3, __VA_ARGS__), f(4, __VA_ARGS__)
-#elif NARGS == 6
-#define ARGMAP(f, ...) f(0, __VA_ARGS__), f(1, __VA_ARGS__), f(2, __VA_ARGS__), f(3, __VA_ARGS__), f(4, __VA_ARGS__), f(5, __VA_ARGS__)
-#else
-#define ARGMAP(f, ...) abort()
-#endif
-
-#define SND(a, b) b
-#define ARGS(t) ARGMAP(SND, t)
-
-void setup_mpfr_f_im(void);
-void setup_mpfr_f_fm(void);
-void setup_mpfr_f_dm(void);
-double f_if(ARGS(float));
-double f_id(ARGS(double));
-double f_im(ARGS(double));
-double f_of(ARGS(float));
-double f_od(ARGS(double));
-double f_om(ARGS(double));
-extern char *name;
-
-typedef unsigned long long int u64;
-typedef unsigned int u32;
-typedef signed long long int i64;
-typedef signed int i32;
-
-u32 ulpf(float x, float y) {
- i32 xx, yy;
-
- if (x == 0) x = fabsf(x); // -0 == 0
- if (y == 0) y = fabsf(y); // -0 == 0
-
- if (x != x && y != y) return 0;
- if (x != x) return INT_MIN; // Maximum error
- if (y != y) return INT_MIN; // Maximum error
-
- memcpy(&xx, &x, sizeof(float));
- memcpy(&yy, &y, sizeof(float));
-
- xx = xx > INT_MAX ? INT_MIN - xx : xx;
- yy = yy > INT_MAX ? INT_MIN - yy : yy;
-
- return xx >= yy ? xx - yy : yy - xx;
-}
-
-u64 ulpd(double x, double y) {
- i64 xx, yy;
-
- if (x == 0) x = fabs(x); // -0 == 0
- if (y == 0) y = fabs(y); // -0 == 0
-
- if (x != x && y != y) return 0;
- if (x != x) return LLONG_MIN; // Maximum error
- if (y != y) return LLONG_MIN; // Maximum error
-
- memcpy(&xx, &x, sizeof(double));
- memcpy(&yy, &y, sizeof(double));
-
- xx = xx < 0 ? LLONG_MIN - xx : xx;
- yy = yy < 0 ? LLONG_MIN - yy : yy;
-
- return xx >= yy ? xx - yy : yy - xx;
-}
-
-char ordinaryf(float x) {
- return 1 / x != 0 && x == x;
-}
-
-char ordinaryd(double x) {
- return 1 / x != 0 && x == x;
-}
-
-#define ulpl ulpd
-#define ulpm ulpd
-
-double rand_double() {
- u64 c0 = rand()&0xffff;
- u64 c1 = rand()&0xffff;
- u64 c2 = rand()&0xffff;
- u64 c3 = rand()&0xffff;
- u64 c = ((c3 << 48) | (c2 << 32) | (c1<<16) | c0);
-
- double cc;
- memcpy(&cc, &c, sizeof(double));
- return cc;
-}
-
-float rand_float() {
- u32 c0 = rand()&0xffff;
- u32 c1 = rand()&0xffff;
- u32 c = ((c1<<16) | c0);
-
- double cc;
- memcpy(&cc, &c, sizeof(double));
- return cc;
-}
-
-float *get_random_floats(int nums) {
- int i;
- float *arr = malloc(sizeof(float) * nums * NARGS);
- for (i = 0; i < nums * NARGS; i++) {
- float rand;
- do {
- rand = rand_float();
- } while (!ordinaryf(rand));
- arr[i] = rand;
- }
- return arr;
-}
-
-double *get_random_doubles(int nums) {
- int i;
- double *arr = malloc(sizeof(double) * nums * NARGS);
- for (i = 0; i < nums * NARGS; i++) {
- double rand;
- do {
- rand = rand_double();
- } while (!ordinaryd(rand));
- arr[i] = rand;
- }
- return arr;
-}
-
-#ifdef __MACH__ // OS X does not have clock_gettime, use clock_get_time
-
-#define CLOCK(ts) \
- clock_get_time(cclock, &mts); \
- ts.tv_sec = mts.tv_sec; \
- ts.tv_nsec = mts.tv_nsec;
-
-#else
-
-#define CLOCK(ts) \
- clock_gettime(CLOCK_REALTIME, &ts);
-
-#endif
-
-/* Some macros to make looping a bit easier */
-
-#define LOOP(iter) \
- CLOCK(start); \
- for (i = 0; i < iter; i++)
-
-#define END() \
- CLOCK(end); \
- rtime = (end.tv_sec - start.tv_sec) * 1.0e9 + (end.tv_nsec - start.tv_nsec);
-
-/* Calling a function with some number of arguments */
-#define EVALAUX(n, rands) rands[NARGS*i] + n
-#define EVAL(rands, f) f(ARGMAP(EVALAUX, rands))
-
-#define CHECK(io, type, iter) \
- max = total = 0; \
- for (i = 0; i < iter; i++) { \
- if (ordinary##type(true##type[i])) { \
- u64 error = ulp##type(out##io##type[i], true##type[i]); \
- if (error > max) max = error; \
- total += log(error + 1.0) / log(2); \
- } \
- } \
- printf("%s%s,%15g,%15g,%15g\n", #io, #type, rtime, \
- log(max + 1.0) / log(2), total / count##type);
-
-int main(int argc, char** argv) {
-
-#ifdef __MACH__
- clock_serv_t cclock;
- mach_timespec_t mts;
- host_get_clock_service(mach_host_self(), SYSTEM_CLOCK, &cclock);
-#endif
-
- struct timespec start, end;
- int i;
- u64 max = 0, maxcount = 0;
- double rtime, total = 0;
- int countf = 0, countd = 0;
- double *ind, *outid, *outod, *trued;
- float *inf, *outif, *outof, *truef;
- setup_mpfr_f_im();
-
- int iter = ITERS;
- if (argc > 1) iter = atoi(argv[1]);
-
- inf = get_random_floats(NARGS * iter);
- ind = get_random_doubles(NARGS * iter);
- outif = malloc(sizeof(float) * iter);
- outid = malloc(sizeof(double) * iter);
- outof = malloc(sizeof(float) * iter);
- outod = malloc(sizeof(double) * iter);
- truef = malloc(sizeof(float) * iter);
- trued = malloc(sizeof(double) * iter);
-
- LOOP(iter) { truef[i] = (float) EVAL(inf, f_im); } END();
- LOOP(iter) { trued[i] = EVAL(ind, f_im); } END();
-
- LOOP(iter) { countf += (int) ordinaryf(truef[i]); } END();
- LOOP(iter) { countd += (int) ordinaryd(trued[i]); } END();
-
- printf("%s\n", name);
- printf("pf,%11d\n", countf);
- printf("pd,%11d\n", countd);
- printf("test, time, max, avg\n");
-
- LOOP(iter) { outif[i] = EVAL(inf, f_if); } END();
- CHECK(i, f, iter);
-
- LOOP(iter) { outid[i] = EVAL(ind, f_id); } END();
- CHECK(i, d, iter);
-
- LOOP(iter) { outof[i] = EVAL(inf, f_of); } END();
- CHECK(o, f, iter);
-
- LOOP(iter) { outod[i] = EVAL(ind, f_od); } END();
- CHECK(o, d, iter);
-
- max = maxcount = 0;
- for (i = 0; i < iter; i++) {
- if (ordinaryd(trued[i])) {
- u32 ierror = ulpf(outif[i], truef[i]);
- u32 oerror = ulpf(outof[i], truef[i]);
- if (ierror < oerror) {
- maxcount++;
- if (max < oerror - ierror) max = oerror - ierror;
- }
- }
- }
- printf("df,%15g,%15llu\n", log(max + 1.0) / log(2), maxcount);
-
- max = maxcount = 0;
- for (i = 0; i < iter; i++) {
- if (ordinaryd(trued[i])) {
- u64 ierror = ulpd(outid[i], trued[i]);
- u64 oerror = ulpd(outod[i], trued[i]);
- if (ierror < oerror) {
- maxcount++;
- if (max < oerror - ierror) max = oerror - ierror;
- }
- }
- }
- printf("dd,%15g,%15llu\n", log(max + 1.0) / log(2), maxcount);
-
-#ifdef __MACH__
- mach_port_deallocate(mach_task_self(), cclock);
-#endif
-
- return 0;
-}
diff --git a/infra/overhead.mk b/infra/overhead.mk
deleted file mode 100644
index 59ffb8d53..000000000
--- a/infra/overhead.mk
+++ /dev/null
@@ -1,67 +0,0 @@
-# Find all compiled test-cases
-# If Herbie times out or crashes, no compiled.c is generated.
-TESTCASES = $(sort $(dir $(wildcard */compiled.c)))
-
-# Flags for building and running C files
-GCC_FLAGS = -std=c11 -Wall -Wextra -Wpedantic -Werror
-SLOW_FLAGS = $(GCC_FLAGS) -O0 -g
-FAST_FLAGS = $(GCC_FLAGS) -march=native -mtune=native -O3 -flto
-UNSAFE_FLAGS = $(GCC_FLAGS) -march=native -mtune=native -Ofast -flto
-
-%/slow.o: %/compiled.c
- gcc $(SLOW_FLAGS) -c $< -o $@
-
-%/fast.o: %/compiled.c
- gcc $(FAST_FLAGS) -c $< -o $@
-
-%/unsafe.o: %/compiled.c
- gcc $(UNSAFE_FLAGS) -c $< -o $@
-
-%/overhead: overhead.c %/fast.o
- gcc $(FAST_FLAGS) $^ -o $@ \
- -lm -lmpfr -lgmp \
- -DNARGS=$(shell grep f_if $*/compiled.c | tr '()_ ,' '\n' | tail -n+2 | grep float -c)
-
-# How many samples to use for evaluation
-POINTS = 100000
-
-%/overhead.csv: %/overhead
- ./$< $(POINTS) > $@
-
-# The output CSV files contain a bunch of fields.
-# These rules aggregate each one into its own file.
-
-names.csv: $(patsubst %/,%/overhead.csv,$(TESTCASES))
- echo $^ | xargs -n1 sed -n 1p > names.csv
-
-pf.csv: $(patsubst %/,%/overhead.csv,$(TESTCASES))
- echo $^ | xargs -n1 sed -n 2p > pf.csv
-
-pd.csv: $(patsubst %/,%/overhead.csv,$(TESTCASES))
- echo $^ | xargs -n1 sed -n 3p > pd.csv
-
-if.csv: $(patsubst %/,%/overhead.csv,$(TESTCASES))
- echo $^ | xargs -n1 sed -n 5p > if.csv
-
-id.csv: $(patsubst %/,%/overhead.csv,$(TESTCASES))
- echo $^ | xargs -n1 sed -n 6p > id.csv
-
-of.csv: $(patsubst %/,%/overhead.csv,$(TESTCASES))
- echo $^ | xargs -n1 sed -n 7p > of.csv
-
-od.csv: $(patsubst %/,%/overhead.csv,$(TESTCASES))
- echo $^ | xargs -n1 sed -n 8p > od.csv
-
-df.csv: $(patsubst %/,%/overhead.csv,$(TESTCASES))
- echo $^ | xargs -n1 sed -n 9p > df.csv
-
-dd.csv: $(patsubst %/,%/overhead.csv,$(TESTCASES))
- echo $^ | xargs -n1 sed -n 10p > dd.csv
-
-DATAFILES = $(patsubst %,%.csv,names pf pd if id of od df dd)
-
-# The top-level target is `overhead` to make the overhead numbers
-
-.PHONY: overhead
-
-overhead: $(DATAFILES)
diff --git a/infra/publish.sh b/infra/publish.sh
index f51215ff5..ff14ea89e 100755
--- a/infra/publish.sh
+++ b/infra/publish.sh
@@ -9,7 +9,7 @@ upload () {
B=$(git rev-parse --abbrev-ref HEAD)
C=$(git rev-parse HEAD | sed 's/\(..........\).*/\1/')
RDIR="$(date +%s):$(hostname):$B:$C"
- find "$DIR" -name "debug.txt" -exec gzip -f {} \;
+ find "$DIR" -name "profile.txt" -or -name "debug.txt" -exec gzip -f {} \;
rsync --recursive "$DIR" --exclude reports/ "$RHOST:$RHOSTDIR/$RDIR"
ssh "$RHOST" chmod a+rx "$RHOSTDIR/$RDIR" -R
}
@@ -23,10 +23,6 @@ index () {
rm index.html
}
-backfill () {
- racket infra/backfill-index.rkt
-}
-
download_reports () {
rsync --recursive --checksum --inplace --ignore-existing \
--include 'results.json' --include '*/' --exclude '*' \
@@ -60,9 +56,6 @@ if [[ $CMD = "upload" ]]; then
elif [[ $CMD = "index" ]]; then
download_reports
index
-elif [[ $CMD = "backfill" ]]; then
- download_reports
- backfill
elif [[ $CMD = "update-reports" ]]; then
upload_reports
index
diff --git a/infra/random-test.rkt b/infra/random-test.rkt
new file mode 100644
index 000000000..2f8f9af96
--- /dev/null
+++ b/infra/random-test.rkt
@@ -0,0 +1,76 @@
+#lang racket
+(require racket/random)
+(require "../src/syntax/syntax.rkt" (submod "../src/syntax/syntax.rkt" internals))
+(require "../src/common.rkt" "../src/float.rkt")
+
+(define (parse-range N)
+ (if (string-contains? N "-")
+ (match-let ([(list min max) (string-split N "-")])
+ (cons (string->number min) (string->number max)))
+ (cons (string->number N) (string->number N))))
+
+
+(define (generate-fpcore i size nvars)
+ (define name (format "Random test ~a" i))
+ (define vars (take '(a b c d e f g h i j k l m n o p q r s t u v) nvars))
+ (define expr (generate-expr vars size 'real))
+ `(FPCore ,vars :name ,name ,expr))
+
+(define (generate-expr vars fuel type)
+ (cond
+ [(<= fuel 1)
+ (define valid-consts
+ (for/list ([const (in-hash-keys (cdr constants))]
+ #:when (equal? (constant-info const 'type) type))
+ const))
+ (match type
+ ['real
+ (if (or (null? vars) (< (random) 0.2))
+ (if (< (random) 0.1)
+ (random-ref valid-consts)
+ (sample-double))
+ (random-ref vars))]
+ [else
+ (random-ref valid-consts)])]
+ [(and (<= fuel 3) (equal? type 'complex) (< (random) 0.9))
+ ;; Force the "complex" call to create good constants
+ `(complex ,(generate-expr vars 1 'real) ,(generate-expr vars 1 'real))]
+ [else
+ (define valid-ops
+ (for/list ([(op _) (in-hash (cdr operators))]
+ #:when true
+ [argnum (operator-info op 'args)]
+ #:when (< (match argnum ['* 2] [n n]) fuel)
+ #:when (equal? (last (car (hash-ref (operator-info op 'type) argnum))) type))
+ (define atypes
+ (match argnum
+ ['*
+ (define reptype (second (car (car (hash-ref (operator-info op 'type) '*)))))
+ (list reptype reptype)]
+ [n
+ (car (car (hash-ref (operator-info op 'type) n)))]))
+ (cons op atypes)))
+ (match-define (cons op atypes) (random-ref valid-ops))
+ (define subfuels (random-ref (filter (λ (x) (= (length x) (length atypes)))
+ (all-partitions (- fuel 1)))))
+ `(,op ,@(map (curry generate-expr vars) subfuels atypes))]))
+
+(module+ main
+ (define size (cons 1 1))
+ (define vars (cons 1 1))
+ (define tests 1)
+
+ (command-line
+ #:once-each
+ [("--size") N "Size of expressions to generate (default 1)"
+ (set! size (parse-range N))]
+ [("--vars") N "Number of variables in generated expressions (default 1)"
+ (set! vars (parse-range N))]
+ [("--tests") N "Number of tests to generate (default 1)"
+ (set! tests (string->number N))]
+ #:args ()
+ (for ([i (in-range tests)])
+ (define s (random (car size) (+ 1 (cdr size))))
+ (define v (random (car vars) (+ 1 (cdr vars))))
+ (pretty-print (generate-fpcore i s v) (current-output-port) 1)
+ (newline))))
diff --git a/infra/regression-chart.js b/infra/regression-chart.js
index d4aa1bed8..d75006c95 100644
--- a/infra/regression-chart.js
+++ b/infra/regression-chart.js
@@ -1,8 +1,9 @@
-margin = 10;
-width = 740;
+vmargin = 10;
+hmargin = 5;
+width = 340;
height = 200;
-labels = 40;
+labels = 50;
precision = 64;
precision_step = 8;
@@ -11,9 +12,9 @@ used_branch = {};
used_tag = {};
function get_point(tr) {
- var tests = tr.children[3].textContent.split("/");
- var bits = tr.children[4].textContent.split("/");
- var flags = tr.children[2].getAttribute("title");
+ var tests = tr.children[4].textContent.split("/");
+ var bits = tr.children[5].textContent.split("/");
+ var flags = tr.children[3].getAttribute("title");
flags = flags !== "" ? flags.split(" ") : [];
var note = tr.getElementsByClassName("note")[0];
@@ -23,8 +24,9 @@ function get_point(tr) {
tag: trtag,
tests: { got: +tests[0], total: +tests[1]},
bits: { got: +bits[0], total: +bits[1] },
- branch: tr.children[1].textContent,
+ branch: tr.children[2].textContent,
time: +tr.children[0].children[0].getAttribute("data-unix"),
+ speed: +tr.children[1].children[0].getAttribute("data-ms") / 1000 / 60,
elt: tr,
flags: flags,
};
@@ -40,56 +42,75 @@ function get_data(table) {
return data;
}
+function print_date(d) {
+ var date = "" + new Date(d * 1000);
+ return date.split(" ").slice(1, 4).join(" ");
+}
+
function step_size(max) {
- if (max > 400) {
- return Math.round(max / 400) * 100;
- } else if (max > 40) {
- return Math.round(max / 40) * 10;
- } else if (max > 4) {
- return Math.round(max / 4);
- } else if (max > .4) {
- return Math.round(max / .4) / 10;
- } else {
- throw "Data points error";
- }
+ var step = Math.pow(10, Math.floor(Math.log10(max / 4)))
+ if (max / step > 20) return step * 5;
+ if (max / step > 8) return step * 2;
+ return step;
}
-function make_graph(node, data, type) {
- if (!data.length) {
- console.log("hi!!", data.length);
- node.append("text")
- .attr("x", width / 2)
- .attr("y", height / 2 + 9)
- .attr("class", "no-data").text("No tests found with these parameters.");
- return;
- }
+function make_accuracy_graph(node, data, type) {
+ if (!data.length) return no_data(node);
- var len = data.length;
- var spacing = width / len;
+ var spacing = width / data.length;
- var max = 0;
- for (var i = 0; i < len; i++) {
- if (data[i][type].total > max) max = data[i][type].total;
- }
+ var max = Math.max.apply(null, data.map(function(x) { return x[type].total }))
var step = step_size(max);
var steps = max ? Math.ceil(max / step) : 0;
var max = steps * step;
- var svg = node
- .attr("width", width + 2 * margin + labels)
- .attr("height", height + 2 * margin)
- .append("g").attr("transform", "translate(" + (margin + labels) + "," + margin + ")");
+ var svg = initialize_svg(node);
+ add_axes(svg);
+ add_gridlines(svg, step, steps, "b");
+
+ var g = mk_datum(svg, data);
+
+ g.append("line")
+ .attr("stroke", function(d) { return key(d.branch) })
+ .attr("x1", function(d, i) { return (i + .5) * spacing })
+ .attr("x2", function(d, i) { return (i + .5) * spacing })
+ .attr("y1", function(d) { return height - height * d[type].total / max })
+ .attr("y2", function(d) { return height - height * (d[type].total - d[type].got) / max - 5 });
+ g.append("polygon").attr("points", "-3.5,-6,3.5,-6,0,0")
+ .attr("fill", function(d) { return key(d.branch) })
+ .attr("transform", function(d, i) {
+ return "translate(" + spacing*(i + .5) + ", " + (height - height * (d[type].total - d[type].got) / max) + ")";
+ });
+}
+
+function no_data(node) {
+ node.append("text")
+ .attr("x", width / 2)
+ .attr("y", height / 2 + 9)
+ .attr("class", "no-data").text("No tests found with these parameters.");
+}
+
+function initialize_svg(node) {
+ return node
+ .attr("width", width + 2 * hmargin + labels)
+ .attr("height", height + 2 * vmargin)
+ .append("g").attr("transform", "translate(" + (hmargin + labels) + "," + vmargin + ")");
+}
+
+function add_axes(svg) {
svg.append("line")
.attr("class", "gridline")
.attr("x1", 0)
- .attr("x2", width)
+ .attr("x2", width-5)
.attr("y1", height)
.attr("y2", height);
svg.append("polygon").attr("class", "gridline").attr("points", "0,3,0,-3,5,0")
- .attr("transform", "translate(" + width + "," + height + ")");
+ .attr("transform", "translate(" + (width - 5) + "," + height + ")");
+}
+function add_gridlines(svg, step, steps, unit) {
for (var i = 1; i <= steps; i++) {
svg.append("line")
.attr("class", "guide")
@@ -98,34 +119,53 @@ function make_graph(node, data, type) {
.attr("y1", height - (i / steps) * height)
.attr("y2", height - (i / steps) * height);
- svg.append("text").text(i * step).attr("class", "guide")
+ svg.append("text").text((step > 1 ? i * step : i / (1 / step)) + (unit ? unit : ""))
+ .attr("class", "guide")
.attr("x", -5)
.attr("y", height - (i / steps) * height + 6);
}
+}
+function mk_datum(svg, data) {
var bar = svg.selectAll("g").data(data).enter();
- var g = bar.append("g").attr("class", "arrow");
+ var g = bar.append("a")
+ .attr("xlink:href", function(d) {
+ return d.elt.querySelector("a").href;
+ }).append("g").attr("class", "arrow");
g.append("title")
- .text(function(d) { return "At " + new Date(d.time * 1000) + "\nOn " + d.branch });
+ .text(function(d) {
+ return print_date(d.time) +
+ "\nOn " + d.branch +
+ "\nTook " + Math.round(d.speed * 10) / 10 + "m";
+ });
+
+ return g;
+}
- g.append("line")
- .attr("stroke", function(d) { return key(d.branch) })
- .attr("x1", function(d, i) { return (i + .5) * spacing })
- .attr("x2", function(d, i) { return (i + .5) * spacing })
- .attr("y1", function(d) { return height - height * d[type].total / max })
- .attr("y2", function(d) { return height - height * (d[type].total - d[type].got) / max - 5 });
+function make_speed_graph(node, data) {
+ if (!data.length) return no_data(node);
- g.append("polygon").attr("points", "-3.5,-6,3.5,-6,0,0")
- .attr("fill", function(d) { return key(d.branch) })
- .attr("transform", function(d, i) {
- return "translate(" + spacing*(i + .5) + ", " + (height - height * (d[type].total - d[type].got) / max) + ")";
- });
+ var spacing = width / data.length;
- g.on("click", function(d) {
- d.elt.querySelector("a").click();
- });
+ var max = Math.max.apply(null, data.map(function(x) { return x.speed }));
+ var step = step_size(max);
+ var steps = max ? Math.ceil(max / step) : 0;
+ var max = steps * step;
+
+ var svg = initialize_svg(node);
+ add_axes(svg);
+ add_gridlines(svg, step, steps, "m");
+
+ var g = mk_datum(svg, data);
+
+ g.append("circle")
+ .attr("fill", function(d) { return key(d.branch) })
+ .attr("cx", function(d, i) { return (i + .5) * spacing })
+ .attr("cy", function(d) { return height - height * d.speed / max })
+ .attr("r", spacing * .75 / 2);
+
}
function select_data(data, options, tag) {
@@ -138,8 +178,9 @@ function select_data(data, options, tag) {
});
}
-function render(node, data, options, tag) {
- node.selectAll("*").remove();
+function render(node1, node2, data, options, tag) {
+ node1.selectAll("*").remove();
+ node2.selectAll("*").remove();
// Update classes
var olds = Array.prototype.slice.call(document.getElementsByClassName("selected"));
olds.forEach(function(old) { old.classList.remove("selected") })
@@ -147,26 +188,29 @@ function render(node, data, options, tag) {
for (var flag in options) {
if (options[flag]) document.getElementById("flag-" + flag).classList.add("selected");
}
- make_graph(node, select_data(data, options, tag), "bits");
+ var data = select_data(data, options, tag);
+ make_accuracy_graph(node1, data, "bits");
+ make_speed_graph(node2, data);
}
-function draw_results(node) {
+function draw_results(node1, node2) {
DATA = get_data(document.getElementById("reports"));
OPTIONS = {"rules:numerics": false};
TAG = null;
- NODE = node;
+ NODE1 = node1;
+ NODE2 = node2;
function toggle_tag(tag) {
return function(evt) {
TAG = tag;
- render(NODE, DATA, OPTIONS, TAG);
+ render(NODE1, NODE2, DATA, OPTIONS, TAG);
}
}
function toggle_flag(flag) {
return function(evt) {
OPTIONS[flag] = !OPTIONS[flag];
- render(NODE, DATA, OPTIONS, TAG);
+ render(NODE1, NODE2, DATA, OPTIONS, TAG);
}
}
@@ -207,7 +251,7 @@ function draw_results(node) {
}
key = d3.scale.category20().domain(branches);
- render(NODE, DATA, OPTIONS, TAG);
+ render(NODE1, NODE2, DATA, OPTIONS, TAG);
var branches = [];
var toclinks = document.getElementById("toc").querySelectorAll("li a");
diff --git a/infra/run.sh b/infra/run.sh
deleted file mode 100755
index 6f20e6220..000000000
--- a/infra/run.sh
+++ /dev/null
@@ -1,149 +0,0 @@
-#!/usr/bin/env bash
-
-# This is where herbie lives on warfa for nightlies.
-# You may change HERBROOT to test locally,
-# but do not push any changes to HERBROOT!
-HERBROOT="$HOME/herbie"
-
-# example crontab entry for nightlies
-# 30 2 * * * $HOME/herbie/infra/run.sh
-
-CORES=4
-
-LOG="$HERBROOT/infra/$(date +%y%m%d%H%M%S).log"
-ln -sf "$LOG" "$HERBROOT/infra/latest.log"
-
-EXC="$HERBROOT/infra/exceptions-$(date +%y%m%d%H%M%S).rkt"
-ln -sf "$EXC" "$HERBROOT/infra/latest-exceptions.rkt"
-
-function main {
- cd "$HERBROOT"
- git pull --quiet
-
- COMMIT="$HERBROOT/infra/latest-commit.txt"
- C=$(git rev-parse HEAD | sed 's/\(..........\).*/\1/')
- if [ -f "$COMMIT" -a "$C" = "$(cat "$COMMIT")" ]; then
- echo "No new commits, exiting."
- exit 0
- else
- echo "$C" > "$COMMIT"
- echo "Latest commit updated to $C."
- fi
-
-## make --quiet --directory="$HERBROOT/randTest"
-## java -classpath "$HERBROOT/randTest/" RandomTest \
-## --size 5 --size-wiggle 5 \
-## --nvars 1 --nvars-wiggle 3 \
-## --ntests 20 \
-## > "$HERBROOT/bench/random.fpcore"
-
- # choose configs based on day of year
- d=$(date "+%j")
-
- # use common seed across every 4 day cycle
- qseed=$(racket -e " \
- (random-seed $(expr $d / 4)) \
- (pseudo-random-generator->vector \
- (current-pseudo-random-generator))")
- seed="${qseed:1}" # :1 removes leading quote
-
-## # toggle fuel every two days
-## if [ $(expr \( $d / 2 \) % 2) -eq 0 ]; then
-## fuel="--fuel 2"
-## else
-## fuel="--fuel 3"
-## fi
-
-## # toggle regimes every other day
-## if [ $(expr $d % 2) -eq 0 ]; then
-## regime=""
-## else
-## regime="--disable reduce:regimes"
-## fi
-
-## # toggle some configs every day
-## for prec in "" "--disable precision:double"; do
-## for postproc in "" "--enable reduce:post-process"; do
-## for num in "" "--enable rules:numerics"; do
-## runEach --seed "$seed" $fuel $regime $prec $postproc $num
-## done
-## done
-## done
-
- runEach --seed "$seed"
-}
-
-function run {
- bench=$1; shift
- name=$1; shift
-
- GRAPHS="$HERBROOT/infra/graphs-$(date +%y%m%d%H%M%S)"
- mkdir -p "$GRAPHS"
-
- cat << EOF
-
-================================================================================
- $name
-================================================================================
-
-run $@
-
-EOF
- time xvfb-run --auto-servernum \
- racket "$HERBROOT/src/herbie.rkt" report \
- --note "$name" \
- --profile \
- --threads $CORES \
- "$@" \
- "$bench" "$GRAPHS"
- cat << EOF >> "$EXC"
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; $name
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-EOF
- cat "$GRAPHS/exceptions.rkt" >> "$EXC"
-
-## echo
-## echo "Evaluating extracted C"
-## time make \
-## --quiet --directory="$HERBROOT/graphs" \
-## --jobs=$CORES \
-## overhead
-## echo
-
- echo
- echo "Publishing to uwplse.org"
- # NOTE: the trailing slash at the end of GRAPHS is required for rsync!
- time "$HERBROOT/infra/publish.sh" upload "$GRAPHS/"
-
- echo
- echo "Rebuilding reports index"
- time "$HERBROOT/infra/publish.sh" index
-
- rm -rf "$GRAPHS"
-}
-
-function runEach {
- ##for bench in $HERBROOT/bench/hamming; do
- for bench in $HERBROOT/bench/*; do
- name=$(basename "$bench" .fpcore)
- # add cases to skip large or misbehaving benchmarks
- case $name in
- haskell|random)
- continue
- ;;
- esac
- run "$bench" "$name" "$@"
- done
-}
-
-# on some machines, this will cause Racket VM to exhaust memory
-function runAll {
- bench="$HERBROOT/bench"
- name="all"
- run "$bench" "$name" "$@"
-}
-
-main &> "$LOG"
diff --git a/infra/travis.rkt b/infra/travis.rkt
index 856b9d5b7..c6f80fa64 100644
--- a/infra/travis.rkt
+++ b/infra/travis.rkt
@@ -1,47 +1,55 @@
#lang racket
-(require racket/date)
-(require racket/cmdline)
-(require "../src/common.rkt")
-(require "../src/points.rkt")
-(require "../src/alternative.rkt")
-(require "../src/sandbox.rkt")
-(require "../src/formats/test.rkt")
-(require "../src/formats/datafile.rkt")
+(require racket/date racket/cmdline)
+(require "../src/common.rkt" "../src/points.rkt")
+(require "../src/alternative.rkt" "../src/sandbox.rkt")
+(require "../src/formats/test.rkt" "../src/formats/datafile.rkt")
+
+(define (test-successful? test input-bits target-bits output-bits)
+ (match* ((test-output test) (test-expected test))
+ [(_ #f) #t]
+ [(_ (? number? n)) (>= n output-bits)]
+ [(#f #t) (>= input-bits output-bits)]
+ [(_ #t) (>= target-bits (- output-bits 1))]))
(define (run-tests . bench-dirs)
(define tests (append-map load-tests bench-dirs))
- (define seed (get-seed))
- (printf "Running Herbie on ~a tests (seed: ~a)...\n" (length tests) seed)
- (for/and ([test tests])
+ (define seed (pseudo-random-generator->vector (current-pseudo-random-generator)))
+ (printf "Running Herbie on ~a tests, seed: ~a\n" (length tests) seed)
+ (for/and ([test tests] [i (in-naturals)])
+ (printf "~a/~a\t" (~a (+ 1 i) #:width 3 #:align 'right) (length tests))
(match (get-test-result test #:seed seed)
- [(test-result test time prec input output pts exs
- start-errors end-error newpts newexs
- start-newerrors end-newerrors target-newerrors timeline)
- (printf "[ ~ams]\t(~a→~a)\t~a\n"
- (~a time #:width 8)
- (~r (errors-score start-newerrors) #:min-width 2 #:precision 0)
- (~r (errors-score end-newerrors) #:min-width 2 #:precision 0)
+ [(test-success test bits time timeline warnings
+ start-alt end-alt points exacts start-est-error end-est-error
+ newpoints newexacts start-error end-error target-error
+ baseline-error oracle-error all-alts)
+ (printf "[ ~as] ~a→~a\t~a\n"
+ (~r (/ time 1000) #:min-width 7 #:precision '(= 3))
+ (~r (errors-score start-error) #:min-width 2 #:precision 0)
+ (~r (errors-score end-error) #:min-width 2 #:precision 0)
(test-name test))
(define success?
(test-successful? test
- (errors-score start-newerrors)
- (and target-newerrors (errors-score target-newerrors))
- (errors-score end-newerrors)))
+ (errors-score start-error)
+ (and target-error (errors-score target-error))
+ (errors-score end-error)))
(when (not success?)
- (printf "Input: ~a\n" (alt-program input))
- (printf "Output:\n")
- (pretty-print (alt-program output))
- (when (test-output test) (printf "Target: ~a\n" (test-output test))))
+ (printf "\nInput (~a bits):\n" (errors-score start-error))
+ (pretty-print (alt-program start-alt) (current-output-port) 1)
+ (printf "\nOutput (~a bits):\n" (errors-score end-error))
+ (pretty-print (alt-program end-alt) (current-output-port) 1)
+ (when (test-output test)
+ (printf "\nTarget (~a bits):\n" (errors-score target-error))
+ (pretty-print (test-output test) (current-output-port) 1)))
success?]
- [(test-failure test prec exn time timeline)
- (printf "[ CRASH ]\t\t\t~a\n" (test-name test))
+ [(test-failure test bits time timeline warnings exn)
+ (printf "[ CRASH ]\t\t~a\n" (test-name test))
((error-display-handler) (exn-message exn) exn)
#f]
- [(test-timeout test prec time timeline)
- (printf "[ timeout ]\t\t\t~a\n" (test-name test))
+ [(test-timeout test bits time timeline warnings)
+ (printf "[ TIMEOUT]\t\t~a\n" (test-name test))
#f])))
(module+ main
diff --git a/infra/travis_times.py b/infra/travis_times.py
new file mode 100644
index 000000000..b3f791262
--- /dev/null
+++ b/infra/travis_times.py
@@ -0,0 +1,42 @@
+#!/bin/python3
+
+import urllib.request
+import json
+
+REPO="uwplse/herbie"
+
+def travis_req(after_number=None):
+ url = "http://api.travis-ci.org/repos/{}/builds".format(REPO)
+ if after_number:
+ url += "?after_number=" + after_number
+ req = urllib.request.Request(url)
+ req.add_header("Accept", "application/vnd.travis-ci.2.1+json")
+ resp = urllib.request.urlopen(req)
+ data = json.load(resp)
+ return data["builds"], data["commits"]
+
+def get_travis():
+ commits = {}
+ last = None
+ while True:
+ data, coms = travis_req(after_number=last)
+ for x in coms:
+ commits[x["id"]] = x
+ for x in data:
+ last = x["number"]
+ if "commit_id" in x:
+ x["commit"] = commits[x["commit_id"]]
+ yield x
+
+def times():
+ for build in get_travis():
+ if build["event_type"] != "push": continue
+ if not build["commit"]["committed_at"]: continue
+ if build["commit"]["committed_at"] < "2018-06-15": break
+ if build["commit"]["branch"] == "master": continue
+ if build["state"] != "passed": continue
+ yield build["started_at"], build["duration"]
+
+if __name__ == "__main__":
+ for d, t in times():
+ print(d.replace("T", " ").replace("Z", ""), t, sep="\t")
diff --git a/randTest/Makefile b/randTest/Makefile
deleted file mode 100644
index fbd9bd19a..000000000
--- a/randTest/Makefile
+++ /dev/null
@@ -1,9 +0,0 @@
-JAVAC = javac
-
-all:
- $(JAVAC) RandomTest.java
-
-clean:
- rm -rf *.class
-
-.PHONY: all
diff --git a/randTest/OperatorTree.java b/randTest/OperatorTree.java
deleted file mode 100644
index bb3614ebd..000000000
--- a/randTest/OperatorTree.java
+++ /dev/null
@@ -1,139 +0,0 @@
-import java.util.Random;
-import java.util.Arrays;
-import java.nio.ByteBuffer;
-
-public class OperatorTree {
- public static final String[] UNOP =
- { "-"
- , "sqrt"
- , "sqr"
- , "exp"
- , "log"
- , "sin"
- , "cos"
- , "tan"
- , "asin"
- , "acos"
- , "atan"
- , "sinh"
- , "cosh"
- , "tanh"
- , "fabs"
- , "expm1"
- , "log1p"
- };
-
- public static final String[] BINOP =
- { "+"
- , "-"
- , "*"
- , "/"
- , "pow"
- , "atan2"
- , "fmod"
- , "hypot"
- };
-
- public static final String[] VARS =
- "abcdefghijklmnopqrstuvwxyz".split("");
-
- private static Random rnd = new Random();
-
- private static String choose(String[] a) {
- return a[rnd.nextInt(a.length)];
- }
-
- private static String getDoubleStr() {
- byte[] bytes = new byte[8];
- rnd.nextBytes(bytes);
- double val = ByteBuffer.wrap(bytes).getDouble();
- return Double.toString(val);
- }
-
- private static int count = 0;
-
- private final String name;
- private final String[] vars;
- private final Node expr;
- private final String[] dist;
-
- public OperatorTree(int size, int nVars, String[] dist) {
- if(size < 1) throw new Error("size < 1");
- if(nVars > VARS.length) throw new Error("nVars > VARS.length");
-
- count++;
- this.name = String.format("\"Random Jason Test %03d\"", count);
- this.vars = Arrays.copyOf(VARS, nVars);
- this.expr = genExpr(size);
- this.dist = dist;
- }
-
- private Node genExpr(int fuel) {
- fuel--;
-
- Node n;
- if(fuel < 1) {
- if(vars.length == 0 || rnd.nextInt(5) == 0) {
- n = new Node(getDoubleStr(), null, null);
- } else {
- n = new Node(choose(vars), null, null);
- }
- } else if(fuel < 2 || rnd.nextInt(4) == 0) {
- n = new Node(choose(UNOP), genExpr(fuel), null);
- } else {
- int l = rnd.nextInt(fuel - 1) + 1;
- int r = fuel - l;
- n = new Node(choose(BINOP), genExpr(l), genExpr(r));
- }
- return n;
- }
-
- private String makeDist() {
- if (dist != null) {
- StringBuilder sb = new StringBuilder();
- int minLen = Math.min(dist.length, vars.length);
- for (int i = 0; i < minLen; i++) {
- sb.append("(" + vars[i] + " (" + dist[i] + ")) ");
- }
- for (int i = minLen; i < vars.length; i++) {
- sb.append(vars[i] + " ");
- }
- return sb.toString();
- } else {
- return String.join(" ", vars);
- }
- }
-
- public String toString() {
- return String.format(
- "(FPCore (%s)\n %s)"
- , String.join(" ", makeDist())
- , expr.toString());
- }
-
- public class Node {
- private final String label;
- private final Node l;
- private final Node r;
-
- public Node(String label, Node l, Node r) {
- this.label = label;
- this.l = l;
- this.r = r;
- }
-
- public String toString() {
- if(l == null && r == null) {
- return label;
- }
- if(l != null && r == null) {
- return String.format("(%s %s)", label, l.toString());
- }
- if(l != null && r != null) {
- return String.format("(%s %s %s)", label, l.toString(), r.toString());
- }
- throw new Error("l == null but r != null");
- }
- }
-}
-
diff --git a/randTest/RandomTest.java b/randTest/RandomTest.java
deleted file mode 100644
index aefe4797f..000000000
--- a/randTest/RandomTest.java
+++ /dev/null
@@ -1,152 +0,0 @@
-import java.util.Random;
-
-public class RandomTest {
- private static int size = 1;
- private static int nVars = 1;
- private static int nTests = 1;
-
- private static int sizeWiggle = 0;
- private static int nVarsWiggle = 0;
- private static String[] dist;
-
- private static final String usage =
- String.join("\n"
- , "Usage: java RandomTest OPTIONS"
- , ""
- , "where OPTIONS include:"
- , " --help print this usage info and exit"
- , " --size N size of expressions to generate (default 1)"
- , " --size-wiggle N how much to wiggle to randomly add to size (default 0)"
- , " --nvars N number of variables in generated expressions (default 1)"
- , " --nvars-wiggle N how much wiggle to randomly add to number of vars (default 0)"
- , " --ntests N number of tests to generate (default 1)"
- , " --samplers N args define samplers for each variable (default default sampler)"
- );
-
- private static class BogusCL extends Exception {
- String msg;
-
- public BogusCL(String m) {
- msg = m;
- }
- }
-
- private static int parseArgInt(String[] args, int i) throws BogusCL {
- try {
- return Integer.parseInt(args[i]);
- }
- catch(ArrayIndexOutOfBoundsException e) {
- throw new BogusCL(
- String.format("expected integer argument at position %d", i));
- }
- catch(NumberFormatException e) {
- throw new BogusCL(
- String.format("could not parse '%s' as integer", args[i]));
- }
- }
-
- private static void parseArgs(String[] args) throws BogusCL {
- int i = 0;
- while(i < args.length) {
- switch(args[i]) {
- case "-h":
- case "--help":
- System.out.println(usage);
- System.exit(0);
- case "-s":
- case "--size":
- i++;
- size = parseArgInt(args, i);
- if(size < 1) {
- throw new BogusCL(
- String.format("size must be positive, but got %d", size));
- }
- break;
- case "-sw":
- case "--size-wiggle":
- i++;
- sizeWiggle = parseArgInt(args, i);
- if(sizeWiggle < 0) {
- throw new BogusCL(
- String.format("wiggle must be nonnegative, but got %d", sizeWiggle));
- }
- break;
- case "-v":
- case "--nvars":
- i++;
- nVars = parseArgInt(args, i);
- if(nVars < 0) {
- throw new BogusCL(
- String.format("number of vars must be nonnegative, but got %d", nVars));
- }
- if(nVars + nVarsWiggle > 26) {
- throw new BogusCL(
- String.format("number of vars plus wiggle must be <= 26, but got %d"
- , nVars + nVarsWiggle));
- }
- break;
- case "-vw":
- case "--nvars-wiggle":
- i++;
- nVarsWiggle = parseArgInt(args, i);
- if(nVarsWiggle < 0) {
- throw new BogusCL(
- String.format("wiggle must be nonnegative, but got %d", nVarsWiggle));
- }
- if(nVars + nVarsWiggle > 26) {
- throw new BogusCL(
- String.format("number of vars plus wiggle must be <= 26, but got %d"
- , nVars + nVarsWiggle));
- }
- break;
- case "-t":
- case "--ntests":
- i++;
- nTests = parseArgInt(args, i);
- if(size < 1) {
- throw new BogusCL(
- String.format("number of tests must be positive, but got %d", nTests));
- }
- break;
- case "-sp":
- case "--samplers":
- i++;
- int numSp = Integer.parseInt(args[i]);
- i++;
- dist = new String[numSp];
- for (int j = 0; j < numSp; j++) {
- dist[j] = args[i].replace('_', ' ');
- i++;
- }
- i--;
- break;
- default:
- throw new BogusCL(
- String.format("invalid argument '%s'", args[i]));
- }
- i++;
- }
- }
-
- public static void main(String[] args) {
- try {
- parseArgs(args);
- }
- catch(BogusCL e) {
- System.err.println("ERROR: " + e.msg);
- System.err.println();
- System.err.println(usage);
- System.exit(1);
- }
-
- Random rnd = new Random();
-
- for(int i=0; i" port))])
-(struct alt-event (program event prevs)
- #:methods gen:custom-write
- [(define (write-proc alt port mode)
- (display "#" port))])
-
-(define alternative? (or/c alt-delta? alt-event?))
-
(define (make-alt prog)
- (alt-event prog 'start '()))
-
-(define (alt? altn)
- (or (alt-delta? altn) (alt-event? altn)))
-
-(define (alt-program altn)
- (match altn
- [(alt-delta prog _ _) prog]
- [(alt-event prog _ _) prog]))
-
-(define (alt-change altn)
- (match altn
- [(alt-delta _ cng _) cng]
- [(alt-event _ _ '()) #f]
- [(alt-event _ _ `(,prev ,_ ...)) (alt-change prev)]))
-
-(define (alt-prev altn)
- (match altn
- [(alt-delta _ _ prev) prev]
- [(alt-event _ _ '()) #f]
- [(alt-event _ _ `(,prev ,_ ...)) (alt-prev prev)]))
-
-(define (alt-errors altn)
- (errors (alt-program altn) (*pcontext*)))
+ (alt prog 'start '()))
(define (alt-cost altn)
(program-cost (alt-program altn)))
-(define (alt-apply altn . changes)
- (foldl (λ (cng altn)
- (alt-delta (change-apply cng (alt-program altn)) cng altn))
- altn changes))
-
-;; Gets the initial version of the current alt.
-(define (alt-initial altn)
- (if (alt-prev altn)
- (alt-initial (alt-prev altn))
- altn))
-
-;; Get a list of every change that's happened to the current alt, in application order.
-(define (alt-changes altn)
- (let loop ([cur-alt altn] [acc '()])
- (if (alt-prev cur-alt)
- (loop (alt-prev cur-alt) (cons (alt-change cur-alt) acc))
- acc)))
-
-(define (alt-rewrite-expression alt #:destruct [destruct? #f] #:root [root-loc '()])
- (let ([subtree (location-get root-loc (alt-program alt))])
- (map (curry alt-apply alt)
- (rewrite-expression subtree #:destruct destruct? #:root root-loc))))
-
-(define (alt-rewrite-rm alt #:root [root-loc '()])
- (let ([subtree (location-get root-loc (alt-program alt))])
- (map (curry apply alt-apply alt)
- (map reverse
- (rewrite-expression-head subtree #:root root-loc)))))
-
-(define (alt-history-length alt)
- (if (alt-prev alt)
- (+ 1 (alt-history-length (alt-prev alt)))
- 0))
-
-(define (alt-set-prev altn prev)
- (alt-delta (alt-program altn) (alt-change altn) prev))
-
(define (alt-add-event altn event)
- (alt-event (alt-program altn) event (list altn)))
-
-(define (make-regime-alt new-prog altns splitpoints)
- (alt-event new-prog (list 'regimes splitpoints) altns))
+ (alt (alt-program altn) event (list altn)))
diff --git a/src/bigcomplex.rkt b/src/bigcomplex.rkt
index a0bdab7be..75e710f52 100644
--- a/src/bigcomplex.rkt
+++ b/src/bigcomplex.rkt
@@ -11,35 +11,29 @@
[bf-complex-neg (-> bigcomplex? bigcomplex?)]
[bf-complex-mult (-> bigcomplex? bigcomplex? bigcomplex?)]
[bf-complex-conjugate (-> bigcomplex? bigcomplex?)]
- [bf-complex-sqr (-> bigcomplex? bigcomplex?)]
[bf-complex-exp (-> bigcomplex? bigcomplex?)]
[bf-complex-log (-> bigcomplex? bigcomplex?)]
[bf-complex-sqrt (-> bigcomplex? bigcomplex?)]
[bf-complex-pow (-> bigcomplex? bigcomplex? bigcomplex?)]
- [bf-complex-div (-> bigcomplex? bigcomplex? bigcomplex?)])
- exact+ exact- exact* exact/ exact-sqr exact-log exact-pow exact-sqrt exact-exp)
-
-(define (bf-complex-add x y)
- (bigcomplex (bf+ (bigcomplex-re x) (bigcomplex-re y)) (bf+ (bigcomplex-im x) (bigcomplex-im y))))
-
-(define (bf-complex-sub x [y #f])
- (if y
- (bf-complex-add x (bf-complex-neg y))
- (bf-complex-neg x)))
+ [bf-complex-div (-> bigcomplex? bigcomplex? bigcomplex?)]))
(define (bf-complex-neg x)
(bigcomplex (bf- (bigcomplex-re x)) (bf- (bigcomplex-im x))))
+(define (bf-complex-add x y)
+ (bigcomplex (bf+ (bigcomplex-re x) (bigcomplex-re y))
+ (bf+ (bigcomplex-im x) (bigcomplex-im y))))
+
+(define (bf-complex-sub x y)
+ (bf-complex-add x (bf-complex-neg y)))
+
(define (bf-complex-mult x y)
(bigcomplex (bf+ (bf* (bigcomplex-re x) (bigcomplex-re y)) (bf- (bf* (bigcomplex-im x) (bigcomplex-im y))))
- (bf+ (bf* (bigcomplex-im x) (bigcomplex-re y)) (bf* (bigcomplex-re x) (bigcomplex-im y)))))
+ (bf+ (bf* (bigcomplex-im x) (bigcomplex-re y)) (bf* (bigcomplex-re x) (bigcomplex-im y)))))
(define (bf-complex-conjugate x)
(bigcomplex (bigcomplex-re x) (bf- (bigcomplex-im x))))
-(define (bf-complex-sqr x)
- (bf-complex-mult x x))
-
(define (bf-complex-exp x)
(match-define (bigcomplex re im) x)
(define scale (bfexp re))
@@ -62,26 +56,6 @@
(define denom (bf-complex-mult y (bf-complex-conjugate y)))
(bigcomplex (bf/ (bigcomplex-re numer) (bigcomplex-re denom)) (bf/ (bigcomplex-im numer) (bigcomplex-re denom))))
-(define (make-exact-fun bf-fun bf-complex-fun)
- (lambda args
- (match args
- [(list (? bigfloat?) ...)
- (apply bf-fun args)]
- [(list (? bigcomplex?) ...)
- (apply bf-complex-fun args)])))
-
-(require (only-in racket/base [exp e]))
-
-(define exact+ (make-exact-fun bf+ bf-complex-add))
-(define exact- (make-exact-fun bf- bf-complex-sub))
-(define exact* (make-exact-fun bf* bf-complex-mult))
-(define exact/ (make-exact-fun bf/ bf-complex-div))
-(define exact-exp (make-exact-fun bfexp bf-complex-exp))
-(define exact-log (make-exact-fun bflog bf-complex-log))
-(define exact-pow (make-exact-fun bfexpt bf-complex-pow))
-(define exact-sqr (make-exact-fun bfsqr bf-complex-sqr))
-(define exact-sqrt (make-exact-fun bfsqrt bf-complex-sqrt))
-
(module+ test
(define (bf-complex-eq-approx bf1 bf2)
(check-equal? (bfround (bigcomplex-re bf1)) (bigcomplex-re bf2))
diff --git a/src/biginterval.rkt b/src/biginterval.rkt
new file mode 100644
index 000000000..75709e96c
--- /dev/null
+++ b/src/biginterval.rkt
@@ -0,0 +1,625 @@
+#lang racket
+
+(require math/private/bigfloat/mpfr)
+(require "common.rkt" "syntax/types.rkt")
+
+(struct ival (lo hi err? err) #:transparent)
+
+(provide (contract-out
+ [struct ival ([lo bigvalue?] [hi bigvalue?] [err? boolean?] [err boolean?])]
+ [mk-ival (-> (or/c real? boolean?) ival?)]
+ [ival-pi (-> ival?)]
+ [ival-e (-> ival?)]
+ [ival-bool (-> boolean? ival?)]
+ [ival-add (-> ival? ival? ival?)]
+ [ival-sub (-> ival? ival? ival?)]
+ [ival-neg (-> ival? ival?)]
+ [ival-mult (-> ival? ival? ival?)]
+ [ival-div (-> ival? ival? ival?)]
+ [ival-fma (-> ival? ival? ival? ival?)]
+ [ival-fabs (-> ival? ival?)]
+ [ival-sqrt (-> ival? ival?)]
+ [ival-cbrt (-> ival? ival?)]
+ [ival-hypot (-> ival? ival? ival?)]
+ [ival-exp (-> ival? ival?)]
+ [ival-expm1 (-> ival? ival?)]
+ [ival-log (-> ival? ival?)]
+ [ival-log1p (-> ival? ival?)]
+ [ival-pow (-> ival? ival? ival?)]
+ [ival-sin (-> ival? ival?)]
+ [ival-cos (-> ival? ival?)]
+ [ival-tan (-> ival? ival?)]
+ [ival-asin (-> ival? ival?)]
+ [ival-acos (-> ival? ival?)]
+ [ival-atan (-> ival? ival?)]
+ [ival-atan2 (-> ival? ival? ival?)]
+ [ival-sinh (-> ival? ival?)]
+ [ival-cosh (-> ival? ival?)]
+ [ival-tanh (-> ival? ival?)]
+ [ival-asinh (-> ival? ival?)]
+ [ival-acosh (-> ival? ival?)]
+ [ival-atanh (-> ival? ival?)]
+ [ival-erf (-> ival? ival?)]
+ [ival-erfc (-> ival? ival?)]
+ [ival-fmod (-> ival? ival? ival?)]
+ [ival-remainder (-> ival? ival? ival?)]
+ [ival-and (->* () #:rest (listof ival?) ival?)]
+ [ival-or (->* () #:rest (listof ival?) ival?)]
+ [ival-not (-> ival? ival?)]
+ [ival-< (->* () #:rest (listof ival?) ival?)]
+ [ival-<= (->* () #:rest (listof ival?) ival?)]
+ [ival-> (->* () #:rest (listof ival?) ival?)]
+ [ival->= (->* () #:rest (listof ival?) ival?)]
+ [ival-== (->* () #:rest (listof ival?) ival?)]
+ [ival-!= (->* () #:rest (listof ival?) ival?)]
+ [ival-if (-> ival? ival? ival? ival?)]))
+
+(define (mk-ival x)
+ (match x
+ [(? real?)
+ (define err? (or (nan? x) (infinite? x)))
+ (define x* (bf x)) ;; TODO: Assuming that float precision < bigfloat precision
+ (ival x* x* err? err?)]
+ [(? boolean?)
+ (ival x x #f #f)]))
+
+(define -inf.bf (bf -inf.0))
+(define -1.bf (bf -1))
+(define 0.bf (bf 0))
+(define half.bf (bf 0.5))
+(define 1.bf (bf 1))
+(define 2.bf (bf 2))
+(define +inf.bf (bf +inf.0))
+(define +nan.bf (bf +nan.0))
+
+(define (ival-pi)
+ (ival (rnd 'down identity (pi.bf)) (rnd 'up identity (pi.bf)) #f #f))
+
+(define (ival-e)
+ (ival (rnd 'down bfexp 1.bf) (rnd 'up bfexp 1.bf) #f #f))
+
+(define (ival-bool b)
+ (ival b b #f #f))
+
+(define ival-true (ival-bool #t))
+
+(define-syntax-rule (rnd mode op args ...)
+ (parameterize ([bf-rounding-mode mode])
+ (op args ...)))
+
+(define (ival-neg x)
+ ;; No rounding, negation is exact
+ (ival (bfneg (ival-hi x)) (bfneg (ival-lo x)) (ival-err? x) (ival-err x)))
+
+(define (ival-add x y)
+ (ival (rnd 'down bfadd (ival-lo x) (ival-lo y))
+ (rnd 'up bfadd (ival-hi x) (ival-hi y))
+ (or (ival-err? x) (ival-err? y))
+ (or (ival-err x) (ival-err y))))
+
+(define (ival-sub x y)
+ (ival (rnd 'down bfsub (ival-lo x) (ival-hi y))
+ (rnd 'up bfsub (ival-hi x) (ival-lo y))
+ (or (ival-err? x) (ival-err? y))
+ (or (ival-err x) (ival-err y))))
+
+(define (bfmin* a . as)
+ (if (null? as) a (apply bfmin* (bfmin2 a (car as)) (cdr as))))
+
+(define (bfmax* a . as)
+ (if (null? as) a (apply bfmax* (bfmax2 a (car as)) (cdr as))))
+
+(define (ival-mult x y)
+ (define err? (or (ival-err? x) (ival-err? y)))
+ (define err (or (ival-err x) (ival-err y)))
+ (match* ((classify-ival x) (classify-ival y))
+ [(1 1)
+ (ival (rnd 'down bfmul (ival-lo x) (ival-lo y))
+ (rnd 'up bfmul (ival-hi x) (ival-hi y)) err? err)]
+ [(1 -1)
+ (ival (rnd 'down bfmul (ival-hi x) (ival-lo y))
+ (rnd 'up bfmul (ival-lo x) (ival-hi y)) err? err)]
+ [(1 0)
+ (ival (rnd 'down bfmul (ival-hi x) (ival-lo y))
+ (rnd 'up bfmul (ival-hi x) (ival-hi y)) err? err)]
+ [(-1 0)
+ (ival (rnd 'down bfmul (ival-lo x) (ival-hi y))
+ (rnd 'up bfmul (ival-lo x) (ival-lo y)) err? err)]
+ [(-1 1)
+ (ival (rnd 'down bfmul (ival-lo x) (ival-hi y))
+ (rnd 'up bfmul (ival-hi x) (ival-lo y)) err? err)]
+ [(-1 -1)
+ (ival (rnd 'down bfmul (ival-hi x) (ival-hi y))
+ (rnd 'up bfmul (ival-lo x) (ival-lo y)) err? err)]
+ [(0 1)
+ (ival (rnd 'down bfmul (ival-lo x) (ival-hi y))
+ (rnd 'up bfmul (ival-hi x) (ival-hi y)) err? err)]
+ [(0 -1)
+ (ival (rnd 'down bfmul (ival-hi x) (ival-lo y))
+ (rnd 'up bfmul (ival-lo x) (ival-lo y)) err? err)]
+ [(0 0) ; The "else" case is always correct, but is slow
+ ;; We round only down, and approximate rounding up with bfnext below
+ (define opts
+ (rnd 'down list
+ (bfmul (ival-lo x) (ival-lo y)) (bfmul (ival-hi x) (ival-lo y))
+ (bfmul (ival-lo x) (ival-hi y)) (bfmul (ival-hi x) (ival-hi y))))
+ (ival (apply bfmin* opts) (bfnext (apply bfmax* opts)) err? err)]))
+
+(define (ival-div x y)
+ (define err? (or (ival-err? x) (ival-err? y) (and (bflte? (ival-lo y) 0.bf) (bfgte? (ival-hi y) 0.bf))))
+ (define err (or (ival-err x) (ival-err y) (and (bf=? (ival-lo y) 0.bf) (bf=? (ival-hi y) 0.bf))))
+ ;; We round only down, and approximate rounding up with bfnext below
+ (match* ((classify-ival x) (classify-ival y))
+ [(_ 0)
+ (ival -inf.bf +inf.bf err? err)]
+ [(1 1)
+ (ival (rnd 'down bfdiv (ival-lo x) (ival-hi y))
+ (rnd 'up bfdiv (ival-hi x) (ival-lo y)) err? err)]
+ [(1 -1)
+ (ival (rnd 'down bfdiv (ival-hi x) (ival-hi y))
+ (rnd 'up bfdiv (ival-lo x) (ival-lo y)) err? err)]
+ [(-1 1)
+ (ival (rnd 'down bfdiv (ival-lo x) (ival-lo y))
+ (rnd 'up bfdiv (ival-hi x) (ival-hi y)) err? err)]
+ [(-1 -1)
+ (ival (rnd 'down bfdiv (ival-hi x) (ival-lo y))
+ (rnd 'up bfdiv (ival-lo x) (ival-hi y)) err? err)]
+ [(0 1)
+ (ival (rnd 'down bfdiv (ival-lo x) (ival-lo y))
+ (rnd 'up bfdiv (ival-hi x) (ival-lo y)) err? err)]
+ [(0 -1)
+ (ival (rnd 'down bfdiv (ival-hi x) (ival-hi y))
+ (rnd 'up bfdiv (ival-lo x) (ival-hi y)) err? err)]
+ [(_ _)
+ (define opts
+ (rnd 'down list
+ (bfdiv (ival-lo x) (ival-lo y)) (bfdiv (ival-hi x) (ival-lo y))
+ (bfdiv (ival-lo x) (ival-hi y)) (bfdiv (ival-hi x) (ival-hi y))))
+ (ival (apply bfmin* opts) (bfnext (apply bfmax* opts)) err? err)]))
+
+(define (ival-exp x)
+ (ival (rnd 'down bfexp (ival-lo x)) (rnd 'up bfexp (ival-hi x)) (ival-err? x) (ival-err x)))
+
+(define (ival-expm1 x)
+ (ival (rnd 'down bfexpm1 (ival-lo x)) (rnd 'up bfexpm1 (ival-hi x)) (ival-err? x) (ival-err x)))
+
+(define (ival-log x)
+ (define err (or (ival-err x) (bflte? (ival-hi x) 0.bf)))
+ (define err? (or err (ival-err? x) (bflte? (ival-lo x) 0.bf)))
+ (ival (rnd 'down bflog (ival-lo x)) (rnd 'up bflog (ival-hi x))
+ err? err))
+
+(define (ival-log1p x)
+ (define err (or (ival-err x) (bflte? (ival-hi x) -1.bf)))
+ (define err? (or err (ival-err? x) (bflte? (ival-lo x) -1.bf)))
+ (ival (rnd 'down bflog1p (ival-lo x)) (rnd 'up bflog1p (ival-hi x))
+ err? err))
+
+(define (ival-sqrt x)
+ (define err (or (ival-err x) (bflte? (ival-hi x) 0.bf)))
+ (define err? (or err (ival-err? x) (bflte? (ival-lo x) 0.bf)))
+ (ival (rnd 'down bfsqrt (ival-lo x)) (rnd 'up bfsqrt (ival-hi x))
+ err? err))
+
+(define (ival-cbrt x)
+ (ival (rnd 'down bfcbrt (ival-lo x)) (rnd 'up bfcbrt (ival-hi x)) (ival-err? x) (ival-err x)))
+
+(define (ival-hypot x y)
+ (define err? (or (ival-err? x) (ival-err? y)))
+ (define err (or (ival-err x) (ival-err y)))
+ (define x* (ival-fabs x))
+ (define y* (ival-fabs y))
+ (ival (rnd 'down bfhypot (ival-lo x*) (ival-lo y*))
+ (rnd 'up bfhypot (ival-hi x*) (ival-hi y*))
+ err? err))
+
+(define (ival-pow x y)
+ (define err? (or (ival-err? x) (ival-err? y)))
+ (define err (or (ival-err x) (ival-err y)))
+ (cond
+ [(bfgte? (ival-lo x) 0.bf)
+ (let ([lo
+ (if (bflt? (ival-lo x) 1.bf)
+ (rnd 'down bfexpt (ival-lo x) (ival-hi y))
+ (rnd 'down bfexpt (ival-lo x) (ival-lo y)))]
+ [hi
+ (if (bfgt? (ival-hi x) 1.bf)
+ (rnd 'up bfexpt (ival-hi x) (ival-hi y))
+ (rnd 'up bfexpt (ival-hi x) (ival-lo y)))])
+ (ival lo hi err? err))]
+ [(and (bf=? (ival-lo y) (ival-hi y)) (bfinteger? (ival-lo y)))
+ (ival (rnd 'down bfexpt (ival-lo x) (ival-lo y))
+ (rnd 'up bfexpt (ival-lo x) (ival-lo y))
+ err? err)]
+ [else
+ ;; In this case, the base range includes negatives and the exp range includes reals
+ ;; Focus first on just the negatives in the base range
+ ;; All the reals in the exp range just make NaN a possible output
+ ;; If there are no integers in the exp range, those NaNs are the only output
+ ;; If there are, the min of the negative base values is from the biggest odd integer in the range
+ ;; and the max is from the biggest even integer in the range
+ (define a (bfceiling (ival-lo y)))
+ (define b (bffloor (ival-hi y)))
+ (define lo (ival-lo x))
+ (define neg-range
+ (cond
+ [(bflt? b a)
+ (ival +nan.bf +nan.bf #t #t)]
+ [(bf=? a b)
+ (ival (rnd 'down bfexpt (ival-lo x) a) (rnd 'up bfexpt (ival-hi x) a) err? err)]
+ [(bfodd? b)
+ (ival (rnd 'down bfexpt (ival-lo x) b)
+ (rnd 'up bfmax2 (bfexpt (ival-hi x) (bfsub b 1.bf)) (bfexpt (ival-lo x) (bfsub b 1.bf))) err? err)]
+ [(bfeven? b)
+ (ival (rnd 'down bfexpt (ival-lo x) (bfsub b 1.bf))
+ (rnd 'up bfmax2 (bfexpt (ival-hi x) b) (bfexpt (ival-lo x) b)) err? err)]
+ [else (ival +nan.bf +nan.bf #f #t)]))
+ (if (bfgt? (ival-hi x) 0.bf)
+ (ival-union neg-range (ival-pow (ival 0.bf (ival-hi x) err? err) y))
+ neg-range)]))
+
+(define (ival-fma a b c)
+ (ival-add (ival-mult a b) c))
+
+(define (ival-and . as)
+ (ival (andmap ival-lo as) (andmap ival-hi as)
+ (ormap ival-err? as) (ormap ival-err as)))
+
+(define (ival-or . as)
+ (ival (ormap ival-lo as) (ormap ival-hi as)
+ (ormap ival-err? as) (ormap ival-err as)))
+
+(define (ival-not x)
+ (ival (not (ival-hi x)) (not (ival-lo x)) (ival-err? x) (ival-err x)))
+
+(define (ival-cos x)
+ (define lopi (rnd 'down identity (pi.bf)))
+ (define hipi (rnd 'up identity (pi.bf)))
+ (define a (rnd 'down bffloor (bfdiv (ival-lo x) (if (bflt? (ival-lo x) 0.bf) lopi hipi))))
+ (define b (rnd 'up bffloor (bfdiv (ival-hi x) (if (bflt? (ival-hi x) 0.bf) hipi lopi))))
+ (cond
+ [(and (bf=? a b) (bfeven? a))
+ (ival (rnd 'down bfcos (ival-hi x)) (rnd 'up bfcos (ival-lo x)) (ival-err? x) (ival-err x))]
+ [(and (bf=? a b) (bfodd? a))
+ (ival (rnd 'down bfcos (ival-lo x)) (rnd 'up bfcos (ival-hi x)) (ival-err? x) (ival-err x))]
+ [(and (bf=? (bfsub b a) 1.bf) (bfeven? a))
+ (ival -1.bf (rnd 'up bfmax2 (bfcos (ival-lo x)) (bfcos (ival-hi x))) (ival-err? x) (ival-err x))]
+ [(and (bf=? (bfsub b a) 1.bf) (bfodd? a))
+ (ival (rnd 'down bfmin2 (bfcos (ival-lo x)) (bfcos (ival-hi x))) 1.bf (ival-err? x) (ival-err x))]
+ [else
+ (ival -1.bf 1.bf (ival-err? x) (ival-err x))]))
+
+(define (ival-sin x)
+ (define lopi (rnd 'down identity (pi.bf)))
+ (define hipi (rnd 'up identity (pi.bf)))
+ (define a (rnd 'down bffloor (bfsub (bfdiv (ival-lo x) (if (bflt? (ival-lo x) 0.bf) lopi hipi)) half.bf))) ; half.bf is exact
+ (define b (rnd 'up bffloor (bfsub (bfdiv (ival-hi x) (if (bflt? (ival-hi x) 0.bf) hipi lopi)) half.bf)))
+ (cond
+ [(and (bf=? a b) (bfeven? a))
+ (ival (rnd 'down bfsin (ival-hi x)) (rnd 'up bfsin (ival-lo x)) (ival-err? x) (ival-err x))]
+ [(and (bf=? a b) (bfodd? a))
+ (ival (rnd 'down bfsin (ival-lo x)) (rnd 'up bfsin (ival-hi x)) (ival-err? x) (ival-err x))]
+ [(and (bf=? (bfsub b a) 1.bf) (bfeven? a))
+ (ival -1.bf (rnd 'up bfmax2 (bfsin (ival-lo x)) (bfsin (ival-hi x))) (ival-err? x) (ival-err x))]
+ [(and (bf=? (bfsub b a) 1.bf) (bfodd? a))
+ (ival (rnd 'down bfmin2 (bfsin (ival-lo x)) (bfsin (ival-hi x))) 1.bf (ival-err? x) (ival-err x))]
+ [else
+ (ival -1.bf 1.bf (ival-err? x) (ival-err x))]))
+
+(define (ival-tan x)
+ (ival-div (ival-sin x) (ival-cos x)))
+
+(define (ival-atan x)
+ (ival (rnd 'down bfatan (ival-lo x)) (rnd 'up bfatan (ival-hi x)) (ival-err? x) (ival-err x)))
+
+(define (classify-ival x)
+ (cond [(bfgte? (ival-lo x) 0.bf) 1] [(bflte? (ival-hi x) 0.bf) -1] [else 0]))
+
+(define (ival-atan2 y x)
+ (define err? (or (ival-err? x) (ival-err? y)))
+ (define err (or (ival-err x) (ival-err y)))
+
+ (define tl (list (ival-hi y) (ival-lo x)))
+ (define tr (list (ival-hi y) (ival-hi x)))
+ (define bl (list (ival-lo y) (ival-lo x)))
+ (define br (list (ival-lo y) (ival-hi x)))
+
+ (define-values (a-lo a-hi)
+ (match* ((classify-ival x) (classify-ival y))
+ [(-1 -1) (values tl br)]
+ [( 0 -1) (values tl tr)]
+ [( 1 -1) (values bl tr)]
+ [( 1 0) (values bl tl)]
+ [( 1 1) (values br tl)]
+ [( 0 1) (values br bl)]
+ [(-1 1) (values tr bl)]
+ [( _ _) (values #f #f)]))
+
+ (if a-lo
+ (ival (rnd 'down apply bfatan2 a-lo) (rnd 'up apply bfatan2 a-hi) err? err)
+ (ival (rnd 'down bfneg (pi.bf)) (rnd 'up identity (pi.bf))
+ (or err? (bfgte? (ival-hi x) 0.bf))
+ (or err (and (bf=? (ival-lo x) 0.bf) (bf=? (ival-hi x) 0.bf) (bf=? (ival-lo y) 0.bf) (bf=? (ival-hi y) 0.bf))))))
+
+(define (ival-asin x)
+ (ival (rnd 'down bfasin (ival-lo x)) (rnd 'up bfasin (ival-hi x))
+ (or (ival-err? x) (bflt? (ival-lo x) -1.bf) (bfgt? (ival-hi x) 1.bf))
+ (or (ival-err x) (bflt? (ival-hi x) -1.bf) (bfgt? (ival-lo x) 1.bf))))
+
+(define (ival-acos x)
+ (ival (rnd 'down bfacos (ival-hi x)) (rnd 'up bfacos (ival-lo x))
+ (or (ival-err? x) (bflt? (ival-lo x) -1.bf) (bfgt? (ival-hi x) 1.bf))
+ (or (ival-err x) (bflt? (ival-hi x) -1.bf) (bfgt? (ival-lo x) 1.bf))))
+
+(define (ival-fabs x)
+ (cond
+ [(bfgt? (ival-lo x) 0.bf) x]
+ [(bflt? (ival-hi x) 0.bf)
+ (ival (bfneg (ival-hi x)) (bfneg (ival-lo x)) (ival-err? x) (ival-err x))]
+ [else ; interval stradles 0
+ (ival 0.bf (bfmax2 (bfneg (ival-lo x)) (ival-hi x)) (ival-err? x) (ival-err x))]))
+
+(define (ival-sinh x)
+ (ival (rnd 'down bfsinh (ival-lo x)) (rnd 'up bfsinh (ival-hi x)) (ival-err? x) (ival-err x)))
+
+(define (ival-cosh x)
+ (define y (ival-fabs x))
+ (ival (rnd 'down bfcosh (ival-lo y)) (rnd 'up bfcosh (ival-hi y)) (ival-err? y) (ival-err y)))
+
+(define (ival-tanh x)
+ (ival (rnd 'down bftanh (ival-lo x)) (rnd 'up bftanh (ival-hi x)) (ival-err? x) (ival-err x)))
+
+(define (ival-asinh x)
+ (ival (rnd 'down bfasinh (ival-lo x)) (rnd 'up bfasinh (ival-hi x)) (ival-err? x) (ival-err x)))
+
+(define (ival-acosh x)
+ (ival (rnd 'down bfacosh (bfmax2 (ival-lo x) 1.bf)) (rnd 'up bfacosh (ival-hi x))
+ (or (bflte? (ival-lo x) 1.bf) (ival-err? x)) (or (bflt? (ival-hi x) 1.bf) (ival-err x))))
+
+(define (ival-atanh x)
+ (ival (rnd 'down bfatanh (ival-lo x)) (rnd 'up bfatanh (ival-hi x)) (ival-err? x) (ival-err x)))
+
+(define (ival-fmod x y)
+ (define y* (ival-fabs y))
+ (define quot (ival-div x y*))
+ (define a (rnd 'down bftruncate (ival-lo quot)))
+ (define b (rnd 'up bftruncate (ival-hi quot)))
+ (define err? (or (ival-err? x) (ival-err? y) (bf=? (ival-lo y*) 0.bf)))
+ (define err (or (ival-err x) (ival-err y) (bf=? (ival-hi y*) 0.bf)))
+ (define tquot (ival a b err? err))
+
+ (cond
+ [(bf=? a b) (ival-sub x (ival-mult tquot y*))]
+ [(bflte? b 0.bf) (ival (bfneg (ival-hi y*)) 0.bf err? err)]
+ [(bfgte? a 0.bf) (ival 0.bf (ival-hi y*) err? err)]
+ [else (ival (bfneg (ival-hi y*)) (ival-hi y*) err? err)]))
+
+(define (ival-remainder x y)
+ (define y* (ival-fabs y))
+ (define quot (ival-div x y*))
+ (define a (rnd 'down bfround (ival-lo quot)))
+ (define b (rnd 'up bfround (ival-hi quot)))
+ (define err? (or (ival-err? x) (ival-err? y) (bf=? (ival-lo y*) 0.bf)))
+ (define err (or (ival-err x) (ival-err y) (bf=? (ival-hi y*) 0.bf)))
+
+ (if (bf=? a b)
+ (ival-sub x (ival-mult (ival a b err? err) y*))
+ (ival (bfneg (bfdiv (ival-hi y*) 2.bf)) (bfdiv (ival-hi y*) 2.bf) err? err)))
+
+(define (ival-erf x)
+ (ival (rnd 'down bferf (ival-lo x)) (rnd 'up bferf (ival-hi x)) (ival-err? x) (ival-err x)))
+
+(define (ival-erfc x)
+ (ival (rnd 'down bferfc (ival-hi x)) (rnd 'up bferfc (ival-lo x)) (ival-err? x) (ival-err x)))
+
+(define (ival-cmp x y)
+ (define can-< (bflt? (ival-lo x) (ival-hi y)))
+ (define must-< (bflt? (ival-hi x) (ival-lo y)))
+ (define can-> (bfgt? (ival-hi x) (ival-lo y)))
+ (define must-> (bfgt? (ival-lo x) (ival-hi y)))
+ (values can-< must-< can-> must->))
+
+(define (ival-<2 x y)
+ (define-values (c< m< c> m>) (ival-cmp x y))
+ (ival m< c< (or (ival-err? x) (ival-err? y)) (or (ival-err x) (ival-err y))))
+
+(define (ival-<=2 x y)
+ (define-values (c< m< c> m>) (ival-cmp x y))
+ (ival (not c>) (not m>) (or (ival-err? x) (ival-err? y)) (or (ival-err x) (ival-err y))))
+
+(define (ival->2 x y)
+ (define-values (c< m< c> m>) (ival-cmp x y))
+ (ival m> c> (or (ival-err? x) (ival-err? y)) (or (ival-err x) (ival-err y))))
+
+(define (ival->=2 x y)
+ (define-values (c< m< c> m>) (ival-cmp x y))
+ (ival (not c<) (not m<) (or (ival-err? x) (ival-err? y)) (or (ival-err x) (ival-err y))))
+
+(define (ival-==2 x y)
+ (define-values (c< m< c> m>) (ival-cmp x y))
+ (ival (and (not c<) (not c>)) (or (not m<) (not m>)) (or (ival-err? x) (ival-err? y)) (or (ival-err x) (ival-err y))))
+
+(define (ival-comparator f name)
+ (procedure-rename
+ (λ as
+ (if (null? as)
+ ival-true
+ (let loop ([head (car as)] [tail (cdr as)] [acc ival-true])
+ (match tail
+ ['() acc]
+ [(cons next rest)
+ (loop next rest (ival-and (f head next) ival-true))]))))
+ name))
+
+(define ival-< (ival-comparator ival-<2 'ival-<))
+(define ival-<= (ival-comparator ival-<=2 'ival-<=))
+(define ival-> (ival-comparator ival->2 'ival->))
+(define ival->= (ival-comparator ival->=2 'ival->=))
+(define ival-== (ival-comparator ival-==2 'ival-==))
+
+(define (ival-!=2 x y)
+ (define-values (c< m< c> m>) (ival-cmp x y))
+ (ival (or c< c>) (or m< m>) (or (ival-err? x) (ival-err? y)) (or (ival-err x) (ival-err y))))
+
+(define (ival-!= . as)
+ (if (null? as)
+ ival-true
+ (let loop ([head (car as)] [tail (cdr as)])
+ (if (null? tail)
+ ival-true
+ (ival-and
+ (foldl ival-and ival-true (map (curry ival-!=2 head) tail))
+ (loop (car tail) (cdr tail)))))))
+
+(define (ival-union x y)
+ (match (ival-lo x)
+ [(? bigfloat?)
+ (ival (bfmin2 (ival-lo x) (ival-lo y)) (bfmax2 (ival-hi x) (ival-hi y))
+ (or (ival-err? x) (ival-err? y)) (or (ival-err x) (ival-err y)))]
+ [(? boolean?)
+ (ival (and (ival-lo x) (ival-lo y)) (or (ival-hi x) (ival-hi y))
+ (or (ival-err? x) (ival-err? y)) (or (ival-err x) (ival-err y)))]))
+
+(define (propagate-err c x)
+ (ival (ival-lo x) (ival-hi x)
+ (or (ival-err? c) (ival-err? x))
+ (or (ival-err c) (ival-err x))))
+
+(define (ival-if c x y)
+ (cond
+ [(ival-lo c) (propagate-err c x)]
+ [(not (ival-hi c)) (propagate-err c y)]
+ [else (propagate-err c (ival-union x y))]))
+
+
+(module+ test
+ (require rackunit math/flonum)
+
+ (define num-tests 1000)
+
+ (define (sample-interval)
+ (if (= (random 0 2) 0)
+ (let ([v1 (sample-double)] [v2 (sample-double)])
+ (ival (bf (min v1 v2)) (bf (max v1 v2)) (or (nan? v1) (nan? v2)) (and (nan? v1) (nan? v2))))
+ (let* ([v1 (bf (sample-double))] [exp (random 0 31)] [mantissa (random 0 (expt 2 exp))] [sign (- (* 2 (random 0 2)) 1)])
+ (define v2 (bfstep v1 (* sign (+ exp mantissa))))
+ (if (= sign -1)
+ (ival v2 v1 (or (bfnan? v1) (bfnan? v2)) (and (bfnan? v1) (bfnan? v2)))
+ (ival v1 v2 (or (bfnan? v1) (bfnan? v2)) (and (bfnan? v1) (bfnan? v2)))))))
+
+ (define (sample-bf)
+ (bf (sample-double)))
+
+ (define (sample-from ival)
+ (if (bigfloat? (ival-lo ival))
+ (let ([p (random)])
+ (bfadd (bfmul (bf p) (ival-lo ival)) (bfmul (bfsub 1.bf (bf p)) (ival-hi ival))))
+ (let ([p (random 0 2)])
+ (if (= p 0) (ival-lo ival) (ival-hi ival)))))
+
+ (define (ival-valid? ival)
+ (or (boolean? (ival-lo ival))
+ (bfnan? (ival-lo ival))
+ (bfnan? (ival-hi ival))
+ (bflte? (ival-lo ival) (ival-hi ival))))
+
+ (define (ival-contains? ival pt)
+ (or (ival-err? ival)
+ (if (bigfloat? pt)
+ (if (bfnan? pt)
+ (ival-err? ival)
+ (and (bflte? (ival-lo ival) pt) (bflte? pt (ival-hi ival))))
+ (or (equal? pt (ival-lo ival)) (equal? pt (ival-hi ival))))))
+
+ (check ival-contains? (ival-bool #f) #f)
+ (check ival-contains? (ival-bool #t) #t)
+ (check ival-contains? (ival-pi) (pi.bf))
+ (check ival-contains? (ival-e) (bfexp 1.bf))
+ (test-case "mk-ival"
+ (for ([i (in-range num-tests)])
+ (define pt (sample-double))
+ (with-check-info (['point pt])
+ (check-pred ival-valid? (mk-ival pt))
+ (check ival-contains? (mk-ival pt) (bf pt)))))
+
+ (define arg1
+ (list (cons ival-neg bfneg)
+ (cons ival-fabs bfabs)
+ (cons ival-sqrt bfsqrt)
+ (cons ival-cbrt bfcbrt)
+ (cons ival-exp bfexp)
+ (cons ival-expm1 bfexpm1)
+ (cons ival-log bflog)
+ (cons ival-log1p bflog1p)
+ (cons ival-sin bfsin)
+ (cons ival-cos bfcos)
+ (cons ival-tan bftan)
+ (cons ival-asin bfasin)
+ (cons ival-acos bfacos)
+ (cons ival-atan bfatan)
+ (cons ival-sinh bfsinh)
+ (cons ival-cosh bfcosh)
+ (cons ival-tanh bftanh)))
+
+ (for ([(ival-fn fn) (in-dict arg1)])
+ (test-case (~a (object-name ival-fn))
+ (for ([n (in-range num-tests)])
+ (define i (sample-interval))
+ (define x (sample-from i))
+ (with-check-info (['fn ival-fn] ['interval i] ['point x] ['number n])
+ (check-pred ival-valid? (ival-fn i))
+ (check ival-contains? (ival-fn i) (fn x))))))
+
+ (define arg2
+ (list (cons ival-add bfadd)
+ (cons ival-sub bfsub)
+ (cons ival-mult bfmul)
+ (cons ival-div bfdiv)
+ (cons ival-hypot bfhypot)
+ (cons ival-atan2 bfatan2)
+ (cons ival-< bflt?)
+ (cons ival-> bfgt?)
+ (cons ival-<= bflte?)
+ (cons ival->= bfgte?)
+ (cons ival-== bf=?)
+ (cons ival-!= (compose not bf=?))))
+
+ (for ([(ival-fn fn) (in-dict arg2)])
+ (test-case (~a (object-name ival-fn))
+ (for ([n (in-range num-tests)])
+ (define i1 (sample-interval))
+ (define i2 (sample-interval))
+ (define x1 (sample-from i1))
+ (define x2 (sample-from i2))
+
+ (with-check-info (['fn ival-fn] ['interval1 i1] ['interval2 i2] ['point1 x1] ['point2 x2] ['number n])
+ (define iy (ival-fn i1 i2))
+ (check-pred ival-valid? iy)
+ (check ival-contains? iy (fn x1 x2))))))
+
+ (define (bffmod x y)
+ (bfsub x (bfmul (bftruncate (bfdiv x y)) y)))
+
+ (define (bfremainder x mod)
+ (bfsub x (bfmul (bfround (bfdiv x mod)) mod)))
+
+ (define weird (list (cons ival-fmod bffmod) (cons ival-remainder bfremainder)))
+
+ (for ([(ival-fn fn) (in-dict weird)])
+ (test-case (~a (object-name ival-fn))
+ (for ([n (in-range num-tests)])
+ (define i1 (sample-interval))
+ (define i2 (sample-interval))
+ (define x1 (sample-from i1))
+ (define x2 (sample-from i2))
+
+ (define y (parameterize ([bf-precision 8000]) (fn x1 x2)))
+
+ ;; Known bug in bffmod where rounding error causes invalid output
+ (unless (or (bflte? (bfmul y x1) 0.bf) (bfgt? (bfabs y) (bfabs x2)))
+ (with-check-info (['fn ival-fn] ['interval1 i1] ['interval2 i2]
+ ['point1 x1] ['point2 x2] ['number n])
+ (define iy (ival-fn i1 i2))
+ (check-pred ival-valid? iy)
+ (check ival-contains? iy y))))))
+ )
diff --git a/src/common.rkt b/src/common.rkt
index 9f173d049..6588e9f00 100644
--- a/src/common.rkt
+++ b/src/common.rkt
@@ -1,21 +1,18 @@
#lang racket
-(require math/flonum)
-(require math/bigfloat)
-(require "config.rkt" "errors.rkt" "debug.rkt")
+(require math/flonum math/bigfloat racket/runtime-path)
+(require "config.rkt" "errors.rkt" "debug.rkt" "interface.rkt")
+(module+ test (require rackunit))
-(module+ test
- (require rackunit))
-
-(provide *start-prog*
+(provide *start-prog* *all-alts*
reap define-table table-ref table-set! table-remove!
- first-value assert for/append
- ordinary-value? =-or-nan? log2 i ([tbl (cons/c (listof (cons/c symbol? contract?)) (hash/c symbol? (listof any/c)))]
- [key symbol?]
- [field symbol?])
- [_ (tbl field) (dict-ref (car tbl) field)])
+ (define name (cons (list (cons 'field type) ...) (make-hash))))
+
+(define (table-ref tbl key field)
(match-let ([(cons header rows) tbl])
(for/first ([(field-name type) (in-dict header)]
- [value (in-list (dict-ref rows key))]
+ [value (in-list (hash-ref rows key))]
#:when (equal? field-name field))
value)))
-(define/contract (table-set! tbl key fields)
- (->i ([tbl (cons/c (listof (cons/c symbol? contract?)) (hash/c symbol? (listof any/c)))]
- [key symbol?]
- [fields (tbl)
- ;; Don't check value types because the contract gets pretty rough :(
- (and/c dict? (λ (d) (andmap (curry dict-has-key? d) (dict-keys (car tbl)))))])
- any)
+(define (table-set! tbl key fields)
(match-let ([(cons header rows) tbl])
(define row (for/list ([(hkey htype) (in-dict header)]) (dict-ref fields hkey)))
- (dict-set! rows key row)))
+ (hash-set! rows key row)))
-(define/contract (table-remove! tbl key)
- ((cons/c (listof (cons/c symbol? contract?)) (hash/c symbol? (listof any/c))) symbol? . -> . void?)
- (match-let ([(cons header rows) tbl])
- (dict-remove! rows key)))
+(define (table-remove! tbl key)
+ (hash-remove! (cdr tbl) key))
;; More various helpful values
-(define-syntax-rule (first-value expr)
- (call-with-values
- (λ () expr)
- (compose car list)))
-
-(module+ test
- (check-equal? (first-value (values 1 2 3)) 1))
-
(define-syntax assert
(syntax-rules ()
[(assert pred #:loc location)
(when (not pred)
(error location "~a returned false!" 'pred))]
- [(assert pred #:extra-info func)
- (when (not pred)
- (error 'assert (format "~a returned false! Extra info: ~a"
- 'pred (func))))]
[(assert pred)
(when (not pred)
(error 'assert "~a returned false!" 'pred))]))
@@ -103,47 +74,16 @@
(check-equal? (for/append ([v (in-range 5)]) (list v v v))
'(0 0 0 1 1 1 2 2 2 3 3 3 4 4 4)))
-;; Simple floating-point functions
-
-(define (ordinary-value? x)
- (match x
- [(? real?)
- (not (or (infinite? x) (nan? x)))]
- [(? complex?)
- (and (ordinary-value? (real-part x)) (ordinary-value? (imag-part x)))]
- [(? boolean?)
- true]))
-
-(module+ test
- (check-true (ordinary-value? 2.5))
- (check-false (ordinary-value? +nan.0))
- (check-false (ordinary-value? -inf.f)))
-
-(define (=-or-nan? x1 x2)
- (or (= x1 x2)
- (and (nan? x1) (nan? x2))))
-
-(module+ test
- (check-true (=-or-nan? 2.3 2.3))
- (check-false (=-or-nan? 2.3 7.8))
- (check-true (=-or-nan? +nan.0 -nan.f))
- (check-false (=-or-nan? 2.3 +nan.f)))
-
-(define (syntax stx (cons #'list parts))))]
[(_ a)
#'(app syntax-e 'a)])))
+
+;; String formatting operations
+
+(define (format-time ms)
+ (cond
+ [(< ms 1000) (format "~ams" (round ms))]
+ [(< ms 60000) (format "~as" (/ (round (/ ms 100.0)) 10))]
+ [(< ms 3600000) (format "~am" (/ (round (/ ms 6000.0)) 10))]
+ [else (format "~ahr" (/ (round (/ ms 360000.0)) 10))]))
+
+(define (format-bits r #:sign [sign #f] #:unit [unit? #f])
+ (define unit (if unit? "b" ""))
+ (cond
+ [(not r) ""]
+ [(and (> r 0) sign) (format "+~a~a" (/ (round (* r 10)) 10) unit)]
+ [else (format "~a~a" (/ (round (* r 10)) 10) unit)]))
+
+(define (call-with-output-files names k)
+ (let loop ([names names] [ps '()])
+ (if (null? names)
+ (apply k (reverse ps))
+ (if (car names)
+ (call-with-output-file
+ (car names) #:exists 'replace
+ (λ (p) (loop (cdr names) (cons p ps))))
+ (loop (cdr names) (cons #f ps))))))
+
+(define-syntax-rule (when-dict d (arg ...) body ...)
+ (if (and (dict-has-key? d 'arg) ...)
+ (let ([arg (dict-ref d 'arg)] ...)
+ body ...)
+ '()))
+
+(define (in-sorted-dict d #:key [key identity])
+ (in-dict (sort (dict->list d) > #:key (compose key cdr))))
+
+(define-runtime-path web-resource-path "web/")
+
+(define (web-resource [name #f])
+ (if name
+ (build-path web-resource-path name)
+ web-resource-path))
+
+(define (all-partitions n #:from [k 1])
+ (cond
+ [(= n 0) '(())]
+ [(< n k) '()]
+ [else
+ (append (map (curry cons k) (all-partitions (- n k) #:from k))
+ (all-partitions n #:from (+ k 1)))]))
+
+(define ((comparator test) . args)
+ (for/and ([left args] [right (cdr args)])
+ (test left right)))
+
+(define (sample-double)
+ (floating-point-bytes->real (integer->integer-bytes (random-exp 64) 8 #f)))
diff --git a/src/config.rkt b/src/config.rkt
index 87c04414d..2590decc9 100644
--- a/src/config.rkt
+++ b/src/config.rkt
@@ -1,26 +1,20 @@
#lang racket
-(require racket/runtime-path)
(provide (all-defined-out))
-(define-runtime-path viz-output-path "../www/viz/")
-(define-runtime-path web-resource-path "web/")
-
-;; Flag Stuff
+;;; Flags
(define all-flags
#hash([precision . (double fallback)]
- [fn . (cbrt)] ;; TODO: This is a bad way to disable functions: figure out a better one
[setup . (simplify early-exit)]
- [generate . (rr taylor simplify)]
- [reduce . (regimes taylor simplify avg-error post-process binary-search branch-expressions)]
+ [generate . (rr taylor simplify better-rr)]
+ [reduce . (regimes avg-error binary-search branch-expressions)]
[rules . (arithmetic polynomials fractions exponents trigonometry hyperbolic numerics complex special bools branches)]))
(define default-flags
#hash([precision . (double fallback)]
- [fn . (cbrt)]
[setup . (simplify)]
[generate . (rr taylor simplify)]
- [reduce . (regimes taylor simplify avg-error binary-search branch-expressions)]
+ [reduce . (regimes avg-error binary-search branch-expressions)]
[rules . (arithmetic polynomials fractions exponents trigonometry hyperbolic complex special bools branches)]))
(define (enable-flag! category flag)
@@ -47,32 +41,32 @@
[(#t #f) (list 'enabled class flag)]
[(#f #t) (list 'disabled class flag)]))))
+;;; Herbie internal parameters
+
;; Number of points to sample for evaluating program accuracy
(define *num-points* (make-parameter 256))
;; Number of iterations of the core loop for improving program accuracy
(define *num-iterations* (make-parameter 4))
-;; The step size with which arbitrary-precision precision is increased
-;; DANGEROUS TO CHANGE
-(define *precision-step* (make-parameter 256))
+;; The maximum number of consecutive skipped points for sampling valid points
+(define *max-skipped-points* (make-parameter 100))
;; Maximum MPFR precision allowed during exact evaluation
(define *max-mpfr-prec* (make-parameter 10000))
-;; In periodicity analysis,
-;; this is how small the period of a function must be to count as periodic
-(define *max-period-coeff* 20)
+;; The maximum size of an egraph
+(define *node-limit* (make-parameter 5000))
;; In localization, the maximum number of locations returned
(define *localize-expressions-limit* (make-parameter 4))
-(define *binary-search-test-points* (make-parameter 16))
-
;; How accurate to make the binary search
+(define *binary-search-test-points* (make-parameter 16))
(define *binary-search-accuracy* (make-parameter 48))
;;; About Herbie:
+
(define (run-command cmd)
(parameterize ([current-error-port (open-output-nowhere)])
(string-trim (with-output-to-string (λ () (system cmd))))))
@@ -84,7 +78,7 @@
(if (equal? out "") default out))
default))
-(define *herbie-version* "1.2")
+(define *herbie-version* "1.3")
(define *hostname* (run-command "hostname"))
@@ -93,3 +87,23 @@
(define *herbie-branch*
(git-command "rev-parse" "--abbrev-ref" "HEAD" #:default "release"))
+
+;;; The "reset" mechanism for clearing caches and such
+
+(define resetters '())
+
+(define (register-reset fn #:priority [priority 0])
+ (set! resetters (cons (cons priority fn) resetters)))
+
+(define (reset!)
+ (for ([fn-rec (sort resetters < #:key car)]) ((cdr fn-rec))))
+
+;; OBSOLETE
+
+;; The step size with which arbitrary-precision precision is increased
+;; DANGEROUS TO CHANGE
+(define *precision-step* (make-parameter 256))
+
+;; In periodicity analysis,
+;; this is how small the period of a function must be to count as periodic
+(define *max-period-coeff* 20)
diff --git a/src/core/alt-table.rkt b/src/core/alt-table.rkt
index 0e5baa2ac..d30f1700c 100644
--- a/src/core/alt-table.rkt
+++ b/src/core/alt-table.rkt
@@ -18,6 +18,7 @@
. -> . (values alt? alt-table?)))
(atab-completed? (alt-table? . -> . boolean?))
(atab-context (alt-table? . -> . pcontext?))
+ (atab-min-errors (alt-table? . -> . (listof real?)))
(split-atab (alt-table? (non-empty-listof any/c) . -> . (listof alt-table?)))
(atab-new-context (alt-table? pcontext? . -> . alt-table?))))
@@ -32,7 +33,7 @@
(define (make-alt-table context initial-alt)
(alt-table (make-immutable-hash
(for/list ([(pt ex) (in-pcontext context)]
- [err (alt-errors initial-alt)])
+ [err (errors (alt-program initial-alt) context)])
(cons pt (point-rec err (list initial-alt)))))
(hash initial-alt (for/list ([(pt ex) (in-pcontext context)])
pt))
@@ -43,18 +44,22 @@
(let* ([old-done (alt-table-alt->done? atab)]
[alts (atab-all-alts atab)]
[table-init (make-alt-table ctx (car alts))])
- (alt-table-with
- (atab-add-altns table-init (cdr alts))
- #:alt->done? old-done)))
+ (struct-copy alt-table (atab-add-altns table-init (cdr alts))
+ [alt->done? old-done])))
(define (atab-add-altns atab altns)
- (for/fold ([atab atab]) ([altn altns])
+ (define prog-set (map alt-program (hash-keys (alt-table-alt->points atab))))
+ (define altns*
+ (filter
+ (negate (compose (curry set-member? prog-set) alt-program))
+ (remove-duplicates altns #:key alt-program)))
+ (for/fold ([atab atab]) ([altn altns*])
(atab-add-altn atab altn)))
(define (atab-pick-alt atab #:picking-func [pick car]
#:only-fresh [only-fresh? #t])
(let* ([picked (atab-peek-alt atab #:picking-func pick #:only-fresh only-fresh?)]
- [atab* (alt-table-with atab #:alt->done? (hash-set (alt-table-alt->done? atab) picked #t))])
+ [atab* (struct-copy alt-table atab [alt->done? (hash-set (alt-table-alt->done? atab) picked #t)])])
(values picked atab*)))
(define (atab-peek-alt atab #:picking-func [pick car]
@@ -92,16 +97,6 @@
;; Helper Functions
-(define (alt-table-with atab
- #:point->alts [pnt->alts #f]
- #:alt->points [alt->pnts #f]
- #:alt->done? [alt->done? #f]
- #:context [pcontext #f])
- (alt-table (or pnt->alts (alt-table-point->alts atab))
- (or alt->pnts (alt-table-alt->points atab))
- (or alt->done? (alt-table-alt->done? atab))
- (or pcontext (alt-table-context atab))))
-
(define (alternate . lsts)
(let loop ([rest-lsts lsts] [acc '()])
(if (ormap null? rest-lsts)
@@ -119,19 +114,17 @@
(struct point-rec (berr altns) #:prefab)
-(define (best-and-tied-at-points point->alt altn)
- (let-values ([(best tied)
- (for/lists (best tied)
- ([(pnt ex) (in-pcontext (*pcontext*))]
- [err (alt-errors altn)])
- (let* ([pnt-rec (hash-ref point->alt pnt)]
- [table-err (point-rec-berr pnt-rec)])
- (cond [(< err table-err)
- (values pnt #f)]
- [(= err table-err)
- (values #f pnt)]
- [else (values #f #f)])))])
- (list (filter identity best) (filter identity tied))))
+(define (best-and-tied-at-points atab altn errs)
+ (define point->alt (alt-table-point->alts atab))
+ (for/fold ([best '()] [tied '()])
+ ([(pnt ex) (in-pcontext (alt-table-context atab))] [err errs])
+ (define table-err (point-rec-berr (hash-ref point->alt pnt)))
+ (cond
+ [(< err table-err)
+ (values (cons pnt best) tied)]
+ [(= err table-err)
+ (values best (cons pnt tied))]
+ [else (values best tied)])))
(define (remove-chnged-pnts point->alts alt->points chnged-pnts)
(let* ([chnged-entries (map (curry hash-ref point->alts) chnged-pnts)]
@@ -142,10 +135,9 @@
(remove* chnged-pnts (hash-ref alt->points altn)))
chnged-altns))))
-(define (override-at-pnts points->alts pnts altn)
- (let ([pnt->alt-err (make-immutable-hash (for/list ([(pnt ex) (in-pcontext (*pcontext*))]
- [err (alt-errors altn)])
- (cons pnt err)))])
+(define (override-at-pnts points->alts pnts altn errs)
+ (let ([pnt->alt-err (for/hash ([(pnt ex) (in-pcontext (*pcontext*))] [err errs])
+ (values pnt err))])
(hash-set-lsts
points->alts pnts
(map (λ (pnt) (point-rec (hash-ref pnt->alt-err pnt) (list altn)))
@@ -177,7 +169,9 @@
; There must always be a not-done tied alt,
; since before adding any alts there weren't any tied alts
(let ([undone-altns (filter (compose not alts->done?) altns)])
- (argmin (compose length alts->pnts) (if (null? undone-altns) altns undone-altns)))))
+ (argmax
+ alt-cost
+ (argmins (compose length alts->pnts) (if (null? undone-altns) altns undone-altns))))))
(let loop ([cur-atab atab])
(let* ([alts->pnts (alt-table-alt->points cur-atab)]
@@ -206,24 +200,28 @@
(alt-table pnts->alts* alts->pnts* alts->done?* (alt-table-context atab))))
(define (atab-add-altn atab altn)
- (match-let* ([pnts->alts (alt-table-point->alts atab)]
- [alts->pnts (alt-table-alt->points atab)]
- [`(,best-pnts ,tied-pnts) (best-and-tied-at-points pnts->alts altn)])
- (if (null? best-pnts)
- atab
- (let* ([alts->pnts*1 (remove-chnged-pnts pnts->alts alts->pnts best-pnts)]
- [alts->pnts*2 (hash-set alts->pnts*1 altn (append best-pnts tied-pnts))]
- [pnts->alts*1 (override-at-pnts pnts->alts best-pnts altn)]
- [pnts->alts*2 (append-at-pnts pnts->alts*1 tied-pnts altn)]
- [alts->done?* (hash-set (alt-table-alt->done? atab) altn #f)]
- [atab*1 (alt-table pnts->alts*2 alts->pnts*2 alts->done?* (alt-table-context atab))]
- [atab*2 (minimize-alts atab*1)])
- atab*2))))
+ (define errs (errors (alt-program altn) (alt-table-context atab)))
+ (match-define (alt-table point->alts alt->points _ _) atab)
+ (define-values (best-pnts tied-pnts) (best-and-tied-at-points atab altn errs))
+ (cond
+ [(and (null? best-pnts) (null? tied-pnts))
+ atab]
+ [else
+ (define alts->pnts*1 (remove-chnged-pnts point->alts alt->points best-pnts))
+ (define alts->pnts*2 (hash-set alts->pnts*1 altn (append best-pnts tied-pnts)))
+ (define pnts->alts*1 (override-at-pnts point->alts best-pnts altn errs))
+ (define pnts->alts*2 (append-at-pnts pnts->alts*1 tied-pnts altn))
+ (define alts->done?* (hash-set (alt-table-alt->done? atab) altn #f))
+ (minimize-alts (alt-table pnts->alts*2 alts->pnts*2 alts->done?* (alt-table-context atab)))]))
(define (atab-not-done-alts atab)
(filter (negate (curry hash-ref (alt-table-alt->done? atab)))
(hash-keys (alt-table-alt->points atab))))
+(define (atab-min-errors atab)
+ (for/list ([(pt ex) (in-pcontext (alt-table-context atab))])
+ (point-rec-berr (hash-ref (alt-table-point->alts atab) pt))))
+
;; The completeness invariant states that at any time, for every point there exists some
;; alt that is best at it.
(define (check-completeness-invariant atab #:message [message ""])
diff --git a/src/core/egraph.rkt b/src/core/egraph.rkt
index 94c580cb9..f53682904 100644
--- a/src/core/egraph.rkt
+++ b/src/core/egraph.rkt
@@ -1,14 +1,12 @@
#lang racket
-(require "enode.rkt")
-(require "../common.rkt")
-(require "../syntax/syntax.rkt")
+(require "../common.rkt" "../syntax/syntax.rkt" "../syntax/types.rkt" "enode.rkt")
-(provide mk-enode! mk-egraph
+(provide mk-enode! mk-enode-rec! mk-egraph
merge-egraph-nodes!
- egraph? egraph-cnt egraph-top
- map-enodes draw-egraph egraph-leaders
- elim-enode-loops! reduce-to-single! reduce-to-new!
+ egraph? egraph-cnt
+ draw-egraph egraph-leaders
+ elim-enode-loops! reduce-to-single!
)
(provide (all-defined-out)
@@ -24,7 +22,6 @@
;;#
;;# The following things should always be true of egraphs:
;;# 1. (egraph-cnt eg) is a positive integer.
-;;# 2. (egraph-top eg) is a valid enode.
;;# 3. For each enode en which is a key of leader->iexprs, en is the leader of
;;# its own pack.
;;# 4. For every mapping (k, v) in leader->iexprs, for each expression e in v,
@@ -49,7 +46,7 @@
;;################################################################################;;
;; Only ever use leaders as keys!
-(struct egraph (cnt top leader->iexprs expr->parent) #:mutable)
+(struct egraph (cnt leader->iexprs expr->parent) #:mutable)
;; For debugging
(define (check-egraph-valid eg #:loc [location 'check-egraph-valid])
@@ -58,36 +55,34 @@
(assert (not (hash-has-key? leader->iexprs #f)))
;; The egraphs count must be a positive integer
(assert (and (integer? count) (positive? count)) #:loc location)
- ;; The top is a valid enode. (enode validity is verified upon creation).
- (assert (enode? (egraph-top eg)) #:loc location)
+
;; Verify properties 4-6
- (hash-for-each leader->iexprs
- (λ (leader iexprs)
- (assert (eq? leader (pack-leader leader)) #:loc location)
- (assert (set-mutable? iexprs) #:loc location)
- (for ([iexpr iexprs])
- (assert (list? iexpr) #:loc location)
- (assert (for/or ([sub (cdr iexpr)])
- (eq? (pack-leader sub) leader))
- #:loc location)
- (assert (for/and ([sub (cdr iexpr)])
- (eq? (pack-leader sub) sub)))
- (assert (hash-has-key? (egraph-expr->parent eg) (update-en-expr iexpr)) #:loc location))))
+ (for ([(leader iexprs) (in-hash leader->iexprs)])
+ (assert (eq? leader (pack-leader leader)) #:loc location)
+ (assert (set-mutable? iexprs) #:loc location)
+ (for ([iexpr iexprs])
+ (assert (list? iexpr) #:loc location)
+ (assert (for/or ([sub (cdr iexpr)])
+ (eq? (pack-leader sub) leader))
+ #:loc location)
+ (assert (for/and ([sub (cdr iexpr)])
+ (eq? (pack-leader sub) sub)))
+ (assert (hash-has-key? (egraph-expr->parent eg) (update-en-expr iexpr)) #:loc location)))
+
;; Verify property 7
- (hash-for-each (egraph-expr->parent eg)
- (λ (k v)
- ;; This line verifies that we didn't change the definition of hashing
- ;; for some part of this expression without also refreshing the binding.
- (assert (hash-has-key? (egraph-expr->parent eg) k) #:loc location)
-
- (when (list? k)
- (for ([en (cdr k)])
- (assert (eq? en (pack-leader en)) #:loc location)))))
+ (for ([(k v) (in-hash (egraph-expr->parent eg))])
+ ;; This line verifies that we didn't change the definition of hashing
+ ;; for some part of this expression without also refreshing the binding.
+ (assert (hash-has-key? (egraph-expr->parent eg) k) #:loc location)
+ (when (list? k)
+ (for ([en (cdr k)])
+ (assert (eq? en (pack-leader en)) #:loc location))))
+
;; Verify property 8
(let loop ([seen (set)] [rest-leaders (hash-keys leader->iexprs)])
(let ([cur-leader-vars (enode-vars (car rest-leaders))])
(assert (for/and ([var cur-leader-vars])
- (or (number? var) (symbol? var) (list? var))))
+ (or (value? var) (symbol? var) (list? var))))
(assert (set-empty? (set-intersect (set-copy-clear seen) cur-leader-vars)))
(when (not (null? (cdr rest-leaders)))
(loop (set-union cur-leader-vars seen) (cdr rest-leaders)))))))
@@ -97,7 +92,7 @@
;; of the graph to indicate the addition, or if the expression already exists
;; in the egraph it returns the node associated with it. While the node exists
;; after this call, if we are creating a new node it still must be merged into
-;; an existing node or otherwise attached to the (egraph-top eg) node to be
+;; an existing node or otherwise attached to some node to be
;; completely added to the egraph.
(define (mk-enode! eg expr)
(if (hash-has-key? (egraph-expr->parent eg) expr)
@@ -111,7 +106,7 @@
(set-egraph-cnt! eg (add1 (egraph-cnt eg)))
(hash-set! leader->iexprs en (mutable-set))
(when (list? expr*)
- (for ([suben (cdr expr*)])
+ (for ([suben (in-list (cdr expr*))])
(set-add! (hash-ref leader->iexprs (pack-leader suben))
expr*)))
(hash-set! (egraph-expr->parent eg)
@@ -128,22 +123,17 @@
;; Takes a plain mathematical expression, quoted, and returns the egraph
;; representing that expression with no expansion or saturation.
-(define (mk-egraph expr)
- (let ([eg (egraph 0 #f (make-hash) (make-hash))])
- (set-egraph-top! eg (mk-enode-rec! eg expr))
- ;; This is an expensive check, but useful for debuggging.
- #;(check-egraph-valid eg #:loc 'constructing-egraph)
- eg))
-
-;; Maps a given function over all the equivilency classes
-;; of a given egraph (node packs).
-(define (map-enodes f eg)
- (map f (egraph-leaders eg)))
+(define (mk-egraph)
+ (egraph 0 (make-hash) (make-hash)))
;; Gets all the pack leaders in the egraph
(define (egraph-leaders eg)
(hash-keys (egraph-leader->iexprs eg)))
+(define (dedup-vars! en)
+ (update-vars! (pack-leader en) update-en-expr)
+ (dedup-children! en))
+
;; Given an egraph and two enodes present in that egraph, merge the
;; packs of those two nodes, so that those nodes return the same
;; pack-leader and enode-vars. The keys of leader->iexprs and
@@ -151,67 +141,70 @@
;; the leaders of en1 and en2, but the values of those mapping are
;; not.
(define (merge-egraph-nodes! eg en1 en2)
- (let ([leader->iexprs (egraph-leader->iexprs eg)]
- [expr->parent (egraph-expr->parent eg)]
- ;; Operate on the pack leaders in case we were passed a non-leader
- [l1 (pack-leader en1)]
- [l2 (pack-leader en2)])
+ (match-define (egraph _ leader->iexprs expr->parent) eg)
+ ;; Operate on the pack leaders in case we were passed a non-leader
+ (define l1 (pack-leader en1))
+ (define l2 (pack-leader en2))
+
+ (cond
+ [(eq? l1 l2)
;; If the leaders are the same, then these nodes are already part
;; of the same pack. However, this call usually means that two
;; vars of this leader were found equivalent through another
;; merge, so we want to update the vars to remove the redundancy.
- (if (eq? l1 l2) (update-vars! l1 update-en-expr)
- (let*-values (;; Hold on to these vars as they won't be the
- ;; same after the merge, but we don't yet know
- ;; which one we need.
- [(old-vars1) (enode-vars l1)]
- [(old-vars2) (enode-vars l2)]
- ;; Merge the node packs
- [(merged-en) (enode-merge! l1 l2)]
- ;; Now that we know which one became leader, we
- ;; can bind these.
- [(leader follower follower-old-vars)
- (if (eq? l1 merged-en)
- (values l1 l2 old-vars1)
- (values l2 l1 old-vars2))]
- ;; Get the expressions which mention the
- ;; follower so we can see if their new form
- ;; causes new merges.
- [(iexprs) (hash-ref leader->iexprs follower)])
- ;; Once we've merged these enodes, other ones might
- ;; have become equivalent. For example, if we had an
- ;; enode which had the variation (+ x 1), and an
- ;; enode which had the variation (+ y 1), and we
- ;; merged x and y, then we know that these two
- ;; enodes are equivalent, and should be merged.
- (define to-merge
- (for/append ([iexpr iexprs])
- (let* ([replaced-iexpr (update-en-expr iexpr)]
- [other-parent (hash-ref expr->parent replaced-iexpr #f)])
- (if other-parent (list (cons other-parent (hash-ref expr->parent iexpr)))
- '()))))
- ;; Now that we have extracted all the information we
- ;; need from the egraph maps in their current state, we
- ;; are ready to update them. We need to know which one
- ;; is the old leader, and which is the new to easily do
- ;; this, so we branch on which one is eq? to merged-en.
- (update-leader! eg follower-old-vars follower leader)
- ;; Now the state is consistent for this merge, so we can
- ;; tackle the other merges.
- (for ([node-pair to-merge])
- (merge-egraph-nodes! eg (car node-pair) (cdr node-pair)))
- ;; The other merges can have caused new things to merge
- ;; with our merged-en from before (due to loops in the
- ;; egraph), so we turn this into a leader before finally
- ;; returning it.
- (pack-leader merged-en)))))
-
-(define (mutable-set-remove-duplicates st)
- (list->mutable-set (set->list st)))
+ (dedup-vars! l1)]
+ [else
+ ;; Hold on to these vars as they won't be the same after the
+ ;; merge, but we don't yet know which one we need.
+ (define old-vars1 (enode-vars l1))
+ (define old-vars2 (enode-vars l2))
+
+ ;; Merge the node packs
+ (define merged-en (enode-merge! l1 l2))
+
+ ;; Now that we know which one became leader, we can bind these.
+ (define-values (leader follower follower-old-vars)
+ (if (eq? l1 merged-en)
+ (values l1 l2 old-vars2)
+ (values l2 l1 old-vars1)))
+
+ ;; Get the expressions which mention the follower so we can see if
+ ;; their new form causes new merges.
+ (define iexprs (hash-ref leader->iexprs follower))
+
+ ;; Once we've merged these enodes, other ones might have become
+ ;; equivalent. For example, if we had an enode which had the
+ ;; variation (+ x 1), and an enode which had the variation (+ y
+ ;; 1), and we merged x and y, then we know that these two enodes
+ ;; are equivalent, and should be merged.
+ (define to-merge
+ (for/append ([iexpr (in-mutable-set iexprs)])
+ (define replaced-iexpr (update-en-expr iexpr))
+ (define other-parent (hash-ref expr->parent replaced-iexpr #f))
+ (if other-parent
+ (list (cons other-parent (hash-ref expr->parent iexpr)))
+ '())))
+
+ ;; Now that we have extracted all the information we need from the
+ ;; egraph maps in their current state, we are ready to update
+ ;; them. We need to know which one is the old leader, and which is
+ ;; the new to easily do this, so we branch on which one is eq? to
+ ;; merged-en.
+ (update-leader! eg follower-old-vars follower leader)
+
+ ;; Now the state is consistent for this merge, so we can tackle
+ ;; the other merges.
+ (for ([node-pair (in-list to-merge)])
+ (merge-egraph-nodes! eg (car node-pair) (cdr node-pair)))
+
+ ;; The other merges can have caused new things to merge with our
+ ;; merged-en from before (due to loops in the egraph), so we turn
+ ;; this into a leader before finally returning it.
+ (pack-leader merged-en)]))
(define (update-en-expr expr)
(if (list? expr)
- (for/list ([sub expr])
+ (for/list ([sub (in-list expr)])
(if (enode? sub) (pack-leader sub) sub))
expr))
@@ -220,17 +213,17 @@
(let* ([changed-exprs (hash-ref (egraph-leader->iexprs eg) old-leader)])
(set-union! (hash-ref! (egraph-leader->iexprs eg) new-leader (mutable-set))
changed-exprs)
- (for ([ch-expr changed-exprs])
- (for ([suben (cdr ch-expr)])
+ (for ([ch-expr (in-mutable-set changed-exprs)])
+ (for ([suben (in-list (cdr ch-expr))])
(hash-update! (egraph-leader->iexprs eg) (pack-leader suben)
(λ (st)
- (for/mutable-set ([expr st])
+ (for/mutable-set ([expr (in-mutable-set st)])
(update-en-expr expr)))))
(let ([old-binding (hash-ref (egraph-expr->parent eg) ch-expr)])
(hash-remove! (egraph-expr->parent eg) ch-expr)
(hash-set! (egraph-expr->parent eg) (update-en-expr ch-expr) (update-en-expr old-binding))))
(hash-remove! (egraph-leader->iexprs eg) old-leader)
- (for ([variation old-vars])
+ (for ([variation (in-set old-vars)])
(hash-set! (egraph-expr->parent eg)
(update-en-expr variation)
new-leader)))))
@@ -323,10 +316,10 @@
;; If there are any variations of this enode that are a single
;; constant or variable, prune to that.
(define (reduce-to-single! eg en)
- (when (for/or ([var (enode-vars en)])
+ (when (for/or ([var (in-set (enode-vars en))])
(or (constant? var) (variable? var)))
(let* ([leader (pack-leader en)]
- [old-vars (for/mutable-set ([var (enode-vars leader)])
+ [old-vars (for/mutable-set ([var (in-set (enode-vars leader))])
(update-en-expr var))]
[leader* (pack-filter! (λ (inner-en)
(not (list? (enode-expr inner-en))))
@@ -334,48 +327,33 @@
(when (not (eq? leader leader*))
(update-leader! eg old-vars leader leader*)))))
-(define (reduce-to-new! eg en expr)
- (unless true
- (let* ([new-en (mk-enode-rec! eg expr)]
- [vars (enode-vars en)]
- [leader (merge-egraph-nodes! eg en new-en)])
- (hash-update! (egraph-leader->iexprs eg)
- leader
- (λ (st)
- (for/mutable-set ([expr st])
- (update-en-expr expr))))
- (let ([leader* (pack-filter! (λ (inner-en)
- (equal? (enode-expr inner-en) (enode-expr new-en)))
- leader)])
- (update-leader! eg vars leader leader*)))))
-
;; Draws a representation of the egraph to the output file specified
;; in the DOT format.
(define (draw-egraph eg fp)
(with-output-to-file
fp #:exists 'replace
(λ ()
- (displayln "digraph {")
+ (printf "digraph {\n")
(for ([en (egraph-leaders eg)])
- (let ([id (enode-pid en)])
- (printf "node~a[label=\"NODE ~a\"]~n" id id)
- (for ([varen (remove-duplicates (pack-members en) #:key enode-expr)]
- [vid (in-naturals)])
- (let ([var (enode-expr varen)])
- (printf "node~avar~a[label=\"~a\",shape=box,color=blue]~n"
- id vid (if (list? var) (car var) var))
- (printf "node~a -> node~avar~a[style=dashed]~n"
- id id vid)
- (cond
- [(not (list? var)) (void)]
- [(= (length var) 2)
- (printf "node~avar~a -> node~a~n"
- id vid (enode-pid (second var)))]
- [(= (length var) 3)
- (printf "node~avar~a -> node~a[tailport=sw]~n"
- id vid (enode-pid (second var)))
- (printf "node~avar~a -> node~a[tailport=se]~n"
- id vid (enode-pid (third var)))])))))
- (displayln "}")))
- (system (format "dot -Tpng -o ~a.png ~a" fp fp))
- (system (format "feh ~a.png" fp)))
+ (define id (enode-pid en))
+
+ (printf "node~a[label=\"NODE ~a\"]\n" id id)
+ (for ([varen (pack-members en)] [vid (in-naturals)])
+ (define var (enode-expr varen))
+ (printf "node~avar~a[label=\"~a\",shape=box,color=blue]\n"
+ id vid (if (list? var) (car var) var))
+ (printf "node~a -> node~avar~a[style=dashed]\n"
+ id id vid)
+ (when (list? var)
+ (define n (length (cdr var)))
+ (for ([arg (cdr var)] [i (in-naturals)])
+ (printf "node~avar~a -> node~a[tailport=~a]\n"
+ id vid
+ (enode-pid arg)
+ (cond
+ [(= i 0) "sw"]
+ [(= i (- n 1)) "se"]
+ [else "s"])
+ )))))
+ (printf "}\n")))
+ (system (format "dot -Tpng -o ~a.png ~a" fp fp)))
diff --git a/src/core/ematch.rkt b/src/core/ematch.rkt
index 1f6febc26..ce34366b0 100644
--- a/src/core/ematch.rkt
+++ b/src/core/ematch.rkt
@@ -17,13 +17,6 @@
;;#
;;################################################################################;;
-(define (list-cartesian-product . lsts)
- (if (null? lsts)
- '(())
- (let ([tails (apply list-cartesian-product (cdr lsts))])
- (for*/list ([elt (car lsts)] [tail tails])
- (cons elt tail)))))
-
(define (merge . bindings)
;; (list bindings) -> binding
(foldl merge2 '() bindings))
@@ -61,7 +54,7 @@
(= (length var) (length pat)))
(filter identity
(map (curry apply merge)
- (apply list-cartesian-product
+ (apply cartesian-product
(for/list ([subpat (in-list (cdr pat))] [sube (in-list (cdr var))])
(match-e subpat sube)))))
'())))]
diff --git a/src/core/enode.rkt b/src/core/enode.rkt
index 387831905..0c74eed9e 100644
--- a/src/core/enode.rkt
+++ b/src/core/enode.rkt
@@ -1,8 +1,6 @@
#lang racket
-(require "../common.rkt")
-(require "../syntax/syntax.rkt")
-(require "../type-check.rkt")
+(require "../common.rkt" "../syntax/syntax.rkt" "../syntax/types.rkt" "../type-check.rkt" "../float.rkt")
(provide new-enode enode-merge!
enode-vars refresh-vars! enode-pid
@@ -13,6 +11,7 @@
enode-subexpr?
pack-filter! for-pack! pack-removef!
set-enode-expr! update-vars!
+ dedup-children!
)
(provide (all-defined-out))
@@ -69,15 +68,14 @@
(match expr
[(? real?) 'real]
[(? complex?) 'complex]
+ [(? value?) (infer-representation expr)]
[(? constant?) (constant-info expr 'type)]
- [(? variable?) 'real]
+ [(? variable?) 'real] ;; TODO: assumes variable types are real
+ [(list 'if cond ift iff)
+ (enode-type ift)]
[(list op ens ...)
- (define sigs (get-sigs op (length ens)))
- (define argtypes
- (for/list ([en ens])
- (enode-type en)))
- (for/or ([sig sigs])
- (argtypes->rtype argtypes sig))]))
+ ;; Assumes single return type for any function
+ (second (first (first (hash-values (operator-info op 'type)))))]))
(module+ test
(require rackunit)
@@ -87,7 +85,7 @@
(check-equal? (type-of-enode-expr (enode-expr xplusy)) 'real)
(define xc (new-enode '1+2i 1))
(define yc (new-enode '2+3i 2))
- (define xcplusyc (new-enode (list '+ xc yc) 3))
+ (define xcplusyc (new-enode (list '+.c xc yc) 3))
(check-equal? (type-of-enode-expr (enode-expr xcplusyc)) 'complex))
@@ -144,7 +142,7 @@
(let ([filtered-children
(filter
identity
- (for/list ([child (enode-children en)])
+ (for/list ([child (in-list (enode-children en))])
(let ([child* (filter-loop! child)])
(or child*
(begin (set-enode-parent! child en) #f)))))])
@@ -197,7 +195,10 @@
(map enode-cvars (enode-children en))))
en)))
-;; Updates the expressions in the pack, using s specified updater.
+(define (dedup-children! en)
+ (set-enode-children! en (remove-duplicates (enode-children en) #:key enode-expr)))
+
+;; Updates the expressions in the pack, using a specified updater.
(define (update-vars! en updater)
(for-pack! (λ (inner-en)
(set-enode-expr! inner-en (updater (enode-expr inner-en))))
@@ -206,9 +207,9 @@
(define (check-valid-enode en #:loc [location 'check-valid-enode])
;; Checks that the enodes expr field is well formed.
(let ([expr (enode-expr en)])
- (assert (or (number? expr) (symbol? expr)
+ (assert (or (value? expr) (symbol? expr)
(and (list? expr) (symbol? (car expr))
- (ormap enode? (cdr expr)))) #:loc location))
+ (andmap enode? (cdr expr)))) #:loc location))
;; Checks that the depth is positive.
(assert (positive? (enode-depth en)) #:loc location))
diff --git a/src/core/localize.rkt b/src/core/localize.rkt
index 1984a962c..0f03fb4fb 100644
--- a/src/core/localize.rkt
+++ b/src/core/localize.rkt
@@ -1,14 +1,10 @@
#lang racket
-(require math/flonum)
-(require math/bigfloat)
-(require "../common.rkt")
-(require "../points.rkt")
-(require "../float.rkt")
-(require "../programs.rkt")
-(require "../alternative.rkt")
+(require math/flonum math/bigfloat)
+(require "../common.rkt" "../points.rkt" "../float.rkt" "../programs.rkt" "../alternative.rkt")
+(require "../interface.rkt" "../type-check.rkt")
-(provide localize-error *analyze-context*)
+(provide localize-error)
(define (repeat c)
(for/list ([(p e) (in-pcontext (*pcontext*))])
@@ -18,13 +14,18 @@
(define *analyze-context* (make-parameter #f))
(define (localize-on-expression expr vars cache)
+ (define ctx
+ (for/hash ([(var vals) (in-dict vars)])
+ (values var (match (representation-name (infer-representation (first vals)))
+ [(or 'binary32 'binary64) 'real]
+ [x x]))))
(hash-ref! cache expr
(λ ()
(match expr
[(? constant?)
(cons (repeat (->bf expr)) (repeat 1))]
[(? variable?)
- (cons (map ->bf (cdr (assoc expr vars))) (repeat 1))]
+ (cons (map ->bf (dict-ref vars expr)) (repeat 1))]
[`(if ,c ,ift ,iff)
(let ([exact-ift (car (localize-on-expression ift vars cache))]
[exact-iff (car (localize-on-expression iff vars cache))]
@@ -33,16 +34,25 @@
(cons (for/list ([c exact-cond] [t exact-ift] [f exact-iff]) (if c t f))
(repeat 1)))]
[`(,f ,args ...)
- (let* ([argvals
- (flip-lists (map (compose car (curryr localize-on-expression vars cache)) args))]
- [f-exact (operator-info f 'bf)]
- [f-approx (operator-info f 'fl)]
- [exact (map (curry apply f-exact) argvals)]
- [approx (map (compose (curry apply f-approx) (curry map ->flonum)) argvals)]
- [error
- (map (λ (ex ap) (+ 1 (abs (ulp-difference (->flonum ex)
- (->flonum ap))))) exact approx)])
- (cons exact error))]))))
+ (define <-bf (representation-bf->repr (get-representation* (type-of expr ctx))))
+ (define arg<-bfs
+ (for/list ([arg args])
+ (representation-bf->repr (get-representation* (type-of arg ctx)))))
+
+ (define argexacts
+ (flip-lists (map (compose car (curryr localize-on-expression vars cache)) args)))
+ (define argapprox
+ (for/list ([pt argexacts])
+ (for/list ([val pt] [arg<-bf arg<-bfs]) (arg<-bf val))))
+
+ (define exact (map (curry apply (operator-info f 'bf)) argexacts))
+ (define approx (map (curry apply (operator-info f 'fl)) argapprox))
+ (cons exact (map (λ (ex ap) (+ 1 (abs (ulp-difference (<-bf ex) ap)))) exact approx))]))))
+
+(register-reset
+ (λ ()
+ (*analyze-context* (*pcontext*))
+ (hash-clear! *analyze-cache*)))
(define (localize-error prog)
(define varmap (map cons (program-variables prog)
@@ -64,7 +74,6 @@
(when (ormap (curry < 1) err)
(for-each (compose sow (curry cons err)) locs)))))
- (map cdr
- (take-up-to
- (sort locs > #:key (compose errors-score car))
- (*localize-expressions-limit*))))
+ (take-up-to
+ (sort locs > #:key (compose errors-score car))
+ (*localize-expressions-limit*)))
diff --git a/src/core/matcher.rkt b/src/core/matcher.rkt
index 28e619c4d..2b6877c12 100644
--- a/src/core/matcher.rkt
+++ b/src/core/matcher.rkt
@@ -1,86 +1,58 @@
#lang racket
-(require "../common.rkt")
-(require "../programs.rkt")
-(require "../syntax/rules.rkt")
-(require "../type-check.rkt")
+(require "../common.rkt" "../timeline.rkt" "../programs.rkt")
+(require "../syntax/rules.rkt" "../type-check.rkt")
(provide
(all-from-out "../syntax/rules.rkt")
- pattern-substitute pattern-match
+ pattern-match
rewrite-expression-head rewrite-expression
- (struct-out change) change-apply changes-apply rule-rewrite)
-
-;; Our own pattern matcher.
-;
-; The racket (match) macro doesn't give us access to the bindings made
-; by the matcher, so we wrote our own.
-;
-; The syntax is simple:
-; numbers are literals ; symbols are variables ; lists are expressions
-;
-; Bindings are stored as association lists
-
-(define (merge-bindings . bindings)
- ; (list bindings) -> binding
- (foldl merge-2-bindings '() bindings))
-
-(define (merge-2-bindings binding1 binding2)
+ (struct-out change) change-apply rule-rewrite)
+
+;;; Our own pattern matcher.
+;;
+;; The racket (match) macro doesn't give us access to the bindings made
+;; by the matcher, so we wrote our own.
+;;
+;; The syntax is simple:
+;; numbers are literals ; symbols are variables ; lists are expressions
+;;
+;; Bindings are stored as association lists
+
+(define (merge-bindings binding1 binding2)
(define (fail . irr) #f)
-
- ; binding binding -> binding
- (if (and binding1 binding2)
- (let loop ([acc binding1] [rest binding2])
- (if (null? rest)
- acc
- (let* ([curr (car rest)]
- [lookup (assoc (car curr) acc)])
- (if lookup
- (if (equal? (cdr lookup) (cdr curr))
- (loop acc (cdr rest))
- (fail "pattern-match: Variable has two different bindings"
- (car curr) (cdr lookup) (cdr curr)))
- (loop (cons curr acc) (cdr rest))))))
- #f))
-
-; The matcher itself
+ (and binding1
+ binding2
+ (let/ec quit
+ (for/fold ([binding binding1]) ([(k v) (in-dict binding2)])
+ (dict-update binding k (λ (x) (if (equal? x v) v (quit #f))) v)))))
(define (pattern-match pattern expr)
- ; pattern expr -> bindings
-
(define (fail . irr) #f)
- (cond
- [(constant? pattern)
- (if (and (constant? expr) (equal? pattern expr))
- '()
- (fail "pattern-match: Literals do not match"
- pattern expr))]
- [(variable? pattern)
+ (match pattern
+ [(? constant?)
+ (and (equal? pattern expr) '())]
+ [(? variable?)
(list (cons pattern expr))]
- ; TODO : test for allowed operators
- [(list? pattern)
- (if (and (list? expr) (eq? (car expr) (car pattern))
- (= (length expr) (length pattern)))
- (apply merge-bindings
- (for/list ([pat (cdr pattern)] [subterm (cdr expr)])
- (pattern-match pat subterm)))
- (fail "pattern-match: Not a list, or wrong length, or wrong operator."
- "Don't ask me, I don't know!"
- pattern expr))]
- [#t (fail "pattern-match: Confused by pattern term" pattern)]))
+ [(list phead _ ...)
+ (and (list? expr)
+ (equal? (car expr) phead)
+ (= (length expr) (length pattern))
+ (for/fold ([bindings '()])
+ ([pat (cdr pattern)] [subterm (cdr expr)])
+ (merge-bindings bindings (pattern-match pat subterm))))]))
(define (pattern-substitute pattern bindings)
; pattern binding -> expr
- (cond
- [(constant? pattern) pattern]
- [(variable? pattern)
- (cdr (assoc pattern bindings))]
- [(list? pattern)
- (cons (car pattern)
- (for/list ([pat (cdr pattern)])
- (pattern-substitute pat bindings)))]
- [#t (error "pattern-substitute: Confused by pattern term" pattern)]))
+ (match pattern
+ [(? constant?) pattern]
+ [(? variable?)
+ (dict-ref bindings pattern)]
+ [(list phead pargs ...)
+ (cons phead (map (curryr pattern-substitute bindings) pargs))]))
+
+;; Random helper functions
(define (rule-apply rule expr)
(let ([bindings (pattern-match (rule-input rule) expr)])
@@ -95,115 +67,81 @@
[(cons out bindings) out]
[#f (return #f)])))))
-(define (rule-apply-force-destructs rule expr)
- (and (not (symbol? (rule-input rule))) (rule-apply rule expr)))
-
-(struct change (rule location bindings) #:transparent
- #:methods gen:custom-write
- [(define (write-proc cng port mode)
- (display "#" port))])
+(define (change-apply cng prog)
+ (match-define (change rule location bindings) cng)
+ (location-do location prog (const (pattern-substitute (rule-output rule) bindings))))
+
+(struct change (rule location bindings) #:transparent)
+
+;; The rewriter
(define (rewrite-expression expr #:destruct [destruct? #f] #:root [root-loc '()])
(define env (for/hash ([v (free-variables expr)]) (values v 'real)))
+ (define type (type-of expr env))
(reap [sow]
- ; TODO: don't recompute the type of every expression
- (for ([rule (if (equal? 'complex (type-of expr env)) (*complex-rules*) (*rules*))])
- (let* ([applyer (if destruct? rule-apply-force-destructs rule-apply)]
- [result (applyer rule expr)])
+ (for ([rule (*rules*)] #:when (equal? type (rule-otype rule)))
+ (let* ([result (rule-apply rule expr)])
(when result
- (sow (change rule root-loc (cdr result))))))))
+ (sow (list (change rule root-loc (cdr result)))))))))
(define (rewrite-expression-head expr #:root [root-loc '()] #:depth [depth 1])
-
(define env (for/hash ([v (free-variables expr)]) (values v 'real)))
- (define (rewriter expr ghead glen loc cdepth)
+ (define type (type-of expr env))
+ (define (rewriter sow expr ghead glen loc cdepth)
; expr _ _ _ _ -> (list (list change))
- (reap (sow)
- (for ([rule (if (equal? 'complex (type-of expr env)) (*complex-rules*) (*rules*))])
- (when (or
- (not ghead) ; Any results work for me
- (and
- (list? (rule-output rule))
- (= (length (rule-output rule)) glen)
- (eq? (car (rule-output rule)) ghead)))
- (let ([options (matcher expr (rule-input rule) loc (- cdepth 1))])
- (for ([option options])
- ; Each option is a list of change lists
- (sow (cons (change rule (reverse loc) (cdr option))
- (car option)))))))))
-
- (define (reduce-children options)
+ (for ([rule (*rules*)] #:when (equal? type (rule-otype rule)))
+ (when (or
+ (not ghead) ; Any results work for me
+ (and
+ (list? (rule-output rule))
+ (= (length (rule-output rule)) glen)
+ (eq? (car (rule-output rule)) ghead)))
+ (for ([option (matcher expr (rule-input rule) loc (- cdepth 1))])
+ ;; Each option is a list of change lists
+ (sow (cons (change rule (reverse loc) (cdr option)) (car option)))))))
+
+ (define (reduce-children sow options)
; (list (list ((list change) * bindings)))
; -> (list ((list change) * bindings))
- (reap (sow)
- (for ([children options])
- (let ([bindings* (apply merge-bindings (map cdr children))])
- (when bindings*
- (sow (cons (apply append (map car children)) bindings*)))))))
-
- (define (fix-up-variables pattern options)
- ; pattern (list (list change)) -> (list (list change) * pattern)
- (reap (sow)
- (for ([cngs options])
- (let* ([out-pattern (rule-output (change-rule (car cngs)))]
- [result (pattern-substitute out-pattern
- (change-bindings (car cngs)))]
- [bindings* (pattern-match pattern result)])
- (when bindings*
- (sow (cons cngs bindings*)))))))
+ (for ([children options])
+ (let ([bindings* (foldl merge-bindings '() (map cdr children))])
+ (when bindings*
+ (sow (cons (apply append (map car children)) bindings*))))))
+
+ (define (fix-up-variables sow pattern cngs)
+ ; pattern (list change) -> (list change) * bindings
+ (match-define (change rule loc bindings) (car cngs))
+ (define result (pattern-substitute (rule-output rule) bindings))
+ (define bindings* (pattern-match pattern result))
+ (when bindings* (sow (cons cngs bindings*))))
(define (matcher expr pattern loc cdepth)
; expr pattern _ -> (list ((list change) * bindings))
- (cond
- [(variable? pattern)
- ; Do nothing, bind variable
- (list (cons '() (list (cons pattern expr))))]
- [(constant? pattern)
- (if (and (constant? expr) (equal? expr pattern))
- '((()) . ()) ; Do nothing, bind nothing
- '())] ; No options
- [(and (list? expr) (list? pattern))
- (if (and (eq? (car pattern) (car expr))
- (= (length pattern) (length expr)))
- ; Everything is terrible
- (reduce-children
- (apply cartesian-product ; (list (list ((list cng) * bnd)))
- (for/list ([i (in-naturals)] [sube expr] [subp pattern]
- #:when (> i 0)) ; (list (list ((list cng) * bnd)))
- ;; Note: we reset the fuel to "depth", not "cdepth"
- (matcher sube subp (cons i loc) depth)))) ; list (expr * pattern)
- (if (> cdepth 0)
- ; Sort of a brute force approach to getting the bindings
- (fix-up-variables
- pattern
- (rewriter expr (car pattern) (length pattern) loc (- cdepth 1)))
- '()))]
- [(and (list? pattern) (not (list? expr)))
- '()]
- [else
- (error "Unknown pattern" pattern)]))
-
- ; The #f #f mean that any output result works. It's a bit of a hack
- (rewriter expr #f #f (reverse root-loc) depth))
-
-(define (change-apply cng prog)
- (let ([loc (change-location cng)]
- [template (rule-output (change-rule cng))]
- [bnd (change-bindings cng)])
- (location-do loc prog (λ (expr) (pattern-substitute template bnd)))))
-
-(define (changes-apply chngs prog)
- (for/fold ([prog prog]) ([chng chngs])
- (change-apply chng prog)))
+ (reap [sow]
+ (match pattern
+ [(? variable?)
+ (sow (cons '() (list (cons pattern expr))))]
+ [(? constant?)
+ (when (equal? expr pattern)
+ (sow (cons '() '())))]
+ [(list phead _ ...)
+ (when (and (list? expr) (equal? phead (car expr))
+ (= (length pattern) (length expr)))
+ (let/ec k ;; We have an option to early exit if a child pattern cannot be matched
+ (define child-options ; (list (list ((list cng) * bnd)))
+ (for/list ([i (in-naturals)] [sube expr] [subp pattern] #:when (> i 0))
+ ;; Note: fuel is "depth" not "cdepth", because we're recursing to a child
+ (define options (matcher sube subp (cons i loc) depth))
+ (when (null? options) (k)) ;; Early exit
+ options))
+ (reduce-children sow (apply cartesian-product child-options))))
+
+ (when (and (> cdepth 0)
+ (or (flag-set? 'generate 'better-rr)
+ (not (and (list? expr) (equal? phead (car expr)) (= (length pattern) (length expr))))))
+ ;; Sort of a brute force approach to getting the bindings
+ (rewriter (curry fix-up-variables sow pattern)
+ expr (car pattern) (length pattern) loc (- cdepth 1)))])))
+
+ ;; The "#f #f" means that any output result works. It's a bit of a hack
+ (reap [sow] (rewriter (compose sow reverse) expr #f #f (reverse root-loc) depth)))
diff --git a/src/core/periodicity.rkt b/src/core/periodicity.rkt
index 5e9c761fb..d2bef6979 100644
--- a/src/core/periodicity.rkt
+++ b/src/core/periodicity.rkt
@@ -61,7 +61,7 @@
[special special]
[(andmap constant-value? (cdr expr))
(annotation expr loc 'constant
- (common-eval (cons (car expr) (map coeffs (cdr expr)))))]
+ (eval-const-expr (cons (car expr) (map coeffs (cdr expr)))))]
[(and (andmap periodic? (cdr expr)) (= 3 (length expr)))
(annotation expr loc 'interesting
(apply alist-merge lcm
@@ -184,9 +184,10 @@
(if (or (> (apply max (map cdr (lp-periods ploc))) *max-period-coeff*))
altn
(let ([context
- (prepare-points-period
+ (prepare-points
program
- (map (compose (curry * 2 pi) cdr) (lp-periods ploc)))])
+ `(and ,@(for/list ([(var period) (lp-periods ploc)])
+ `(<= 0 ,var ,(* 2 pi var)))))])
(parameterize ([*pcontext* context])
(improve-func (make-alt program)))))))
plocs)]
@@ -199,19 +200,23 @@
(location-do (lp-loc ploc) prog (const oexpr)))])
(debug #:from 'periodicity "Periodicity result: " final-prog)
(if (not (null? oalts))
- (alt-event final-prog 'periodicity (cons altn oalts))
+ (alt final-prog 'periodicity (cons altn oalts))
altn)))
(define (symbol-mod v periods)
- (if (assoc v periods)
- (let ([coeff (cdr (assoc v periods))])
+ (if (dict-has-key? periods v)
+ (let ([coeff (dict-ref periods v)])
`(mod ,v ,(if (= 1/2 coeff) 'PI `(* ,(* 2 coeff) PI))))
v))
+(define (replace-vars vars expr periods)
+ (for/fold ([expr expr]) ([var vars])
+ (replace-expression expr var (symbol-mod var periods))))
+
(define (coerce-conditions prog periods)
(let loop ([cur-body (program-body prog)])
(match cur-body
[`(if ,cond ,a ,b)
- `(if ,(replace-leaves cond #:variable (curryr symbol-mod periods))
+ `(if ,(replace-vars (program-variables prog) cond periods)
,(loop a) ,(loop b))]
[_ cur-body])))
diff --git a/src/core/reduce.rkt b/src/core/reduce.rkt
index 8e3c27559..8d414ff1b 100755
--- a/src/core/reduce.rkt
+++ b/src/core/reduce.rkt
@@ -38,9 +38,7 @@
[`(lambda ,vars ,body)
`(λ ,vars ,(simplify* body))]
[(? (compose null? free-variables) `(,op ,args ...))
- (let ([value
- (with-handlers ([(const #t) (const #f)])
- (common-eval expr))])
+ (let ([value (with-handlers ([(const #t) (const #f)]) (eval-const-expr expr))])
(if (and (number? value) (real? value) (exact? value))
value
(simplify-node `(,op ,@(map simplify* args)))))]
@@ -53,7 +51,7 @@
[(? variable?) expr]
[(or `(+ ,_ ...) `(- ,_ ...))
(make-addition-node (combine-aterms (gather-additive-terms expr)))]
- [(or `(* ,_ ...) `(/ ,_ ...) `(sqr ,_) `(sqrt ,_))
+ [(or `(* ,_ ...) `(/ ,_ ...) `(sqrt ,_) `(cbrt ,_))
(make-multiplication-node (combine-mterms (gather-multiplicative-terms expr)))]
[`(exp (* ,c (log ,x)))
`(pow ,x ,c)]
@@ -100,8 +98,6 @@
(list* (car term) (simplify-node (list* '/ (cadr term) args)) (cons label (cddr term)))))
`((1 ,expr)))]
- [`(sqr ,arg)
- (recurse `(* ,arg ,arg) #:label expr)]
[`(pow ,arg ,(? integer? n))
(cond
[(positive? n)
@@ -132,11 +128,6 @@
(cons (if (ormap (compose (curry = 0) car) dens) +nan.0 (apply / (car num) (map car dens)))
(append (cdr num)
(map negate-term (append-map cdr dens)))))]
- [`(sqr ,arg)
- (let ([terms (gather-multiplicative-terms arg)])
- (cons (sqr (car terms))
- (for/list ([term (cdr terms)])
- (cons (* 2 (car term)) (cdr term)))))]
[`(sqrt ,arg)
(let ([terms (gather-multiplicative-terms arg)])
(cond
@@ -151,6 +142,19 @@
(cons 1 `(sqrt ,(car terms)))
(for/list ([term (cdr terms)])
(cons (/ (car term) 2) (cdr term))))]))]
+ [`(cbrt ,arg)
+ (let ([terms (gather-multiplicative-terms arg)])
+ (define head-cbrt (expt (car terms) 1/3))
+ (cond
+ [(equal? (expt (inexact->exact head-cbrt) 3) (car terms))
+ (cons head-cbrt
+ (for/list ([term (cdr terms)])
+ (cons (/ (car term) 3) (cdr term))))]
+ [else
+ (list* 1
+ (cons 1 `(cbrt ,(car terms)))
+ (for/list ([term (cdr terms)])
+ (cons (/ (car term) 3) (cdr term))))]))]
[`(pow ,arg ,(? real? a))
(let ([terms (gather-multiplicative-terms arg)])
(cond
diff --git a/src/core/regimes.rkt b/src/core/regimes.rkt
index 72ec96bae..da45cea1b 100644
--- a/src/core/regimes.rkt
+++ b/src/core/regimes.rkt
@@ -1,53 +1,70 @@
#lang racket
-(require "../common.rkt")
-(require "../config.rkt")
-(require "../alternative.rkt")
-(require "../programs.rkt")
-(require "../points.rkt")
-(require "../float.rkt")
-(require "../syntax/syntax.rkt")
-(require "matcher.rkt")
-(require "localize.rkt")
-(require "../type-check.rkt")
+(require "../common.rkt" "../alternative.rkt" "../programs.rkt" "../timeline.rkt")
+(require "../type-check.rkt" "../syntax/types.rkt")
+(require "../points.rkt" "../float.rkt") ; For binary search
+(require (submod "../timeline.rkt" debug))
(module+ test
(require rackunit))
-(provide infer-splitpoints (struct-out sp) splitpoints->point-preds)
+(provide infer-splitpoints (struct-out sp) splitpoints->point-preds combine-alts)
-(define (infer-splitpoints alts [axis #f])
- (match alts
- [(list alt)
- (list (list (sp 0 0 +nan.0)) (list alt))]
- [_
- (debug "Finding splitpoints for:" alts #:from 'regime-changes #:depth 2)
- (define options
- (map (curry option-on-expr alts)
- (if axis (list axis) (exprs-to-branch-on alts))))
- (define best-option (argmin (compose errors-score option-errors) options))
- (define splitpoints (option-splitpoints best-option))
- (define altns (used-alts splitpoints alts))
- (define splitpoints* (coerce-indices splitpoints))
- (debug #:from 'regimes "Found splitpoints:" splitpoints* ", with alts" altns)
- (list splitpoints* altns)]))
-
-(struct option (splitpoints errors) #:transparent
+(struct option (split-indices alts pts expr errors) #:transparent
#:methods gen:custom-write
[(define (write-proc opt port mode)
(display "#" port))])
+;; Struct representing a splitpoint
+;; cidx = Candidate index: the index of the candidate program that should be used to the left of this splitpoint
+;; bexpr = Branch Expression: The expression that this splitpoint should split on
+;; point = Split Point: The point at which we should split.
+(struct sp (cidx bexpr point) #:prefab)
+
+;; Struct representing a splitindex
+;; cidx = Candidate index: the index candidate program that should be used to the left of this splitindex
+;; pidx = Point index: The index of the point to the left of which we should split.
+(struct si (cidx pidx) #:prefab)
+
+;; `infer-splitpoints` and `combine-alts` are split so the mainloop
+;; can insert a timeline break between them.
+
+(define (infer-splitpoints alts)
+ (debug "Finding splitpoints for:" alts #:from 'regime #:depth 2)
+ (define branch-exprs
+ (if (flag-set? 'reduce 'branch-expressions)
+ (exprs-to-branch-on alts)
+ (program-variables (*start-prog*))))
+ (debug "Trying" (length branch-exprs) "branch expressions:" branch-exprs
+ #:from 'regime-changes #:depth 3)
+ (define options
+ ;; We can only combine alts for which the branch expression is
+ ;; critical, to enable binary search.
+ (reap [sow]
+ (for ([bexpr branch-exprs])
+ (define unsound-option (option-on-expr alts bexpr))
+ (sow unsound-option)
+ (define sound-alts (filter (λ (alt) (critical-subexpression? (program-body (alt-program alt)) bexpr)) alts))
+ (when (and (> (length sound-alts) 1)
+ (for/or ([si (option-split-indices unsound-option)])
+ (not (set-member? sound-alts (list-ref alts (si-cidx si))))))
+ (sow (option-on-expr sound-alts bexpr))))))
+ (define best (argmin (compose errors-score option-errors) options))
+ (debug "Found split indices:" best #:from 'regime #:depth 3)
+ best)
+
(define (exprs-to-branch-on alts)
- (if (flag-set? 'reduce 'branch-expressions)
- (let ([alt-critexprs (for/list ([alt alts])
- (all-critical-subexpressions (alt-program alt)))]
- [critexprs (all-critical-subexpressions (*start-prog*))])
- (remove-duplicates (foldr append '() (cons critexprs alt-critexprs))))
- (program-variables (*start-prog*))))
-
-;; Requires that expr is a λ expression
+ (define alt-critexprs (map (compose all-critical-subexpressions alt-program) alts))
+ (define start-critexprs (all-critical-subexpressions (*start-prog*)))
+ ;; We can only binary search if the branch expression is critical
+ ;; for all of the alts and also for the start prgoram.
+ (filter
+ (λ (e) (equal? (type-of e (for/list ([v (program-variables (*start-prog*))]) (cons v 'real))) 'real))
+ (set-intersect start-critexprs (apply set-union alt-critexprs))))
+
+;; Requires that expr is not a λ expression
(define (critical-subexpression? expr subexpr)
(define crit-vars (free-variables subexpr))
(define replaced-expr (replace-expression expr subexpr 1))
@@ -58,47 +75,74 @@
(define (all-critical-subexpressions prog)
(define (subexprs-in-expr expr)
(cons expr (if (list? expr) (append-map subexprs-in-expr (cdr expr)) '())))
- (define prog-body (location-get (list 2) prog))
- (for/list ([expr (remove-duplicates (subexprs-in-expr prog-body))]
+ (define prog-body (program-body prog))
+ ;; We append program-variables here in case of (λ (x y) 0) or
+ ;; similar, where the variables do not appear in the body but are
+ ;; still worth splitting on
+ (for/list ([expr (remove-duplicates (append (program-variables prog)
+ (subexprs-in-expr prog-body)))]
#:when (and (not (null? (free-variables expr)))
(critical-subexpression? prog-body expr)))
expr))
-(define (used-alts splitpoints all-alts)
- (let ([used-indices (remove-duplicates (map sp-cidx splitpoints))])
- (map (curry list-ref all-alts) used-indices)))
-
-;; Takes a list of splitpoints, `splitpoints`, whose indices originally referred to some list of alts `alts`,
-;; and changes their indices so that they are consecutive starting from zero, but all indicies that
-;; previously matched still match.
-(define (coerce-indices splitpoints)
- (let* ([used-indices (remove-duplicates (map sp-cidx splitpoints))]
- [mappings (map cons used-indices (range (length used-indices)))])
- (map (λ (splitpoint)
- (sp (cdr (assoc (sp-cidx splitpoint) mappings))
- (sp-bexpr splitpoint)
- (sp-point splitpoint)))
- splitpoints)))
+(define (combine-alts best-option precision)
+ (match-define (option splitindices alts pts expr _) best-option)
+ (match splitindices
+ [(list (si cidx _)) (list-ref alts cidx)]
+ [_
+ (define splitpoints (sindices->spoints pts expr alts splitindices precision))
+ (debug #:from 'regimes "Found splitpoints:" splitpoints ", with alts" alts)
+
+ (define expr*
+ (for/fold
+ ([expr (program-body (alt-program (list-ref alts (sp-cidx (last splitpoints)))))])
+ ([splitpoint (cdr (reverse splitpoints))])
+ `(if ,(mk-<= precision (sp-bexpr splitpoint) (sp-point splitpoint))
+ ,(program-body (alt-program (list-ref alts (sp-cidx splitpoint))))
+ ,expr)))
+
+ ;; We don't want unused alts in our history!
+ (define-values (alts* splitpoints*) (remove-unused-alts alts splitpoints))
+ (alt `(λ ,(program-variables (*start-prog*)) ,expr*)
+ (list 'regimes splitpoints*) alts*)]))
+
+(define (remove-unused-alts alts splitpoints)
+ (for/fold ([alts* '()] [splitpoints* '()]) ([splitpoint splitpoints])
+ (define alt (list-ref alts (sp-cidx splitpoint)))
+ ;; It's important to snoc the alt in order for the indices not to change
+ (define alts** (remove-duplicates (append alts* (list alt))))
+ (define splitpoint* (struct-copy sp splitpoint [cidx (index-of alts** alt)]))
+ (define splitpoints** (append splitpoints* (list splitpoint*)))
+ (values alts** splitpoints**)))
+
+(define (sort-context-on-expr context expr variables)
+ (let ([p&e (sort (for/list ([(pt ex) (in-pcontext context)]) (cons pt ex))
+ bits) err-lsts))
- (define merged-err-lsts (map (curry merge-err-lsts pts) bit-err-lsts))
- (define split-indices (err-lsts->split-indices merged-err-lsts can-split?))
+ (define split-indices (err-lsts->split-indices bit-err-lsts can-split?))
(for ([pidx (map si-pidx (drop-right split-indices 1))])
(assert (> pidx 0))
(assert (list-ref can-split? pidx)))
- (define split-points (sindices->spoints pts expr alts split-indices))
+ (assert (= (si-pidx (last split-indices)) (length pts)))
+ (option split-indices alts pts expr (pick-errors split-indices pts err-lsts)))
- (assert (set=? (remove-duplicates (map (point->alt split-points) pts))
- (map sp-cidx split-points)))
-
- (option split-points (pick-errors split-points pts err-lsts)))
+(define/contract (pick-errors split-indices pts err-lsts)
+ (-> (listof si?) (listof (listof value?)) (listof (listof value?))
+ (listof nonnegative-integer?))
+ (for/list ([i (in-naturals)] [pt pts] [errs (flip-lists err-lsts)])
+ (for/first ([si split-indices] #:when (< i (si-pidx si)))
+ (list-ref errs (si-cidx si)))))
(module+ test
(parameterize ([*start-prog* '(λ (x) 1)]
@@ -106,129 +150,100 @@
(define alts (map (λ (body) (make-alt `(λ (x) ,body))) (list '(fmin x 1) '(fmax x 1))))
;; This is a basic sanity test
- (check (λ (x y) (equal? (map sp-cidx (option-splitpoints x)) y))
+ (check (λ (x y) (equal? (map si-cidx (option-split-indices x)) y))
(option-on-expr alts 'x)
'(1 0))
;; This test ensures we handle equal points correctly. All points
;; are equal along the `1` axis, so we should only get one
;; splitpoint (the second, since it is better at the further point).
- (check (λ (x y) (equal? (map sp-cidx (option-splitpoints x)) y))
+ (check (λ (x y) (equal? (map si-cidx (option-split-indices x)) y))
(option-on-expr alts '1)
'(0))
- (check (λ (x y) (equal? (map sp-cidx (option-splitpoints x)) y))
+ (check (λ (x y) (equal? (map si-cidx (option-split-indices x)) y))
(option-on-expr alts '(if (== x 0.5) 1 +nan.0))
'(0))))
;; (pred p1) and (not (pred p2))
(define (binary-search-floats pred p1 p2)
- (let ([midpoint (midpoint-float p1 p2)])
+ (let ([midpoint (midpoint p1 p2)])
(cond [(< (bit-difference p1 p2) 48) midpoint]
[(pred midpoint) (binary-search-floats pred midpoint p2)]
[else (binary-search-floats pred p1 midpoint)])))
+(define (extract-subexpression program expr)
+ (define var (gensym 'branch))
+ (define body* (replace-expression (program-body program) expr var))
+ (define vars* (set-subtract (program-variables program) (free-variables expr)))
+ (if (subset? (free-variables body*) (cons var vars*))
+ `(λ (,var ,@vars*) ,body*)
+ #f))
+
;; Accepts a list of sindices in one indexed form and returns the
;; proper splitpoints in float form. A crucial constraint is that the
;; float form always come from the range [f(idx1), f(idx2)). If the
;; float form of a split is f(idx2), or entirely outside that range,
;; problems may arise.
-(define (sindices->spoints points expr alts sindices)
- (for ([alt alts])
- (assert
- (set-empty? (set-intersect (free-variables expr)
- (free-variables (replace-expression (alt-program alt) expr 0))))
- #:extra-info (cons expr alt)))
-
+(define (sindices->spoints points expr alts sindices precision)
(define eval-expr
(eval-prog `(λ ,(program-variables (alt-program (car alts))) ,expr) 'fl))
+ (define progs (map (compose (curryr extract-subexpression expr) alt-program) alts))
+ (define start-prog (extract-subexpression (*start-prog*) expr))
+
+ (define (find-split prog1 prog2 v1 v2)
+ (define iters 0)
+ (define (pred v)
+ (set! iters (+ 1 iters))
+ (define ctx
+ (parameterize ([*num-points* (*binary-search-test-points*)]
+ [*timeline-disabled* true])
+ (prepare-points start-prog `(== ,(caadr start-prog) ,v) precision)))
+ (< (errors-score (errors prog1 ctx)) (errors-score (errors prog2 ctx))))
+ (define pt (binary-search-floats pred v1 v2))
+ (timeline-push! 'bstep v1 v2 iters pt)
+ pt)
+
(define (sidx->spoint sidx next-sidx)
- (let* ([alt1 (list-ref alts (si-cidx sidx))]
- [alt2 (list-ref alts (si-cidx next-sidx))]
- [p1 (eval-expr (list-ref points (si-pidx sidx)))]
- [p2 (eval-expr (list-ref points (sub1 (si-pidx sidx))))]
- [pred (λ (v)
- (let* ([start-prog* (replace-expression (*start-prog*) expr v)]
- [prog1* (replace-expression (alt-program alt1) expr v)]
- [prog2* (replace-expression (alt-program alt2) expr v)]
- [context
- (parameterize ([*num-points* (*binary-search-test-points*)])
- (prepare-points start-prog* 'TRUE))])
- (< (errors-score (errors prog1* context))
- (errors-score (errors prog2* context)))))])
- (debug #:from 'regimes "searching between" p1 "and" p2 "on" expr)
- (sp (si-cidx sidx) expr (binary-search-floats pred p2 p1))))
+ (define prog1 (list-ref progs (si-cidx sidx)))
+ (define prog2 (list-ref progs (si-cidx next-sidx)))
+
+ (define p1 (eval-expr (list-ref points (sub1 (si-pidx sidx)))))
+ (define p2 (eval-expr (list-ref points (si-pidx sidx))))
+
+ (sp (si-cidx sidx) expr (find-split prog1 prog2 p1 p2)))
+
+ (define final-sp (sp (si-cidx (last sindices)) expr +nan.0))
(append
- (if (flag-set? 'reduce 'binary-search)
- (map sidx->spoint
- (take sindices (sub1 (length sindices)))
- (drop sindices 1))
- (for/list ([sindex (take sindices (sub1 (length sindices)))])
- (sp (si-cidx sindex) expr (eval-expr (list-ref points (- (si-pidx sindex) 1))))))
- (list (let ([last-sidx (list-ref sindices (sub1 (length sindices)))])
- (sp (si-cidx last-sidx)
- expr
- +nan.0)))))
-
-(define (merge-err-lsts pts errs)
- (let loop ([pt (car pts)] [pts (cdr pts)] [err (car errs)] [errs (cdr errs)])
- (if (null? pts)
- (list err)
- (if (equal? pt (car pts))
- (loop pt (cdr pts) (+ err (car errs)) (cdr errs))
- (cons err (loop (car pts) (cdr pts) (car errs) (cdr errs)))))))
+ (if (and (flag-set? 'reduce 'binary-search)
+ ;; Binary search is only valid if we correctly extracted the branch expression
+ (andmap identity (cons start-prog progs)))
+ (begin
+ (debug #:from 'binary-search "Improving bounds with binary search for" expr "and" alts)
+ (for/list ([si1 sindices] [si2 (cdr sindices)])
+ (sidx->spoint si1 si2)))
+ (begin
+ (debug #:from 'binary-search "Only using regimes for bounds on" expr "and" alts)
+ (for/list ([sindex (take sindices (sub1 (length sindices)))])
+ (sp (si-cidx sindex) expr (eval-expr (list-ref points (- (si-pidx sindex) 1)))))))
+ (list final-sp)))
(define (point-with-dim index point val)
(map (λ (pval pindex) (if (= pindex index) val pval))
point
(range (length point))))
-(define (point->alt splitpoints)
- (assert (all-equal? (map sp-bexpr splitpoints)))
- (assert (nan? (sp-point (last splitpoints))))
- (define expr `(λ ,(program-variables (*start-prog*)) ,(sp-bexpr (car splitpoints))))
- (define prog (eval-prog expr 'fl))
-
- (λ (pt)
- (define val (prog pt))
- (for/first ([right splitpoints]
- #:when (or (nan? (sp-point right)) (<= val (sp-point right))))
- ;; Note that the last splitpoint has an sp-point of +nan.0, so we always find one
- (sp-cidx right))))
-
-(define (pick-errors splitpoints pts err-lsts)
- (define which-alt (point->alt splitpoints))
- (for/list ([pt pts] [errs (flip-lists err-lsts)])
- (list-ref errs (which-alt pt))))
-
-(define (with-entry idx lst item)
- (if (= idx 0)
- (cons item (cdr lst))
- (cons (car lst) (with-entry (sub1 idx) (cdr lst) item))))
-
;; Takes a vector of numbers, and returns the partial sum of those numbers.
;; For example, if your vector is #(1 4 6 3 8), then this returns #(1 5 11 14 22).
(define (partial-sum vec)
- (first-value
- (for/fold ([res (make-vector (vector-length vec))]
- [cur-psum 0])
- ([(el idx) (in-indexed (in-vector vec))])
- (let ([new-psum (+ cur-psum el)])
- (vector-set! res idx new-psum)
- (values res new-psum)))))
-
-;; Struct represeting a splitpoint
-;; cidx = Candidate index: the index of the candidate program that should be used to the left of this splitpoint
-;; bexpr = Branch Expression: The expression that this splitpoint should split on
-;; point = Split Point: The point at which we should split.
-(struct sp (cidx bexpr point) #:prefab)
-
-;; Struct representing a splitindex
-;; cidx = Candidate index: the index candidate program that should be used to the left of this splitindex
-;; pidx = Point index: The index of the point to the left of which we should split.
-(struct si (cidx pidx) #:prefab)
+ (define res (make-vector (vector-length vec)))
+ (for/fold ([cur-psum 0]) ([(el idx) (in-indexed (in-vector vec))])
+ (let ([new-psum (+ cur-psum el)])
+ (vector-set! res idx new-psum)
+ new-psum))
+ res)
;; Struct representing a candidate set of splitpoints that we are considering.
;; cost = The total error in the region to the left of our rightmost splitpoint
@@ -256,7 +271,7 @@
;; We take the CSE corresponding to the best choice of previous split point.
;; The default, not making a new split-point, gets a bonus of min-weight
(let ([acost (- (cse-cost point-entry) min-weight)] [aest point-entry])
- (for ([prev-split-idx (in-naturals)] [prev-entry (in-list (take sp-prev point-idx))]
+ (for ([prev-split-idx (in-range 0 point-idx)] [prev-entry (in-list sp-prev)]
#:when (can-split? (si-pidx (car (cse-indices prev-entry)))))
;; For each previous split point, we need the best candidate to fill the new regime
(let ([best #f] [bcost #f])
@@ -296,10 +311,21 @@
;; Extract the splitpoints from our data structure, and reverse it.
(reverse (cse-indices (last final))))
-(define (splitpoints->point-preds splitpoints num-alts)
- (define which-alt (point->alt splitpoints))
- (for/list ([i (in-range num-alts)])
- (λ (pt) (equal? (which-alt pt) i))))
+(define (splitpoints->point-preds splitpoints alts)
+ (assert (= (set-count (list->set (map sp-bexpr splitpoints))) 1))
+ (assert (nan? (sp-point (last splitpoints))))
+
+ (define vars (program-variables (alt-program (first alts))))
+ (define expr `(λ ,vars ,(sp-bexpr (car splitpoints))))
+ (define prog (eval-prog expr 'fl))
+
+ (for/list ([i (in-naturals)] [alt alts]) ;; alts necessary to terminate loop
+ (λ (pt)
+ (define val (prog pt))
+ (for/first ([right splitpoints]
+ #:when (or (nan?-all-types (sp-point right)) (<=/total val (sp-point right))))
+ ;; Note that the last splitpoint has an sp-point of +nan.0, so we always find one
+ (equal? (sp-cidx right) i)))))
(module+ test
(parameterize ([*start-prog* '(λ (x y) (/ x y))])
@@ -308,7 +334,8 @@
(sp 2 '(/ y x) 0.0)
(sp 0 '(/ y x) +inf.0)
(sp 1 '(/ y x) +nan.0)))
- (match-define (list p0? p1? p2?) (splitpoints->point-preds sps 3))
+ (match-define (list p0? p1? p2?)
+ (splitpoints->point-preds sps (map make-alt (build-list 3 (const '(λ (x y) (/ x y)))))))
(check-true (p0? '(0 -1)))
(check-true (p2? '(-1 1)))
diff --git a/src/core/simplify.rkt b/src/core/simplify.rkt
index c54f58574..d6091ee29 100644
--- a/src/core/simplify.rkt
+++ b/src/core/simplify.rkt
@@ -1,19 +1,9 @@
#lang racket
-(require "../common.rkt")
-(require "../alternative.rkt")
-(require "../programs.rkt")
-(require "../syntax/syntax.rkt")
-(require "../syntax/rules.rkt")
-(require "egraph.rkt")
-(require "ematch.rkt")
-(require "enode.rkt")
-(require "matcher.rkt")
-(require (rename-in "reduce.rkt" [simplify backup-simplify]))
-
-(provide simplify-expr simplify *max-egraph-iters*)
-(provide (all-defined-out) (all-from-out "egraph.rkt" "../syntax/rules.rkt" "ematch.rkt"))
-
+(require "../common.rkt" "../programs.rkt" "../float.rkt" "../timeline.rkt")
+(require "../syntax/rules.rkt" "../syntax/types.rkt")
+(require "enode.rkt" "egraph.rkt" "ematch.rkt")
+(provide simplify-expr simplify-batch)
(module+ test (require rackunit))
;;################################################################################;;
@@ -23,238 +13,185 @@
;;# partially, then extracting the simplest expression from it.
;;#
;;# Simplify attempts to make only one strong guarantee:
-;;# that the input is mathematically equivilent to the output; that is, for any
+;;# that the input is mathematically equivalent to the output; that is, for any
;;# exact x, evalutating the input on x will yield the same expression as evaluating
;;# the output on x.
;;#
;;################################################################################;;
-;; Cap the number of iterations to try at this.
-(define *max-egraph-iters* (make-parameter 6))
-(define *node-limit* (make-parameter 500))
-
-(define/contract (make-simplify-change program loc replacement)
- (-> expr? location? expr? change?)
- (change (rule 'simplify (location-get loc program) replacement)
- loc
- (for/list ([var (program-variables program)])
- (cons var var))))
-
-(define/contract (simplify altn #:rules [rls (*simplify-rules*)])
- (->* (alternative?) (#:rules (listof rule?)) (listof change?))
- (define prog (alt-program altn))
- (cond
- [(not (alt-delta? altn))
- (define prog* (simplify-expr (program-body prog) #:rules rls))
- (if ((num-nodes (program-body prog)) . > . (num-nodes prog*))
- (list (make-simplify-change prog '(2) prog*))
- '())]
- [else
- (match-define (change rule loc _) (alt-change altn))
- (define expr (location-get loc prog))
- ;; We want to avoid simplifying if possible, so we only simplify
- ;; things produced by function calls in the rule pattern. This means
- ;; no simplification if the rule output as a whole is not a function
- ;; call pattern, and no simplifying subexpressions that don't
- ;; correspond to function call patterns.
- (define pattern (rule-output rule))
- (cond
- [(not (list? pattern)) '()]
- [(not (list? expr)) '()]
- [else
- (reap [sow]
- (for ([pos (in-naturals 1)] [arg (cdr expr)] [arg-pattern (cdr pattern)])
- (when (and (list? arg-pattern) (list? arg))
- (define arg* (simplify-expr arg #:rules rls))
- (debug #:from 'simplify #:tag 'exit (format "Simplified to ~a" arg*))
- (when ((num-nodes arg) . > . (num-nodes arg*)) ; Simpler
- (sow (make-simplify-change prog (append loc (list pos)) arg*))))))])]))
-
-(define/contract (simplify-fp-safe altn)
- (-> alternative? (listof change?))
- (simplify altn #:rules (*fp-safe-simplify-rules*)))
-
(define/contract (simplify-expr expr #:rules rls)
(-> expr? #:rules (listof rule?) expr?)
- (debug #:from 'simplify #:tag 'enter (format "Simplifying ~a" expr))
- (if (has-nan? expr) +nan.0
- (let* ([iters (min (*max-egraph-iters*) (iters-needed expr))]
- [eg (mk-egraph expr)])
- (iterate-egraph! eg iters #:rules rls)
- (define out (extract-smallest eg))
- (debug #:from 'simplify #:tag 'exit (format "Simplified to ~a" out))
- out)))
-
-(define (num-nodes expr)
- (if (not (list? expr)) 1
- (add1 (apply + (map num-nodes (cdr expr))))))
-
-(define (has-nan? expr)
- (or (and (number? expr) (nan? expr))
- (and (list? expr)
- (ormap has-nan? (cdr expr)))))
-
-;; Returns the worst-case iterations needed to simplify this expression
-(define (iters-needed expr)
- (if (not (list? expr)) 0
- (let ([sub-iters-needed (apply max (map iters-needed (cdr expr)))])
- (if (let ([op (car expr)]) (or (eq? op '*) (eq? op '+) (eq? op '-) (eq? op '/)))
- (+ 2 sub-iters-needed)
- (+ 1 sub-iters-needed)))))
-
-(define (iterate-egraph! eg iters #:rules [rls (*simplify-rules*)])
- (let ([start-cnt (egraph-cnt eg)])
- (debug #:from 'simplify #:depth 2 (format "iters left: ~a (~a enodes)" iters start-cnt))
- (one-iter eg rls)
- (when (and (> (egraph-cnt eg) start-cnt)
- (> iters 1)
- (< (egraph-cnt eg) (*node-limit*)))
- (iterate-egraph! eg (sub1 iters) #:rules rls))))
+ (first (simplify-batch (list expr) #:rules rls)))
+
+(define/contract (simplify-batch exprs #:rules rls)
+ (-> (listof expr?) #:rules (listof rule?) (listof expr?))
+ (debug #:from 'simplify (format "Simplifying:\n ~a" (string-join (map ~a exprs) "\n ")))
+
+ (define eg (mk-egraph))
+ (define ens (for/list ([expr exprs]) (mk-enode-rec! eg expr)))
+
+ (for/and ([iter (in-naturals 0)])
+ (debug #:from 'simplify #:depth 2 (format "iteration ~a: ~a enodes" iter (egraph-cnt eg)))
+ (timeline-push! 'egraph iter (egraph-cnt eg))
+ (one-iter eg rls))
+ (debug #:from 'simplify #:depth 2 (format "iteration complete: ~a enodes" (egraph-cnt eg)))
+ (timeline-push! 'egraph "done" (egraph-cnt eg))
+
+ (define out (apply extract-smallest eg ens))
+ (debug #:from 'simplify (format "Simplified to:\n ~a" (string-join (map ~a out) "\n ")))
+ out)
+
+(define (rule-applicable? rl en)
+ (equal? (rule-otype rl) (enode-type en)))
+
+;; Tries to match the rules against the given enodes, and returns a
+;; list of matches found. Matches are of the form:
+;;
+;; (rule enode . bindings)
+;;
+;; where bindings is a list of different matches between the rule and
+;; the enode.
+
+(define (find-matches ens rls)
+ (reap [sow]
+ (for* ([rl rls] [en ens]
+ #:when (rule-applicable? rl en)
+ #:unless (rule-applied? en rl))
+ (define bindings (match-e (rule-input rl) en))
+ (unless (null? bindings)
+ (sow (list* rl en bindings))))))
+
+(define (apply-match eg rl en bindings)
+
+ ;; These next two lines are here because an earlier match
+ ;; application may have pruned the tree, invalidating the this
+ ;; one. Luckily, a pruned enode will still point to it's old
+ ;; leader, so we just get the leader, and then double check the
+ ;; bindings to make sure our match hasn't changed.
+
+ (define en* (pack-leader en))
+ (define bindings-set (apply set bindings))
+ (define bindings* (apply set (match-e (rule-input rl) en*)))
+ (define valid-bindings (set-intersect bindings-set bindings*))
+
+ (for ([binding valid-bindings])
+ (merge-egraph-nodes! eg en (substitute-e eg (rule-output rl) binding)))
+ ;; Mark this node as having this rule applied so that we don't try
+ ;; to apply it again.
+ (when (subset? bindings-set valid-bindings) (rule-applied! en rl)))
;; Iterates the egraph by applying each of the given rules in parallel
;; to the egraph nodes.
(define (one-iter eg rls)
- ;; Tries to match the rules against the given enodes, and returns a
- ;; list of matches found. Matches are of the form:
- ;;
- ;; (rule enode . bindings)
- ;;
- ;; where bindings is a list of different matches between the rule
- ;; and the enode.
- (define (find-matches ens)
- (filter (negate null?)
- (for*/list ([rl rls]
- [en ens]
- #:when (rule-valid-at-type? rl (enode-type en)))
- (if (rule-applied? en rl) '()
- (let ([bindings (match-e (rule-input rl) en)])
- (if (null? bindings) '()
- (list* rl en bindings)))))))
- (define (apply-match match)
- (match-let* ([`(,rl ,en . ,bindings) match]
- ;; These next two lines are here because an earlier
- ;; match application may have pruned the tree,
- ;; invalidating the this one. Luckily, a pruned
- ;; enode will still point to it's old leader, so we
- ;; just get the leader, and then double check the
- ;; bindings to make sure our match hasn't
- ;; changed. While it may be aggressive to
- ;; invalidate any change in bindings, it seems like
- ;; the right thing to do for now.
- [en (pack-leader en)]
- [bindings* (match-e (rule-input rl) en)]
- [applied #f])
- ;; Apply the match for each binding.
- (for ([binding bindings]
- #:when (set-member? bindings* binding))
- (merge-egraph-nodes! eg en (substitute-e eg (rule-output rl) binding))
- (set! applied #t))
- (when applied
- ;; Prune the enode if we can.
- (try-prune-enode en)
- ;; Mark this node as having this rule applied so that we don't try
- ;; to apply it again.
- (rule-applied! en rl))))
- (define (try-prune-enode en)
- ;; If one of the variations of the enode is a single variable or
- ;; constant, reduce to that.
- (reduce-to-single! eg en)
- ;; If one of the variations of the enode chains back to itself,
- ;; prune it away. Loops in the egraph coorespond to identity
- ;; functions.
- #;(elim-enode-loops! eg en))
- (for ([m (find-matches (egraph-leaders eg))])
- (apply-match m))
- (map-enodes (curry set-precompute! eg) eg))
-
-(define-syntax-rule (matches? expr pattern)
- (match expr
- [pattern #t]
- [_ #f]))
-
-(define (exact-value? type val)
- (match type
- ['real (exact? val)]
- ['complex (exact? val)]
- ['boolean true]))
-
-(define/match (val-of-type type val)
- [('real (? real?)) true]
- [('complex (? complex?)) true]
- [('boolean (? boolean?)) true]
- [(_ _) false])
-
-(define (val-to-type type val)
- (match type
- ['real val]
- ['complex `(complex ,(real-part val) ,(imag-part val))]
- ['boolean (if val 'TRUE 'FALSE)]))
+ (define change? #f)
+ (define (run-phase f . args)
+ (define old-cnt (egraph-cnt eg))
+ (apply f args)
+ (define changed? (> (egraph-cnt eg) old-cnt))
+ (set! change? (or changed? change?))
+ changed?)
+
+ (for ([m (find-matches (egraph-leaders eg) rls)]
+ #:break (>= (egraph-cnt eg) (*node-limit*)))
+ (match-define (list rl en bindings ...) m)
+ ;; The loop here ensures that we don't pass the node limit just
+ ;; because the bindings are too long. This is pretty ugly.
+ (let loop ([bindings bindings])
+ (cond
+ [(>= (egraph-cnt eg) (*node-limit*))
+ (void)]
+ [(<= (+ (length bindings) (egraph-cnt eg)) (*node-limit*))
+ (when (run-phase apply-match eg rl en bindings)
+ (reduce-to-single! eg en))]
+ [else
+ (let-values ([(head tail) (split-at bindings (- (*node-limit*) (egraph-cnt eg)))])
+ (loop head)
+ (loop tail))])))
+ (for ([en (egraph-leaders eg)]
+ #:break (>= (egraph-cnt eg) (*node-limit*)))
+ (when (run-phase set-precompute! eg en)
+ (reduce-to-single! eg en)))
+ (and change? (< (egraph-cnt eg) (*node-limit*))))
(define (set-precompute! eg en)
(define type (enode-type en))
- (for ([var (enode-vars en)])
- (when (list? var)
- (let ([constexpr
- (cons (car var)
- (map (compose (curry setfindf constant?) enode-vars)
- (cdr var)))])
- (when (and (not (matches? constexpr `(/ ,a 0)))
- (not (matches? constexpr `(log 0)))
- (not (matches? constexpr `(/ 0)))
- (andmap real? (cdr constexpr)))
- (let ([res (eval-const-expr constexpr)])
- (when (and (val-of-type type res) (exact-value? type res))
- (reduce-to-new! eg en (val-to-type type res)))))))))
-
-(define (hash-set*+ hash assocs)
- (for/fold ([h hash]) ([assoc assocs])
- (hash-set h (car assoc) (cdr assoc))))
-
-(define (extract-smallest eg)
- (define (resolve en ens->exprs)
- (let ([possible-resolutions
- (filter identity
- (for/list ([var (enode-vars en)])
- (if (not (list? var)) var
- (let ([expr (cons (car var)
- (for/list ([en (cdr var)])
- (hash-ref ens->exprs (pack-leader en) #f)))])
- (if (andmap identity (cdr expr))
- expr
- #f)))))])
- (if (null? possible-resolutions) #f
- (argmin expression-cost possible-resolutions))))
- (define (pass ens ens->exprs)
- (let-values ([(pairs left)
- (partition pair?
- (for/list ([en ens])
- (let ([resolution (resolve en ens->exprs)])
- (if resolution
- (cons en resolution)
- en))))])
- (list (hash-set*+ ens->exprs pairs)
- left)))
- (let loop ([todo-ens (egraph-leaders eg)]
- [ens->exprs (hash)])
- (match-let* ([`(,ens->exprs* ,todo-ens*)
- (pass todo-ens ens->exprs)]
- [top-expr (hash-ref ens->exprs* (pack-leader (egraph-top eg)) #f)])
- (cond [top-expr top-expr]
- [((length todo-ens*) . = . (length todo-ens))
- (error "failed to extract: infinite loop.")]
- [#t (loop todo-ens* ens->exprs*)]))))
+ (for ([var (enode-vars en)] #:when (list? var))
+ (define constexpr
+ (cons (car var)
+ (map (compose (curry setfindf constant?) enode-vars) (cdr var))))
+ (when (andmap identity constexpr)
+ (with-handlers ([exn:fail:contract:divide-by-zero? void])
+ (define res (eval-const-expr constexpr))
+ (when (and ((value-of type) res) (exact-value? type res))
+ (define en* (mk-enode-rec! eg (val-to-type type res)))
+ (merge-egraph-nodes! eg en en*))))))
+
+
+(define (extract-smallest eg . ens)
+ ;; The work list maps enodes to a pair (cost . expr) of that node's
+ ;; cheapest representation and its cost. If the cost is #f, the expr
+ ;; is also #f, and in this case no expression is yet known for that
+ ;; enode.
+ (define work-list (make-hash))
+ (for ([en ens])
+ (hash-set! work-list (pack-leader en) (cons #f #f)))
+
+ ;; Extracting the smallest expression means iterating, until
+ ;; fixedpoint, either discovering new relevant expressions or
+ ;; cheaper expressions for some expression.
+ (let loop ([iter 0])
+ (define changed? #f)
+ (debug #:from 'simplify #:depth 2
+ (format "Extracting #~a: cost ~a inf + ~a"
+ iter (count (compose not car) (hash-values work-list))
+ (apply + (filter identity (map car (hash-values work-list))))))
+ (for ([leader (in-list (hash-keys work-list))])
+ (define vars (enode-vars leader))
+ (define vars*
+ (filter identity
+ (for/list ([var vars])
+ (match var
+ [(list op args ...)
+ (define args*
+ (for/list ([en args])
+ (define subleader (pack-leader en))
+ (match (hash-ref work-list subleader (cons #f #t))
+ [(cons (? number? cost) best-arg)
+ best-arg]
+ [(cons #f not-in-hash?)
+ (hash-set! work-list subleader (cons #f #f))
+ (set! changed? (or changed? not-in-hash?))
+ #f])))
+ (if (andmap identity args*)
+ (cons op args*)
+ #f)]
+ [_
+ var]))))
+ (match vars*
+ ['() #f]
+ [_
+ (define best-resolution (argmin expression-cost vars*))
+ (define cost (expression-cost best-resolution))
+ (define old-cost (car (hash-ref work-list leader)))
+ (when (or (not old-cost) (< cost old-cost))
+ (hash-set! work-list leader (cons cost best-resolution))
+ (set! changed? #t))]))
+ (if changed?
+ (loop (+ iter 1))
+ (for/list ([en ens])
+ (cdr (hash-ref work-list (pack-leader en)))))))
(module+ test
(define test-exprs
#hash([1 . 1]
[0 . 0]
[(+ 1 0) . 1]
- #;[(+ 1 5) . 6]
+ [(+ 1 5) . 6]
[(+ x 0) . x]
[(- x 0) . x]
[(* x 1) . x]
[(/ x 1) . x]
- #;[(- (* 1 x) (* (+ x 1) 1)) . -1]
+ [(- (* 1 x) (* (+ x 1) 1)) . -1]
[(- (+ x 1) x) . 1]
[(- (+ x 1) 1) . x]
[(/ (* x 3) x) . 3]
@@ -262,9 +199,15 @@
(* (sqrt x) (sqrt x))) . 1]
[(re (complex a b)) . a]))
- (for ([(original target) test-exprs])
+ (*timeline-disabled* true)
+ (define outputs (simplify-batch (hash-keys test-exprs) #:rules (*simplify-rules*)))
+ (for ([(original target) test-exprs] [output outputs])
(with-check-info (['original original])
- (check-equal? (simplify-expr original #:rules (*simplify-rules*)) target)))
+ (check-equal? output target)))
+
+ (check set-member?
+ '((* x 6) (* 6 x))
+ (simplify-expr '(+ (+ (+ (+ (+ x x) x) x) x) x) #:rules (*simplify-rules*)))
(define no-crash-exprs
'((exp (/ (/ (* (* c a) 4) (- (- b) (sqrt (- (* b b) (* 4 (* a c)))))) (* 2 a)))))
diff --git a/src/core/taylor.rkt b/src/core/taylor.rkt
index 63a8a675e..bfefdaba7 100644
--- a/src/core/taylor.rkt
+++ b/src/core/taylor.rkt
@@ -16,8 +16,9 @@
(when (not tforms)
(set! tforms (map (const (cons identity identity)) vars)))
(set! expr
- (for/fold ([expr expr]) ([var vars] [tform tforms])
- (replace-expression expr var ((car tform) var))))
+ (simplify
+ (for/fold ([expr expr]) ([var vars] [tform tforms])
+ (replace-expression expr var ((car tform) var)))))
(debug #:from 'approximate "Taking taylor expansion of" expr "in" vars "around" 0)
; This is a very complex routine, with multiple parts.
@@ -158,7 +159,13 @@
(list-ref seg i)))))
(define taylor-expansion-known
- '(+ - * / sqr sqrt exp sin cos log pow))
+ '(+ - * / sqrt cbrt exp sin cos log pow))
+
+(register-reset
+ (λ ()
+ (hash-clear! n-sum-to-cache)
+ (hash-clear! logcache)
+ (hash-set! logcache 1 '((1 -1 1)))))
(define (taylor var expr*)
"Return a pair (e, n), such that expr ~= e var^n"
@@ -180,19 +187,18 @@
(apply taylor-add (map (curry taylor var) args))]
[`(- ,arg)
(taylor-negate ((curry taylor var) arg))]
- [`(- ,arg ,args ...)
- (apply taylor-add ((curry taylor var) arg) (map (compose taylor-negate (curry taylor var)) args))]
+ [`(- ,arg1 ,arg2)
+ (taylor-add (taylor var arg1) (taylor-negate (taylor var arg2)))]
[`(* ,left ,right)
(taylor-mult (taylor var left) (taylor var right))]
[`(/ 1 ,arg)
(taylor-invert (taylor var arg))]
[`(/ ,num ,den)
(taylor-quotient (taylor var num) (taylor var den))]
- [`(sqr ,a)
- (let ([ta (taylor var a)])
- (taylor-mult ta ta))]
[`(sqrt ,arg)
(taylor-sqrt (taylor var arg))]
+ [`(cbrt ,arg)
+ (taylor-cbrt (taylor var arg))]
[`(exp ,arg)
(let ([arg* (normalize-series (taylor var arg))])
(if (positive? (car arg*))
@@ -238,8 +244,8 @@
(simplify `(+ (* (- ,(car arg*)) (log ,var))
,((cdr rest) 0)))
((cdr rest) n))))))]
- [`(pow ,(? (curry equal? var)) ,(? exact-integer? power))
- (cons (- power) (λ (n) (if (= n 0) 1 0)))]
+ [`(pow ,base ,(? exact-integer? power))
+ (taylor-pow (normalize-series (taylor var base)) power)]
[`(pow ,base ,power)
(taylor var `(exp (* ,power (log ,base))))]
[_
@@ -369,20 +375,29 @@
(* 2 ,(f 0)))])))))])
(cons (/ offset* 2) f))))
+(define (taylor-cbrt num)
+ (let* ([num* (normalize-series num)]
+ [offset (car num*)]
+ [offset* (- offset (modulo offset 3))]
+ [coeffs (cdr num*)]
+ [coeffs* (if (= (modulo offset 3) 0) coeffs (λ (n) (if (= n 0) 0 (coeffs (+ n (modulo offset 3))))))]
+ [hash (make-hash)])
+ (hash-set! hash 0 (simplify `(cbrt ,(coeffs* 0))))
+ (hash-set! hash 1 (simplify `(/ ,(coeffs* 1) (* 3 (cbrt ,(coeffs* 0))))))
+ (letrec ([f (λ (n)
+ (hash-ref! hash n
+ (λ ()
+ (simplify
+ `(/ (- ,(coeffs* n)
+ (+ ,@(for/list ([j (in-range 1 n)] [k (in-range 1 n)] #:when (<= (+ j k) n))
+ `(* 2 (* ,(f j) ,(f k) ,(f (- n j k)))))))
+ (* 3 ,(f 0)))))))])
+ (cons (/ offset* 3) f))))
+
(define (rle l)
(for/list ([run (group-by identity l)])
(cons (length run) (car run))))
-(define (partition-list n)
- (define (aux n k)
- (cond
- [(= n 0) '(())]
- [(< n k) '()]
- [else
- (append (map (curry cons k) (aux (- n k) k))
- (aux n (+ k 1)))]))
- (map rle (aux n 1)))
-
(define (taylor-exp coeffs)
(let* ([hash (make-hash)])
(hash-set! hash 0 (simplify `(exp ,(coeffs 0))))
@@ -393,11 +408,11 @@
(simplify
`(* (exp ,(coeffs 0))
(+
- ,@(for/list ([p (partition-list n)])
+ ,@(for/list ([p (map rle (all-partitions n))])
`(*
- ,@(for/list ([factor p])
- `(/ (pow ,(coeffs (cdr factor)) ,(car factor))
- ,(factorial (car factor)))))))))))))))
+ ,@(for/list ([(count num) (in-dict p)])
+ `(/ (pow ,(coeffs num) ,count)
+ ,(factorial count))))))))))))))
(define (taylor-sin coeffs)
(let ([hash (make-hash)])
@@ -408,14 +423,26 @@
(λ ()
(simplify
`(+
- ,@(for/list ([p (partition-list n)])
+ ,@(for/list ([p (map rle (all-partitions n))])
(if (= (modulo (apply + (map car p)) 2) 1)
`(* ,(if (= (modulo (apply + (map car p)) 4) 1) 1 -1)
- ,@(for/list ([factor p])
- `(/ (pow ,(coeffs (cdr factor)) ,(car factor))
- ,(factorial (car factor)))))
+ ,@(for/list ([(count num) (in-dict p)])
+ `(/ (pow ,(coeffs num) ,count)
+ ,(factorial count))))
0))))))))))
+(define (taylor-pow coeffs n)
+ (match n ;; Russian peasant multiplication
+ [(? negative?) (taylor-pow (taylor-invert coeffs) (- n))]
+ [0 (taylor-exact 1)]
+ [1 coeffs]
+ [(? even?)
+ (define half (taylor-pow coeffs (/ n 2)))
+ (taylor-mult half half)]
+ [(? odd?)
+ (define half (taylor-pow coeffs (/ (- n 1) 2)))
+ (taylor-mult coeffs (taylor-mult half half))]))
+
(define (taylor-cos coeffs)
(let ([hash (make-hash)])
(hash-set! hash 0 1)
@@ -425,12 +452,12 @@
(λ ()
(simplify
`(+
- ,@(for/list ([p (partition-list n)])
+ ,@(for/list ([p (map rle (all-partitions n))])
(if (= (modulo (apply + (map car p)) 2) 0)
`(* ,(if (= (modulo (apply + (map car p)) 4) 0) 1 -1)
- ,@(for/list ([factor p])
- `(/ (pow ,(coeffs (cdr factor)) ,(car factor))
- ,(factorial (car factor)))))
+ ,@(for/list ([(count num) (in-dict p)])
+ `(/ (pow ,(coeffs num) ,count)
+ ,(factorial count))))
0))))))))))
;; This is a hyper-specialized symbolic differentiator for log(f(x))
diff --git a/src/debug.rkt b/src/debug.rkt
index b4f2140dd..7fafe7b6a 100644
--- a/src/debug.rkt
+++ b/src/debug.rkt
@@ -1,5 +1,5 @@
#lang racket
-
+(require "config.rkt")
(provide *debug* *debug-port* *debug-pref-range* debug set-debug-level!)
;; Sets how powerful, and therefore how computationally expensive, the
@@ -99,19 +99,20 @@
[(and from (dict-has-key? (*debug*) from)) (dict-ref (*debug*) from)]
[#t (dict-ref (*debug*) #t)]))
-(define (debug #:from [from 'none] #:tag [tag 'misc] #:depth [depth 1] . args)
+(define (debug #:from [from 'none] #:depth [depth 1] . args)
(when (should-print-debug? from depth)
(set! *last-time-printed* (/ (current-inexact-milliseconds) 1000))
- (debug-print from depth tag args (*debug-port*))))
+ (debug-print from depth args (*debug-port*))))
+
+(define debug-start-time (current-inexact-milliseconds))
+(register-reset (λ () (set! debug-start-time (current-inexact-milliseconds))))
-(define (debug-print from depth tag args port)
- (for ([i (range depth)])
- (display "* " port))
- (display (hash-ref *tags* tag "; ") port)
- (write from port)
- (display ": " port)
- (for/list ([arg args])
- (display " " port)
- ((if (string? arg) display write) arg port))
+(define (debug-print from depth args port)
+ (fprintf port "~a ~a [~a]:"
+ (~r (/ (- (current-inexact-milliseconds) debug-start-time) 1000)
+ #:precision '(= 3))
+ (string-join (build-list depth (const "*")) " ")
+ from)
+ (for ([arg args]) (fprintf port " ~a" arg))
(newline port)
(flush-output port))
diff --git a/src/errors.rkt b/src/errors.rkt
index ae34e000d..a91f628d9 100644
--- a/src/errors.rkt
+++ b/src/errors.rkt
@@ -3,7 +3,8 @@
(provide raise-herbie-error raise-herbie-syntax-error
herbie-error->string herbie-error-url
(struct-out exn:fail:user:herbie)
- (struct-out exn:fail:user:herbie:syntax))
+ (struct-out exn:fail:user:herbie:syntax)
+ warn warning-log expect-warning)
(struct exn:fail:user:herbie exn:fail:user (url)
#:extra-constructor-name make-exn:fail:user:herbie)
@@ -55,3 +56,29 @@
(exn-message err) *herbie-version*)]
[else
(old-error-display-handler message err)])))
+
+(define warnings-seen (mutable-set))
+(define warning-log '())
+
+(define (warn type message #:url [url #f] #:extra [extra '()] . args)
+ (unless (set-member? warnings-seen type)
+ (set-add! warnings-seen type)
+ (define url* (and url (format "https://herbie.uwplse.org/doc/~a/~a" *herbie-version* url)))
+ (set! warning-log (cons (list type message args url* extra) warning-log))
+ (eprintf "Warning: ~a\n" (apply format message args))
+ (for ([line extra]) (eprintf " ~a\n" line))
+ (when url (eprintf "See <~a> for more.\n" url*))))
+
+(define (expect-warning type thunk)
+ (define already-silent #f)
+ (dynamic-wind
+ (λ ()
+ (set! already-silent (set-member? warnings-seen type))
+ (set-add! warnings-seen type))
+ thunk
+ (λ () (unless already-silent (set-remove! warnings-seen type)))))
+
+(register-reset
+ (λ ()
+ (set-clear! warnings-seen)
+ (set! warning-log '())))
diff --git a/src/float.rkt b/src/float.rkt
index 9cbb993c3..1dbf383a4 100644
--- a/src/float.rkt
+++ b/src/float.rkt
@@ -1,44 +1,63 @@
#lang racket
(require math/flonum math/bigfloat)
-(require "config.rkt")
-(require "common.rkt")
+(require "config.rkt" "common.rkt" "interface.rkt" "syntax/types.rkt" "bigcomplex.rkt" "syntax/syntax.rkt")
+(module+ test (require rackunit))
-(provide midpoint-float ulp-difference *bit-width* ulps->bits bit-difference sample-float sample-double)
+(provide midpoint ulp-difference *bit-width* ulps->bits bit-difference
+ flonum ->bf random-generate fl->repr repr->fl
+ <-all-precisions mk-<= special-value?
+ get-representation*)
-(define (single-flonum->bit-field x)
- (integer-bytes->integer (real->floating-point-bytes x 4) #f))
+(define (infer-representation x)
+ (get-representation
+ (for/first ([(type rec) (in-hash type-dict)] #:when ((car rec) x))
+ (if (equal? type 'real)
+ (if (flag-set? 'precision 'double) 'binary64 'binary32)
+ type))))
-(define (single-flonum->ordinal x)
- (cond [(x . < . 0.0f0) (- (single-flonum->bit-field (- 0.0f0 x)))]
- [else (single-flonum->bit-field (abs x))]))
+(define (infer-big-representation x)
+ (let/ec return
+ (for ([(type rec) (in-hash type-dict)] #:unless (equal? type 'complex))
+ (define name
+ (if (equal? type 'real)
+ (if (flag-set? 'precision 'double) 'binary64 'binary32)
+ type))
+ (cond
+ [((car rec) x) (return (cons (get-representation name) 'fl))]))
+ (error "Could not infer big representation for" x)))
-(define (single-flonums-between x y)
- (- (single-flonum->ordinal y) (single-flonum->ordinal x)))
+(define (infer-double-representation x y)
+ (define repr1 (infer-representation x))
+ (define repr2 (infer-representation y))
+ (unless (equal? repr1 repr2)
+ (error 'infer-representation "Different representations: ~a for ~a and ~a for ~a"
+ repr1 x repr2 y))
+ repr1)
+
+(define (get-representation* x)
+ (match x
+ ['real (get-representation (if (flag-set? 'precision 'double) 'binary64 'binary32))]
+ [x (get-representation x)]))
(define (ulp-difference x y)
- (match* (x y)
- [((? real?) (? real?))
- (if (flag-set? 'precision 'double) (flonums-between x y) (single-flonums-between x y))]
- [((? complex?) (? complex?))
- (+ (ulp-difference (real-part x) (real-part y))
- (ulp-difference (imag-part x) (imag-part y)))]
- [((? boolean?) (? boolean?))
- (if (equal? x y) 0 64)]))
-
-(define (midpoint-float p1 p2)
- (cond
- [(and (double-flonum? p1) (double-flonum? p2))
- (flstep p1 (quotient (flonums-between p1 p2) 2))]
- [(and (single-flonum? p1) (single-flonum? p2))
- (floating-point-bytes->real
- (integer->integer-bytes
- (quotient
- (+ (single-flonum->ordinal p1) (single-flonum->ordinal p2))
- 2)
- 4) #f)]
- [else
- (error "Mixed precisions in binary search")]))
+ (if (and (complex? x) (complex? y) (not (real? x)) (not (real? y)))
+ (+ (ulp-difference (real-part x) (real-part y))
+ (ulp-difference (imag-part x) (imag-part y)))
+ (let ([->ordinal (representation-repr->ordinal (infer-double-representation x y))])
+ (- (->ordinal y) (->ordinal x)))))
+
+;; Returns the midpoint of the representation's ordinal values,
+;; not the real-valued midpoint
+(define (midpoint p1 p2)
+ (define repr (infer-double-representation p1 p2))
+ ((representation-ordinal->repr repr)
+ (floor (/ (+ ((representation-repr->ordinal repr) p1)
+ ((representation-repr->ordinal repr) p2))
+ 2))))
(define (*bit-width*) (if (flag-set? 'precision 'double) 64 32))
@@ -46,13 +65,137 @@
(cond
[(nan? x) +nan.0]
[(infinite? x) (*bit-width*)]
- [else (log2 x)]))
+ [else (/ (log x) (log 2))]))
(define (bit-difference x y)
(ulps->bits (+ 1 (abs (ulp-difference x y)))))
-(define (sample-float)
- (floating-point-bytes->real (integer->integer-bytes (random-exp 32) 4 #f)))
+(define (random-generate repr)
+ ((representation-ordinal->repr repr) (random-exp (representation-total-bits repr))))
+
+(define (special-value? x)
+ (define repr (infer-representation x))
+ (set-member? (representation-special-values repr) x))
+
+(define (ordinary-value? x)
+ (if (and (complex? x) (not (real? x)))
+ (and (not (and (real? x) (nan? x))) (not (and (real? x) (infinite? x))))
+ (not (special-value? x))))
+
+(module+ test
+ (check-true (ordinary-value? 2.5))
+ (check-false (ordinary-value? +nan.0))
+ (check-false (ordinary-value? -inf.0)))
+
+(define (=-or-nan? x1 x2)
+ (cond
+ [(and (number? x1) (number? x2))
+ (or (= x1 x2) (and (nan? x1) (nan? x2)))]
+ [else
+ (define repr (infer-double-representation x1 x2))
+ (= ((representation-repr->ordinal repr) x1)
+ ((representation-repr->ordinal repr) x2))]))
+
+(module+ test
+ (check-true (=-or-nan? 2.3 2.3))
+ (check-false (=-or-nan? 2.3 7.8))
+ (check-true (=-or-nan? +nan.0 -nan.f))
+ (check-false (=-or-nan? 2.3 +nan.f)))
+
+(define (ordinal repr) x1)
+ ((representation-repr->ordinal repr) x2))])]))
+
+(define (nan?-all-types x)
+ (if (or (real? x) (complex? x))
+ (nan? x)
+ (set-member? (representation-special-values (infer-representation x)) x)))
+
+(define (<=/total x1 x2)
+ (or (ordinal repr) x)))]))
+
+(define/contract (->flonum x)
+ (-> any/c value?)
+ (cond
+ [(and (complex? x) (not (real? x)))
+ (make-rectangular (->flonum (real-part x)) (->flonum (imag-part x)))]
+ [(bigcomplex? x)
+ (make-rectangular (->flonum (bigcomplex-re x)) (->flonum (bigcomplex-im x)))]
+ [(and (symbol? x) (constant? x))
+ (->flonum ((constant-info x 'fl)))]
+ [else
+ (match-define (cons repr kind) (infer-big-representation x))
+ (match kind
+ ['bf ((representation-bf->repr repr) x)]
+ ['fl (if (and (real? x) (exact? x)) (exact->inexact x) x)])]))
+
+(define (fl->repr x repr)
+ ((representation-exact->repr repr) x))
+
+(define (repr->fl x repr)
+ (bigfloat->flonum ((representation-repr->bf repr) x)))
+
+(define/contract (->bf x)
+ (-> any/c bigvalue?)
+ (cond
+ [(and (symbol? x) (constant? x)) ((constant-info x 'bf))]
+ [(and (complex? x) (not (real? x)))
+ (bigcomplex (bf (real-part x)) (bf (imag-part x)))]
+ [else
+ ((representation-repr->bf (infer-representation x)) x)]))
+
+(define (<-all-precisions x1 x2)
+ (cond
+ [(or (real? x1) (complex? x1))
+ (< x1 x2)]
+ [else
+ (define repr (infer-double-representation x1 x2))
+ (define ->ordinal (representation-repr->ordinal repr))
+ (< (->ordinal x1) (->ordinal x2))]))
-(define (sample-double)
- (floating-point-bytes->real (integer->integer-bytes (random-exp 64) 8 #f)))
+(define (mk-<= precision var val)
+ (define repr (get-representation precision))
+ (define (cast x)
+ (match precision
+ ['posit8 `(real->posit8 ,x)] ['posit16 `(real->posit16 ,x)] ['posit32 `(real->posit32 ,x)]
+ ['quire8 `(real->quire8 ,x)] ['quire16 `(real->quire16 ,x)] ['quire32 `(real->quire32 ,x)]
+ [(or 'binary64 'binary32) x]))
+ (define prec-point (cast (repr->fl val repr)))
+ (define <=-operator
+ (match precision
+ [(or 'binary64 'binary32) '<=]
+ ['posit8 `<=.p8] ['posit16 `<=.p16] ['posit32 `<=.p32]
+ ['quire8 `<=.p8] ['quire16 `<=.q16] ['quire32 `<=.q32]))
+ (list <=-operator var prec-point))
diff --git a/src/formats/c.rkt b/src/formats/c.rkt
index b3e6b9c47..6d06eb3da 100644
--- a/src/formats/c.rkt
+++ b/src/formats/c.rkt
@@ -1,11 +1,13 @@
#lang racket
(require net/uri-codec)
-(require "../common.rkt")
-(require "../programs.rkt")
-(require "datafile.rkt")
+(require "../common.rkt" "../programs.rkt" "datafile.rkt" "../syntax/types.rkt")
-(provide compile-info program->c)
+(provide program->c)
+
+(define (unused-variables prog)
+ (remove* (free-variables (program-body prog))
+ (program-variables prog)))
(define (fix-name name)
(string-replace (uri-encode (~a name)) #rx"[^a-zA-Z0-9]" "_"))
@@ -20,14 +22,14 @@
(define/contract (value->c expr)
(-> expr? string?)
- (cond
- [(member expr vars) (fix-name expr)]
- [(number? expr) (~a expr)]
- [(constant? expr) (constant-info expr '->c/double)]
- [(symbol? expr) (~a expr)] ; intermediate variable
- [else
- (define val (real->double-flonum (->flonum expr)))
- (if (equal? type "float") (format "~af" val) (~a val))]))
+ (match expr
+ [(? (curry set-member? vars)) (fix-name expr)]
+ [(? number?)
+ (format (if (equal? type "float") "~af" "~a") (real->double-flonum expr))]
+ [(? value?)
+ (format "/* ERROR: no support for value ~a in C */" expr)]
+ [(? constant?) (constant-info expr '->c/double)]
+ [(? symbol?) (~a expr)])) ; intermediate variable
(define/contract (app->c expr)
(-> expr? string?)
@@ -121,28 +123,3 @@
(display (program->mpfr iprog bits "f_im"))
(display (program->mpfr fprog bits "f_fm"))
(display (program->mpfr dprog bits "f_dm")))
-
-(define (compile-info base-dir single-info double-info)
- (for ([single-test (report-info-tests single-info)] [double-test (report-info-tests double-info)])
- (when (and (not (member (table-row-status single-test) '("timeout" "error" "crash")))
- (not (member (table-row-status double-test) '("timeout" "error" "crash"))))
- (match (cons single-test double-test)
- [(cons (table-row name single-status _ _ _ _ _ _ _ vars input single-output _ single-bits dir)
- (table-row name double-status _ _ _ _ _ _ _ vars input double-output _ double-bits dir))
- (define fname (build-path base-dir dir "compiled.c"))
- (debug #:from 'compile-info "Compiling" name "to" fname)
- (write-file fname
- (compile-all name `(λ ,vars ,input) `(λ ,vars ,single-output)
- `(λ ,vars ,double-output) (max single-bits double-bits)))]
- [else
- (error "Test case order, names, inputs don't match for single and double precision results."
- single-test double-test)]))))
-
-(module+ main
- (require racket/cmdline)
- (require "../config.rkt")
-
- (command-line
- #:program "compile/c.rkt"
- #:args (single-json-file double-json-file dir)
- (compile-info dir (read-datafile single-json-file) (read-datafile double-json-file))))
diff --git a/src/formats/datafile.rkt b/src/formats/datafile.rkt
index 0df502a24..a6f7b44e6 100644
--- a/src/formats/datafile.rkt
+++ b/src/formats/datafile.rkt
@@ -1,9 +1,7 @@
#lang racket
-(require racket/date)
-(require json)
-(require "../common.rkt")
-(require "../float.rkt")
+(require racket/date json)
+(require "../common.rkt" "../float.rkt")
(provide
(struct-out table-row) (struct-out report-info)
@@ -11,7 +9,9 @@
(struct table-row
- (name status start result target inf- inf+ start-est result-est vars input output time bits link) #:prefab)
+ (name status pre precision vars input output target-prog
+ start result target inf- inf+ start-est result-est
+ time bits link) #:prefab)
(struct report-info
(date commit branch hostname seed flags points iterations bit-width note tests) #:prefab #:mutable)
@@ -32,20 +32,25 @@
(define (write-datafile file info)
(define (simplify-test test)
(match test
- [(table-row name status start-bits end-bits target-bits
- inf- inf+ start-est end-est vars input output time bits link)
+ [(table-row name status pre prec vars input output target-prog
+ start-bits end-bits target-bits inf- inf+ start-est end-est
+ time bits link)
(make-hash
`((name . ,name)
+ (pre . ,(write-string (write pre)))
+ (prec . ,(symbol->string prec))
(status . ,status)
(start . ,start-bits)
(end . ,end-bits)
(target . ,target-bits)
(ninf . ,inf-)
(pinf . ,inf+)
+ (start-est . ,start-est)
(end-est . ,end-est)
(vars . ,(if vars (map symbol->string vars) #f))
- (input . ,(~a input))
- (output . ,(~a output))
+ (input . ,(write-string (write input)))
+ (output . ,(write-string (write output)))
+ (target-prog . ,(write-string (write target-prog)))
(time . ,time)
(bits . ,bits)
(link . ,(~a link))))]))
@@ -91,12 +96,14 @@
(hash-ref json 'note #f)
(for/list ([test (get 'tests)] #:when (hash-has-key? test 'vars))
(let ([get (λ (field) (hash-ref test field))])
- ;; TODO: ignoring the result-est
(define vars
(match (hash-ref test 'vars)
[(list names ...) (map string->symbol names)]
[string-lst (parse-string string-lst)]))
- (table-row (get 'name) (get 'status) (get 'start) (get 'end) (get 'target)
- (get 'ninf) (get 'pinf) (hash-ref test 'start-est 0) (hash-ref test 'end-est 0)
+ (table-row (get 'name) (get 'status) (parse-string (hash-ref test 'pre "TRUE")) (string->symbol (hash-ref test 'prec "binary64"))
vars (parse-string (get 'input)) (parse-string (get 'output))
+ (parse-string (hash-ref test 'target-prog "#f"))
+ (get 'start) (get 'end) (get 'target)
+ (get 'ninf) (get 'pinf) (hash-ref test 'start-est 0) (hash-ref test 'end-est 0)
+
(get 'time) (get 'bits) (get 'link)))))))
diff --git a/src/formats/test.rkt b/src/formats/test.rkt
index 1f9a2a53a..c66b54d12 100644
--- a/src/formats/test.rkt
+++ b/src/formats/test.rkt
@@ -1,14 +1,11 @@
#lang racket
-(require "../common.rkt")
-(require "../errors.rkt")
-(require "../alternative.rkt")
-(require "../programs.rkt")
-(require "../syntax-check.rkt")
-(require "../type-check.rkt")
+(require "../common.rkt" "../errors.rkt")
+(require "../programs.rkt" "../syntax-check.rkt" "../type-check.rkt")
-(provide (struct-out test) test-program
- load-tests load-file test-target parse-test test-successful? test)
+(provide (struct-out test) test-program test-target load-tests parse-test)
+
+(struct test (name vars input output expected precondition precision) #:prefab)
(define (test-program test)
`(λ ,(test-vars test) ,(test-input test)))
@@ -16,72 +13,64 @@
(define (test-target test)
`(λ ,(test-vars test) ,(test-output test)))
-(define (test-successful? test input-bits target-bits output-bits)
- (match* ((test-output test) (test-expected test))
- [(_ #f) #t]
- [(_ (? number? n)) (>= n output-bits)]
- [(#f #t) (>= input-bits output-bits)]
- [(_ #t) (>= target-bits (- output-bits 1))]))
-
-(struct test (name vars input output expected precondition) #:prefab)
-
(define (parse-test stx)
(assert-program! stx)
(assert-program-type! stx)
- (define expr (syntax->datum stx))
- (match expr
- [(list 'FPCore (list args ...) props ... body)
- (define prop-dict
- (let loop ([props props] [out '()])
- (if (null? props)
- (reverse out)
- (loop (cddr props) (cons (cons (first props) (second props)) out)))))
+ (match-define (list 'FPCore (list args ...) props ... body) (syntax->datum stx))
- (test (~a (dict-ref prop-dict ':name body))
- args
- (desugar-program body)
- (desugar-program (dict-ref prop-dict ':herbie-target #f))
- (dict-ref prop-dict ':herbie-expected #t)
- (desugar-program (dict-ref prop-dict ':pre 'TRUE)))]
- [(list (or 'λ 'lambda 'define 'herbie-test) _ ...)
- (raise-herbie-error "Herbie 1.0+ no longer supports input formats other than FPCore."
- #:url "input.html")]
- [_
- (raise-herbie-error "Invalid input expression." #:url "input.html")]))
+ (define prop-dict
+ (let loop ([props props])
+ (match props
+ ['() '()]
+ [(list prop val rest ...) (cons (cons prop val) (loop rest))])))
-(define (load-file file)
- (call-with-input-file file
- (λ (port)
- (for/list ([test (in-port (curry read-syntax file) port)])
- (parse-test test)))))
+ (define ctx-prec
+ ;; Default to 'real because types and precisions are mixed up right now
+ (match (dict-ref prop-dict ':precision 'real)
+ ['binary32 'real]
+ ['binary64 'real]
+ [x x]))
+ (define type-ctx (map (curryr cons ctx-prec) args))
-(define (is-racket-file? f)
- (and (equal? (filename-extension f) #"fpcore") (file-exists? f)))
+ (test (~a (dict-ref prop-dict ':name body))
+ args
+ (desugar-program body type-ctx)
+ (desugar-program (dict-ref prop-dict ':herbie-target #f) type-ctx)
+ (dict-ref prop-dict ':herbie-expected #t)
+ (desugar-program (dict-ref prop-dict ':pre 'TRUE) type-ctx)
+ (dict-ref prop-dict ':precision 'binary64)))
(define (load-stdin)
(for/list ([test (in-port (curry read-syntax "stdin") (current-input-port))])
(parse-test test)))
+(define (load-file file)
+ (call-with-input-file file
+ (λ (port)
+ (port-count-lines! port)
+ (for/list ([test (in-port (curry read-syntax file) port)])
+ (parse-test test)))))
+
(define (load-directory dir)
- (for/append ([fname (in-directory dir)] #:when (is-racket-file? fname))
+ (for/append ([fname (in-directory dir)]
+ #:when (file-exists? fname)
+ #:when (equal? (filename-extension fname) #"fpcore"))
(load-file fname)))
(define (load-tests path)
(define path* (if (string? path) (string->path path) path))
- (cond
- [(equal? path "-")
- (load-stdin)]
- [(directory-exists? path*)
- (load-directory path*)]
- [else
- (load-file path*)]))
-
-(define (test t1 t2)
- (cond
- [(and (test-output t1) (test-output t2))
- (string (test-name t1) (test-name t2))]
- [(and (not (test-output t1)) (not (test-output t2)))
- (string (test-name t1) (test-name t2))]
- [else
- ; Put things with an output first
- (test-output t1)]))
+ (define out
+ (cond
+ [(equal? path "-")
+ (load-stdin)]
+ [(directory-exists? path*)
+ (load-directory path*)]
+ [else
+ (load-file path*)]))
+ (define duplicates (find-duplicates (map test-name out)))
+ (unless (null? duplicates)
+ (warn 'duplicate-names
+ "Duplicate ~a ~a used for multiple cores"
+ (if (equal? (length duplicates) 1) "name" "names")
+ (string-join (map (curry format "\"~a\"") duplicates) ", ")))
+ out)
diff --git a/src/formats/tex.rkt b/src/formats/tex.rkt
index 6f97d8312..7cc96fc4c 100644
--- a/src/formats/tex.rkt
+++ b/src/formats/tex.rkt
@@ -1,12 +1,19 @@
#lang racket
-(require "../common.rkt")
-(require "../syntax/syntax.rkt")
-(require "../programs.rkt")
+(require math/bigfloat)
+(require "../common.rkt" "../syntax/syntax.rkt" "../programs.rkt" "../interface.rkt" "../syntax/types.rkt" "../float.rkt")
-(provide mathjax-url texify-expr texify-prog)
+(provide js-tex-include texify-expr texify-prog)
-(define mathjax-url
- "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML")
+(define js-tex-include
+ '((link ([rel "stylesheet"] [href "https://cdn.jsdelivr.net/npm/katex@0.10.0-beta/dist/katex.min.css"]
+ [integrity "sha384-9tPv11A+glH/on/wEu99NVwDPwkMQESOocs/ZGXPoIiLE8MU/qkqUcZ3zzL+6DuH"]
+ [crossorigin "anonymous"]))
+ (script ([src "https://cdn.jsdelivr.net/npm/katex@0.10.0-beta/dist/katex.min.js"]
+ [integrity "sha384-U8Vrjwb8fuHMt6ewaCy8uqeUXv4oitYACKdB0VziCerzt011iQ/0TqlSlv8MReCm"]
+ [crossorigin "anonymous"]))
+ (script ([src "https://cdn.jsdelivr.net/npm/katex@0.10.0-beta/dist/contrib/auto-render.min.js"]
+ [integrity "sha384-aGfk5kvhIq5x1x5YdvCp4upKZYnA8ckafviDpmWEKp4afOZEqOli7gqSnh8I6enH"]
+ [crossorigin "anonymous"]))))
(define/match (texify-variable var)
[('l) "\\ell"]
@@ -23,17 +30,6 @@
[('lambda2) "\\lambda_2"]
[(_) (symbol->string var)])
-; "enclose" is a MathJax extension which may
-; not work with standard TeX processors.
-(define (tag str idx)
- (let* ([enc (format "\\enclose{circle}{~a}" str)]
- [col (format "\\color{red}{~a}" enc)]
- [css (format "\\class{location}{\\cssId{~a}{~a}}" idx col)])
- css))
-
-(define (untag str)
- (format "\\color{black}{~a}" str))
-
; self-paren-level : #t --> paren me
; #f --> do not paren me
;
@@ -50,38 +46,16 @@
[(or '+ '- 'or 'complex) (values '+ '+)]
[(or '* 'and) (values '* '*)]
['/ (values #f #t)]
- [(or 'sqr 'cube 'fma 'hypot 'pow) (values #f #f)]
+ ['pow (values #f #f)]
['atan2 (values 'fn #t)]
- ['log1p (values #f '+)]
['if (values #t #t)]
[(or 'remainder 'fmod) (values #t #f)]
- [(or 'cbrt 'ceil 'copysign 'expm1 'exp2 'floor 'fmax 'exp 'sqrt 'fmin 'fabs 'fdim)
+ [(or 'cbrt 'ceil 'copysign 'exp2 'floor 'fmax 'exp 'sqrt 'fmin 'fabs 'fdim 'expm1 'fma 'log1p 'hypot 'j0 'j1 'y0 'y1 'lgamma 'tgamma 'trunc)
(values #f #t)]
[(or '== '< '> '<= '>= '!=)
(values #f #t)]
[_ (values 'fn #f)]))
-(define ((highlight-template op) idx args)
- (define to-tag-infix
- #hash((+ . "+") (- . "-") (* . "\\cdot") (fmod . "\\bmod") (remainder . "\\mathsf{rem}")
- (< . "\\lt") (> . "\\gt") (== . "=") (!= . "\\ne") (<= . "\\le") (>= . "\\ge")
- (and . "\\land") (or . "\\lor")))
- (cond
- [(and (equal? (length args) 2) (hash-has-key? to-tag-infix op))
- (match-define (list a b) args)
- (format "~a ~a ~a" a (tag (hash-ref to-tag-infix op) idx) b)]
- [(equal? op 'if)
- (match-define (list a b c) args)
- (format "~a ~a ~a : ~a" a (tag "?" idx) b c)]
- [(equal? op 'sqr)
- (match-define (list a) args)
- (format "{~a}^{~a}" a (tag "2" idx))]
- [(equal? op 'cube)
- (match-define (list a) args)
- (format "{~a}^{~a}" a (tag "3" idx))]
- [else
- (tag (apply (operator-info op '->tex) (map untag args)) idx)]))
-
(define (collect-branches expr loc)
(match expr
[`(if ,cond ,ift ,iff)
@@ -90,16 +64,12 @@
[else
(list (list #t expr loc))]))
-;; The highlight ops are an alist of locations to indexes that marks
-;; those locations as highlighted with the given location
-;; index. highlight-ops and loc/colors are not meant to be used
-;; simultaniously.
-(define (texify-prog prog
- #:loc [color-loc #f]
- #:color [color "red"]
- #:highlight-ops [highlight-locs '()])
- "Compile the body of a program to math mode TeX."
- (let texify ([expr (program-body prog)] [parens #t] [loc '(2)])
+(define (texify-prog expr #:loc [color-loc #f] #:color [color "red"])
+ (texify-expr (program-body expr) #:loc color-loc #:color color))
+
+(define (texify-expr expr #:loc [color-loc #f] #:color [color "red"])
+ "Compile an expression to math mode TeX."
+ (let texify ([expr expr] [parens #t] [loc '(2)])
(format
(if (and color-loc (equal? (reverse color-loc) loc))
(format "\\color{~a}{~~a}" color)
@@ -107,12 +77,18 @@
(match expr
[(? exact-integer?)
(number->string expr)]
- [(? exact-rational?)
+ [(and (? rational?) (? exact?))
(format "\\frac{~a}{~a}" (numerator expr) (denominator expr))]
- [(? real?)
- (match (string-split (number->string expr) "e")
- [(list "-inf.0") "-\\infty"]
- [(list "+inf.0") "+\\infty"]
+ [(? (conjoin complex? (negate real?)))
+ (format "~a ~a ~a i"
+ (texify (real-part expr) '+ loc)
+ (if (or (< (imag-part expr) 0) (equal? (imag-part expr) -0.0)) '- '+)
+ (texify (abs (imag-part expr)) '+ loc))]
+ [(? value?)
+ (define s (bigfloat->string ((representation-repr->bf (infer-representation expr)) expr)))
+ (match (string-split s "e")
+ [(list "-inf.bf") "-\\infty"]
+ [(list "+inf.bf") "+\\infty"]
[(list num) num]
[(list significand exp)
(define num
@@ -120,11 +96,6 @@
(format "10^{~a}" exp)
(format "~a \\cdot 10^{~a}" significand exp)))
(if (precedence< parens #f) num (format "\\left( ~a \\right)" num))])]
- [(? complex?)
- (format "~a ~a ~a i"
- (texify (real-part expr) '+ loc)
- (if (or (< (imag-part expr) 0) (equal? (imag-part expr) -0.0)) '- '+)
- (texify (abs (imag-part expr)) '+ loc))]
[(? constant?)
(constant-info expr '->tex)]
[(? symbol?) (texify-variable expr)]
@@ -134,13 +105,14 @@
(with-output-to-string
(λ ()
(printf "\\begin{array}{l}\n")
- (for ([branch (collect-branches expr loc)])
+ (for ([branch (collect-branches expr loc)] [n (in-naturals)])
(match branch
[(list #t bexpr bloc)
(printf "\\mathbf{else}:~a~a~a~a\n"
NL IND (texify bexpr #t (cons 2 bloc)) NL)]
[(list bcond bexpr bloc)
- (printf "\\mathbf{if}\\;~a:~a~a~a~a\n"
+ (printf "\\mathbf{~a}\\;~a:~a~a~a~a\n"
+ (if (= n 0) "if" "elif")
(texify bcond #t (cons 1 bloc))
NL IND (texify bexpr #t (cons 2 bloc)) NL)]))
(printf "\\end{array}")))]
@@ -152,27 +124,8 @@
(for/list ([arg args] [id (in-naturals 1)])
(texify arg arg-paren-level (cons id loc)))]
[hl-loc
- (assoc (reverse loc) highlight-locs)])
- (format
- ; omit parens if parent contex has lower precedence
- (if (precedence< parens self-paren-level)
- "~a"
- "\\left(~a\\right)")
- (if hl-loc
- ((highlight-template f) (cdr hl-loc) texed-args)
- (apply (operator-info f '->tex) texed-args))))]))))
-
-; TODO probably a better way to write this wrapper using
-; make-keyword-procedure and keyword-apply
-(define (texify-expr expr
- #:loc [color-loc #f]
- #:color [color "red"]
- #:highlight-ops [highlight-locs '()])
- (texify-prog (expr->prog expr)
- #:loc color-loc
- #:color color
- #:highlight-ops highlight-locs))
-
-(define (exact-rational? r)
- (and (rational? r) (exact? r)))
+ #f])
+ (format ; omit parens if parent contex has lower precedence
+ (if (precedence< parens self-paren-level) "~a" "\\left(~a\\right)")
+ (apply (operator-info f '->tex) texed-args)))]))))
diff --git a/src/reports/core2js.rkt b/src/fpcore/core2js.rkt
similarity index 100%
rename from src/reports/core2js.rkt
rename to src/fpcore/core2js.rkt
diff --git a/src/reports/fpcore-common.rkt b/src/fpcore/fpcore-common.rkt
similarity index 100%
rename from src/reports/fpcore-common.rkt
rename to src/fpcore/fpcore-common.rkt
diff --git a/src/reports/fpcore.rkt b/src/fpcore/fpcore.rkt
similarity index 100%
rename from src/reports/fpcore.rkt
rename to src/fpcore/fpcore.rkt
diff --git a/src/glue.rkt b/src/glue.rkt
deleted file mode 100644
index 0ffe0efb4..000000000
--- a/src/glue.rkt
+++ /dev/null
@@ -1,168 +0,0 @@
-#lang racket
-
-(require "common.rkt")
-(require "points.rkt")
-(require "alternative.rkt")
-(require "programs.rkt")
-(require "core/simplify.rkt")
-(require "core/localize.rkt")
-(require "core/regimes.rkt")
-(require "core/periodicity.rkt")
-(require "core/taylor.rkt")
-(require "core/alt-table.rkt")
-(require "core/matcher.rkt")
-(require "type-check.rkt")
-
-(provide remove-pows setup-prog setup-alt-simplified post-process
- split-table extract-alt combine-alts
- best-alt simplify-alt completely-simplify-alt
- taylor-alt zach-alt)
-
-(define initial-fuel '())
-
-;; Implementation
-
-(define (remove-pows altn)
- (define body*
- (let loop ([expr (program-body (alt-program altn))])
- (match expr
- [(list 'expt base (and (? integer?) (? positive?) (? (curryr < 10)) exponent))
- (for/fold ([term base]) ([i (in-range 1 exponent)])
- (list '* base term))]
- [(list op args ...)
- (cons op (map loop args))]
- [_ expr])))
- (if (equal? body* (program-body (alt-program altn)))
- altn
- (alt-event `(λ ,(program-variables (alt-program altn)) ,body*)
- 'removed-pows (list altn))))
-
-(define (setup-prog prog fuel)
- (let* ([alt (make-alt prog)]
- [table (make-alt-table (*pcontext*) alt)]
- [extracted (atab-all-alts table)])
- (assert (equal? extracted (list alt))
- #:extra-info (λ () (format "Extracted is ~a, but we gave it ~a"
- extracted alt)))
- table))
-
-(define (setup-alt-simplified prog)
- (let* ([alt (make-alt prog)]
- [maybe-simplify (if (flag-set? 'setup 'simplify) simplify-alt identity)]
- [processed (maybe-simplify alt)])
- processed))
-
-(define (extract-alt table)
- (parameterize ([*pcontext* (atab-context table)])
- (argmin alt-history-length
- (argmins alt-cost
- (argmins (compose errors-score alt-errors)
- (atab-all-alts table))))))
-
-(define (combine-alts splitpoints alts)
- (define expr
- (for/fold
- ([expr (program-body (alt-program (list-ref alts (sp-cidx (last splitpoints)))))])
- ([splitpoint (cdr (reverse splitpoints))])
- (define test `(<= ,(sp-bexpr splitpoint) ,(sp-point splitpoint)))
- `(if ,test ,(program-body (alt-program (list-ref alts (sp-cidx splitpoint)))) ,expr)))
- (make-regime-alt `(λ ,(program-variables (*start-prog*)) ,expr) alts splitpoints))
-
-(define (best-alt alts)
- (argmin alt-cost
- (argmins (compose errors-score alt-errors)
- alts)))
-
-(define (simplify-alt altn)
- (apply alt-apply altn (simplify altn)))
-
-(define (completely-simplify-alt altn)
- (let* ([prog (alt-program altn)]
- [prog* `(λ ,(program-variables prog) ,(parameterize ([*max-egraph-iters* (/ (*max-egraph-iters*) 2)])
- (simplify-expr (program-body prog))))]
- [chng (change (rule 'simplify prog prog*) '() (map cons (program-variables prog) (program-variables prog)))])
- (debug "prog is" prog*)
- (alt-add-event (alt-delta prog* chng altn) 'final-simplify)))
-
-(define (post-process table log!)
- (debug #:from 'progress #:depth 2 "Final touches.")
- (let* ([all-alts (atab-all-alts table)]
- [num-alts (length all-alts)]
- [zached-alts 0]
- [maybe-zach (if (flag-set? 'reduce 'zach)
- (λ (alt locs)
- (debug #:from 'progress #:depth 3 "zaching alt" (add1 zached-alts) "of" num-alts)
- (log! 'zach)
- (set! zached-alts (add1 zached-alts))
- (append-map (curry zach-alt alt) locs))
- (const '()))]
- [taylored-alts 0]
- [maybe-taylor (if (flag-set? 'reduce 'taylor)
- (λ (alt locs)
- (debug #:from 'progress #:depth 3 "tayloring alt" (add1 taylored-alts) "of" num-alts)
- (log! 'series)
- (set! taylored-alts (add1 taylored-alts))
- (append-map (curry taylor-alt alt) locs))
- (λ (x y) (list x)))]
- [_ (log! 'localize)]
- [locss (map (compose localize-error alt-program) all-alts)]
- [alts*
- (apply append
- (for/list ([alt all-alts] [locs locss])
- (append (maybe-zach alt locs) (maybe-taylor alt locs))))]
- [num-alts* (length alts*)]
- [simplified-alts 0]
- [maybe-simplify (if (flag-set? 'reduce 'simplify)
- (λ (alt)
- (debug #:from 'progress #:depth 3 "simplifying alt" (add1 simplified-alts) "of" num-alts*)
- (log! 'simplify)
- (set! simplified-alts (add1 simplified-alts))
- (completely-simplify-alt alt))
- identity)]
- [table* (atab-add-altns table (map maybe-simplify alts*))])
- table*))
-
-(define transforms-to-try
- (let ([invert-x (λ (x) `(/ 1 ,x))] [exp-x (λ (x) `(exp ,x))] [log-x (λ (x) `(log ,x))]
- [ninvert-x (λ (x) `(/ 1 (- ,x)))])
- `((0 ,identity ,identity)
- (inf ,invert-x ,invert-x)
- (-inf ,ninvert-x ,ninvert-x)
- #;(exp ,exp-x ,log-x)
- #;(log ,log-x ,exp-x))))
-
-(define (taylor-alt altn loc)
- ; BEWARE WHEN EDITING: the free variables of an expression can be null
- (define expr (location-get loc (alt-program altn)))
- (match (type-of expr (for/hash ([var (free-variables expr)]) (values var 'real)))
- ['real
- (for/list ([transform transforms-to-try])
- (match transform
- [(list name f finv)
- (alt-event
- (location-do loc (alt-program altn)
- (λ (expr) (let ([fv (free-variables expr)])
- (if (null? fv) expr
- (approximate expr fv #:transform (map (const (cons f finv)) fv))))))
- `(taylor ,name ,loc)
- (list altn))]))]
- ['complex
- (list altn)]))
-
-(define (zach-alt altn loc)
- (let ([sibling (location-sibling loc)]
- [rewrite
- (if (flag-set? 'generate 'rm) alt-rewrite-rm alt-rewrite-expression)])
- (if (and sibling
- (= (length (location-get (location-parent loc)
- (alt-program altn))) 3))
- (rewrite (alt-add-event altn '(start zaching)) #:root sibling)
- '())))
-
-(define (split-table orig-table)
- (match-let* ([(list splitpoints altns) (infer-splitpoints (atab-all-alts orig-table))])
- (if (= 1 (length splitpoints)) (list (list orig-table) splitpoints)
- (let* ([preds (splitpoints->point-preds splitpoints (length altns))]
- [tables* (split-atab orig-table preds)])
- (list tables* splitpoints)))))
-
diff --git a/src/herbie.rkt b/src/herbie.rkt
index 332d26711..4e23dc2f7 100644
--- a/src/herbie.rkt
+++ b/src/herbie.rkt
@@ -1,30 +1,20 @@
#lang racket
-(require racket/lazy-require)
-(require "common.rkt" "multi-command-line.rkt" "sandbox.rkt" "errors.rkt"
- "syntax/syntax.rkt" "syntax/rules.rkt")
+(require racket/lazy-require racket/runtime-path)
+(require "common.rkt" "multi-command-line.rkt" "sandbox.rkt" "errors.rkt" "plugin.rkt")
+
+;; Load all the plugins
+(load-herbie-plugins)
(lazy-require
["web/demo.rkt" (run-demo)]
- ["reports/run.rkt" (make-report)]
+ ["web/run.rkt" (make-report rerun-report)]
["shell.rkt" (run-shell)]
["improve.rkt" (run-improve)])
(define (string->thread-count th)
(match th ["no" #f] ["yes" (max (- (processor-count) 1) 1)] [_ (string->number th)]))
-(define (check-operator-fallbacks!)
- (prune-operators!)
- (prune-rules!)
- (unless (null? (if (flag-set? 'precision 'double) (*unknown-d-ops*) (*unknown-f-ops*)))
- (eprintf "Warning: native ~a not supported on your system; "
- (string-join (map ~a (if (flag-set? 'precision 'double) (*unknown-d-ops*) (*unknown-f-ops*)))
- ", "))
- (eprintf (if (flag-set? 'precision 'fallback) "fallbacks will be used.\n" "functions are disabled.\n"))
- (eprintf "See for more info.\n"
- *herbie-version*))
- (unless (flag-set? 'fn 'cbrt) (eprintf "cbrt is diabled.\n")))
-
(module+ main
(define quiet? #f)
(define demo-output #f)
@@ -32,10 +22,12 @@
(define demo-prefix "/")
(define demo? #f)
(define demo-port 8000)
+ (define demo-public #f)
(define threads #f)
(define report-profile? #f)
(define report-note #f)
+ (define report-debug? #f)
(define seed (random 1 (expt 2 31)))
(set-seed! seed)
@@ -45,34 +37,35 @@
#:once-each
[("--timeout") s "Timeout for each test (in seconds)"
(*timeout* (* 1000 (string->number s)))]
- [("--seed") rs "The random seed to use in point generation"
- (define given-seed (read (open-input-string rs)))
+ [("--seed") int "The random seed to use in point generation"
+ (define given-seed (read (open-input-string int)))
(when given-seed (set-seed! given-seed))]
- [("--num-iters") fu "The number of iterations of the main loop to use"
- (*num-iterations* (string->number fu))]
- [("--num-points") points "The number of points to use"
- (*num-points* (string->number points))]
+ [("--num-iters") num "The number of iterations of the main loop to use"
+ (*num-iterations* (string->number num))]
+ [("--num-points") num "The number of points to use"
+ (*num-points* (string->number num))]
#:multi
- [("-o" "--disable") tf "Disable a flag (formatted category:name)"
- (define flag (parse-flag tf))
- (when (not flag)
- (raise-herbie-error "Invalid flag ~a" tf #:url "options.html"))
- (apply disable-flag! flag)]
- [("+o" "--enable") tf "Enable a flag (formatted category:name)"
- (define flag (parse-flag tf))
- (when (not flag)
- (raise-herbie-error "Invalid flag ~a" tf #:url "options.html"))
- (apply enable-flag! flag)]
+ [("-o" "--disable") flag "Disable a flag (formatted category:name)"
+ (define tf (parse-flag flag))
+ (when (not tf)
+ (raise-herbie-error "Invalid flag ~a" flag #:url "options.html"))
+ (apply disable-flag! tf)]
+ [("+o" "--enable") flag "Enable a flag (formatted category:name)"
+ (define tf (parse-flag flag))
+ (when (not tf)
+ (raise-herbie-error "Invalid flag ~a" flag #:url "options.html"))
+ (apply enable-flag! tf)]
#:subcommands
[shell "Interact with Herbie from the shell"
#:args ()
- (check-operator-fallbacks!)
(run-shell)]
[web "Interact with Herbie from your browser"
#:once-each
[("--port") port "Port to run the web shell on"
(set! demo-port (string->number port))]
+ [("--public") "Whether to listen on a public port (instead of localhost)"
+ (set! demo-public #t)]
[("--save-session") dir "The dir to place a report from submitted expressions"
(set! demo-output dir)]
[("--log") file "The file to write web access log to"
@@ -83,27 +76,38 @@
(set! demo? true)]
[("--quiet") "Print a smaller banner and don't start a browser."
(set! quiet? true)]
+ [("--debug") "Whether to compute metrics and debug info"
+ (set! report-debug? true)]
#:args ()
- (check-operator-fallbacks!)
- (run-demo #:quiet quiet? #:output demo-output #:log demo-log #:prefix demo-prefix #:demo? demo? #:port demo-port)]
+ (run-demo #:quiet quiet? #:output demo-output #:log demo-log #:prefix demo-prefix #:debug report-debug? #:demo? demo? #:port demo-port #:public? demo-public)]
[improve "Run Herbie on an FPCore file, producing an FPCore file"
#:once-each
- [("--threads") th "How many tests to run in parallel: 'yes', 'no', or a number"
- (set! threads (string->thread-count th))]
+ [("--threads") num "How many tests to run in parallel: 'yes', 'no', or a number"
+ (set! threads (string->thread-count num))]
#:args (input output)
- (check-operator-fallbacks!)
(run-improve input output #:threads threads)]
[report "Run Herbie on an FPCore file, producing an HTML report"
#:once-each
[("--note") note "Add a note for this run"
(set! report-note note)]
- [("--threads") th "How many tests to run in parallel: 'yes', 'no', or a number"
- (set! threads (string->thread-count th))]
+ [("--threads") num "How many tests to run in parallel: 'yes', 'no', or a number"
+ (set! threads (string->thread-count num))]
+ [("--profile") "Whether to profile each run"
+ (set! report-profile? true)]
+ [("--debug") "Whether to compute metrics and debug info"
+ (set! report-debug? true)]
+ #:args (input output)
+ (make-report (list input) #:dir output #:profile report-profile? #:debug report-debug? #:note report-note #:threads threads)]
+ [reproduce "Rerun an HTML report"
+ #:once-each
+ [("--note") note "Add a note for this run"
+ (set! report-note note)]
+ [("--threads") num "How many tests to run in parallel: 'yes', 'no', or a number"
+ (set! threads (string->thread-count num))]
[("--profile") "Whether to profile each run"
(set! report-profile? true)]
#:args (input output)
- (check-operator-fallbacks!)
- (make-report (list input) #:dir output #:profile report-profile? #:note report-note #:threads threads)]
+ (rerun-report input #:dir output #:profile report-profile? #:debug report-debug? #:note report-note #:threads threads)]
#:args files
(begin
diff --git a/src/improve.rkt b/src/improve.rkt
index 5e9efa131..fa647b5eb 100644
--- a/src/improve.rkt
+++ b/src/improve.rkt
@@ -1,34 +1,33 @@
#lang racket
-(require "formats/datafile.rkt" "reports/thread-pool.rkt" "formats/test.rkt" "common.rkt" "sandbox.rkt" "alternative.rkt")
+(require "formats/datafile.rkt" "web/thread-pool.rkt" "formats/test.rkt" "common.rkt" "sandbox.rkt" "alternative.rkt")
(provide run-improve)
(define (print-outputs tests results p #:seed [seed #f])
(when seed
(fprintf p ";; seed: ~a\n\n" seed))
(for ([res results] [test tests] #:when res)
- (match-define (table-row name status start result target inf- inf+ start-est result-est vars input output time bits link) (cdr res))
- (match status
+ (define name (table-row-name res))
+ (match (table-row-status res)
["error"
(fprintf p ";; Error in ~a\n" name)
- (write (car res) p)
+ (write (unparse-result res) p)
(newline p)]
["crash"
(fprintf p ";; Crash in ~a\n" name)
- (write (car res) p)
+ (write (unparse-result res) p)
(newline p)]
["timeout"
- (fprintf p ";; ~a times out in ~as\n"
- (/ (*timeout*) 1000) name)
- (write (car res) p)
+ (fprintf p ";; ~a times out in ~as\n" (/ (*timeout*) 1000) name)
+ (write (unparse-result res) p)
(newline p)]
[(? string?)
- (write (car res) p)
+ (write (unparse-result res) p)
(newline p)])))
(define (run-improve input output #:threads [threads #f])
(define seed (get-seed))
(define tests (load-tests input))
- (define results (get-test-results tests #:threads threads #:seed seed #:profile #f #:dir #f))
+ (define results (get-test-results tests #:threads threads #:seed seed #:profile #f #:debug #f #:dir #f))
(if (equal? output "-")
(print-outputs tests results (current-output-port) #:seed seed)
diff --git a/src/info.rkt b/src/info.rkt
index 8f7b1acc8..f52adb146 100644
--- a/src/info.rkt
+++ b/src/info.rkt
@@ -1,7 +1,7 @@
#lang info
(define collection "herbie")
-(define version "1.1")
+(define version "1.3")
;; Packaging information
@@ -9,6 +9,7 @@
(define pkg-authors
'("Pavel Panchekha"
"Alex Sanchez-Stern"
+ "David Thien"
"Jason Qiu"
"James Wilcox"
"Zachary Tatlock"
@@ -22,7 +23,7 @@
;; Dependencies
(define deps
- '(("base" #:version "6.3")
+ '(("base" #:version "7.0")
"math-lib"
"plot-lib"
"profile-lib"
@@ -31,6 +32,3 @@
(define build-deps
'("rackunit-lib"))
-
-(define compile-omit-paths '("test" "old"))
-(define test-omit-paths '("test" "old"))
diff --git a/src/interface.rkt b/src/interface.rkt
new file mode 100644
index 000000000..f30e094a6
--- /dev/null
+++ b/src/interface.rkt
@@ -0,0 +1,76 @@
+#lang racket
+
+(require math/bigfloat math/flonum "bigcomplex.rkt")
+
+(provide (struct-out representation) get-representation)
+(module+ internals (provide define-representation))
+
+(struct representation
+ (name
+ bf->repr repr->bf ordinal->repr repr->ordinal
+ total-bits special-values exact->repr)
+ #:methods gen:custom-write
+ [(define (write-proc repr port mode)
+ (fprintf port "#" (representation-name repr)))])
+
+(define representations (make-hash))
+(define (get-representation name)
+ (hash-ref representations name
+ (λ () (error 'get-representation "Unknown representation ~a" name))))
+
+(define-syntax-rule (define-representation name args ...)
+ (begin
+ (define name (representation 'name args ...))
+ (hash-set! representations 'name name)))
+
+(define-representation bool
+ identity
+ identity
+ (λ (x) (= x 0))
+ (λ (x) (if x 1 0))
+ 1
+ null
+ identity)
+
+(define-representation binary64
+ bigfloat->flonum
+ bf
+ ordinal->flonum
+ flonum->ordinal
+ 64
+ '(+nan.0 +inf.0 -inf.0)
+ real->double-flonum)
+
+(define (single-flonum->bit-field x)
+ (integer-bytes->integer (real->floating-point-bytes x 4) #f))
+
+(define (single-flonum->ordinal x)
+ (cond
+ [(< x 0.0f0) (- (single-flonum->bit-field (- 0.0f0 x)))]
+ [else (single-flonum->bit-field (abs x))]))
+
+(define (bit-field->single-flonum x)
+ (real->single-flonum (floating-point-bytes->real (integer->integer-bytes x 4 #f) #f)))
+
+(define (ordinal->single-flonum x)
+ (cond
+ [(< x 0) (- (bit-field->single-flonum (- x)))]
+ [else (bit-field->single-flonum x)]))
+
+(define-representation binary32
+ (compose real->single-flonum bigfloat->flonum)
+ bf
+ ordinal->single-flonum
+ single-flonum->ordinal
+ 32
+ '(+nan.f +inf.f -inf.f)
+ real->single-flonum)
+
+(define-representation complex
+ (λ (x) (make-rectangular (bigfloat->flonum (bigcomplex-re x)) (bigfloat->flonum (bigcomplex-im x))))
+ (λ (x) (bigcomplex (bf (real-part x)) (bf (imag-part x))))
+ (λ (x) (make-rectangular (ordinal->flonum (quotient x (expt 2 64))) (ordinal->flonum (modulo x (expt 2 64)))))
+ (λ (x) (+ (* (expt 2 64) (flonum->ordinal (real-part x))) (flonum->ordinal (imag-part x))))
+ 128
+ '(+nan.0 +inf.0)
+ real->double-flonum)
diff --git a/src/mainloop.rkt b/src/mainloop.rkt
index 364dc068a..4a655c40c 100644
--- a/src/mainloop.rkt
+++ b/src/mainloop.rkt
@@ -1,23 +1,12 @@
#lang racket
-(require "common.rkt")
-(require "glue.rkt")
-(require "programs.rkt")
-(require "points.rkt")
-(require "core/localize.rkt")
-(require "core/taylor.rkt")
-(require "core/alt-table.rkt")
-(require "alternative.rkt")
-(require "core/simplify.rkt")
-(require "formats/test.rkt")
-(require "core/matcher.rkt")
+(require "common.rkt" "programs.rkt" "points.rkt" "alternative.rkt" "errors.rkt" "timeline.rkt")
+(require "core/localize.rkt" "core/taylor.rkt" "core/alt-table.rkt" "core/simplify.rkt"
+ "core/matcher.rkt" "core/regimes.rkt")
+(require "type-check.rkt") ;; For taylor not running on complex exprs
(provide (all-defined-out))
-; For debugging
-(define program-a '(λ (x) (/ (- (exp x) 1) x)))
-(define program-b '(λ (x) (- (sqrt (+ x 1)) (sqrt x))))
-
;; I'm going to use some global state here to make the shell more
;; friendly to interact with without having to store your own global
;; state in the repl as you would normally do with debugging. This is
@@ -26,10 +15,10 @@
;; head at once, because then global state is going to mess you up.
(struct shellstate
- (table next-alt locs children gened-series gened-rewrites simplified precondition timeline)
+ (table next-alt locs children gened-series gened-rewrites simplified precondition precision)
#:mutable)
-(define ^shell-state^ (make-parameter (shellstate #f #f #f #f #f #f #f 'TRUE '())))
+(define ^shell-state^ (make-parameter (shellstate #f #f #f #f #f #f #f 'TRUE #f)))
(define (^locs^ [newval 'none])
(when (not (equal? newval 'none)) (set-shellstate-locs! (^shell-state^) newval))
@@ -46,9 +35,9 @@
(define (^precondition^ [newval 'none])
(when (not (equal? newval 'none)) (set-shellstate-precondition! (^shell-state^) newval))
(shellstate-precondition (^shell-state^)))
-(define (^timeline^ [newval 'none])
- (when (not (equal? newval 'none)) (set-shellstate-timeline! (^shell-state^) newval))
- (map unbox (reverse (shellstate-timeline (^shell-state^)))))
+(define (^precision^ [newval 'none])
+ (when (not (equal? newval 'none)) (set-shellstate-precision! (^shell-state^) newval))
+ (shellstate-precision (^shell-state^)))
;; Keep track of state for (finish-iter!)
(define (^gened-series^ [newval 'none])
@@ -61,46 +50,48 @@
(when (not (equal? newval 'none)) (set-shellstate-simplified! (^shell-state^) newval))
(shellstate-simplified (^shell-state^)))
-(define *setup-fuel* (make-parameter 3))
-
-(define (timeline-event! type)
- (let ([b (box (list (cons 'type type) (cons 'time (current-inexact-milliseconds))))])
- (set-shellstate-timeline! (^shell-state^) (cons b (shellstate-timeline (^shell-state^))))
- (λ (key value) (set-box! b (cons (cons key value) (unbox b))))))
+(define (check-unused-variables vars precondition expr)
+ ;; Fun story: you might want variables in the precondition that
+ ;; don't appear in the `expr`, because that can allow you to do
+ ;; non-uniform sampling. For example, if you have the precondition
+ ;; `(< x y)`, where `y` is otherwise unused, then `x` is sampled
+ ;; non-uniformly (biased toward small values).
+ (define used (set-union (free-variables expr) (free-variables precondition)))
+ (unless (set=? vars used)
+ (define unused (set-subtract vars used))
+ (warn 'unused-variable
+ "unused ~a ~a" (if (equal? (set-count unused) 1) "variable" "variables")
+ (string-join (map ~a unused) ", "))))
;; Setting up
-(define (setup-prog! prog #:precondition [precondition 'TRUE])
+(define (setup-prog! prog #:precondition [precondition 'TRUE]
+ #:precision [precision 'binary64])
(*start-prog* prog)
(rollback-improve!)
- (timeline-event! 'start) ; This has no associated data, so we don't name it
+ (check-unused-variables (program-variables prog) precondition (program-body prog))
+
(debug #:from 'progress #:depth 3 "[1/2] Preparing points")
- (let* ([context (prepare-points prog precondition)])
- (^precondition^ precondition)
- (*pcontext* context)
- (*analyze-context* context)
- (debug #:from 'progress #:depth 3 "[2/2] Setting up program.")
- (define log! (timeline-event! 'setup))
- (^table^ (setup-prog prog (*setup-fuel*)))
- (void)))
+ (timeline-event! 'sample)
+ (define context (prepare-points prog precondition precision))
+ (^precondition^ precondition)
+ (^precision^ precision)
+ (*pcontext* context)
+ (debug #:from 'progress #:depth 3 "[2/2] Setting up program.")
+ (^table^ (make-alt-table context (make-alt prog)))
+ (void))
;; Information
(define (list-alts)
- (printf "Here are the current alts in the table\n")
- (printf "Key:\n")
- (printf "x = already expanded\n")
- (printf "+ = currently chosen\n")
- (printf "* = left to expand\n")
- (printf)
+ (printf "Key: [.] = done; [>] = chosen\n")
(let ([ndone-alts (atab-not-done-alts (^table^))])
(for ([alt (atab-all-alts (^table^))]
[n (in-naturals)])
(printf "~a ~a ~a\n"
- (cond [(equal? alt (^next-alt^)) "+"]
- [(set-member? ndone-alts alt) "*"]
- [else "x"])
+ (cond [(equal? alt (^next-alt^)) ">"]
+ [(set-member? ndone-alts alt) " "]
+ [else "."])
n
- alt)))
- (void))
+ alt))))
;; Begin iteration
(define (choose-alt! n)
@@ -112,6 +103,11 @@
(^table^ table*)
(void))))
+(define (best-alt alts)
+ (argmin alt-cost
+ (argmins (λ (alt) (errors-score (errors (alt-program alt) (*pcontext*))))
+ alts)))
+
(define (choose-best-alt!)
(let-values ([(picked table*) (atab-pick-alt (^table^) #:picking-func best-alt
#:only-fresh #t)])
@@ -122,44 +118,150 @@
;; Invoke the subsystems individually
(define (localize!)
- (define log! (timeline-event! 'localize))
- (^locs^ (localize-error (alt-program (^next-alt^))))
+ (timeline-event! 'localize)
+ (define locs (localize-error (alt-program (^next-alt^))))
+ (for/list ([(err loc) (in-dict locs)])
+ (timeline-push! 'locations
+ (location-get loc (alt-program (^next-alt^)))
+ (errors-score err)))
+ (^locs^ (map cdr locs))
(void))
+(define transforms-to-try
+ (let ([invert-x (λ (x) `(/ 1 ,x))] [exp-x (λ (x) `(exp ,x))] [log-x (λ (x) `(log ,x))]
+ [ninvert-x (λ (x) `(/ 1 (- ,x)))])
+ `((0 ,identity ,identity)
+ (inf ,invert-x ,invert-x)
+ (-inf ,ninvert-x ,ninvert-x)
+ #;(exp ,exp-x ,log-x)
+ #;(log ,log-x ,exp-x))))
+
+(define (taylor-alt altn loc)
+ (define expr (location-get loc (alt-program altn)))
+ (define vars (free-variables expr))
+ (if (or (null? vars) ;; `approximate` cannot be called with a null vars list
+ (not (equal? (type-of expr (for/hash ([var vars]) (values var 'real))) 'real)))
+ (list altn)
+ (for/list ([transform-type transforms-to-try])
+ (match-define (list name f finv) transform-type)
+ (define transformer (map (const (cons f finv)) vars))
+ (alt
+ (location-do loc (alt-program altn) (λ (expr) (approximate expr vars #:transform transformer)))
+ `(taylor ,name ,loc)
+ (list altn)))))
+
(define (gen-series!)
(when (flag-set? 'generate 'taylor)
- (define log! (timeline-event! 'series))
+ (timeline-event! 'series)
+
(define series-expansions
(apply
append
(for/list ([location (^locs^)] [n (in-naturals 1)])
(debug #:from 'progress #:depth 4 "[" n "/" (length (^locs^)) "] generating series at" location)
- (taylor-alt (^next-alt^) location))))
+ (define tnow (current-inexact-milliseconds))
+ (begin0
+ (taylor-alt (^next-alt^) location)
+ (timeline-push! 'times
+ (location-get location (alt-program (^next-alt^)))
+ (- (current-inexact-milliseconds) tnow))))))
+
+ (timeline-log! 'inputs (length (^locs^)))
+ (timeline-log! 'outputs (length series-expansions))
+
(^children^ (append (^children^) series-expansions)))
(^gened-series^ #t)
(void))
(define (gen-rewrites!)
- (define alt-rewrite (if (flag-set? 'generate 'rr) alt-rewrite-rm alt-rewrite-expression))
- (define log! (timeline-event! 'rewrite))
- (define rewritten
+ (timeline-event! 'rewrite)
+ (define rewrite (if (flag-set? 'generate 'rr) rewrite-expression-head rewrite-expression))
+ (timeline-log! 'method (object-name rewrite))
+ (define altn (alt-add-event (^next-alt^) '(start rm)))
+
+ (define changelists
(apply append
(for/list ([location (^locs^)] [n (in-naturals 1)])
(debug #:from 'progress #:depth 4 "[" n "/" (length (^locs^)) "] rewriting at" location)
- (alt-rewrite (alt-add-event (^next-alt^) '(start rm)) #:root location))))
- (^children^
- (append (^children^) rewritten))
+ (define tnow (current-inexact-milliseconds))
+ (define expr (location-get location (alt-program altn)))
+ (begin0 (rewrite expr #:root location)
+ (timeline-push! 'times expr (- (current-inexact-milliseconds) tnow))))))
+
+ (define rules-used
+ (append-map (curry map change-rule) changelists))
+ (define rule-counts
+ (sort
+ (hash->list
+ (for/hash ([rgroup (group-by identity rules-used)])
+ (values (rule-name (first rgroup)) (length rgroup))))
+ > #:key cdr))
+
+ (define rewritten
+ (for/list ([cl changelists])
+ (for/fold ([altn altn]) ([cng cl])
+ (alt (change-apply cng (alt-program altn)) (list 'change cng) (list altn)))))
+
+ (timeline-log! 'inputs (length (^locs^)))
+ (timeline-log! 'rules rule-counts)
+ (timeline-log! 'outputs (length rewritten))
+
+ (^children^ (append (^children^) rewritten))
(^gened-rewrites^ #t)
(void))
+(define (num-nodes expr)
+ (if (not (list? expr)) 1
+ (add1 (apply + (map num-nodes (cdr expr))))))
+
(define (simplify!)
(when (flag-set? 'generate 'simplify)
- (define log! (timeline-event! 'simplify))
- (define simplified
+ (timeline-event! 'simplify)
+
+ (define locs-list
(for/list ([child (^children^)] [n (in-naturals 1)])
- (debug #:from 'progress #:depth 4 "[" n "/" (length (^children^)) "] simplifiying candidate" child)
- (with-handlers ([exn:fail? (λ (e) (printf "Failed while simplifying candidate ~a\n" child) (raise e))])
- (apply alt-apply child (simplify child)))))
+ ;; We want to avoid simplifying if possible, so we only
+ ;; simplify things produced by function calls in the rule
+ ;; pattern. This means no simplification if the rule output as
+ ;; a whole is not a function call pattern, and no simplifying
+ ;; subexpressions that don't correspond to function call
+ ;; patterns.
+ (match (alt-event child)
+ [(list 'taylor _ loc) (list loc)]
+ [(list 'change cng)
+ (match-define (change rule loc _) cng)
+ (define pattern (rule-output rule))
+ (define expr (location-get loc (alt-program child)))
+ (cond
+ [(not (list? pattern)) '()]
+ [else
+ (for/list ([pos (in-naturals 1)]
+ [arg-pattern (cdr pattern)] #:when (list? arg-pattern))
+ (append (change-location cng) (list pos)))])]
+ [_ (list '(2))])))
+
+ (define to-simplify
+ (for/list ([child (^children^)] [locs locs-list]
+ #:when true [loc locs])
+ (location-get loc (alt-program child))))
+
+ (define simplifications
+ (simplify-batch to-simplify #:rules (*simplify-rules*)))
+
+ (define simplify-hash
+ (make-immutable-hash (map cons to-simplify simplifications)))
+
+ (define simplified
+ (for/list ([child (^children^)] [locs locs-list])
+ (for/fold ([child child]) ([loc locs])
+ (define child* (location-do loc (alt-program child) (λ (expr) (hash-ref simplify-hash expr))))
+ (if (> (program-cost (alt-program child)) (program-cost child*))
+ (alt child* (list 'simplify loc) (list child))
+ child))))
+
+ (timeline-log! 'inputs (length locs-list))
+ (timeline-log! 'outputs (length simplified))
+
(^children^ simplified))
(^simplified^ #t)
(void))
@@ -167,8 +269,11 @@
;; Finish iteration
(define (finalize-iter!)
- (define log! (timeline-event! 'prune))
+ (timeline-event! 'prune)
(^table^ (atab-add-altns (^table^) (^children^)))
+ (timeline-log! 'kept-alts (length (atab-not-done-alts (^table^))))
+ (timeline-log! 'done-alts (- (length (atab-all-alts (^table^))) (length (atab-not-done-alts (^table^)))))
+ (timeline-log! 'min-error (errors-score (atab-min-errors (^table^))))
(rollback-iter!)
(void))
@@ -207,8 +312,8 @@
(define (rollback-improve!)
(rollback-iter!)
+ (reset!)
(^table^ #f)
- (^timeline^ '())
(void))
;; Run a complete iteration
@@ -231,53 +336,50 @@
(finalize-iter!)))
(void))
-(define (run-improve prog iters #:get-context [get-context? #f] #:precondition [precondition 'TRUE])
+(define (run-improve prog iters #:precondition [precondition 'TRUE]
+ #:precision [precision 'binary64])
(debug #:from 'progress #:depth 1 "[Phase 1 of 3] Setting up.")
- (setup-prog! prog #:precondition precondition)
- (if (and (flag-set? 'setup 'early-exit) (< (errors-score (errors (*start-prog*) (*pcontext*))) 0.1))
- (let ([init-alt (make-alt (*start-prog*))])
- (debug #:from 'progress #:depth 1 "Initial program already accurate, stopping.")
- (if get-context?
- (list init-alt (*pcontext*))
- init-alt))
- (begin
- (debug #:from 'progress #:depth 1 "[Phase 2 of 3] Improving.")
- (let* ([current-alts (atab-all-alts (^table^))]
- [new-alt (setup-alt-simplified prog)]
- [all-alts (append current-alts (list new-alt))])
- (^table^ (atab-add-altns (^table^) all-alts))
- (for ([iter (in-range iters)] #:break (atab-completed? (^table^)))
- (debug #:from 'progress #:depth 2 "iteration" (+ 1 iter) "/" iters)
- (run-iter!))
- (finalize-table!)
- (debug #:from 'progress #:depth 1 "[Phase 3 of 3] Extracting.")
- (if get-context?
- (list (get-final-combination) (*pcontext*))
- (get-final-combination))))))
-
-;; Finishing Herbie
-(define (finalize-table!)
- (when (flag-set? 'reduce 'post-process)
- (^table^ (post-process (^table^) timeline-event!)))
- (void))
+ (setup-prog! prog #:precondition precondition #:precision precision)
+ (cond
+ [(and (flag-set? 'setup 'early-exit)
+ (< (errors-score (errors (*start-prog*) (*pcontext*))) 0.1))
+ (debug #:from 'progress #:depth 1 "Initial program already accurate, stopping.")
+ (make-alt (*start-prog*))]
+ [else
+ (debug #:from 'progress #:depth 1 "[Phase 2 of 3] Improving.")
+ (when (flag-set? 'setup 'simplify)
+ (^children^ (atab-all-alts (^table^)))
+ (simplify!)
+ (finalize-iter!))
+ (for ([iter (in-range iters)] #:break (atab-completed? (^table^)))
+ (debug #:from 'progress #:depth 2 "iteration" (+ 1 iter) "/" iters)
+ (run-iter!))
+ (debug #:from 'progress #:depth 1 "[Phase 3 of 3] Extracting.")
+ (get-final-combination precision)]))
-(define (get-final-combination)
+(define (get-final-combination precision)
+ (define all-alts (atab-all-alts (^table^)))
+ (*all-alts* all-alts)
(define joined-alt
- (if (flag-set? 'reduce 'regimes)
- (let ([log! (timeline-event! 'regimes)])
- (match-let ([`(,tables ,splitpoints) (split-table (^table^))])
- (if (= (length tables) 1)
- (extract-alt (car tables))
- (combine-alts splitpoints (map extract-alt tables)))))
- (extract-alt (^table^))))
- (define reduced-alt (remove-pows joined-alt))
- (define cleaned-alt (apply alt-apply reduced-alt (simplify-fp-safe reduced-alt)))
+ (cond
+ [(and (flag-set? 'reduce 'regimes) (> (length all-alts) 1))
+ (timeline-event! 'regimes)
+ (define option (infer-splitpoints all-alts))
+ (timeline-event! 'bsearch)
+ (combine-alts option precision)]
+ [else
+ (best-alt all-alts)]))
+ (timeline-event! 'simplify)
+ (define cleaned-alt
+ (alt `(λ ,(program-variables (alt-program joined-alt))
+ ,(simplify-expr (program-body (alt-program joined-alt)) #:rules (*fp-safe-simplify-rules*)))
+ 'final-simplify (list joined-alt)))
(timeline-event! 'end)
cleaned-alt)
;; Other tools
-(define (resample!)
- (let ([context (prepare-points (*start-prog*) (^precondition^))])
+(define (resample! precision)
+ (let ([context (prepare-points (*start-prog*) (^precondition^) precision)])
(*pcontext* context)
(^table^ (atab-new-context (^table^) context)))
(void))
diff --git a/src/old/data.rkt b/src/old/data.rkt
deleted file mode 100644
index b09b44476..000000000
--- a/src/old/data.rkt
+++ /dev/null
@@ -1,63 +0,0 @@
-#lang racket
-
-(require "../points.rkt")
-(require "../alternative.rkt")
-(require "../formats/test.rkt")
-(require "../formats/datafile.rkt")
-(require "../config.rkt")
-(require "../plot.rkt")
-(require "../common.rkt")
-(require "../mainloop.rkt")
-(require json)
-(require math/flonum)
-
-
-(define (get-report-errs start end target file)
- (define newcontext
- (parameterize ([*num-points* 8000])
- (prepare-points (alt-program start))))
- (write-errors file newcontext start end target))
-
-(define (run-test-write-errors tst file)
- (define start (make-alt (test-program tst)))
- (define target (make-alt (test-target tst)))
- (define end (run-improve (test-program tst) (*num-iterations*)))
- (get-report-errs start end target file))
-
-(define (write-errors file pcontext start end target)
- (parameterize ([*pcontext* pcontext])
- (define (get-errors altn)
- (for/list ([(p _) (in-pcontext pcontext)]
- [err (alt-errors altn)])
- (list p err)))
- (let ([data
- (make-hash
- `((points . ,(for/list ([(p _) (in-pcontext pcontext)]) p))
- (startErrors . ,(alt-errors start))
- (endErrors . ,(alt-errors end))
- (targetErrors . ,(alt-errors target))))])
- (call-with-output-file file (curry write-json data) #:exists 'replace))))
-
-(define (json->graph axis-index json-file graph-file)
- (let* ([data (call-with-input-file json-file read-json)]
- [pnts (hash-ref data 'points)])
- (define (sow-data sow data-points theme)
- (when (not (= (length data-points) (length pnts)))
- (error "lists don't match"))
- (sow (error-points data-points pnts #:axis axis-index #:color theme))
- (sow (error-avg data-points pnts #:axis axis-index #:color theme)))
- (call-with-output-file graph-file #:exists 'replace
- (λ (port)
- (herbie-plot #:port port #:kind 'png
- (reap [sow]
- (sow-data sow (hash-ref data 'startErrors) *red-theme*)
- (sow-data sow (hash-ref data 'endErrors) *blue-theme*)
- (sow-data sow (hash-ref data 'targetErrors) *green-theme*)))))))
-
-(define (json->ordinal-json in-file out-file)
- (let* ([data (call-with-input-file in-file read-json)]
- [float-points (hash-ref data 'points)]
- [ordinal-points (map (curry map flonum->ordinal) float-points)]
- [out-data (hash-set data 'points ordinal-points)])
- (call-with-output-file out-file (curry write-json out-data) #:exists 'replace)))
-
diff --git a/src/old/herbie.rkt b/src/old/herbie.rkt
deleted file mode 100644
index 2c2ecf292..000000000
--- a/src/old/herbie.rkt
+++ /dev/null
@@ -1,72 +0,0 @@
-#lang racket
-
-(require "../common.rkt" "../errors.rkt" "../points.rkt" "../alternative.rkt"
- "../formats/test.rkt" "../sandbox.rkt")
-(provide run-herbie)
-
-(define (read-fpcore name port)
- (with-handlers
- ([(or/c exn:fail:user? exn:fail:read?)
- (λ (e)
- ((error-display-handler) (exn-message e) e)
- (read-fpcore name port))])
- (define input (read-syntax name port))
- (if (eof-object? input) eof (parse-test input))))
-
-(define (herbie-input? fname)
- (or (not fname) ; Command line
- (and
- (not (file-name-from-path fname))
- (directory-exists? fname)) ; Directory of files
- (and
- (file-name-from-path fname)
- (regexp-match? #rx"\\.fpcore" (file-name-from-path fname))
- (file-exists? fname)))) ; Herbie input format 1 or 2
-
-(define (in-herbie-files files)
- (if (null? files)
- (in-port (curry read-fpcore "stdin") (current-input-port))
- (all-herbie-tests files)))
-
-
-(define (all-herbie-tests files)
- (apply append
- (for/list ([file files])
- (if (directory-exists? file)
- (all-herbie-tests (filter herbie-input? (directory-list file #:build? #t)))
- (call-with-input-file file
- (λ (port)
- (define file* (if (string? file) (string->path file) file))
- (port-count-lines! port)
- (sequence->list (in-port (curry read-fpcore file*) port))))))))
-
-
-(define (in-herbie-output files #:seed seed)
- (eprintf "Seed: ~a\n" seed)
- (sequence-map
- (λ (test) (get-test-result test #:seed seed))
- (in-herbie-files files)))
-
-
-(define (run-herbie files)
- (define seed (get-seed))
- (with-handlers ([exn:break? (λ (e) (exit 0))])
- (for ([output (in-herbie-output files #:seed seed)] [idx (in-naturals)]
- #:when output)
- (match output
- [(test-result test time bits start-alt end-alt points exacts
- start-est-error end-est-error newpoint newexacts
- start-error end-error target-error timeline)
- (eprintf "[ ~ams]\t~a\t(~a→~a)\n"
- (~a time #:width 8)
- (test-name test)
- (~r (errors-score start-error) #:min-width 2 #:precision 1)
- (~r (errors-score end-error) #:min-width 2 #:precision 1))
- (printf "~a\n" (unparse-test (alt-program end-alt)))]
- [(test-failure test bits exn time timeline)
- (eprintf "[ CRASH ]\t~a\n" (test-name test))
- (printf ";; Crash in ~a\n" (test-name test))
- ((error-display-handler) (exn-message exn) exn)]
- [(test-timeout test bits time timeline)
- (eprintf "[ timeout ]\t~a\n" (test-name test))
- (printf ";; ~as timeout in ~a\n;; use --timeout to change timeout\n" (/ time 1000) (test-name test))]))))
diff --git a/src/old/inout.rkt b/src/old/inout.rkt
deleted file mode 100644
index 4dc9ea85e..000000000
--- a/src/old/inout.rkt
+++ /dev/null
@@ -1,63 +0,0 @@
-#lang racket
-
-(require "../config.rkt")
-(require "../common.rkt")
-(require "../points.rkt")
-(require "../programs.rkt")
-(require "../alternative.rkt")
-(require "../formats/test.rkt")
-(require "../mainloop.rkt")
-(require "../errors.rkt")
-
-(define (run #:print-points [print-points? #f])
- (eprintf "; Seed: ~a\n" (get-seed))
- (define in-expr (read))
- (define out-alt
- (match in-expr
- [`(herbie-test . ,_)
- (let ([tst (parse-test in-expr)])
- (set! in-expr (test-program tst))
- (run-improve (test-program tst) (*num-iterations*)))]
- [`(,(or 'λ 'lambda) ,vars ,body)
- (run-improve in-expr (*num-iterations*))]
- [_ (error "did not recognize input")]))
- (printf "; Input error: ~a\n" (errors-score (alt-errors (make-alt in-expr))))
- (printf "; Output error: ~a\n" (errors-score (alt-errors out-alt)))
- (define in-prog (eval-prog in-expr 'fl))
- (define out-prog (eval-prog (alt-program out-alt) 'fl))
- (when print-points?
- (for ([(pt ex) (in-pcontext (*pcontext*))])
- (let ([in-ans (in-prog pt)] [out-ans (out-prog pt)])
- (when (not (= in-ans out-ans))
- (printf "; sample ~a exact ~a input ~a output ~a improvement ~a\n"
- pt ex in-ans out-ans
- (- (bit-difference ex in-ans)
- (bit-difference ex out-ans)))))))
- (printf "~a\n" (alt-program out-alt)))
-
-(module+ main
- (define print-points #f)
- (command-line
- #:program "herbie/inout.rkt"
- #:once-each
- [("-r" "--seed") rs "The random seed vector to use in point generation"
- (set-seed! (read (open-input-string rs)))]
- [("--fuel") fu "The amount of 'fuel' to use"
- (*num-iterations* (string->number fu))]
- [("--num-points") points "The number of points to use"
- (*num-points* (string->number points))]
- [("--print-points") "Print all sampled points"
- (set! print-points #t)]
- #:multi
- [("-o" "--disable") tf "Disable flag formatted category:name"
- (define flag (parse-flag tf))
- (when (not flag)
- (raise-herbie-error "Invalid flag ~a" tf #:url "options.html"))
- (apply disable-flag! flag)]
- [("+o" "--enable") tf "Enable flag formatted category:name"
- (define flag (parse-flag tf))
- (when (not flag)
- (raise-herbie-error "Invalid flag ~a" tf #:url "options.html"))
- (apply enable-flag! flag)]
- #:args ()
- (run #:print-points print-points)))
diff --git a/src/old/util.rkt b/src/old/util.rkt
deleted file mode 100644
index 79ccbfa36..000000000
--- a/src/old/util.rkt
+++ /dev/null
@@ -1,107 +0,0 @@
-#lang racket
-
-(require "../points.rkt")
-(require "../alternative.rkt")
-(require "../common.rkt")
-(require "../core/matcher.rkt")
-(require "../programs.rkt")
-(require "../glue.rkt")
-(require "../mainloop.rkt")
-(require "../core/egraph.rkt")
-(require "../syntax/rules.rkt")
-(require "../plot.rkt")
-
-(provide (all-defined-out))
-
-
-(define (visualize alt #:marks [marks '()] #:axis [axis 0])
- (define pts (for/list ([(pt ex) (in-pcontext (*pcontext*))]) pt))
- (define errs (alt-errors alt))
-
- (define renderers
- (list* (error-avg errs pts #:axis axis) (error-points errs pts #:axis axis)
- (for/list ([x-val marks]) (error-mark x-val))))
-
- (apply herbie-plot renderers))
-
-
-;; (define (saturate-iters expr)
-;; (let ([eg (mk-egraph expr)])
-;; (let loop ([iters-done 1])
-;; (let ([start-cnt (egraph-cnt eg)])
-;; (one-iter eg (*simplify-rules*))
-;; (printf "Did iter #~a, have ~a nodes.~n" iters-done (egraph-cnt eg))
-;; (if (> (egraph-cnt eg) start-cnt)
-;; (loop (add1 iters-done))
-;; (sub1 iters-done))))))
-
-(define (print-improve prog max-iters)
- (match-let ([`(,end-prog ,context) (run-improve prog max-iters #:get-context #t)])
- (parameterize ([*pcontext* context])
- (let ([start (make-alt prog)]
- [end (make-alt end-prog)])
- (printf "Started at: ~a\n" start)
- (printf "Ended at: ~a\n" end)
- (printf "Improvement by an average of ~a bits of precision\n"
- (- (errors-score (alt-errors start)) (errors-score (alt-errors end))))
- (void)))))
-
-(define (prog-improvement prog1 prog2)
- (let-values ([(points exacts) (prepare-points prog1)])
- (- (errors-score (errors prog1 points exacts)) (errors-score (errors prog2 points exacts)))))
-
-(define (annotated-alts-compare alt1 alt2)
- (match-let ([(list pts exs) (sorted-context-list (*pcontext*) 0)])
- (parameterize ([*pcontext* (mk-pcontext pts exs)])
- (annotated-errors-compare (alt-errors alt1) (alt-errors alt2)))))
-
-(define (annotated-errors-compare errs1 errs2)
- (printf "~a\n"
- (reverse
- (first-value
- (for/fold ([acc '()] [region #f])
- ([err-diff (for/list ([e1 errs1] [e2 errs2])
- (cond [(> e1 e2) '>]
- [(< e1 e2) '<]
- [#t '=]))]
- [(pt _) (in-pcontext (*pcontext*))])
- (if (eq? region err-diff)
- (values (cons err-diff acc)
- region)
- (values (cons (cons pt err-diff) acc)
- err-diff)))))))
-
-(define (compare-alts . altns)
- (printf "~a\n"
- (reverse
- (first-value
- (for/fold ([acc '()] [region-idx -1])
- ([(pt ex) (in-pcontext (*pcontext*))]
- [errs (flip-lists (map alt-errors altns))])
- (let ([best-idx
- (argmin (curry list-ref errs) (range (length altns)))])
- (if (= best-idx region-idx)
- (values (cons best-idx acc) region-idx)
- (values (cons (list best-idx (list-ref altns best-idx) pt)
- acc)
- best-idx))))))))
-
-(define (print-alt-info altn)
- (if (not (alt-prev altn))
- (printf "Started with: ~a\n" (alt-program altn))
- (begin (print-alt-info (alt-prev altn))
- (let ([chng (alt-change altn)])
- (printf "Applied rule ~a at ~a [ ~a ], and got: ~a\n"
- (change-rule chng) (change-location chng)
- (location-get (change-location chng)
- (alt-program (alt-prev altn)))
- (alt-program altn))
- (void)))))
-
-(define (incremental-changes-apply changes expr)
- (let loop ([rest-chngs changes] [cur-expr expr])
- (if (null? rest-chngs)
- cur-expr
- (begin (printf "~a\n" cur-expr)
- (printf "~a\n" (car rest-chngs))
- (loop (cdr rest-chngs) (change-apply (car rest-chngs) cur-expr))))))
diff --git a/src/plot.rkt b/src/plot.rkt
index f883dcb93..cfc3f58e0 100644
--- a/src/plot.rkt
+++ b/src/plot.rkt
@@ -2,14 +2,11 @@
(require math/flonum)
(require plot/no-gui)
-(require "common.rkt")
-(require "float.rkt")
-(require "points.rkt")
-(require "programs.rkt")
-(require "alternative.rkt")
+(require "common.rkt" "float.rkt" "points.rkt" "programs.rkt" "alternative.rkt" "interface.rkt")
-(provide error-points herbie-plot error-mark error-avg error-axes
- *red-theme* *blue-theme* *green-theme* *yellow-theme*)
+(provide error-points best-alt-points herbie-plot alt-plot error-mark error-avg
+ herbie-ratio-point-renderers herbie-ratio-point-colors error-axes
+ *red-theme* *blue-theme* *green-theme* *yellow-theme*)
(struct color-theme (scatter line fit))
(define *red-theme* (color-theme "pink" "red" "darkred"))
@@ -17,20 +14,22 @@
(define *green-theme* (color-theme "lightgreen" "green" "darkgreen"))
(define *yellow-theme* (color-theme "gold" "yellow" "olive"))
-(define double-transform
+(define (double-transform)
+ (define repr (get-representation (if (flag-set? 'precision 'double) 'binary64 'binary32)))
(invertible-function
- (compose flonum->ordinal fl)
- (compose ordinal->flonum round)))
+ (compose (representation-repr->ordinal repr) ->flonum)
+ (compose (representation-ordinal->repr repr) round)))
-(define double-axis
- (make-axis-transform double-transform))
+(define (double-axis)
+ (make-axis-transform (double-transform)))
(define (power10-upto x)
+ (define ->repr (if (flag-set? 'precision 'double) real->double-flonum real->single-flonum))
(if (= x 0)
'()
(reverse
(let loop ([power (round (/ (log x) (log 10)))])
- (define value (expt 10 power))
+ (define value (->repr (expt 10.0 power)))
(if (= value 0) '() (cons value (loop (- power 1))))))))
(define (possible-ticks min max)
@@ -94,14 +93,14 @@
(if (<= min 1.0 max) (list (pre-tick 1.0 #t)) '())
(if (<= min 0.0 max) (list (pre-tick 0.0 #t)) '())
(if (<= min -1.0 max) (list (pre-tick -1.0 #t)) '())
- ((ticks-layout (ticks-scale (linear-ticks #:number 6 #:base 10 #:divisors '(1 2 5)) double-transform)) min max))]
+ ((ticks-layout (ticks-scale (linear-ticks #:number 6 #:base 10 #:divisors '(1 2 5)) (double-transform))) min max))]
[else
(define necessary (filter identity (map (curry index-of possible) '(1.0 0.0 -1.0))))
(define major-indices (pick-spaced-indices necessary (length possible) 12))
(for/list ([idx major-indices])
(pre-tick (list-ref possible idx) #t))]))
-(define double-ticks
+(define (double-ticks)
(ticks
choose-ticks
(λ (lft rgt pticks)
@@ -121,6 +120,37 @@
(vector (x pt) (+ (ulps->bits err) (random) -1/2)))
#:sym 'fullcircle #:color (color-theme-line color) #:alpha alpha #:size 4))
+(define (best-alt-points point-alt-idxs var-idxs)
+ (define point-idxs (remove-duplicates (map cadr point-alt-idxs)))
+ (define points-list (for/list ([i point-idxs])
+ (filter (λ (x) (= (cadr x) i)) point-alt-idxs)))
+ (define non-empty-points-list (for/list ([point-list points-list])
+ point-list))
+ (for/list ([point-list non-empty-points-list] [color (range 2 121)])
+ (points (map (λ (p) (list (list-ref (car p) (car var-idxs))
+ (list-ref (car p) (cadr var-idxs))))
+ point-list) #:color color #:sym 'fullcircle #:size 5)))
+
+(define (herbie-ratio-point-colors test-points baseline-errors herbie-errors oracle-errors)
+ (define points-with-colors (for/list ([point test-points] [base-err baseline-errors]
+ [herbie-err herbie-errors]
+ [oracle-err oracle-errors])
+ (define span (- base-err oracle-err))
+ (define herbie-percent (if (= span 0) 1 (/ (- base-err herbie-err) span)))
+ (define color-num (max (round (* 240 herbie-percent)) 0))
+ (list point color-num)))
+ (define colors (remove-duplicates (map cadr points-with-colors)))
+ (for/list ([c colors])
+ (filter (λ (p) (eq? (cadr p) c)) points-with-colors)))
+
+(define (herbie-ratio-point-renderers points-colors var-idxs)
+ (for/list ([l points-colors])
+ (define color-num (cadar l))
+ (define point-color (list color-num color-num color-num))
+ (define color-points (map (λ (l) (list (list-ref (car l) (car var-idxs))
+ (list-ref (car l) (cadr var-idxs)))) l))
+ (points color-points #:color point-color #:sym 'fullcircle #:size 5)))
+
(define (error-axes pts #:axis [axis 0])
(list
(y-tick-lines)
@@ -129,8 +159,8 @@
(define (with-herbie-plot #:title [title #f] thunk)
(parameterize ([plot-width 800] [plot-height 300]
[plot-background-alpha 0]
- [plot-x-transform double-axis]
- [plot-x-ticks double-ticks]
+ [plot-x-transform (double-axis)]
+ [plot-x-ticks (double-ticks)]
[plot-x-tick-label-anchor 'top]
[plot-x-label #f]
[plot-x-far-axis? #t]
@@ -149,6 +179,30 @@
(lambda () (plot-pict (cons (y-axis) renderers) #:y-min 0 #:y-max (*bit-width*)))))
(with-herbie-plot #:title title thunk))
+(define (with-alt-plot #:title [title #f] thunk)
+ (parameterize ([plot-width 800] [plot-height 800]
+ [plot-background-alpha 1]
+ [plot-x-transform (double-axis)]
+ [plot-x-ticks (double-ticks)]
+ [plot-x-tick-label-anchor 'top]
+ [plot-x-label #f]
+ [plot-x-far-axis? #t]
+ [plot-x-far-ticks no-ticks]
+ [plot-y-transform (double-axis)]
+ [plot-y-ticks (double-ticks)]
+ [plot-y-tick-label-anchor 'left]
+ [plot-y-label #f]
+ [plot-y-far-axis? #t]
+ [plot-y-far-ticks no-ticks]
+ [plot-font-size 10]
+ [plot-y-label title])
+ (thunk)))
+
+(define (alt-plot #:port [port #f] #:kind [kind 'auto] #:title [title #f] . renderers)
+ (define thunk
+ (lambda () (plot-file renderers port kind)))
+ (with-alt-plot #:title title thunk))
+
(define (errors-by x errs pts)
(sort (map (λ (pt err) (cons (x pt) err)) pts errs) < #:key car))
@@ -200,8 +254,12 @@
(define (avg-fun x)
(define h (histogram-f x))
(/ (apply + (vector->list h)) (vector-length h)))
- (function avg-fun
- (car (first eby)) (car (last eby))
+ ;; TODO: This is a weird hack in several ways, and ideally wouldn't exist
+ (define-values (min max)
+ (match* ((car (first eby)) (car (last eby)))
+ [(x x) (values #f #f)]
+ [(x y) (values (flmax (flnext -inf.0) x) (flmin (flprev +inf.0) y))]))
+ (function avg-fun min max
#:width 2 #:color (color-theme-fit color)))
(define (error-mark x-val)
diff --git a/src/plugin.rkt b/src/plugin.rkt
new file mode 100644
index 000000000..92bd04c49
--- /dev/null
+++ b/src/plugin.rkt
@@ -0,0 +1,19 @@
+#lang racket
+(require racket/lazy-require racket/runtime-path setup/getinfo)
+(require (submod "syntax/types.rkt" internals) (submod "interface.rkt" internals)
+ (submod "syntax/rules.rkt" internals) (submod "syntax/syntax.rkt" internals))
+(provide define-type define-representation declare-parametric-operator! define-operator define-ruleset load-herbie-plugins)
+
+(define (module-exists? module)
+ (with-handlers ([exn:fail:filesystem:missing-module? (const false)])
+ (dynamic-require module #f)
+ true))
+
+(define (load-herbie-plugins)
+ (for ([dir (find-relevant-directories '(herbie-plugin))])
+ (define info
+ (with-handlers ([exn:fail:filesystem? (const false)])
+ (get-info/full dir)))
+ (define value (info 'herbie-plugin (const false)))
+ (when (and value (module-exists? value))
+ (dynamic-require value #f))))
diff --git a/src/points.rkt b/src/points.rkt
index ba238fee6..df3d28c39 100644
--- a/src/points.rkt
+++ b/src/points.rkt
@@ -2,51 +2,27 @@
(require math/flonum)
(require math/bigfloat)
-(require "float.rkt" "common.rkt" "programs.rkt" "config.rkt" "errors.rkt" "range-analysis.rkt")
+(require "float.rkt" "common.rkt" "programs.rkt" "config.rkt" "errors.rkt" "timeline.rkt"
+ "range-analysis.rkt" "biginterval.rkt" "interface.rkt")
(provide *pcontext* in-pcontext mk-pcontext pcontext?
- prepare-points prepare-points-period make-exacts
- errors errors-score sorted-context-list sort-context-on-expr
- random-subsample)
+ prepare-points errors errors-score
+ oracle-error baseline-error oracle-error-idx)
-(module+ test
- (require rackunit))
-
-(define (sample-bounded lo hi #:left-closed? [left-closed? #t] #:right-closed? [right-closed? #t])
- (define lo* (exact->inexact lo))
- (define hi* (exact->inexact hi))
- (cond
- [(> lo* hi*) #f]
- [(= lo* hi*)
- (if (and left-closed? right-closed?) lo* #f)]
- [(< lo* hi*)
- (define ordinal (- (flonum->ordinal hi*) (flonum->ordinal lo*)))
- (define num-bits (ceiling (/ (log ordinal) (log 2))))
- (define random-num (random-exp (inexact->exact num-bits)))
- (if (or (and (not left-closed?) (equal? 0 random-num))
- (and (not right-closed?) (equal? ordinal random-num))
- (> random-num ordinal))
- ;; Happens with p < .5 so will not loop forever
- (sample-bounded lo hi #:left-closed? left-closed? #:right-closed? right-closed?)
- (ordinal->flonum (+ (flonum->ordinal lo*) random-num)))]))
-
-(module+ test
- (check-true (<= 1.0 (sample-bounded 1 2) 2.0))
- (let ([a (sample-bounded 1 2 #:left-closed? #f)])
- (check-true (< 1 a))
- (check-true (<= a 2)))
- (check-false (sample-bounded 1 1.0 #:left-closed? #f) "Empty interval due to left openness")
- (check-false (sample-bounded 1 1.0 #:right-closed? #f) "Empty interval due to right openness")
- (check-false (sample-bounded 1 1.0 #:left-closed? #f #:right-closed? #f)
- "Empty interval due to both-openness")
- (check-false (sample-bounded 2.0 1.0) "Interval bounds flipped"))
+(module+ test (require rackunit))
+(module+ internals (provide make-sampler ival-eval))
(define/contract (sample-multi-bounded ranges)
- (-> (listof interval?) (or/c flonum? #f))
+ (-> (listof interval?) (or/c flonum? single-flonum? #f))
+ (define repr (get-representation (if (flag-set? 'precision 'double) 'binary64 'binary32)))
+ (define ->ordinal (representation-repr->ordinal repr))
+ (define <-ordinal (representation-ordinal->repr repr))
+ (define <-exact (representation-exact->repr repr))
+
(define ordinal-ranges
(for/list ([range ranges])
- (match-define (interval (app exact->inexact lo) (app exact->inexact hi) lo? hi?) range)
- (list (flonum->ordinal lo) (flonum->ordinal hi) lo? hi?)))
+ (match-define (interval (app <-exact lo) (app <-exact hi) lo? hi?) range)
+ (list (->ordinal lo) (->ordinal hi) lo? hi?)))
(define (points-in-range lo hi lo? hi?)
;; The `max` handles the case lo > hi and similar
@@ -70,7 +46,7 @@
;; The `(car)` is guaranteed to succeed by the construction of `sample`
(match-define (list lo hi lo? hi?) (car ordinal-ranges))
(if (< sample (points-in-range lo hi lo? hi?))
- (ordinal->flonum (+ lo (if lo? 0 1) sample))
+ (<-ordinal (+ lo (if lo? 0 1) sample))
(loop (- sample (points-in-range lo hi lo? hi?)) (cdr ordinal-ranges))))]))
(module+ test
@@ -84,47 +60,173 @@
(define (in-pcontext context)
(in-parallel (in-vector (pcontext-points context)) (in-vector (pcontext-exacts context))))
-(define (mk-pcontext points exacts)
- (pcontext (if (list? points)
- (begin (assert (not (null? points)))
- (list->vector points))
- (begin (assert (not (= 0 (vector-length points))))
- points))
- (if (list? exacts)
- (begin (assert (not (null? exacts)))
- (list->vector exacts))
- (begin (assert (not (= 0 (vector-length exacts))))
- exacts))))
-
-(define (random-subsample pcontext n)
- (let*-values ([(old-points) (pcontext-points pcontext)]
- [(old-exacts) (pcontext-exacts pcontext)]
- [(points exacts)
- (for/lists (points exacts)
- ([i (in-range n)])
- (let ([idx (random (vector-length old-points))])
- (values (vector-ref old-points idx)
- (vector-ref old-exacts idx))))])
- (mk-pcontext points exacts)))
-
-(define (sorted-context-list context vidx)
- (let ([p&e (sort (for/list ([(pt ex) (in-pcontext context)]) (cons pt ex))
- (non-empty-listof (listof any/c)) (non-empty-listof any/c) pcontext?)
+ (pcontext (list->vector points) (list->vector exacts)))
+
+(module+ test
+ (require "formats/test.rkt")
+ (require racket/runtime-path)
+ (define-runtime-path benchmarks "../bench/")
+ (define exprs
+ (let ([tests (expect-warning 'duplicate-names (λ () (load-tests benchmarks)))])
+ (append (map test-input tests) (map test-precondition tests))))
+ (define unsup-count (count (compose not (curryr expr-supports? 'ival)) exprs))
+ (eprintf "-> ~a benchmarks still not supported by the biginterval sampler.\n" unsup-count)
+ (check <= unsup-count 50))
+
+(define (point-logger name dict prog)
+ (define start (current-inexact-milliseconds))
+ (define (log! . args)
+ (define key
+ (match args
+ [`(exit ,prec ,pt)
+ (define key (list name 'exit prec))
+ (warn 'ground-truth #:url "faq.html#ground-truth"
+ "could not determine a ground truth for program ~a" name
+ #:extra (for/list ([var (program-variables prog)] [val pt])
+ (format "~a = ~a" var val)))
+ key]
+ [`(sampled ,prec ,pt #f) (list name 'false prec)]
+ [`(sampled ,prec ,pt #t) (list name 'true prec)]
+ [`(sampled ,prec ,pt ,_) (list name 'valid prec)]
+ [`(nan ,prec ,pt) (list name 'nan prec)]))
+ (define dt (- (current-inexact-milliseconds) start))
+ (hash-update! dict key (λ (x) (cons (+ (car x) 1) (+ (cdr x) dt))) (cons 0 0)))
+ (if dict log! void))
+
+(define (ival-eval fn pt prec #:precision [precision 80] #:log [log! void])
+ (define <-bf (representation-bf->repr (get-representation prec)))
+ (let loop ([precision precision])
+ (parameterize ([bf-precision precision])
+ (if (> precision (*max-mpfr-prec*))
+ (begin (log! 'exit precision pt) +nan.0)
+ (match-let* ([(ival lo hi err? err) (fn pt)] [lo* (<-bf lo)] [hi* (<-bf hi)])
+ (cond
+ [err
+ (log! 'nan precision pt)
+ +nan.0]
+ [(and (not err?) (or (equal? lo* hi*)
+ (and (equal? lo* -0.0) (equal? hi* +0.0))
+ (and (equal? lo* -0.0f0) (equal? hi* +0.0f0))))
+ (log! 'sampled precision pt hi*)
+ hi*]
+ [else
+ (loop (inexact->exact (round (* precision 2))))]))))))
+
+; These definitions in place, we finally generate the points.
+
+(define (make-sampler precondition)
+ (define range-table (condition->range-table (program-body precondition)))
+ (for ([var (program-variables precondition)]
+ #:unless (range-table-ref range-table var))
+ (raise-herbie-error "No valid values of variable ~a" var
+ #:url "faq.html#no-valid-values"))
+ (λ ()
+ (map (compose sample-multi-bounded (curry range-table-ref range-table))
+ (program-variables precondition))))
+
+(define (prepare-points-intervals prog precondition precision)
+ (timeline-log! 'method 'intervals)
+ (define log (make-hash))
+ (timeline-log! 'outcomes log)
+
+ (define pre-prog `(λ ,(program-variables prog) ,precondition))
+ (define sampler (make-sampler pre-prog))
+
+ (define pre-fn (eval-prog pre-prog 'ival))
+ (define body-fn (eval-prog prog 'ival))
+
+ (define-values (points exacts)
+ (let loop ([sampled 0] [skipped 0] [points '()] [exacts '()])
+ (define pt (sampler))
+
+ (define pre
+ (or (equal? precondition 'TRUE)
+ (ival-eval pre-fn pt 'bool #:log (point-logger 'pre log pre-prog))))
+
+ (define ex
+ (and pre (ival-eval body-fn pt precision #:log (point-logger 'body log prog))))
+
+ (cond
+ [(and (andmap ordinary-value? pt) pre (ordinary-value? ex))
+ (if (>= sampled (- (*num-points*) 1))
+ (values points exacts)
+ (loop (+ 1 sampled) 0 (cons pt points) (cons ex exacts)))]
+ [else
+ (unless (< skipped (- (*max-skipped-points*) 1))
+ (raise-herbie-error "Cannot sample enough valid points."
+ #:url "faq.html#sample-valid-points"))
+ (loop sampled (+ 1 skipped) points exacts)])))
+
+ (mk-pcontext points exacts))
+
+(define (prepare-points prog precondition precision)
+ "Given a program, return two lists:
+ a list of input points (each a list of flonums)
+ and a list of exact values for those points (each a flonum)"
+ (if (and (expr-supports? precondition 'ival) (expr-supports? (program-body prog) 'ival))
+ (prepare-points-intervals prog precondition precision)
+ (prepare-points-halfpoints prog precondition precision)))
+
+#;(define (prepare-points prog precondition precision)
+ "Given a program, return two lists:
+ a list of input points (each a list of flonums)
+ and a list of exact values for those points (each a flonum)"
+
+ (define sampled-pts (extract-sampled-points (program-variables prog) precondition))
+ (define range-table (condition->range-table precondition))
+
+ (cond
+ [sampled-pts
+ (mk-pcontext sampled-pts (make-exacts prog sampled-pts 'TRUE))]
+ [else
+ (for ([var (program-variables prog)]
+ #:unless (range-table-ref range-table var))
+ (raise-herbie-error "No valid values of variable ~a" var
+ #:url "faq.html#no-valid-values"))
+ (prepare-points-halfpoints prog precondition precision range-table)]))
+
+
+(define (point-error out exact)
+ (if (ordinary-value? out)
+ (+ 1 (abs (ulp-difference out exact)))
+ (+ 1 (expt 2 (*bit-width*)))))
+
+(define (eval-errors eval-fn pcontext)
+ (define max-ulps (expt 2 (*bit-width*)))
+ (for/list ([(point exact) (in-pcontext pcontext)])
+ (point-error (eval-fn point) exact)))
+
+(define (oracle-error-idx alt-bodies points exacts)
+ (for/list ([point points] [exact exacts])
+ (list point (argmin (λ (i) (point-error ((list-ref alt-bodies i) point) exact)) (range (length alt-bodies))))))
+
+(define (oracle-error alt-bodies pcontext)
+ (for/list ([(point exact) (in-pcontext pcontext)])
+ (argmin identity (map (λ (alt) (point-error (alt point) exact)) alt-bodies))))
+
+(define (baseline-error alt-bodies pcontext newpcontext)
+ (define baseline (argmin (λ (alt) (errors-score (eval-errors alt pcontext))) alt-bodies))
+ (eval-errors baseline newpcontext))
+
+(define (errors-score e)
+ (let-values ([(reals unreals) (partition ordinary-value? e)])
+ (if (flag-set? 'reduce 'avg-error)
+ (/ (+ (apply + (map ulps->bits reals))
+ (* (*bit-width*) (length unreals)))
+ (length e))
+ (apply max (map ulps->bits reals)))))
+
+(define (errors prog pcontext)
+ (define fn (eval-prog prog 'fl))
+ (for/list ([(point exact) (in-pcontext pcontext)])
+ (with-handlers ([exn:fail? (λ (e) (eprintf "Error when evaluating ~a on ~a\n" prog point) (raise e))])
+ (point-error (fn point) exact))))
+
+;; Old, halfpoints method of sampling points
(define (select-every skip l)
(let loop ([l l] [count skip])
@@ -135,7 +237,8 @@
[else
(loop (cdr l) (- count 1))])))
-(define (make-exacts* prog pts precondition)
+(define (make-exacts-walkup prog pts precondition prec)
+ (define <-bf (representation-bf->repr (get-representation prec)))
(let ([f (eval-prog prog 'bf)] [n (length pts)]
[pre (eval-prog `(λ ,(program-variables prog) ,precondition) 'bf)])
(let loop ([prec (max 64 (- (bf-precision) (*precision-step*)))]
@@ -146,59 +249,36 @@
(debug #:from 'points #:depth 4
"Setting MPFR precision to" prec)
(bf-precision prec)
- (let ([curr (map f pts)]
+ (let ([curr (map (compose <-bf f) pts)]
[good? (map pre pts)])
(if (and prev (andmap (λ (good? old new) (or (not good?) (=-or-nan? old new))) good? prev curr))
(map (λ (good? x) (if good? x +nan.0)) good? curr)
(loop (+ prec (*precision-step*)) curr))))))
; warning: this will start at whatever precision exacts happens to be at
-(define (make-exacts prog pts precondition)
+(define (make-exacts-halfpoints prog pts precondition prec)
(define n (length pts))
(let loop ([nth (floor (/ n 16))])
(if (< nth 2)
(begin
(debug #:from 'points #:depth 4
"Computing exacts for" n "points")
- (make-exacts* prog pts precondition))
+ (make-exacts-walkup prog pts precondition prec))
(begin
(debug #:from 'points #:depth 4
"Computing exacts on every" nth "of" n
"points to ramp up precision")
- (make-exacts* prog (select-every nth pts) precondition)
+ (make-exacts-walkup prog (select-every nth pts) precondition prec)
(loop (floor (/ nth 2)))))))
-(define (filter-points pts exacts)
- "Take only the points for which the exact value is normal, and the point is normal"
- (reap (sow)
- (for ([pt pts] [exact exacts])
- (when (and (ordinary-value? exact) (andmap ordinary-value? pt))
- (sow pt)))))
-
-(define (filter-exacts pts exacts)
- "Take only the exacts for which the exact value is normal, and the point is normal"
- (reap (sow)
- (for ([pt pts] [exact exacts])
- (when (and (ordinary-value? exact) (andmap ordinary-value? pt))
- (sow exact)))))
+(define (filter-p&e pts exacts)
+ "Take only the points and exacts for which the exact value and the point coords are ordinary"
+ (for/lists (ps es)
+ ([pt pts] [ex exacts] #:when (ordinary-value? ex) #:when (andmap ordinary-value? pt))
+ (values pt ex)))
(define (extract-sampled-points allvars precondition)
(match precondition
- [`(== ,(? variable? var) ,(? constant? val))
- (if (set=? (list var) allvars)
- (list (list val))
- #f)]
- [`(and (== ,(? variable? vars) ,(? constant? vals)) ...)
- (if (set=? vars allvars)
- (list (map (curry dict-ref (map cons vars vals)) allvars))
- #f)]
- [`(or (== ,(? variable? varss) ,(? constant? valss)) ...)
- (define pts
- (for/list ([var varss] [val valss])
- (if (set=? (list var) allvars)
- (list val)
- #f)))
- (and (andmap identity pts) pts)]
[`(or (and (== ,(? variable? varss) ,(? constant? valss)) ...) ...)
(define pts
(for/list ([vars varss] [vals valss])
@@ -206,82 +286,40 @@
(map (curry dict-ref (map cons vars vals)) allvars)
#f)))
(and (andmap identity pts) pts)]
- [`FALSE '()]
[_ #f]))
-; These definitions in place, we finally generate the points.
-
-(define (prepare-points prog precondition)
- "Given a program, return two lists:
- a list of input points (each a list of flonums)
- and a list of exact values for those points (each a flonum)"
-
- (define range-table (condition->range-table precondition))
+(define (filter-valid-points prog precondition points)
+ (define f (eval-prog (list 'λ (program-variables prog) precondition) 'fl))
+ (filter f points))
- (define sampler
- (match (extract-sampled-points (program-variables prog) precondition)
- [(list pts ...)
- (let ([l (length pts)]) (λ () (list-ref pts (random l))))]
- [#f
- (for ([var (program-variables prog)]
- #:unless (range-table-ref range-table var))
- (raise-herbie-error "No valid values of variable ~a" var
- #:url "faq.html#no-valid-values"))
- (λ ()
- (for/list ([var (program-variables prog)])
- (match (range-table-ref range-table var)
- [(interval lo hi lo? hi?)
- (sample-bounded lo hi #:left-closed? lo? #:right-closed? hi?)]
- [(list (? interval? ivals) ...)
- (sample-multi-bounded ivals)])))]))
+;; This is the obsolete version for the "halfpoint" method
+(define (prepare-points-halfpoints prog precondition precision)
+ (timeline-log! 'method 'halfpoints)
+ (define sample (make-sampler `(λ ,(program-variables prog) ,precondition)))
(let loop ([pts '()] [exs '()] [num-loops 0])
- (let ([npts (length pts)])
- (cond [(> num-loops 200)
- (raise-herbie-error "Cannot sample enough valid points."
- #:url "faq.html#sample-valid-points")]
- [(>= npts (*num-points*))
- (begin
- (debug #:from 'points #:tag 'exit #:depth 4
- "Sampled" npts "points with exact outputs")
- (mk-pcontext (take pts (*num-points*))
- (take exs (*num-points*))))]
- [#t
- (let* (; pad to avoid repeatedly trying to get last point
- [num (max 4 (- (*num-points*) npts))]
- [_ (debug #:from 'points #:depth 4
- "Sampling" num "additional inputs,"
- "on iter" num-loops "have" npts "/" (*num-points*))]
- [pts1 (for/list ([n (in-range num)]) (sampler))]
- [exs1 (make-exacts prog pts1 precondition)]
- [_ (debug #:from 'points #:depth 4
- "Filtering points with unrepresentable outputs")]
- [pts* (filter-points pts1 exs1)]
- [exs* (filter-exacts pts1 exs1)])
- ; keep iterating till we get at least *num-points*
- (loop (append pts* pts) (append exs* exs) (+ 1 num-loops)))]))))
-
-(define (prepare-points-period prog periods)
- (let* ([pts (make-period-points (*num-points*) periods)]
- [exacts (make-exacts prog pts)]
- [pts* (filter-points pts exacts)]
- [exacts* (filter-exacts pts exacts)])
- (mk-pcontext pts* exacts*)))
-
-(define (errors prog pcontext)
- (let ([fn (eval-prog prog 'fl)]
- [max-ulps (expt 2 (*bit-width*))])
- (for/list ([(point exact) (in-pcontext pcontext)])
- (let ([out (fn point)])
- (add1
- (if (real? out)
- (abs (ulp-difference out exact))
- max-ulps))))))
-
-(define (errors-score e)
- (let-values ([(reals unreals) (partition ordinary-value? e)])
- (if (flag-set? 'reduce 'avg-error)
- (/ (+ (apply + (map ulps->bits reals))
- (* (*bit-width*) (length unreals)))
- (length e))
- (apply max (map ulps->bits reals)))))
+ (define npts (length pts))
+ (cond
+ [(> num-loops 200)
+ (raise-herbie-error "Cannot sample enough valid points."
+ #:url "faq.html#sample-valid-points")]
+ [(>= npts (*num-points*))
+ (debug #:from 'points #:depth 4 "Sampled" npts "points with exact outputs")
+ (mk-pcontext (take-up-to pts (*num-points*)) (take-up-to exs (*num-points*)))]
+ [else
+ (define num-vars (length (program-variables prog)))
+ (define num (max 4 (- (*num-points*) npts))) ; pad to avoid repeatedly trying to get last point
+ (debug #:from 'points #:depth 4
+ "Sampling" num "additional inputs,"
+ "on iter" num-loops "have" npts "/" (*num-points*))
+ (define sampler
+ (if (set-member? '(binary32 binary64) precision)
+ sample
+ (λ () (for/list ([var (program-variables prog)])
+ (random-generate (get-representation precision))))))
+ (define pts1 (for/list ([n (in-range num)]) (sampler)))
+ (define exs1 (make-exacts-halfpoints prog pts1 precondition precision))
+ (debug #:from 'points #:depth 4
+ "Filtering points with unrepresentable outputs")
+ (define-values (pts* exs*) (filter-p&e pts1 exs1))
+ (loop (append pts* pts) (append exs* exs) (+ 1 num-loops))])))
diff --git a/src/programs.rkt b/src/programs.rkt
index c3ec24fb0..22dd340af 100644
--- a/src/programs.rkt
+++ b/src/programs.rkt
@@ -1,22 +1,23 @@
#lang racket
(require math/bigfloat math/flonum)
-(require "common.rkt" "syntax/syntax.rkt" "errors.rkt" "bigcomplex.rkt")
+(require "common.rkt" "syntax/types.rkt" "syntax/syntax.rkt" "plugin.rkt")
+(require "errors.rkt" "type-check.rkt" "biginterval.rkt" "float.rkt" "interface.rkt")
(module+ test (require rackunit))
(provide (all-from-out "syntax/syntax.rkt")
program-body program-variables ->flonum ->bf
- replace-leaves location-hash
+ expr-supports?
+ location-hash
location? expr?
- location-do location-get location-parent location-sibling
- eval-prog
+ location-do location-get
+ eval-prog eval-const-expr
compile expression-cost program-cost
- free-variables unused-variables replace-expression
- eval-exact eval-const-expr
- desugar-program expr->prog)
+ free-variables replace-expression
+ desugar-program resugar-program)
-(define expr? (or/c list? symbol? number?))
+(define expr? (or/c list? symbol? value?))
(define location? (listof natural-number/c))
@@ -34,31 +35,6 @@
;; Converting constants
-(define/contract (->flonum x)
- (-> any/c (or/c flonum? complex? boolean?))
- (define convert
- (if (flag-set? 'precision 'double)
- real->double-flonum
- real->single-flonum))
- (cond
- [(real? x) (convert x)]
- [(bigfloat? x) (convert (bigfloat->flonum x))]
- [(bigcomplex? x)
- (make-rectangular (->flonum (bigcomplex-re x))
- (->flonum (bigcomplex-im x)))]
- [(and (symbol? x) (constant? x))
- (->flonum ((constant-info x 'fl)))]
- [else x]))
-
-(define (->bf x)
- (cond
- [(real? x) (bf x)]
- [(bigfloat? x) x]
- [(complex? x)
- (bigcomplex (->bf (real-part x)) (->bf (imag-part x)))]
- [(constant? x) ((constant-info x 'bf))]
- [else x]))
-
(define/contract (location-hash prog)
(-> expr? (hash/c expr? (listof location?)))
(define hash (make-hash))
@@ -78,41 +54,13 @@
hash)
-(define/contract (replace-leaves prog #:constant [constant identity]
- #:variable [variable identity] #:symbol [symbol-table identity])
- (->* (expr?)
- (#:constant (-> constant? any/c) #:variable (-> variable? any/c) #:symbol (-> operator? any/c))
- any/c)
-
- ; Inlined for speed
- (define (inductor prog)
- (match prog
- [(list (or 'lambda 'λ) (list vars ...) body)
- `(λ ,vars ,(inductor body))]
- [(? constant?) (constant prog)]
- [(? variable?) (variable prog)]
- [(list 'if cond ift iff)
- `(if ,(inductor cond) ,(inductor ift) ,(inductor iff))]
- [(list op args ...)
- (cons (symbol-table op) (map inductor args))]
- [_ (error (format "Invalid program ~a" prog))]))
-
- (inductor prog))
-
(define (free-variables prog)
(match prog
[(? constant?) '()]
[(? variable?) (list prog)]
- [(list (or 'lambda 'λ) vars body)
- (remove* vars (free-variables body))]
[`(,op ,args ...)
(remove-duplicates (append-map free-variables args))]))
-(define (unused-variables prog)
- (remove* (free-variables (program-body prog))
- (program-variables prog)))
-
-
(define/contract (location-do loc prog f)
(-> location? expr? (-> expr? expr?) expr?)
(cond
@@ -132,52 +80,52 @@
(let/ec return
(location-do loc prog return)))
-(define (location-parent loc)
- (reverse (cdr (reverse loc))))
-
-(define (location-sibling loc)
- (if (<= (length loc) 1)
- #f
- (let ([loc* (reverse loc)])
- (cond
- [(= (car loc*) 1)
- (reverse (cons 2 (cdr loc*)))]
- [(= (car loc*) 2)
- (reverse (cons 1 (cdr loc*)))]
- [else
- #f]))))
-
(define (eval-prog prog mode)
- (let* ([real->precision (if (equal? mode 'bf) ->bf ->flonum)]
- [op->precision (λ (op) (operator-info op mode))] ; TODO change use of mode
- [body* (replace-leaves (program-body prog) #:constant real->precision #:symbol op->precision)]
- [prog-opt `(λ ,(program-variables prog) ,(compile body*))]
- [fn (eval prog-opt common-eval-ns)])
- (lambda (pts)
- (->flonum (apply fn (map real->precision pts))))))
-
-;; Does the same thing as the above with mode 'bf, but doesn't convert
-;; the results back to floats.
-(define (eval-exact prog)
- (let* ([body* (replace-leaves (program-body prog) #:constant ->bf #:symbol (curryr operator-info 'bf))]
- [prog-opt `(lambda ,(program-variables prog) ,(compile body*))]
- [fn (eval prog-opt common-eval-ns)])
- (lambda (pts)
- (apply fn (map ->bf pts)))))
+ (define real->precision (match mode ['bf ->bf] ['fl ->flonum] ['ival mk-ival] ['nonffi identity])) ; Keep exact numbers exact
+ (define precision->real (match mode ['bf identity] ['fl ->flonum] ['ival identity] ['nonffi identity]))
+
+ (define body*
+ (let inductor ([prog (program-body prog)])
+ (match prog
+ [(? value?) (real->precision prog)]
+ [(? constant?) (list (constant-info prog mode))]
+ [(? variable?) prog]
+ #;[(list 'if cond ift iff)
+ `(if ,(inductor cond) ,(inductor ift) ,(inductor iff))]
+ [(list op args ...)
+ (cons (operator-info op mode) (map inductor args))]
+ [_ (error (format "Invalid program ~a" prog))])))
+ (define fn (common-eval `(λ ,(program-variables prog) ,(compile body*))))
+ (lambda (pts)
+ (precision->real (apply fn (map real->precision pts)))))
(define (eval-const-expr expr)
- (eval
- (replace-leaves
- expr
- #:constant (λ (x) (if (symbol? x) (->flonum x) x))
- #:symbol (curryr operator-info 'nonffi))
- common-eval-ns))
+ ((eval-prog `(λ () ,expr) 'nonffi) '()))
(module+ test
(check-equal? (eval-const-expr '(+ 1 1)) 2)
(check-equal? (eval-const-expr 'PI) pi)
(check-equal? (eval-const-expr '(exp 2)) (exp 2)))
+(module+ test
+ (define tests
+ #hash([(λ (a b c) (/ (- (sqrt (- (* b b) (* a c))) b) a))
+ . (-1.918792216976527e-259 8.469572834134629e-97 -7.41524568576933e-282)
+ ])) ;(2.4174342574957107e-18 -1.4150052601637869e-40 -1.1686799408259549e+57)
+
+ (define (in-interval? iv pt)
+ (match-define (ival lo hi err? err) iv)
+ (and (bf<= lo pt) (bf<= pt hi)))
+
+ (define-binary-check (check-in-interval? in-interval? interval point))
+
+ (for ([(e p) (in-hash tests)])
+ (parameterize ([bf-precision 4000])
+ (define iv ((eval-prog e 'ival) p))
+ (define val ((eval-prog e 'bf) p))
+ (check bf<= (ival-lo iv) (ival-hi iv))
+ (check-in-interval? iv val))))
+
;; To compute the cost of a program, we could use the tree as a
;; whole, but this is inaccurate if the program has many common
;; subexpressions. So, we compile the program to a register machine
@@ -235,13 +183,13 @@
(define (unfold-let expr)
- (match expr
+ (match expr
[`(let ([,vars ,vals] ...) ,body)
(define bindings (map cons vars vals))
- (unfold-let (replace-vars bindings body))]
- [`(,head ,args ...)
- (cons head (map unfold-let args))]
- [x x]))
+ (unfold-let (replace-vars bindings body))]
+ [`(,head ,args ...)
+ (cons head (map unfold-let args))]
+ [x x]))
(define (expand-associativity expr)
(match expr
@@ -256,6 +204,69 @@
[_
expr]))
+(define (expand-parametric expr ctx)
+ (define precision (if (and (list? ctx) (not (empty? ctx))) (cdr (first ctx)) 'real))
+ (define-values (expr* type)
+ (let loop ([expr expr])
+ ;; Run after unfold-let, so no need to track lets
+ (match expr
+ [(list (? (curry hash-has-key? parametric-operators) op) args ...)
+ (define sigs (hash-ref parametric-operators op))
+ (define-values (args* actual-types)
+ (for/lists (args* actual-types) ([arg args])
+ (loop arg)))
+ (match-define (cons op* rtype)
+ (for/or ([sig sigs])
+ (match-define (list* true-name rtype atypes) sig)
+ (and
+ (if (symbol? atypes)
+ (andmap (curry equal? atypes) actual-types)
+ (if (set-member? variary-operators op)
+ (and (andmap (λ (x) (eq? (car actual-types) x)) actual-types)
+ (eq? (car actual-types) (car atypes)))
+ (equal? atypes actual-types)))
+ (cons true-name rtype))))
+ (values (cons op* args*) rtype)]
+ [(list 'if cond ift iff)
+ (define-values (cond* _a) (loop cond))
+ (define-values (ift* rtype) (loop ift))
+ (define-values (iff* _b) (loop iff))
+ (values (list 'if cond* ift* iff*) rtype)]
+ [(list op args ...)
+ (define-values (args* _) (for/lists (args* _) ([arg args]) (loop arg)))
+ (values (cons op args*) (second (first (first (hash-values (operator-info op 'type))))))]
+ [(? real?) (values (fl->repr expr (get-representation (match precision ['real (if (flag-set? 'precision 'double) 'binary64 'binary32)] [x x]))) precision)]
+ [(? complex?) (values expr 'complex)]
+ [(? value?) (values expr (representation-name (infer-representation expr)))]
+ [(? constant?) (values expr (constant-info expr 'type))]
+ [(? variable?) (values expr (dict-ref ctx expr))])))
+ expr*)
+
+(define (expand-parametric-reverse expr)
+ (define expr*
+ (let loop ([expr expr])
+ ;; Run after unfold-let, so no need to track lets
+ (match expr
+ [(list (? (curry hash-has-key? parametric-operators-reverse) op) args ...)
+ (define args* (for/list ([arg args]) (loop arg)))
+ (define op* (hash-ref parametric-operators-reverse op))
+ (cons op* args*)]
+ [(list 'if cond ift iff)
+ (list 'if (loop cond) (loop ift) (loop iff))]
+ [(list op args ...)
+ (cons op (for/list ([arg args]) (loop arg)))]
+ [(? (conjoin complex? (negate real?))) expr]
+ [(? value?) (repr->fl expr (infer-representation expr))]
+ [(? constant?) expr]
+ [(? variable?) expr])))
+ expr*)
+
+(define (desugar-program prog ctx)
+ (expand-parametric (expand-associativity (unfold-let prog)) ctx))
+
+(define (resugar-program prog)
+ (expand-parametric-reverse prog))
+
(define (replace-vars dict expr)
(cond
[(dict-has-key? dict expr) (dict-ref dict expr)]
@@ -271,8 +282,10 @@
[#t
expr]))
-(define (desugar-program prog)
- (expand-associativity (unfold-let prog)))
-
-(define (expr->prog expr)
- `(lambda ,(free-variables expr) ,expr))
+(define (expr-supports? expr field)
+ (let loop ([expr expr])
+ (match expr
+ [(list op args ...)
+ (and (operator-info op field) (andmap loop args))]
+ [(? variable?) true]
+ [(? constant?) (or (not (symbol? expr)) (constant-info expr field))])))
diff --git a/src/reports/common.rkt b/src/reports/common.rkt
deleted file mode 100644
index c5f7ccd94..000000000
--- a/src/reports/common.rkt
+++ /dev/null
@@ -1,16 +0,0 @@
-#lang racket
-(provide format-time format-bits)
-
-(define (format-time ms)
- (cond
- [(< ms 1000) (format "~ams" (round ms))]
- [(< ms 60000) (format "~as" (/ (round (/ ms 100.0)) 10))]
- [(< ms 3600000) (format "~am" (/ (round (/ ms 6000.0)) 10))]
- [else (format "~ahr" (/ (round (/ ms 360000.0)) 10))]))
-
-(define (format-bits r #:sign [sign #f] #:unit [unit? #f])
- (define unit (if unit? "b" ""))
- (cond
- [(not r) ""]
- [(and (> r 0) sign) (format "+~a~a" (/ (round (* r 10)) 10) unit)]
- [else (format "~a~a" (/ (round (* r 10)) 10) unit)]))
diff --git a/src/reports/make-graph.rkt b/src/reports/make-graph.rkt
deleted file mode 100644
index 3cb4f0d13..000000000
--- a/src/reports/make-graph.rkt
+++ /dev/null
@@ -1,430 +0,0 @@
-#lang racket
-
-(require "../common.rkt" "common.rkt")
-(require "../points.rkt" "../float.rkt")
-(require "../alternative.rkt" "../errors.rkt")
-(require "../formats/test.rkt")
-(require "../formats/datafile.rkt")
-(require "../core/matcher.rkt")
-(require "../core/regimes.rkt")
-(require "../programs.rkt")
-(require "../plot.rkt")
-(require "../sandbox.rkt")
-(require "../formats/tex.rkt")
-(require "core2js.rkt")
-(require (only-in xml write-xexpr xexpr?))
-
-(provide make-graph make-traceback make-timeout make-axis-plot make-points-plot
- make-plots output-interactive-js make-interactive-js get-interactive-js)
-
-(define/contract (regime-var alt)
- (-> alternative? (or/c expr? #f))
- (let loop ([alt alt])
- (match alt
- [(alt-event _ `(regimes ,splitpoints) prevs)
- (sp-bexpr (car splitpoints))]
- [(alt-event _ _ (list)) #f]
- [(alt-event _ _ (list prev _ ...)) (loop prev)]
- [(alt-delta _ _ prev) (loop prev)])))
-
-(define/contract (regime-splitpoints alt)
- (-> alternative? (listof number?))
- (let loop ([alt alt])
- (match alt
- [(alt-event _ `(regimes ,splitpoints) prevs)
- (map sp-point (take splitpoints (sub1 (length splitpoints))))]
- [(alt-event _ _ (list)) #f]
- [(alt-event _ _ (list prev _ ...)) (loop prev)]
- [(alt-delta _ _ prev) (loop prev)])))
-
-(define/contract (render-command-line)
- (-> string?)
- (format
- "herbie shell --seed ~a ~a"
- (if (vector? (get-seed)) (format "'~a'" (get-seed)) (get-seed))
- (string-join
- (for/list ([rec (changed-flags)])
- (match rec
- [(list 'enabled class flag) (format "+o ~a:~a" class flag)]
- [(list 'disabled class flag) (format "-o ~a:~a" class flag)]))
- " ")))
-
-(define/contract (render-fpcore test)
- (-> test? string?)
- (string-join
- (filter
- identity
- (list
- (format "(FPCore ~a" (test-vars test))
- (format " :name ~s" (test-name test))
- (if (equal? (test-precondition test) 'TRUE)
- #f
- (format " :pre ~a" (test-precondition test)))
- (if (equal? (test-expected test) #t)
- #f
- (format " :herbie-expected ~a" (test-expected test)))
- (if (test-output test)
- (format "\n :herbie-target\n ~a\n" (test-output test)) ; Extra newlines for clarity
- #f)
- (format " ~a)" (test-input test))))
- "\n"))
-
-(define timeline? any/c)
-
-(define/contract (render-timeline timeline)
- (-> timeline? xexpr?)
- `(div ((class "timeline"))
- ,@(for/list ([curr timeline] [next (cdr timeline)])
- `(div
- ((class ,(format "timeline-phase ~a" (dict-ref curr 'type)))
- (data-timespan ,(~a (- (dict-ref next 'time) (dict-ref curr 'time))))
- ,@(for/list ([(type value) (in-dict curr)] #:when (not (member type '(time))))
- `(,(string->symbol (format "data-~a" type)) ,(~a value))))))))
-
-
-(define/contract (render-process-info time timeline profile? test #:bug? [bug? #f])
- (->* (number? timeline? boolean? test?) (#:bug? boolean?) xexpr?)
- `(section ((id "process-info"))
- (h1 "Runtime")
- (p ((class "header"))
- "Time bar (total: " (span ((class "number")) ,(format-time time)) ")"
- (a ((class "attachment") (href "debug.txt")) "Debug log")
- ,(if profile?
- `(a ((class "attachment") (href "profile.txt")) "Profile")
- "")
- ,(render-timeline timeline)
- ,(if bug?
- `(p "Please include this information when filing a "
- (a ((href "https://github.com/uwplse/herbie/issues")) "bug report") ":")
- "")
- (pre ((class "shell"))
- (code
- ,(render-command-line) "\n"
- ,(render-fpcore test) "\n")))))
-
-(define (alt2fpcore alt)
- (match-define (list _ args expr) (alt-program alt))
- (list 'FPCore args ':name 'alt expr))
-
-(define (get-interactive-js result)
- (with-handlers ([exn:fail?
- (λ (e) #f)])
- (define start-fpcore (alt2fpcore (test-result-start-alt result)))
- (define end-fpcore (alt2fpcore (test-result-end-alt result)))
- (define start-js (compile-program start-fpcore #:name "start"))
- (define end-js (compile-program end-fpcore #:name "end"))
- (string-append start-js end-js)))
-
-(define (make-interactive-js result rdir profile?)
- (define js-text (get-interactive-js result))
- (if (string? js-text)
- (display-to-file js-text
- (build-path rdir "interactive.js")
- #:exists 'replace)
- #f))
-
-(define (output-interactive-js result rdir profile?)
- (define js-text (get-interactive-js result))
- (if (string? js-text)
- (display js-text)
- #f))
-
-(define/contract (render-interactive start-prog point)
- (-> alternative? (listof number?) xexpr?)
- (define start-fpcore (alt2fpcore start-prog))
- `(section ([id "try-it"])
- (h1 "Try it out")
- (div ([id "try-inputs-wrapper"])
- (form ([id "try-inputs"])
- (p ([class "header"]) "Your Program's Arguments")
- (ol
- ,@(for/list ([var-name (second start-fpcore)] [i (in-naturals)] [val point])
- `(li (label ([for ,(string-append "var-name-" (~a i))]) ,(~a var-name))
- (input ([type "text"]
- [name ,(string-append "var-name-" (~a i))]
- [class "input-submit"]
- [oninput "submit_inputs();"]
- [value ,(~a val)])))))))
- (div ([id "try-result"] [class "no-error"])
- (p ([class "header"]) "Results")
- (table
- (tbody
- (tr
- (td
- (label ([for "try-original-output"]) "In"))
- (td
- (output ([id "try-original-output"]))))
- (tr
- (td
- (label ([for "try-herbie-output"]) "Out"))
- (td
- (output ([id "try-herbie-output"]))))))
- (div ([id "try-error"]) "Enter valid numbers for all inputs"))))
-
-(define (make-axis-plot result idx out)
- (define var (list-ref (test-vars (test-result-test result)) idx))
- (define split-var? (equal? var (regime-var (test-result-end-alt result))))
- (define pts (test-result-newpoints result))
- (herbie-plot
- #:port out #:kind 'png
- (error-axes pts #:axis idx)
- (map error-mark (if split-var? (regime-splitpoints (test-result-end-alt result)) '()))))
-
-(define (make-points-plot result idx letter out)
- (define-values (theme accessor)
- (match letter
- ['r (values *red-theme* test-result-start-error)]
- ['g (values *green-theme* test-result-target-error)]
- ['b (values *blue-theme* test-result-end-error)]))
-
- (define pts (test-result-newpoints result))
- (define err (accessor result))
-
- (herbie-plot
- #:port out #:kind 'png
- (error-points err pts #:axis idx #:color theme)
- (error-avg err pts #:axis idx #:color theme)))
-
-(define (make-plots result rdir profile?)
- (define (open-file #:type [type #f] idx fun . args)
- (call-with-output-file (build-path rdir (format "plot-~a~a.png" idx (or type ""))) #:exists 'replace
- (apply curry fun args)))
-
- (for ([var (test-vars (test-result-test result))] [idx (in-naturals)])
- (when (> (length (remove-duplicates (map (curryr list-ref idx) (test-result-newpoints result)))) 1)
- ;; This is bad code
- (open-file idx make-axis-plot result idx)
- (open-file idx #:type 'r make-points-plot result idx 'r)
- (when (test-result-target-error result)
- (open-file idx #:type 'g make-points-plot result idx 'g))
- (open-file idx #:type 'b make-points-plot result idx 'b))))
-
-(define (make-graph result rdir profile? valid-js-prog)
- (match-define
- (test-result test time bits start-alt end-alt
- points exacts start-est-error end-est-error
- newpoints newexacts start-error end-error target-error timeline)
- result)
-
- (printf "\n")
- (write-xexpr
- `(html
- (head
- (meta ([charset "utf-8"]))
- (title "Result for " ,(~a (test-name test)))
- (link ([rel "stylesheet"] [type "text/css"] [href "../graph.css"]))
- (script ([src ,mathjax-url]))
- (script ([src "../report.js"]))
- (script ([src "interactive.js"]))
- (script ([src "https://unpkg.com/mathjs@4.4.2/dist/math.min.js"])))
- (body ([onload "graph()"])
-
- (section ([id "large"])
- (div "Average Error: "
- (span ([class "number"]
- [title ,(format "Maximum error: ~a → ~a"
- (format-bits (apply max (map ulps->bits start-error)) #:unit #f)
- (format-bits (apply max (map ulps->bits end-error)) #:unit #f))])
- ,(format-bits (errors-score start-error) #:unit #f)
- " → "
- ,(format-bits (errors-score end-error) #:unit #f)))
- (div "Time: " (span ([class "number"]) ,(format-time time)))
- (div "Precision: " (span ([class "number"]) ,(format-bits (*bit-width*) #:unit #f)))
- (div "Internal Precision: " (span ([class "number"]) ,(format-bits bits #:unit #f))))
-
- (section ([id "program"])
- (div ([class "program"]) "\\[" ,(texify-prog (alt-program start-alt)) "\\]")
- (div ([class "arrow"]) "↓")
- (div ([class "program"]) "\\[" ,(texify-prog (alt-program end-alt)) "\\]"))
-
- (section ([id "graphs"])
- (h1 "Error")
- (div
- ,@(for/list ([var (test-vars test)] [idx (in-naturals)])
- (cond
- [(> (length (remove-duplicates (map (curryr list-ref idx) newpoints))) 1)
- (define split-var? (equal? var (regime-var end-alt)))
- (define title "The X axis uses an exponential scale")
- `(figure ([id ,(format "fig-~a" idx)] [class ,(if split-var? "default" "")])
- (img ([width "800"] [height "300"] [title ,title]
- [src ,(format "plot-~a.png" idx)]))
- (img ([width "800"] [height "300"] [title ,title] [data-name "Input"]
- [src ,(format "plot-~ar.png" idx)]))
- ,(if target-error
- `(img ([width "800"] [height "300"] [title ,title] [data-name "Target"]
- [src ,(format "plot-~ag.png" idx)]))
- "")
- (img ([width "800"] [height "300"] [title ,title] [data-name "Result"]
- [src ,(format "plot-~ab.png" idx)]))
- (figcaption (p "Bits error versus " (var ,(~a var)))))]
- [else ""]))))
-
- ,(if valid-js-prog
- (render-interactive start-alt (car points))
- `(p ([display "none"])))
-
- ,(if (test-output test)
- `(section ([id "comparison"])
- (h1 "Target")
- (table
- (tr (th "Original") (td ,(format-bits (errors-score start-error))))
- (tr (th "Target") (td ,(format-bits (errors-score target-error))))
- (tr (th "Herbie") (td ,(format-bits (errors-score end-error)))))
- (div "\\[" ,(texify-prog `(λ ,(test-vars test) ,(test-output test))) "\\]"))
- "")
-
- (section ([id "history"])
- (h1 "Derivation")
- (ol ([class "history"])
- ,@(parameterize ([*pcontext* (mk-pcontext newpoints newexacts)]
- [*start-prog* (alt-program start-alt)])
- (render-history end-alt))))
-
- ,(render-process-info time timeline profile? test)))))
-
-(define (make-traceback result rdir profile?)
- (match-define (test-failure test bits exn time timeline) result)
- (printf "\n")
- (write-xexpr
- `(html
- (head
- (meta ((charset "utf-8")))
- (title "Exception for " ,(~a (test-name test)))
- (link ((rel "stylesheet") (type "text/css") (href "../graph.css"))))
- (body
- (h1 "Error in " ,(format-time time))
- ,@(cond
- [(exn:fail:user:herbie? exn)
- `((section ([id "user-error"])
- (h2 ,(~a (exn-message exn)) (a ([href ,(herbie-error-url exn)]) " (more)"))
- ,(if (exn:fail:user:herbie:syntax? exn)
- `(table
- (thead
- (th ([colspan "2"]) ,(exn-message exn)) (th "L") (th "C"))
- (tbody
- ,@(for/list ([(stx msg) (in-dict (exn:fail:user:herbie:syntax-locations exn))])
- `(tr
- (td ([class "procedure"]) ,(~a msg))
- (td ,(~a (syntax-source stx)))
- (td ,(or (~a (syntax-line stx) "")))
- (td ,(or (~a (syntax-column stx)) (~a (syntax-position stx))))))))
- "")))]
- [else
- `(,(render-process-info time timeline profile? test #:bug? #t)
- (section ([id "backtrace"])
- (h1 "Backtrace")
- (table
- (thead
- (th ([colspan "2"]) ,(exn-message exn)) (th "L") (th "C"))
- (tbody
- ,@(for/list ([tb (continuation-mark-set->context (exn-continuation-marks exn))])
- (match (cdr tb)
- [(srcloc file line col _ _)
- `(tr
- (td ([class "procedure"]) ,(procedure-name->string (car tb)))
- (td ,(~a file))
- (td ,(~a line))
- (td ,(~a col)))]
- [#f
- `(tr
- (td ([class "procedure"]) ,(procedure-name->string (car tb)))
- (td ([colspan "3"]) "unknown"))]))))))])))))
-
-(define (make-timeout result rdir profile?)
- (match-define (test-timeout test bits time timeline) result)
- (printf "\n")
- (write-xexpr
- `(html
- (head
- (meta ((charset "utf-8")))
- (title ,(format "Timeout for ~a" (test-name test)))
- (link ([rel "stylesheet"] [type "text/css"] [href "../graph.css"])))
- (body
- (h1 "Timeout in " ,(format-time time))
- (p "Use the " (code "--timeout") " flag to change the timeout.")
- ,(render-process-info time timeline profile? test)))))
-
-(struct interval (alt-idx start-point end-point expr))
-
-(define (render-history altn)
- (-> alternative? (listof xexpr?))
-
- (define err (format-bits (errors-score (alt-errors altn))))
- (match altn
- [(alt-event prog 'start _)
- (list
- `(li (p "Initial program " (span ([class "error"]) ,err))
- (div "\\[" ,(texify-prog prog) "\\]")))]
- [(alt-event prog `(start ,strategy) `(,prev))
- `(,@(render-history prev)
- (li ([class "event"]) "Using strategy " (code ,(~a strategy))))]
-
- [(alt-event _ `(regimes ,splitpoints) prevs)
- (let* ([start-sps (cons (sp -1 -1 #f) (take splitpoints (sub1 (length splitpoints))))]
- [vars (program-variables (alt-program altn))]
- [intervals
- (for/list ([start-sp start-sps] [end-sp splitpoints])
- (interval (sp-cidx end-sp) (sp-point start-sp) (sp-point end-sp) (sp-bexpr end-sp)))]
- [preds (splitpoints->point-preds splitpoints (length prevs))]
- [interval->string
-
- (λ (ival)
- (string-join
- (list
- (if (interval-start-point ival)
- (format "~a < " (interval-start-point ival))
- "")
- (~a (interval-expr ival))
- (if (equal? (interval-end-point ival) +nan.0)
- ""
- (format " < ~a" (interval-end-point ival))))))])
- `((li ([class "event"]) "Split input into " ,(~a (length prevs)) " regimes")
- (li
- ,@(apply
- append
- (for/list ([entry prevs] [entry-idx (range (length prevs))] [pred preds])
- (let* ([entry-ivals
- (filter (λ (intrvl) (= (interval-alt-idx intrvl) entry-idx)) intervals)]
- [condition
- (string-join (map interval->string entry-ivals) " or ")])
- (define-values (ivalpoints ivalexacts)
- (for/lists (pts exs) ([(pt ex) (in-pcontext (*pcontext*))] #:when (pred pt))
- (values pt ex)))
-
- ;; TODO: The (if) here just corrects for the possibility
- ;; that we might have sampled new points that include no
- ;; points in a given regime. Instead it would be best to
- ;; continue sampling until we actually have many points in
- ;; each regime. That would require breaking some
- ;; abstraction boundaries right now so we haven't done it
- ;; yet.
- (define new-pcontext
- (if (null? ivalpoints) (*pcontext*) (mk-pcontext ivalpoints ivalexacts)))
-
- `((h2 (code "if " (span ([class "condition"]) ,condition)))
- (ol ,@(parameterize ([*pcontext* new-pcontext]) (render-history entry))))))))
- (li ([class "event"]) "Recombined " ,(~a (length prevs)) " regimes into one program.")))]
-
- [(alt-event prog `(taylor ,pt ,loc) `(,prev))
- `(,@(render-history prev)
- (li (p "Taylor expanded around " ,(~a pt) " " (span ([class "error"]) ,err))
- (div "\\[\\leadsto " ,(texify-prog prog #:loc loc #:color "blue") "\\]")))]
-
- [(alt-event prog 'removed-pows `(,alt))
- `(,@(render-history alt)
- (li ([class "event"]) "Removed slow " (code "pow") " expressions."))]
-
- [(alt-event prog 'final-simplify `(,alt))
- `(,@(render-history alt)
- (li ([class "event"]) "Applied final simplification."))]
-
- [(alt-delta prog cng prev)
- `(,@(render-history prev)
- (li (p "Applied " (span ([class "rule"]) ,(~a (rule-name (change-rule cng))))
- (span ([class "error"]) ,err))
- (div "\\[\\leadsto " ,(texify-prog prog #:loc (change-location cng) #:color "blue") "\\]")))]))
-
-(define (procedure-name->string name)
- (if name
- (~a name)
- "(unnamed)"))
diff --git a/src/reports/make-report.rkt b/src/reports/make-report.rkt
deleted file mode 100644
index 74779dc85..000000000
--- a/src/reports/make-report.rkt
+++ /dev/null
@@ -1,407 +0,0 @@
-#lang racket
-
-(require racket/date (only-in xml write-xexpr))
-(require "../common.rkt" "common.rkt")
-(require "../formats/datafile.rkt")
-
-(provide (all-defined-out))
-
-(define (log-exceptions file info)
- (define (print-test t)
- (printf "(FPCore ~a\n :name ~s\n ~a)\n\n"
- (table-row-vars t)
- (table-row-name t)
- (table-row-input t)))
- (match info
- [(report-info date commit branch hostname seed flags points iterations bit-width note tests)
- (write-file file
- (printf "; seed : ~a\n\n" seed)
- (printf "; flags :\n")
- (for ([fs (hash->list flags)])
- (printf "; ~a = ~a\n"
- (~a (car fs) #:min-width 10)
- (cdr fs)))
- (printf "\n")
- (for ([t tests])
- (match (table-row-status t)
- ["error"
- (printf "; errored\n")
- (print-test t)]
- ["crash"
- (printf "; crashed\n")
- (print-test t)]
- ["timeout"
- (printf "; timed out\n")
- (print-test t)]
- [_ #f])))]))
-
-(define (web-resource name)
- (build-path web-resource-path name))
-
-(define (badge-label result)
- (match (table-row-status result)
- ["error" "ERR"]
- ["crash" "!!!"]
- ["timeout" "TIME"]
- [_ (format-bits (- (table-row-start result) (table-row-result result)) #:sign #t)]))
-
-(define (make-report-page file info)
- (match info
- [(report-info date commit branch hostname seed flags points iterations bit-width note tests)
-
- (define table-labels
- '("Test" "Start" "Result" "Target" "∞ ↔ ℝ" "Time"))
-
- (define help-text
- #hash(("Result" . "Color key:\nGreen: improved accuracy\nLight green: no initial error\nOrange: no accuracy change\nRed: accuracy worsened")
- ("Target" . "Color key:\nDark green: better than target\nGreen: matched target\nOrange: improved but did not match target\nYellow: no accuracy change\n")))
-
- (define-values (dir _name _must-be-dir?) (split-path file))
-
- (copy-file (web-resource "report.js") (build-path dir "report.js") #t)
- (copy-file (web-resource "report.css") (build-path dir "report.css") #t)
- (copy-file (web-resource "graph.css") (build-path dir "graph.css") #t)
- (copy-file (web-resource "arrow-chart.js") (build-path dir "arrow-chart.js") #t)
-
- (define total-time (apply + (map table-row-time tests)))
- (define total-passed
- (for/sum ([row tests])
- (if (member (table-row-status row) '("gt-target" "eq-target" "imp-start")) 1 0)))
- (define total-available
- (for/sum ([row tests])
- (if (not (equal? (table-row-status row) "ex-start")) 1 0)))
- (define total-crashes
- (for/sum ([row tests])
- (if (equal? (table-row-status row) "crash") 1 0)))
-
- (define total-gained
- (for/sum ([row tests])
- (or (table-row-result row) 0)))
- (define total-start
- (for/sum ([row tests])
- (or (table-row-start row) 0)))
-
- (define (round* x)
- (inexact->exact (round x)))
-
- (define any-has-target? (ormap table-row-target tests))
- (define any-has-inf+/-?
- (for*/or ([test tests] [field (list table-row-inf- table-row-inf+)])
- (and (field test) (> (field test) 0))))
-
- (define sorted-tests
- (sort (map cons tests (range (length tests))) >
- #:key (λ (x) (or (table-row-start (car x)) 0))))
-
- (define classes
- (filter identity
- (list (if any-has-target? #f 'no-target)
- (if any-has-inf+/-? #f 'no-inf))))
-
- (write-file file
- ; HTML cruft
- (printf "\n")
- (write-xexpr
- `(html
- (head
- (title "Herbie results")
- (meta ((charset "utf-8")))
- (link ((rel "stylesheet") (type "text/css") (href "report.css")))
- (script ((src "report.js")))
- (script ((src "http://d3js.org/d3.v3.min.js") (charset "utf-8")))
- (script ((type "text/javascript") (src "arrow-chart.js"))))
-
- (body ((onload "report()"))
- (div ((id "large"))
- (div "Time: " (span ((class "number")) ,(format-time total-time)))
- (div "Passed: " (span ((class "number")) ,(~a total-passed) "/" ,(~a total-available)))
- ,(if (> total-crashes 0)
- `(div "Crashes: " (span ((class "number")) ,(~a total-crashes)))
- "")
- (div "Tests: " (span ((class "number")) ,(~a (length tests))))
- (div "Bits: " (span ((class "number"))
- ,(~a (round* (- total-start total-gained)))
- "/"
- ,(~a (round* total-start)))))
-
- (figure
- (svg ((id "graph") (width "400")))
- (script "window.addEventListener('load', function(){draw_results(d3.select('#graph'))})")))
-
- (ul ((id "test-badges"))
- ,@(for/list ([(result id) (in-dict sorted-tests)])
- `(li ((class ,(format "badge ~a" (table-row-status result)))
- (title ,(format "~a (~a to ~a)"
- (table-row-name result)
- (format-bits (table-row-start result))
- (format-bits (table-row-result result))))
- (data-id ,(~a id)))
- ,(badge-label result))))
- (hr ((style "clear:both;visibility:hidden")))
-
- (table ((id "about"))
- (tr (th "Date:") (td ,(date->string date)))
- (tr (th "Commit:") (td ,commit " on " ,branch))
- (tr (th "Hostname:") (td ,hostname))
- (tr (th "Points:") (td ,(~a (*num-points*))))
- (tr (th "Fuel:") (td ,(~a (*num-iterations*))))
- (tr (th "Seed:") (td ,(~a seed)))
- (tr (th "Flags:")
- (td ((id "flag-list"))
- (div ((id "all-flags"))
- ,@(for*/list ([(class flags) (*flags*)] [flag flags])
- `(kbd ,(~a class) ":" ,(~a flag))))
- (div ((id "changed-flags"))
- ,@(if (null? (changed-flags))
- '("default")
- (for/list ([rec (changed-flags)])
- (match-define (list delta class flag) rec)
- `(kbd ,(match delta ['enabled "+o"] ['disabled "-o"])
- " " ,(~a class) ":" ,(~a flag))))))))
-
- (table ((id "results") (class ,(string-join (map ~a classes) " ")))
- (thead
- (tr ,@(for/list ([label table-labels])
- (if (dict-has-key? help-text label)
- `(th ,label " " (span ([class "help-button"] [title ,(dict-ref help-text label)]) "?"))
- `(th ,label)))))
- (tbody
- ,@(for/list ([result tests] [id (in-naturals)])
- `(tr ((class ,(~a (table-row-status result))))
- (td ,(or (table-row-name result) ""))
- (td ,(format-bits (table-row-start result)))
- (td ,(format-bits (table-row-result result)))
- (td ,(format-bits (table-row-target result)))
- (td ,(let ([inf- (table-row-inf- result)])
- (if (and inf- (> inf- 0)) (format "+~a" inf-) ""))
- ,(let ([inf+ (table-row-inf+ result)])
- (if (and inf+ (> inf+ 0)) (format "-~a" inf+) "")))
- (td ,(format-time (table-row-time result)))
- ,(if (table-row-link result)
- `(td
- (a ((id ,(format "link~a" id))
- (href ,(format "~a/graph.html" (table-row-link result))))
- "»"))
- ""))))))))
-
- ; Delete old files
- (let* ([expected-dirs (map string->path (filter identity (map table-row-link tests)))]
- [actual-dirs (filter (λ (name) (directory-exists? (build-path dir name))) (directory-list dir))]
- [extra-dirs (filter (λ (name) (not (member name expected-dirs))) actual-dirs)])
- (for ([subdir extra-dirs])
- (with-handlers ([exn:fail:filesystem? (const true)])
- (delete-directory/files (build-path dir subdir)))))]))
-
-(define (make-compare-page out-file info1 info2)
- (match-let ([(report-info date1 commit1 branch1 hostname1 seed1 flags1 points1 iterations1 bit-width1 note1 tests1)
- info1]
- [(report-info date2 commit2 branch2 hostname2 seed2 flags2 points2 iterations2 bit-width2 note2 tests2)
- info2])
- (define table-labels
- '("Test" "Start" "Result" "Result" "Target" "∞ ↔ ℝ" "∞ ↔ ℝ" "Time" "Time"))
-
- (define-values (dir _name _must-be-dir?) (split-path out-file))
-
- (copy-file (web-resource "compare.css") (build-path dir "compare.css") #t)
-
- (define total-time1 (apply + (map table-row-time tests1)))
- (define total-time2 (apply + (map table-row-time tests2)))
-
- (define (total-passed tests)
- (for/sum ([row tests])
- (if (member (table-row-status row) '("gt-target" "eq-target" "imp-start")) 1 0)))
- (define total-passed1 (total-passed tests1))
- (define total-passed2 (total-passed tests2))
-
- (define (total-available tests)
- (for/sum ([row tests])
- (if (not (equal? (table-row-status row) "ex-start")) 1 0)))
- (define total-available1 (total-passed tests1))
- (define total-available2 (total-passed tests2))
-
- (define (total-crashes tests)
- (for/sum ([row tests])
- (if (equal? (table-row-status row) "crash") 1 0)))
- (define total-crashes1 (total-crashes tests1))
- (define total-crashes2 (total-crashes tests2))
-
- (define (total-gained tests)
- (for/sum ([row tests])
- (or (table-row-result row) 0)))
- (define total-gained1 (total-gained tests1))
- (define total-gained2 (total-gained tests2))
-
- (define (total-start tests)
- (for/sum ([row tests])
- (or (table-row-start row) 0)))
- (define total-start1 (total-start tests1))
- (define total-start2 (total-start tests2))
-
- (define sorted-tests1
- (sort (map cons tests1 (range (length tests1))) >
- #:key (λ (x) (or (table-row-start (car x)) 0))))
- (define sorted-tests2
- (sort (map cons tests2 (range (length tests2))) >
- #:key (λ (x) (or (table-row-start (car x)) 0))))
-
- (define (round* x)
- (inexact->exact (round x)))
-
- (define (double-large-number title val1 val2)
- `(div ,title ": " (span ([class "number"]) ,(~a val1))
- " vs " (span ([class "number"]) ,(~a val2))))
-
-
- (write-file out-file
- ; HTML cruft
- (printf "\n")
- (write-xexpr
- `(html
- (head
- (title "Herbie test results")
- (meta ([charset "utf-8"]))
- (link ([rel "stylesheet"] [type "text/css"] [href "compare.css"]))
- (script ([src "http://d3js.org/d3.v3.min.js"] [charset "utf-8"])))
- (body
- (div ([id "large"])
- ,(double-large-number "Time" (format-time total-time1) (format-time total-time2))
- ,(double-large-number "Passed"
- (format "~a/~a" total-time1 total-available1)
- (format "~a/~a" total-time2 total-available2))
- ,(if (and (= total-crashes1 0) (= total-crashes2 0))
- ""
- (double-large-number "Crashes" total-crashes1 total-crashes2))
- ,(double-large-number "Tests" (length tests1) (length tests2))
- ,(double-large-number
- "Bits"
- (format "~a/~a" (round* (- total-start1 total-gained1)) (round* total-start1))
- (format "~a/~a" (round* (- total-start1 total-gained2)) (round* total-start2))))
-
- (ul ([id "test-badges"])
- ,@(for/list ([name (remove-duplicates (map table-row-name (append tests1 tests2)))])
- (define result1 (findf (compose (curry equal? name) table-row-name) tests1))
- (define result2 (findf (compose (curry equal? name) table-row-name) tests2))
- `(li ([class "badge"]
- [title ,(format "~a (~a to ~a) vs. (~a to ~a)"
- (table-row-name result1)
- (format-bits (table-row-start result1))
- (format-bits (table-row-result result1))
- (format-bits (table-row-start result2))
- (format-bits (table-row-result result2)))])
- (table
- (tbody
- (tr
- (td ([class ,(~a (table-row-status result1))]) ,(badge-label result1))
- (td ([class ,(~a (table-row-status result2))]) ,(badge-label result1))))))))
- (hr ([style "clear:both;visibility:hidden"]))
-
- (table ([id "about"])
- (tr (th "Date:")
- (td ([class "hinfo-cell"]) ,(date->string date1) (br) ,(date->string date2)))
- (tr (th "Commit:")
- (td ([class "hinfo-cell"]) ,(~a commit1) " on " ,(~a branch1)
- (br) ,(~a commit2) " on " ,(~a branch2)))
- (tr (th "Hostname:")
- (td ([class "hinfo-cell"]) ,(~a hostname1) (br) ,(~a hostname2)))
- (tr (th "Points:")
- (td ([class "hinfo-cell"]) ,(~a points1) (br) ,(~a points2)))
- (tr (th "Fuel:")
- (td ([class "hinfo-cell"]) ,(~a iterations1) (br) ,(~a iterations2)))
- (tr (th "Seed:")
- (td ([class "hinfo-cell"]) ,(~a seed1) (br) ,(~a seed2)))
- (tr (th "Flags:")
- (td ([id "flag-list"] [class "hinfo-cell"])
- ,@(for*/list ([rec (hash->list flags1)] [fl (cdr rec)])
- `(kbd ,(format "~a:~a" (car rec) fl)))
- (br)
- ,@(for*/list ([rec (hash->list flags2)] [fl (cdr rec)])
- `(kbd ,(format "~a:~a" (car rec) fl))))))
-
- (table ([id "results"])
- (thead ,@(for/list ([label table-labels]) `(th ,(~a label))))
- (tbody
- ,@(for/list ([name (remove-duplicates (map table-row-name (append tests1 tests2)))]
- [id (in-naturals)])
- (define result1 (findf (compose (curry equal? name) table-row-name)
- tests1))
- (define result2 (findf (compose (curry equal? name) table-row-name)
- tests2))
- ;; Some helper functions for displaying the different boxes for results
- (define (format-bits-vs-other bits other)
- (cond [(and (not bits) other)
- `(td ,(format-bits other))]
- [(and bits (not other))
- `(td ,(format-bits bits))]
- [(and (not bits) (not other))
- `(td)]
- [((abs (- bits other)) . > . 1)
- `(td ,(format-bits bits) "/" ,(format-bits other))]
- [#t
- `(td ,(format-bits bits))]))
-
- (define (format-bits-vs-est result est-result status)
- (if (and result est-result
- (> (abs (- result est-result)) 1))
- `(td ([class ,(format "bad-est" status)])
- "[" ,(format-bits est-result) " ≠] " ,(format-bits result))
- `(td ([class ,(~a status)]) ,(format-bits result))))
-
- (define (display-num-infs inf- inf+)
- `(td ([class "infs"])
- ,(if (and inf- (> inf- 0)) (format "+~a" inf-) "")
- ,(if (and inf+ (> inf+ 0)) (format "-~a" inf+) "")))
-
- `(tr
- (td ,(~a name))
- ;; The starting bits
- ,(format-bits-vs-other (table-row-start result1) (table-row-start result2))
- ;; The first result bits box
- ,(format-bits-vs-est (table-row-result result1) (table-row-result-est result1)
- (table-row-status result1))
- ;; The second result bits box
- ,(format-bits-vs-est (table-row-result result2) (table-row-result-est result2)
- (table-row-status result2))
- ;; The target bits
- ,(format-bits-vs-other (table-row-target result1) (table-row-target result2))
- ;; The number of points that went to infinity and back
-
- ,(display-num-infs (table-row-inf- result1) (table-row-inf+ result1))
- ,(display-num-infs (table-row-inf- result2) (table-row-inf+ result2))
- (td ,(format-time (table-row-time result1)))
- (td ,(format-time (table-row-time result2)))))))))))
-
- ; Delete old files
- (let* ([expected-dirs (map string->path (filter identity (map table-row-link tests1)))]
- [actual-dirs (filter (λ (name) (directory-exists? (build-path dir name))) (directory-list dir))]
- [extra-dirs (filter (λ (name) (not (member name expected-dirs))) actual-dirs)])
- (for ([subdir extra-dirs])
- (with-handlers ([exn? (const 'ok)])
- (delete-directory/files (build-path dir subdir)))))))
-
-(define (render-json dir file)
- (define info (read-datafile file))
-
- (when (not (directory-exists? dir))
- (make-directory dir))
-
- (make-report-page (build-path dir "report.html") info))
-
-(define (render-json-compare dir file1 file2)
- (define info1 (read-datafile file1))
- (define info2 (read-datafile file2))
-
- (when (not (directory-exists? dir))
- (make-directory dir))
-
- (make-compare-page (build-path dir "compare.html") info1 info2))
-
-(define (render dir files)
- (if (= 1 (length files))
- (render-json dir (car files))
- (render-json-compare dir (car files) (cadr files))))
-
-(module+ main
- (command-line
- #:program "make-report"
- #:args (dir info-files)
- (render dir info-files)))
diff --git a/src/reports/rerun.rkt b/src/reports/rerun.rkt
deleted file mode 100644
index 489e3f50d..000000000
--- a/src/reports/rerun.rkt
+++ /dev/null
@@ -1,72 +0,0 @@
-#lang racket
-
-(require racket/date)
-(require racket/cmdline)
-(require "make-report.rkt")
-(require "../common.rkt")
-(require "../programs.rkt")
-(require "../points.rkt")
-(require "../alternative.rkt")
-(require "../formats/test.rkt")
-(require "../formats/datafile.rkt")
-(require "../glue.rkt")
-(require "../formats/c.rkt")
-(require "thread-pool.rkt")
-(provide (all-defined-out))
-
-(define (rerun-report json-file #:dir dir #:threads threads #:profile? profile?)
- (when (not (directory-exists? dir)) (make-directory dir))
-
- (define data (read-datafile json-file))
- (define tests
- (for/list ([row (report-info-tests data)])
- (test (table-row-name row) (table-row-vars row)
- (table-row-input row) (table-row-output row) #f #t 'TRUE)))
- (*flags* (report-info-flags data))
- (set-seed! (report-info-seed data))
- (*num-points* (report-info-points data))
- (*num-iterations* (report-info-iterations data))
-
- (define results (get-test-results tests #:threads threads #:dir dir
- #:seed (get-seed) #:profile profile?))
- (define info (make-report-info (map cdr results)))
-
- (write-datafile (build-path dir "results.json") info)
- (make-report-page (build-path dir "report.html") info)
- ; TODO: Uses the same expressions for float and double. This could be good to change.
- (compile-info dir info info))
-
-(define (allowed-tests bench-dirs)
- (define unsorted-tests (append-map load-tests bench-dirs))
- (reverse (sort unsorted-tests test)))
-
-(define (test t1 t2)
- (cond
- [(and (test-output t1) (test-output t2))
- (string (test-name t1) (test-name t2))]
- [(and (not (test-output t1)) (not (test-output t2)))
- (string (test-name t1) (test-name t2))]
- [else
- ; Put things with an output first
- (test-output t1)]))
-
-(module+ main
-
-(define *profile?* #f)
-(define *max-test-threads* #f)
-
-(command-line
- #:program "herbie-rerun"
- #:once-each
- [("-p" "--profile") "Whether to profile each test"
- (set! *profile?* #t)]
- [("--threads") th "How many tests to run in parallel to use. Pass 'no' to use no threads (default), 'yes' to use the number of machine cores less one, and a number to use that many."
- (when (eq? (system-type 'os) 'macosx)
- (eprintf "WARNING Herbie does not support threads on OS X\n\tdue to a bug in MPFR. Herbie will attempt\n\tto execute anyway, but may fail.\n"))
- (set! *max-test-threads*
- (match th
- ["no" #f]
- ["yes" (max (- (processor-count) 1) 1)]
- [_ (string->number th)]))]
- #:args (json)
- (rerun-report json #:profile? *profile?* #:threads *max-test-threads*)))
diff --git a/src/reports/run.rkt b/src/reports/run.rkt
deleted file mode 100644
index 49515dec2..000000000
--- a/src/reports/run.rkt
+++ /dev/null
@@ -1,83 +0,0 @@
-#lang racket
-
-(require racket/date)
-(require racket/cmdline)
-(require "make-report.rkt")
-(require "../common.rkt")
-(require "../programs.rkt")
-(require "../points.rkt")
-(require "../alternative.rkt")
-(require "../formats/test.rkt")
-(require "../glue.rkt")
-(require "../formats/c.rkt")
-(require "../sandbox.rkt")
-(require "thread-pool.rkt")
-(require "../formats/datafile.rkt")
-(require "../errors.rkt")
-(provide (all-defined-out))
-
-(define (make-report bench-dirs #:dir dir #:profile profile? #:note note #:threads threads)
- (define seed (get-seed))
- (when (not (directory-exists? dir)) (make-directory dir))
-
- (define tests (allowed-tests bench-dirs))
- (define results
- (get-test-results tests #:threads threads #:seed seed #:profile profile? #:dir dir))
- (define info (make-report-info (map cdr (filter values results)) #:note note #:seed seed))
-
- (write-datafile (build-path dir "results.json") info)
- (make-report-page (build-path dir "report.html") info)
- (log-exceptions (build-path dir "exceptions.rkt") info)
- ; TODO: Uses the same expressions for float and double. This could be good to change.
- (compile-info dir info info))
-
-(define (allowed-tests bench-dirs)
- (define unsorted-tests (append-map load-tests bench-dirs))
- (reverse (sort unsorted-tests test)))
-
-(define (test t1 t2)
- (cond
- [(and (test-output t1) (test-output t2))
- (string (test-name t1) (test-name t2))]
- [(and (not (test-output t1)) (not (test-output t2)))
- (string (test-name t1) (test-name t2))]
- [else
- ; Put things with an output first
- (test-output t1)]))
-
-(module+ main
-(define threads #f)
-(define profile? #f)
-(define note #f)
-
-(command-line
- #:program "run"
- #:once-each
- [("--timeout") s "Timeout for each test (in seconds)"
- (*timeout* (* 1000 (string->number s)))]
- [("-r" "--seed") rs "The random seed to use in point generation"
- (set-seed! (read (open-input-string rs)))]
- [("-p" "--profile") "Whether to profile each test"
- (set! profile? #t)]
- [("--threads") th "How many tests to run in parallel to use. Pass 'no' to use no threads (default), 'yes' to use the number of machine cores less one, and a number to use that many."
- (set! threads
- (match th ["no" #f] ["yes" (max (- (processor-count) 1) 1)] [_ (string->number th)]))]
- [("--fuel") fu "The amount of 'fuel' to use"
- (*num-iterations* (string->number fu))]
- [("--num-points") points "The number of points to use"
- (*num-points* (string->number points))]
- [("--note") note "Add a note for this run"
- (set! note note)]
- #:multi
- [("-o" "--disable") tf "Disable flag formatted category:name"
- (define flag (parse-flag tf))
- (when (not flag)
- (raise-herbie-error "Invalid flag ~a" tf #:url "options.html"))
- (apply disable-flag! flag)]
- [("+o" "--enable") tf "Enable flag formatted category:name"
- (define flag (parse-flag tf))
- (when (not flag)
- (raise-herbie-error "Invalid flag ~a" tf #:url "options.html"))
- (apply enable-flag! flag)]
- #:args bench-dir
- (make-report bench-dir #:dir "graphs/" #:profile profile? #:note note)))
diff --git a/src/reports/thread-pool.rkt b/src/reports/thread-pool.rkt
deleted file mode 100644
index 48874e25a..000000000
--- a/src/reports/thread-pool.rkt
+++ /dev/null
@@ -1,194 +0,0 @@
-#lang racket
-
-(require racket/place)
-(require "../common.rkt")
-(require "../formats/test.rkt")
-(require "../points.rkt")
-(require "../programs.rkt")
-(require "../alternative.rkt")
-(require "../sandbox.rkt")
-(require "make-graph.rkt")
-(require "../formats/datafile.rkt")
-
-(provide get-test-results)
-
-(define (make-graph-if-valid result tname index rdir #:profile profile? #:seed seed)
- (with-handlers ([(const #f) (λ _ #f)])
- (when (not (directory-exists? rdir))
- (make-directory rdir))
-
- (set-seed! seed)
- (write-file (build-path rdir "graph.html")
- ((cond [(test-result? result)
- (λ args
- (define valid-js (apply make-interactive-js args))
- (apply make-graph (append args (list valid-js)))
- (apply make-plots args))]
- [(test-timeout? result) make-timeout]
- [(test-failure? result) make-traceback])
- result rdir profile?))))
-
-(define (graph-folder-path tname index)
- (let* ([stripped-tname (string-replace tname #px"\\W+" "")]
- [index-label (number->string index)])
- (string-append index-label "-"
- (if (> (string-length stripped-tname) 50)
- (substring stripped-tname 0 50)
- stripped-tname))))
-
-(define (call-with-output-files names k)
- (let loop ([names names] [ps '()])
- (if (null? names)
- (apply k (reverse ps))
- (if (car names)
- (call-with-output-file
- (car names) #:exists 'replace
- (λ (p) (loop (cdr names) (cons p ps))))
- (loop (cdr names) (cons #f ps))))))
-
-(define (run-test index test #:seed seed #:profile profile? #:dir dir)
- (cond
- [dir
- (let* ([rdir (graph-folder-path (test-name test) index)]
- [rdir* (build-path dir rdir)])
- (when (not (directory-exists? rdir*))
- (make-directory rdir*))
-
- (define result
- (call-with-output-files
- (list (build-path rdir* "debug.txt") (and profile? (build-path rdir* "profile.txt")))
- (λ (dp pp) (get-test-result test #:seed seed #:profile pp #:debug dp #:setup! (λ () (set-debug-level! #t #t))))))
-
- (make-graph-if-valid result (test-name test) index rdir* #:profile profile? #:seed seed)
- (get-table-data result rdir))]
- [else
- (define result (get-test-result test #:seed seed))
- (get-table-data result "")]))
-
-(define (make-worker)
- (place ch
- (let loop ([seed #f] [profile? #f] [dir #f])
- (match (place-channel-get ch)
- [`(init
- rand ,vec
- flags ,flag-table
- num-iters ,iterations
- points ,points
- profile? ,profile
- dir ,path
- timeout ,timeout
- reeval ,reeval)
-
- (set! seed vec)
- (set! profile? profile)
- (set! dir path)
- (*flags* flag-table)
- (*num-iterations* iterations)
- (*num-points* points)
- (*timeout* timeout)
- (*reeval-pts* reeval)]
- [`(apply ,self ,id ,test)
- (let ([result (run-test id test #:seed seed #:profile profile? #:dir dir)])
- (place-channel-put ch
- `(done ,id ,self ,result)))])
- (loop seed profile? dir))))
-
-(define (print-test-result data)
- (match-define (cons fpcore tr) data)
- (match (table-row-status tr)
- ["error"
- (eprintf "[ ERROR ]\t~a\n" (table-row-name tr))]
- ["crash"
- (eprintf "[ CRASH ]\t~a\n" (table-row-name tr))]
- ["timeout"
- (eprintf "[ timeout ]\t~a\n" (table-row-name tr))]
- [_
- (eprintf "[ ~ams]\t(~a→~a)\t~a\n" (~a (table-row-time tr) #:width 8)
- (~r (table-row-start tr) #:min-width 2 #:precision 0)
- (~r (table-row-result tr) #:min-width 2 #:precision 0)
- (table-row-name tr))]))
-
-(define (run-workers progs threads #:seed seed #:profile profile? #:dir dir)
- (define config
- `(init rand ,seed
- flags ,(*flags*)
- num-iters ,(*num-iterations*)
- points ,(*num-points*)
- profile? ,profile?
- dir ,dir
- timeout ,(*timeout*)
- reeval ,(*reeval-pts*)))
-
- (define workers
- (for/list ([wid (in-range threads)])
- (define worker (make-worker))
- (place-channel-put worker config)
- worker))
-
- (define work
- (for/list ([id (in-naturals)] [prog progs])
- (list id prog)))
-
- (eprintf "Starting ~a Herbie workers on ~a problems (seed: ~a)...\n" threads (length progs) seed)
- (for ([worker workers])
- (place-channel-put worker `(apply ,worker ,@(car work)))
- (set! work (cdr work)))
-
- (define outs
- (let loop ([out '()])
- (with-handlers ([exn:break?
- (λ (_)
- (eprintf "Terminating after ~a problem~a!\n"
- (length out) (if (= (length out) 1) "" "s"))
- out)])
- (match-define `(done ,id ,more ,tr) (apply sync workers))
-
- (when (not (null? work))
- (place-channel-put more `(apply ,more ,@(car work)))
- (set! work (cdr work)))
-
- (define out* (cons (cons id tr) out))
-
- (eprintf "~a/~a\t" (~a (length out*) #:width 3 #:align 'right) (length progs))
- (print-test-result tr)
-
- (if (= (length out*) (length progs))
- out*
- (loop out*)))))
-
- (map place-kill workers)
-
- outs)
-
-(define (run-nothreads progs #:seed seed #:profile profile? #:dir dir)
- (eprintf "Starting Herbie on ~a problems (seed: ~a)...\n" (length progs) seed)
- (define out '())
- (with-handlers ([exn:break?
- (λ (_)
- (eprintf "Terminating after ~a problem~a!\n"
- (length out) (if (= (length out) 1) "s" "")))])
- (for ([test progs] [i (in-naturals)])
- (define tr (run-test i test #:seed seed #:profile profile? #:dir dir))
- (eprintf "~a/~a\t" (~a (+ 1 i) #:width 3 #:align 'right) (length progs))
- (print-test-result tr)
- (set! out (cons (cons i tr) out))))
- out)
-
-(define/contract (get-test-results progs #:threads threads #:seed seed #:profile profile? #:dir dir)
- (-> (listof test?) #:threads (or/c #f natural-number/c)
- #:seed (or/c pseudo-random-generator-vector? (integer-in 1 (sub1 (expt 2 31))))
- #:profile boolean? #:dir (or/c #f path-string?)
- (listof (or/c #f (cons/c expr? table-row?))))
- (when (and threads (> threads (length progs)))
- (set! threads (length progs)))
-
- (define outs
- (if threads
- (run-workers progs threads #:seed seed #:profile profile? #:dir dir)
- (run-nothreads progs #:seed seed #:profile profile? #:dir dir)))
-
- (define out (make-vector (length progs) #f))
- (for ([(idx result) (in-dict outs)])
- (vector-set! out idx result))
-
- (vector->list out))
diff --git a/src/sandbox.rkt b/src/sandbox.rkt
index b996611da..cc5c1099d 100644
--- a/src/sandbox.rkt
+++ b/src/sandbox.rkt
@@ -1,202 +1,193 @@
#lang racket
-(require profile)
-(require math/bigfloat)
-(require racket/engine)
-
-(require "common.rkt" "errors.rkt")
-(require "debug.rkt")
-(require "mainloop.rkt")
-(require "formats/datafile.rkt")
-(require "programs.rkt")
-(require "points.rkt")
-(require "formats/test.rkt")
-(require "alternative.rkt")
-(require "glue.rkt")
+(require profile math/bigfloat racket/engine)
+(require "common.rkt" "errors.rkt" "debug.rkt")
+(require "float.rkt" "points.rkt" "programs.rkt")
+(require "mainloop.rkt" "alternative.rkt" "timeline.rkt" (submod "timeline.rkt" debug))
+(require "formats/datafile.rkt" "formats/test.rkt")
(provide get-test-result *reeval-pts* *timeout*
- (struct-out test-result) (struct-out test-failure) (struct-out test-timeout)
+ (struct-out test-result) (struct-out test-success)
+ (struct-out test-failure) (struct-out test-timeout)
get-table-data unparse-result)
-; For things that don't leave a thread
-(struct test-result
- (test time bits
- start-alt end-alt points exacts start-est-error end-est-error
- newpoints newexacts start-error end-error target-error timeline))
-(struct test-failure (test bits exn time timeline))
-(struct test-timeout (test bits time timeline))
+;; These cannot move between threads!
+(struct test-result (test bits time timeline warnings))
+(struct test-success test-result
+ (start-alt end-alt points exacts start-est-error end-est-error
+ newpoints newexacts start-error end-error target-error
+ baseline-error oracle-error all-alts))
+(struct test-failure test-result (exn))
+(struct test-timeout test-result ())
(define *reeval-pts* (make-parameter 8000))
(define *timeout* (make-parameter (* 1000 60 10)))
(define (get-p&es context)
- (call-with-values
- (λ ()
- (for/lists (pts exs)
- ([(pt ex) (in-pcontext context)])
- (values pt ex)))
- list))
+ (for/lists (pts exs)
+ ([(pt ex) (in-pcontext context)])
+ (values pt ex)))
-(define (get-test-result test #:seed [seed #f] #:setup! [setup! #f]
- #:profile [profile? #f] #:debug [debug? #f])
- (define (on-error e) `(error ,e ,(bf-precision)))
+(define (get-test-result test #:seed [seed #f] #:debug [debug? #f]
+ #:profile [profile? #f] #:debug-port [debug-port #f] #:debug-level [debug-level #f])
+
+ (define timeline #f)
(define (compute-result test)
- (parameterize ([*debug-port* (or debug? (*debug-port*))])
+ (parameterize ([*debug-port* (or debug-port (*debug-port*))])
(when seed (set-seed! seed))
(random) ;; Child process uses deterministic but different seed from evaluator
- (when setup! (setup!))
- (with-handlers ([exn? on-error])
- (match-define (list alt context)
- (run-improve (test-program test)
- (*num-iterations*)
- #:get-context #t
- #:precondition (test-precondition test)))
+ (match debug-level
+ [(cons x y) (set-debug-level! x y)]
+ [_ (void)])
+ (with-handlers ([exn? (λ (e) (timeline-event! 'end) `(error ,(bf-precision) ,warning-log ,e))])
+ (define alt
+ (run-improve (test-program test)
+ (*num-iterations*)
+ #:precondition (test-precondition test)
+ #:precision (test-precision test)))
+ (define context (*pcontext*))
(when seed (set-seed! seed))
+ (timeline-event! 'sample)
(define newcontext
(parameterize ([*num-points* (*reeval-pts*)])
- (prepare-points (test-program test) (test-precondition test))))
- `(good ,(make-alt (test-program test)) ,alt ,context ,newcontext
- ,(^timeline^) ,(bf-precision)))))
+ (prepare-points (test-program test) (test-precondition test) (test-precision test))))
+ (timeline-event! 'end)
+ (define end-err (errors-score (errors (alt-program alt) newcontext)))
+
+ (define all-alts (remove-duplicates (*all-alts*)))
+ (define baseline-errs
+ (baseline-error (map (λ (alt) (eval-prog (alt-program alt) 'fl)) all-alts) context newcontext))
+ (define oracle-errs
+ (oracle-error (map (λ (alt) (eval-prog (alt-program alt) 'fl)) all-alts) newcontext))
+
+ (debug #:from 'regime-testing #:depth 1
+ "Baseline error score:" (errors-score baseline-errs))
+ (debug #:from 'regime-testing #:depth 1
+ "Oracle error score:" (errors-score oracle-errs))
+
+ ;; The cells are stored in reverse order, so this finds last regimes invocation
+ (for/first ([cell (unbox timeline)]
+ #:when (equal? (dict-ref cell 'type) 'regimes))
+ (dict-set! cell 'oracle (errors-score oracle-errs))
+ (dict-set! cell 'accuracy end-err)
+ (dict-set! cell 'baseline (errors-score baseline-errs)))
+
+ (debug #:from 'regime-testing #:depth 1
+ "End program error score:" end-err)
+ (when (test-output test)
+ (debug #:from 'regime-testing #:depth 1
+ "Target error score:" (errors-score (errors (test-target test) newcontext))))
+ `(good ,(bf-precision) ,warning-log
+ ,(make-alt (test-program test)) ,alt ,context ,newcontext
+ ,baseline-errs ,oracle-errs ,all-alts))))
(define (in-engine _)
+ (set! timeline *timeline*)
(if profile?
(parameterize ([current-output-port (or profile? (current-output-port))])
(profile (compute-result test)))
(compute-result test)))
-
+
(let* ([start-time (current-inexact-milliseconds)] [eng (engine in-engine)])
(engine-run (*timeout*) eng)
(match (engine-result eng)
- [`(good ,start ,end ,context ,newcontext ,timeline ,bits)
- (match-define (list newpoints newexacts) (get-p&es newcontext))
- (match-define (list points exacts) (get-p&es context))
- (test-result test
- (- (current-inexact-milliseconds) start-time)
- bits
- start end points exacts
- (errors (alt-program start) context)
- (errors (alt-program end) context)
- newpoints newexacts
- (errors (alt-program start) newcontext)
- (errors (alt-program end) newcontext)
- (if (test-output test)
- (errors (test-target test) newcontext)
- #f)
- timeline)]
- [`(error ,e ,bits)
- (test-failure test bits e (- (current-inexact-milliseconds) start-time) (^timeline^))]
+ [`(good ,bits ,warnings ,start ,end ,context ,newcontext
+ ,baseline-errs ,oracle-errs ,all-alts)
+ (define-values (newpoints newexacts) (get-p&es newcontext))
+ (define-values (points exacts) (get-p&es context))
+ (test-success test
+ bits
+ (- (current-inexact-milliseconds) start-time)
+ (reverse (unbox timeline))
+ warnings start end points exacts
+ (errors (alt-program start) context)
+ (errors (alt-program end) context)
+ newpoints newexacts
+ (errors (alt-program start) newcontext)
+ (errors (alt-program end) newcontext)
+ (if (test-output test)
+ (errors (test-target test) newcontext)
+ #f)
+ baseline-errs
+ oracle-errs
+ all-alts)]
+ [`(error ,bits ,warnings ,e)
+ (test-failure test bits (- (current-inexact-milliseconds) start-time) (reverse (unbox timeline)) warnings e)]
[#f
- (test-timeout test (bf-precision) (*timeout*) (^timeline^))])))
+ (define timeline*
+ (reverse
+ (cons (hash 'type 'end 'time (current-inexact-milliseconds))
+ (unbox timeline))))
+ (test-timeout test (bf-precision) (*timeout*) timeline* '())])))
+
+(define (dummy-table-row result status link)
+ (define test (test-result-test result))
+ (table-row (test-name test) status (resugar-program (test-precondition test)) (test-precision test)
+ (test-vars test) (resugar-program (test-input test)) #f
+ (and (test-output test) (resugar-program (test-output test)))
+ #f #f #f #f #f #f #f (test-result-time result) (test-result-bits result) link))
(define (get-table-data result link)
- (cons (unparse-result result) (get-table-data* result link)))
+ (define test (test-result-test result))
-(define (get-table-data* result link)
(cond
- [(test-result? result)
- (let* ([name (test-name (test-result-test result))]
- [start-errors (test-result-start-error result)]
- [end-errors (test-result-end-error result)]
- [target-errors (test-result-target-error result)]
-
- [start-score (errors-score start-errors)]
- [end-score (errors-score end-errors)]
- [target-score (and target-errors (errors-score target-errors))]
-
- [est-start-score (errors-score (test-result-start-est-error result))]
- [est-end-score (errors-score (test-result-end-est-error result))])
-
- (let*-values ([(reals infs) (partition ordinary-value? (map - end-errors start-errors))]
- [(good-inf bad-inf) (partition positive? infs)])
- (table-row name
- (if target-score
- (cond
- [(< end-score (- target-score 1)) "gt-target"]
- [(< end-score (+ target-score 1)) "eq-target"]
- [(> end-score (+ start-score 1)) "lt-start"]
- [(> end-score (- start-score 1)) "eq-start"]
- [(> end-score (+ target-score 1)) "lt-target"])
- (cond
- [(and (< start-score 1) (< end-score (+ start-score 1))) "ex-start"]
- [(< end-score (- start-score 1)) "imp-start"]
- [(< end-score (+ start-score 1)) "apx-start"]
- [else "uni-start"]))
- start-score
- end-score
- (and target-score target-score)
- (length good-inf)
- (length bad-inf)
- est-start-score
- est-end-score
- (program-variables (alt-program (test-result-start-alt result)))
- (program-body (alt-program (test-result-start-alt result)))
- (program-body (alt-program (test-result-end-alt result)))
- (test-result-time result)
- (test-result-bits result)
- link)))]
+ [(test-success? result)
+ (define name (test-name test))
+ (define start-errors (test-success-start-error result))
+ (define end-errors (test-success-end-error result))
+ (define target-errors (test-success-target-error result))
+
+ (define start-score (errors-score start-errors))
+ (define end-score (errors-score end-errors))
+ (define target-score (and target-errors (errors-score target-errors)))
+ (define est-start-score (errors-score (test-success-start-est-error result)))
+ (define est-end-score (errors-score (test-success-end-est-error result)))
+
+ ;; TODO: this is broken because errors are always ordinary values now!
+ (define-values (reals infs) (partition ordinary-value? (map - end-errors start-errors)))
+ (define-values (good-inf bad-inf) (partition positive? infs))
+
+ (define status
+ (if target-score
+ (cond
+ [(< end-score (- target-score 1)) "gt-target"]
+ [(< end-score (+ target-score 1)) "eq-target"]
+ [(> end-score (+ start-score 1)) "lt-start"]
+ [(> end-score (- start-score 1)) "eq-start"]
+ [(> end-score (+ target-score 1)) "lt-target"])
+ (cond
+ [(and (< start-score 1) (< end-score (+ start-score 1))) "ex-start"]
+ [(< end-score (- start-score 1)) "imp-start"]
+ [(< end-score (+ start-score 1)) "apx-start"]
+ [else "uni-start"])))
+
+ (struct-copy table-row (dummy-table-row result status link)
+ [output (resugar-program (program-body (alt-program (test-success-end-alt result))))]
+ [start start-score] [result end-score] [target target-score]
+ [start-est est-start-score] [result-est est-end-score] [inf- (length good-inf)] [inf+ (length bad-inf)])]
[(test-failure? result)
- (define test (test-failure-test result))
- (table-row (test-name test) (if (exn:fail:user:herbie? (test-failure-exn result)) "error" "crash")
- #f #f #f #f #f #f #f (test-vars test) (test-input test) #f
- (test-failure-time result) (test-failure-bits result) link)]
+ (define status (if (exn:fail:user:herbie? (test-failure-exn result)) "error" "crash"))
+ (dummy-table-row result status link)]
[(test-timeout? result)
- (define test (test-timeout-test result))
- (table-row (test-name (test-timeout-test result)) "timeout"
- #f #f #f #f #f #f #f (test-vars test) (test-input test) #f
- (test-timeout-time result) (test-timeout-bits result) link)]))
-
-(define (unparse-result result)
- (match result
- [(test-result test time bits
- start-alt end-alt points exacts start-est-error end-est-error
- newpoints newexacts start-error end-error target-error timeline)
- `(FPCore ,(test-vars test)
- :herbie-status success
- :herbie-time ,time
- :herbie-bits-used ,bits
- :herbie-error-input
- ([,(*num-points*) ,(errors-score start-est-error)]
- [,(*reeval-pts*) ,(errors-score start-error)])
- :herbie-error-output
- ([,(*num-points*) ,(errors-score end-est-error)]
- [,(*reeval-pts*) ,(errors-score end-error)])
- ,@(if target-error
- `(:herbie-error-target
- ([,(*reeval-pts*) ,(errors-score target-error)]))
- '())
- :name ,(test-name test)
- ,@(if (eq? (test-precondition test) 'TRUE)
- '()
- `(:pre ,(test-precondition test)))
- ,@(if (test-output test)
- `(:herbie-target ,(test-output test))
- '())
- ,(program-body (alt-program end-alt)))]
- [(test-failure test bits exn time timeline)
- `(FPCore ,(test-vars test)
- :herbie-status ,(if (exn:fail:user:herbie? (test-failure-exn result)) 'error 'crash)
- :herbie-time ,time
- :herbie-bits-used ,bits
- :name ,(test-name test)
- ,@(if (eq? (test-precondition test) 'TRUE)
- '()
- `(:pre ,(test-precondition test)))
- ,@(if (test-output test)
- `(:herbie-target ,(test-output test))
- '())
- ,(test-input test))]
- [(test-timeout test bits time timeline)
- `(FPCore ,(test-vars test)
- :herbie-status timeout
- :herbie-time ,time
- :herbie-bits-used ,bits
- :name ,(test-name test)
- ,@(if (eq? (test-precondition test) 'TRUE)
- '()
- `(:pre ,(test-precondition test)))
- ,@(if (test-output test)
- `(:herbie-target ,(test-output test))
- '())
- ,(test-input test))]))
+ (dummy-table-row result "timeout" link)]))
+
+(define (unparse-result row)
+ `(FPCore ,(table-row-vars row)
+ :herbie-status ,(string->symbol (table-row-status row))
+ :herbie-time ,(table-row-time row)
+ :herbie-error-input
+ ([,(*num-points*) ,(table-row-start-est row)]
+ [,(*reeval-pts*) ,(table-row-start row)])
+ :herbie-error-output
+ ([,(*num-points*) ,(table-row-result-est row)]
+ [,(*reeval-pts*) ,(table-row-result row)])
+ ,@(if (table-row-target row)
+ `(:herbie-error-target ([,(*reeval-pts*) ,(table-row-target row)]))
+ '())
+ :name ,(table-row-name row)
+ :precision ,(table-row-precision row)
+ ,@(if (eq? (table-row-pre row) 'TRUE) '() `(:pre (table-row-pre row)))
+ ,@(if (table-row-target-prog row) `(:herbie-target ,(table-row-target-prog row)) '())
+ ,(table-row-output row)))
diff --git a/src/shell.rkt b/src/shell.rkt
index 4c9674b9d..ba7e7492e 100644
--- a/src/shell.rkt
+++ b/src/shell.rkt
@@ -18,15 +18,15 @@
(define (run-shell)
(define seed (get-seed))
(eprintf "Herbie ~a with seed ~a\n" *herbie-version* seed)
- (eprintf "Find help on , exit with ~a\n"
+ (eprintf "Find help on https://herbie.uwplse.org/, exit with ~a\n"
(match (system-type 'os) ['windows "Ctrl-Z Enter"] [_ "Ctrl-D"]))
(with-handlers ([exn:break? (λ (e) (exit 0))])
(for ([test (in-producer get-input eof-object?)] [idx (in-naturals)])
(define output (get-test-result test #:seed seed))
(match output
- [(? test-result?)
- (printf "~a\n" (unparse-result output))]
- [(test-failure test bits exn time timeline)
+ [(? test-success?)
+ (pretty-print (unparse-result (get-table-data output "")) (current-output-port) 1)]
+ [(test-failure test bits time timeline warnings exn)
((error-display-handler) (exn-message exn) exn)]
- [(test-timeout test bits time timeline)
+ [(test-timeout test bits time timeline warnings)
(printf "Timeout in ~as (see --timeout option)\n" (/ time 1000))]))))
diff --git a/src/syntax-check.rkt b/src/syntax-check.rkt
index f4826b58c..109e8d41e 100644
--- a/src/syntax-check.rkt
+++ b/src/syntax-check.rkt
@@ -1,7 +1,7 @@
#lang racket
(require syntax/id-set)
-(require "common.rkt" "syntax/syntax.rkt" "errors.rkt")
+(require "common.rkt" "syntax/syntax.rkt" "errors.rkt" "interface.rkt")
(provide assert-expression! assert-program!)
(define (check-expression* stx vars error!)
@@ -17,14 +17,14 @@
(error! var "Invalid variable name ~a" var))
(check-expression* val vars error!))
(check-expression* body (bound-id-set-union vars (immutable-bound-id-set vars*)) error!)]
+ [#`(let ,varlist #,body)
+ (error! stx "Invalid `let` expression variable list ~a" (syntax->datum varlist))
+ (check-expression* body vars error!)]
+ [#`(let ,args ...)
+ (error! stx "Invalid `let` expression with ~a arguments (expects 2)" (length args))]
[#`(,(? (curry set-member? '(+ - * /))) #,args ...)
;; These expand associativity so we don't check the number of arguments
(for ([arg args]) (check-expression* arg vars error!))]
- [#`(,(and (or 'sqr 'cube) f) #,args ...)
- (unless (= (length args) 1)
- (error! stx "Operator ~a given ~a arguments (expects 1)" f (length args)))
- (eprintf "Warning: the `sqr` and `cube` operators are deprecated and will be removed in later versions.\n")
- (for ([arg args]) (check-expression* arg vars error!))]
[#`(,f #,args ...)
(if (operator? f)
(let ([num-args (operator-info f 'args)])
@@ -33,7 +33,7 @@
f (length args) (string-join (map ~a num-args) " or "))))
(error! stx "Unknown operator ~a" f))
(for ([arg args]) (check-expression* arg vars error!))]
- [_ (error! stx "Unknown syntax ~a" stx)]))
+ [_ (error! stx "Unknown syntax ~a" (syntax->datum stx))]))
(define (check-property* prop error!)
(unless (identifier? prop)
@@ -66,6 +66,15 @@
(unless (string? (syntax-e desc))
(error! desc "Invalid :description ~a; must be a string" desc)))
+ (when (dict-has-key? prop-dict ':precision)
+ (define prec (dict-ref prop-dict ':precision))
+ (define known-prec?
+ (with-handlers ([exn:fail? (const false)])
+ (get-representation (syntax-e prec))
+ true))
+ (unless known-prec?
+ (error! prec "Unknown :precision ~a" prec)))
+
(when (dict-has-key? prop-dict ':cite)
(define cite (dict-ref prop-dict ':cite))
(unless (list? (syntax-e cite))
diff --git a/src/syntax/rules.rkt b/src/syntax/rules.rkt
index 63ed17336..182efd8cd 100644
--- a/src/syntax/rules.rkt
+++ b/src/syntax/rules.rkt
@@ -2,18 +2,15 @@
;; Arithmetic identities for rewriting programs.
-(require "../common.rkt")
-(require "syntax.rkt")
+(require "../common.rkt" "syntax.rkt" "../float.rkt" "../type-check.rkt")
-(provide (struct-out rule) *complex-rules* rule-valid-at-type? *rules* *simplify-rules*
- *fp-safe-simplify-rules* prune-rules!)
+(provide (struct-out rule) *rules* *simplify-rules* *fp-safe-simplify-rules*)
+(module+ internals (provide define-ruleset *rulesets*))
-(struct rule (name input output) ; Input and output are patterns
+(struct rule (name input output itypes otype) ; Input and output are patterns
#:methods gen:custom-write
[(define (write-proc rule port mode)
- (display "#" port))])
+ (fprintf port "#" (rule-name rule)))])
(define *rulesets* (make-parameter '()))
@@ -27,12 +24,13 @@
[else #t]))
(ops-in-expr (rule-output rule)))
-(define (prune-rules!)
- (*rulesets* (for/list ([ruleset (*rulesets*)])
- (cons (for/list ([rule (car ruleset)]
- #:when (rule-ops-supported? rule))
- rule)
- (cdr ruleset)))))
+(register-reset
+ #:priority 10 ; Must be higher than priority for pruning operators
+ (λ ()
+ (*rulesets*
+ (for/list ([ruleset (*rulesets*)])
+ (match-define (list rules groups types) ruleset)
+ (list (filter rule-ops-supported? rules) groups types)))))
(define-syntax define-ruleset
(syntax-rules ()
@@ -40,16 +38,24 @@
(define-ruleset name groups #:type () [rname input output] ...)]
[(define-ruleset name groups #:type ([var type] ...)
[rname input output] ...)
- (begin (define name (list (rule 'rname 'input 'output) ...))
+ (begin (define name (list (rule 'rname 'input 'output '((var . type) ...)
+ (type-of 'input '((var . type) ...))) ...))
(*rulesets* (cons (list name 'groups '((var . type) ...)) (*rulesets*))))]))
; Commutativity
-(define-ruleset commutativity (arithmetic simplify complex fp-safe)
+(define-ruleset commutativity (arithmetic simplify fp-safe)
+ #:type ([a real] [b real])
[+-commutative (+ a b) (+ b a)]
[*-commutative (* a b) (* b a)])
+(define-ruleset commutativity.c (arithmetic simplify fp-safe complex)
+ #:type ([a complex] [b complex])
+ [+.c-commutative (+.c a b) (+.c b a)]
+ [*.c-commutative (*.c a b) (*.c b a)])
+
; Associativity
-(define-ruleset associativity (arithmetic simplify complex)
+(define-ruleset associativity (arithmetic simplify)
+ #:type ([a real] [b real] [c real])
[associate-+r+ (+ a (+ b c)) (+ (+ a b) c)]
[associate-+l+ (+ (+ a b) c) (+ a (+ b c))]
[associate-+r- (+ a (- b c)) (- (+ a b) c)]
@@ -69,8 +75,35 @@
[sub-neg (- a b) (+ a (- b))]
[unsub-neg (+ a (- b)) (- a b)])
+(define-ruleset associativity.c (arithmetic simplify complex)
+ #:type ([a complex] [b complex] [c complex])
+ [associate-+r+.c (+.c a (+.c b c)) (+.c (+.c a b) c)]
+ [associate-+l+.c (+.c (+.c a b) c) (+.c a (+.c b c))]
+ [associate-+r-.c (+.c a (-.c b c)) (-.c (+.c a b) c)]
+ [associate-+l-.c (+.c (-.c a b) c) (-.c a (-.c b c))]
+ [associate--r+.c (-.c a (+.c b c)) (-.c (-.c a b) c)]
+ [associate--l+.c (-.c (+.c a b) c) (+.c a (-.c b c))]
+ [associate--l-.c (-.c (-.c a b) c) (-.c a (+.c b c))]
+ [associate--r-.c (-.c a (-.c b c)) (+.c (-.c a b) c)]
+ [associate-*r*.c (*.c a (*.c b c)) (*.c (*.c a b) c)]
+ [associate-*l*.c (*.c (*.c a b) c) (*.c a (*.c b c))]
+ [associate-*r/.c (*.c a (/.c b c)) (/.c (*.c a b) c)]
+ [associate-*l/.c (*.c (/.c a b) c) (/.c (*.c a c) b)]
+ [associate-/r*.c (/.c a (*.c b c)) (/.c (/.c a b) c)]
+ [associate-/l*.c (/.c (*.c b c) a) (/.c b (/.c a c))]
+ [associate-/r/.c (/.c a (/.c b c)) (*.c (/.c a b) c)]
+ [associate-/l/.c (/.c (/.c b c) a) (/.c b (*.c a c))]
+ [sub-neg.c (-.c a b) (+.c a (neg.c b))]
+ [unsub-neg.c (+.c a (neg.c b)) (-.c a b)])
+
+; Counting
+(define-ruleset counting (arithmetic simplify)
+ #:type ([x real])
+ [count-2 (+ x x) (* 2 x)])
+
; Distributivity
-(define-ruleset distributivity (arithmetic simplify complex)
+(define-ruleset distributivity (arithmetic simplify)
+ #:type ([a real] [b real] [c real])
[distribute-lft-in (* a (+ b c)) (+ (* a b) (* a c))]
[distribute-rgt-in (* a (+ b c)) (+ (* b a) (* c a))]
[distribute-lft-out (+ (* a b) (* a c)) (* a (+ b c))]
@@ -80,8 +113,20 @@
[distribute-lft1-in (+ (* b a) a) (* (+ b 1) a)]
[distribute-rgt1-in (+ a (* c a)) (* (+ c 1) a)])
+(define-ruleset distributivity.c (arithmetic simplify complex)
+ #:type ([a complex] [b complex] [c complex])
+ [distribute-lft-in.c (*.c a (+.c b c)) (+.c (*.c a b) (*.c a c))]
+ [distribute-rgt-in.c (*.c a (+.c b c)) (+.c (*.c b a) (*.c c a))]
+ [distribute-lft-out.c (+.c (*.c a b) (*.c a c)) (*.c a (+.c b c))]
+ [distribute-lft-out--.c (-.c (*.c a b) (*.c a c)) (*.c a (-.c b c))]
+ [distribute-rgt-out.c (+.c (*.c b a) (*.c c a)) (*.c a (+.c b c))]
+ [distribute-rgt-out--.c (-.c (*.c b a) (*.c c a)) (*.c a (-.c b c))]
+ [distribute-lft1-in.c (+.c (*.c b a) a) (*.c (+.c b (complex 1 0)) a)]
+ [distribute-rgt1-in.c (+.c a (*.c c a)) (*.c (+.c c (complex 1 0)) a)])
+
; Safe Distributiviity
(define-ruleset distributivity-fp-safe (arithmetic simplify fp-safe)
+ #:type ([a real] [b real])
[distribute-lft-neg-in (- (* a b)) (* (- a) b)]
[distribute-rgt-neg-in (- (* a b)) (* a (- b))]
[distribute-lft-neg-out (* (- a) b) (- (* a b))]
@@ -90,23 +135,33 @@
[distribute-neg-out (+ (- a) (- b)) (- (+ a b))]
[distribute-frac-neg (/ (- a) b) (- (/ a b))]
[distribute-neg-frac (- (/ a b)) (/ (- a) b)])
+
; Difference of squares
(define-ruleset difference-of-squares-canonicalize (polynomials simplify)
+ #:type ([a real] [b real])
+ [swap-sqr (* (* a b) (* a b)) (* (* a a) (* b b))]
+ [unswap-sqr (* (* a a) (* b b)) (* (* a b) (* a b))]
[difference-of-squares (- (* a a) (* b b)) (* (+ a b) (- a b))]
[difference-of-sqr-1 (- (* a a) 1) (* (+ a 1) (- a 1))]
- [difference-of-sqr--1 (+ (* a a) -1) (* (+ a 1) (- a 1))])
+ [difference-of-sqr--1 (+ (* a a) -1) (* (+ a 1) (- a 1))]
+ [sqr-pow (pow a b) (* (pow a (/ b 2)) (pow a (/ b 2)))]
+ [pow-sqr (* (pow a b) (pow a b)) (pow a (* 2 b))]
+ )
(define-ruleset difference-of-squares-flip (polynomials)
+ #:type ([a real] [b real])
[flip-+ (+ a b) (/ (- (* a a) (* b b)) (- a b))]
[flip-- (- a b) (/ (- (* a a) (* b b)) (+ a b))])
; Identity
(define-ruleset id-reduce (arithmetic simplify)
+ #:type ([a real])
[remove-double-div (/ 1 (/ 1 a)) a]
[rgt-mult-inverse (* a (/ 1 a)) 1]
[lft-mult-inverse (* (/ 1 a) a) 1])
(define-ruleset id-reduce-fp-safe-nan (arithmetic simplify fp-safe-nan)
+ #:type ([a real])
[+-inverses (- a a) 0]
[*-inverses (/ a a) 1]
[div0 (/ 0 a) 0]
@@ -114,10 +169,11 @@
[mul0 (* a 0) 0])
(define-ruleset id-reduce-fp-safe (arithmetic simplify fp-safe)
+ #:type ([a real])
[+-lft-identity (+ 0 a) a]
[+-rgt-identity (+ a 0) a]
[--rgt-identity (- a 0) a]
- [sub0-neg (- 0 b) (- b)]
+ [sub0-neg (- 0 a) (- a)]
[remove-double-neg (- (- a)) a]
[*-lft-identity (* 1 a) a]
[*-rgt-identity (* a 1) a]
@@ -125,11 +181,13 @@
[mul-1-neg (* -1 a) (- a)])
(define-ruleset id-transform (arithmetic)
+ #:type ([a real] [b real])
[div-inv (/ a b) (* a (/ 1 b))]
[un-div-inv (* a (/ 1 b)) (/ a b)]
[clear-num (/ a b) (/ 1 (/ b a))])
(define-ruleset id-transform-fp-safe (arithmetic fp-safe)
+ #:type ([a real] [b real])
[sub-neg (- a b) (+ a (- b))]
[unsub-neg (+ a (- b)) (- a b)]
[neg-sub0 (- b) (- 0 b)]
@@ -138,6 +196,7 @@
; Difference of cubes
(define-ruleset difference-of-cubes (polynomials)
+ #:type ([a real] [b real])
[sum-cubes (+ (pow a 3) (pow b 3))
(* (+ (* a a) (- (* b b) (* a b))) (+ a b))]
[difference-cubes (- (pow a 3) (pow b 3))
@@ -148,49 +207,67 @@
(/ (- (pow a 3) (pow b 3)) (+ (* a a) (+ (* b b) (* a b))))])
; Dealing with fractions
-(define-ruleset fractions-distribute (fractions simplify complex)
+(define-ruleset fractions-distribute (fractions simplify)
+ #:type ([a real] [b real] [c real] [d real])
[div-sub (/ (- a b) c) (- (/ a c) (/ b c))]
[times-frac (/ (* a b) (* c d)) (* (/ a c) (/ b d))])
-(define-ruleset fractions-transform (fractions complex)
+(define-ruleset fractions-distribute.c (fractions simplify complex)
+ #:type ([a complex] [b complex] [c complex] [d complex])
+ [div-sub.c (/.c (-.c a b) c) (-.c (/.c a c) (/.c b c))]
+ [times-frac.c (/.c (*.c a b) (*.c c d)) (*.c (/.c a c) (/.c b d))])
+
+(define-ruleset fractions-transform (fractions)
+ #:type ([a real] [b real] [c real] [d real])
[sub-div (- (/ a c) (/ b c)) (/ (- a b) c)]
[frac-add (+ (/ a b) (/ c d)) (/ (+ (* a d) (* b c)) (* b d))]
[frac-sub (- (/ a b) (/ c d)) (/ (- (* a d) (* b c)) (* b d))]
[frac-times (* (/ a b) (/ c d)) (/ (* a c) (* b d))]
[frac-2neg (/ a b) (/ (- a) (- b))])
+(define-ruleset fractions-transform.c (fractions complex)
+ #:type ([a complex] [b complex] [c complex] [d complex])
+ [sub-div.c (-.c (/.c a c) (/.c b c)) (/.c (-.c a b) c)]
+ [frac-add.c (+.c (/.c a b) (/.c c d)) (/.c (+.c (*.c a d) (*.c b c)) (*.c b d))]
+ [frac-sub.c (-.c (/.c a b) (/.c c d)) (/.c (-.c (*.c a d) (*.c b c)) (*.c b d))]
+ [frac-times.c (*.c (/.c a b) (/.c c d)) (/.c (*.c a c) (*.c b d))]
+ [frac-2neg.c (/.c a b) (/.c (neg.c a) (neg.c b))])
+
; Square root
(define-ruleset squares-reduce (arithmetic simplify)
+ #:type ([x real])
[rem-square-sqrt (* (sqrt x) (sqrt x)) x]
[rem-sqrt-square (sqrt (* x x)) (fabs x)])
(define-ruleset squares-reduce-fp-sound (arithmetic simplify fp-sound)
+ #:type ([x real])
[sqr-neg (* (- x) (- x)) (* x x)])
-(define-ruleset squares-distribute (arithmetic simplify)
- [square-prod (sqr (* x y)) (* (* x x) (* y y))]
- [square-div (sqr (/ x y)) (/ (* x x) (* y y))]
- [square-mult (sqr x) (* x x)])
-
(define-ruleset squares-transform (arithmetic)
+ #:type ([x real] [y real])
[sqrt-prod (sqrt (* x y)) (* (sqrt x) (sqrt y))]
[sqrt-div (sqrt (/ x y)) (/ (sqrt x) (sqrt y))]
+ [sqrt-pow1 (sqrt (pow x y)) (pow x (/ y 2))]
+ [sqrt-pow2 (pow (sqrt x) y) (pow x (/ y 2))]
[sqrt-unprod (* (sqrt x) (sqrt y)) (sqrt (* x y))]
[sqrt-undiv (/ (sqrt x) (sqrt y)) (sqrt (/ x y))]
[add-sqr-sqrt x (* (sqrt x) (sqrt x))])
; Cube root
(define-ruleset cubes-reduce (arithmetic simplify)
+ #:type ([x real])
[rem-cube-cbrt (pow (cbrt x) 3) x]
[rem-cbrt-cube (cbrt (pow x 3)) x]
[cube-neg (pow (- x) 3) (- (pow x 3))])
(define-ruleset cubes-distribute (arithmetic simplify)
+ #:type ([x real] [y real])
[cube-prod (pow (* x y) 3) (* (pow x 3) (pow y 3))]
[cube-div (pow (/ x y) 3) (/ (pow x 3) (pow y 3))]
[cube-mult (pow x 3) (* x (* x x))])
(define-ruleset cubes-transform (arithmetic)
+ #:type ([x real] [y real])
[cbrt-prod (cbrt (* x y)) (* (cbrt x) (cbrt y))]
[cbrt-div (cbrt (/ x y)) (/ (cbrt x) (cbrt y))]
[cbrt-unprod (* (cbrt x) (cbrt y)) (cbrt (* x y))]
@@ -199,30 +276,35 @@
[add-cbrt-cube x (cbrt (* (* x x) x))])
(define-ruleset cubes-canonicalize (arithmetic simplify)
+ #:type ([x real])
[cube-unmult (* x (* x x)) (pow x 3)])
; Exponentials
(define-ruleset exp-expand (exponents)
+ #:type ([x real])
[add-exp-log x (exp (log x))]
[add-log-exp x (log (exp x))])
(define-ruleset exp-reduce (exponents simplify)
+ #:type ([x real])
[rem-exp-log (exp (log x)) x]
[rem-log-exp (log (exp x)) x])
-(define-ruleset exp-reduce-fp-safe (exponents simplify fp-safe)
+(define-ruleset exp-constants (exponents simplify fp-safe)
[exp-0 (exp 0) 1]
- [1-exp 1 (exp 0)]
[exp-1-e (exp 1) E]
+ [1-exp 1 (exp 0)]
[e-exp-1 E (exp 1)])
(define-ruleset exp-distribute (exponents simplify)
+ #:type ([a real] [b real])
[exp-sum (exp (+ a b)) (* (exp a) (exp b))]
[exp-neg (exp (- a)) (/ 1 (exp a))]
[exp-diff (exp (- a b)) (/ (exp a) (exp b))])
(define-ruleset exp-factor (exponents simplify)
+ #:type ([a real] [b real])
[prod-exp (* (exp a) (exp b)) (exp (+ a b))]
[rec-exp (/ 1 (exp a)) (exp (- a))]
[div-exp (/ (exp a) (exp b)) (exp (- a b))]
@@ -234,19 +316,24 @@
; Powers
(define-ruleset pow-reduce (exponents simplify)
+ #:type ([a real])
[unpow-1 (pow a -1) (/ 1 a)])
(define-ruleset pow-reduce-fp-safe (exponents simplify fp-safe)
+ #:type ([a real])
[unpow1 (pow a 1) a])
(define-ruleset pow-reduce-fp-safe-nan (exponents simplify fp-safe-nan)
+ #:type ([a real])
[unpow0 (pow a 0) 1]
[pow-base-1 (pow 1 a) 1])
(define-ruleset pow-expand-fp-safe (exponents fp-safe)
+ #:type ([a real])
[pow1 a (pow a 1)])
(define-ruleset pow-canonicalize (exponents simplify)
+ #:type ([a real] [b real])
[exp-to-pow (exp (* (log a) b)) (pow a b)]
[pow-plus (* (pow a b) a) (pow a (+ b 1))]
[unpow1/2 (pow a 1/2) (sqrt a)]
@@ -255,6 +342,7 @@
[unpow1/3 (pow a 1/3) (cbrt a)])
(define-ruleset pow-transform (exponents)
+ #:type ([a real] [b real] [c real])
[pow-exp (pow (exp a) b) (exp (* a b))]
[pow-to-exp (pow a b) (exp (* (log a) b))]
[pow-prod-up (* (pow a b) (pow a c)) (pow a (+ b c))]
@@ -273,13 +361,16 @@
[pow3 (* (* a a) a) (pow a 3)])
(define-ruleset pow-transform-fp-safe-nan (exponents fp-safe-nan)
+ #:type ([a real])
[pow-base-0 (pow 0 a) 0])
(define-ruleset pow-transform-fp-safe (exponents fp-safe)
+ #:type ([a real])
[inv-pow (/ 1 a) (pow a -1)])
; Logarithms
(define-ruleset log-distribute (exponents simplify)
+ #:type ([a real] [b real])
[log-prod (log (* a b)) (+ (log a) (log b))]
[log-div (log (/ a b)) (- (log a) (log b))]
[log-rec (log (/ 1 a)) (- (log a))]
@@ -289,12 +380,14 @@
[log-E (log E) 1])
(define-ruleset log-factor (exponents)
+ #:type ([a real] [b real])
[sum-log (+ (log a) (log b)) (log (* a b))]
[diff-log (- (log a) (log b)) (log (/ a b))]
[neg-log (- (log a)) (log (/ 1 a))])
; Trigonometry
(define-ruleset trig-reduce (trigonometry simplify)
+ #:type ([a real] [b real] [x real])
[cos-sin-sum (+ (* (cos a) (cos a)) (* (sin a) (sin a))) 1]
[1-sub-cos (- 1 (* (cos a) (cos a))) (* (sin a) (sin a))]
[1-sub-sin (- 1 (* (sin a) (sin a))) (* (cos a) (cos a))]
@@ -337,11 +430,13 @@
[tan-0 (tan 0) 0])
(define-ruleset trig-reduce-fp-sound-nan (trigonometry simplify fp-safe-nan)
+ #:type ([x real])
[sin-neg (sin (- x)) (- (sin x))]
[cos-neg (cos (- x)) (cos x)]
[tan-neg (tan (- x)) (- (tan x))])
(define-ruleset trig-expand (trigonometry)
+ #:type ([x real] [y real] [a real] [b real])
[sin-sum (sin (+ x y)) (+ (* (sin x) (cos y)) (* (cos x) (sin y)))]
[cos-sum (cos (+ x y)) (- (* (cos x) (cos y)) (* (sin x) (sin y)))]
[tan-sum (tan (+ x y)) (/ (+ (tan x) (tan y)) (- 1 (* (tan x) (tan y))))]
@@ -384,28 +479,42 @@
(/ (- (sin a) (sin b)) (+ (cos a) (cos b)))])
(define-ruleset trig-expand-fp-safe (trignometry fp-safe)
+ #:type ([x real])
[sqr-sin (* (sin x) (sin x)) (- 1 (* (cos x) (cos x)))]
[sqr-cos (* (cos x) (cos x)) (- 1 (* (sin x) (sin x)))])
-(define-ruleset atrig-expand (trigonometry)
+(define-ruleset trig-inverses (trigonometry)
+ #:type ([x real])
[sin-asin (sin (asin x)) x]
+ [cos-acos (cos (acos x)) x]
+ [tan-atan (tan (atan x)) x]
+ [atan-tan (atan (tan x)) (remainder x PI)]
+ [asin-sin (asin (sin x)) (- (fabs (remainder (+ x (/ PI 2)) (* 2 PI))) (/ PI 2))]
+ [acos-cos (acos (cos x)) (fabs (remainder x (* 2 PI)))])
+
+(define-ruleset trig-inverses-simplified (trigonometry)
+ #:type ([x real])
+ [atan-tan-s (atan (tan x)) x]
+ [asin-sin-s (asin (sin x)) x]
+ [acos-cos-s (acos (cos x)) x])
+
+(define-ruleset atrig-expand (trigonometry)
+ #:type ([x real])
[cos-asin (cos (asin x)) (sqrt (- 1 (* x x)))]
[tan-asin (tan (asin x)) (/ x (sqrt (- 1 (* x x))))]
[sin-acos (sin (acos x)) (sqrt (- 1 (* x x)))]
- [cos-acos (cos (acos x)) x]
[tan-acos (tan (acos x)) (/ (sqrt (- 1 (* x x))) x)]
[sin-atan (sin (atan x)) (/ x (sqrt (+ 1 (* x x))))]
[cos-atan (cos (atan x)) (/ 1 (sqrt (+ 1 (* x x))))]
- [tan-atan (tan (atan x)) x]
[asin-acos (asin x) (- (/ PI 2) (acos x))]
[acos-asin (acos x) (- (/ PI 2) (asin x))]
[asin-neg (asin (- x)) (- (asin x))]
[acos-neg (acos (- x)) (- PI (acos x))]
- [atan-neg (atan (- x)) (- (atan x))]
- )
+ [atan-neg (atan (- x)) (- (atan x))])
; Hyperbolic trigonometric functions
(define-ruleset htrig-reduce (hyperbolic simplify)
+ #:type ([x real])
[sinh-def (sinh x) (/ (- (exp x) (exp (- x))) 2)]
[cosh-def (cosh x) (/ (+ (exp x) (exp (- x))) 2)]
[tanh-def (tanh x) (/ (- (exp x) (exp (- x))) (+ (exp x) (exp (- x))))]
@@ -416,6 +525,7 @@
[sinh---cosh (- (cosh x) (sinh x)) (exp (- x))])
(define-ruleset htrig-expand (hyperbolic)
+ #:type ([x real] [y real])
[sinh-undef (/ (- (exp x) (exp (- x))) 2) (sinh x)]
[cosh-undef (/ (+ (exp x) (exp (- x))) 2) (cosh x)]
[tanh-undef (/ (- (exp x) (exp (- x))) (+ (exp x) (exp (- x)))) (tanh x)]
@@ -437,12 +547,14 @@
[diff-cosh (- (cosh x) (cosh y)) (* 2 (* (sinh (/ (+ x y) 2)) (sinh (/ (- x y) 2))))])
(define-ruleset htrig-expand-fp-safe (hyperbolic fp-safe)
+ #:type ([x real])
[sinh-neg (sinh (- x)) (- (sinh x))]
[sinh-0 (sinh 0) 0]
[cosh-neg (cosh (- x)) (cosh x)]
[cosh-0 (cosh 0) 1])
(define-ruleset ahtrig-expand (hyperbolic)
+ #:type ([x real])
[asinh-def (asinh x) (log (+ x (sqrt (+ (* x x) 1))))]
[acosh-def (acosh x) (log (+ x (sqrt (- (* x x) 1))))]
[atanh-def (atanh x) (/ (log (/ (+ 1 x) (- 1 x))) 2)]
@@ -460,6 +572,7 @@
; Specialized numerical functions
(define-ruleset special-numerical-reduce (numerics simplify)
+ #:type ([x real] [y real] [z real])
[expm1-def (- (exp x) 1) (expm1 x)]
[log1p-def (log (+ 1 x)) (log1p x)]
[log1p-expm1 (log1p (expm1 x)) x]
@@ -471,6 +584,7 @@
[fma-udef (fma x y z) (+ (* x y) z)])
(define-ruleset special-numerical-expand (numerics)
+ #:type ([x real] [y real])
[expm1-udef (expm1 x) (- (exp x) 1)]
[log1p-udef (log1p x) (log (+ 1 x))]
[log1p-expm1-u x (log1p (expm1 x))]
@@ -478,6 +592,7 @@
[hypot-udef (hypot x y) (sqrt (+ (* x x) (* y y)))])
(define-ruleset numerics-papers (numerics)
+ #:type ([a real] [b real] [c real] [d real])
; "Further Analysis of Kahan's Algorithm for
; the Accurate Computation of 2x2 Determinants"
; Jeannerod et al., Mathematics of Computation, 2013
@@ -506,6 +621,7 @@
[or-same (or a a) a])
(define-ruleset compare-reduce (bools simplify fp-safe-nan)
+ #:type ([x real] [y real])
[lt-same (< x x) FALSE]
[gt-same (> x x) FALSE]
[lte-same (<= x x) TRUE]
@@ -516,7 +632,7 @@
[not-gte (not (>= x y)) (< x y)])
(define-ruleset branch-reduce (branches simplify fp-safe)
- #:type ([a bool] [b bool])
+ #:type ([a bool] [b bool] [x real] [y real])
[if-true (if TRUE x y) x]
[if-false (if FALSE x y) y]
[if-same (if a x x) x]
@@ -527,41 +643,26 @@
[if-if-and-not (if a (if b y x) y) (if (and a (not b)) x y)])
(define-ruleset complex-number-basics (complex simplify)
+ #:type ([x real] [y real] [a real] [b real] [c real] [d real])
[real-part (re (complex x y)) x]
[imag-part (im (complex x y)) y]
- [complex-add-def (+ (complex a b) (complex c d)) (complex (+ a c) (+ b d))]
- [complex-def-add (complex (+ a c) (+ b d)) (+ (complex a b) (complex c d))]
- [complex-sub-def (- (complex a b) (complex c d)) (complex (- a c) (- b d))]
- [complex-def-sub (complex (- a c) (- b d)) (- (complex a b) (complex c d))]
- [complex-neg-def (- (complex a b)) (complex (- a) (- b))]
- [complex-def-neg (complex (- a) (- b)) (- (complex a b))]
- [complex-mul-def (* (complex a b) (complex c d)) (complex (- (* a c) (* b d)) (+ (* a d) (* b c)))]
- [complex-div-def (/ (complex a b) (complex c d)) (complex (/ (+ (* a c) (* b d)) (+ (* c c) (* d d))) (/ (- (* b c) (* a d)) (+ (* c c) (* d d))))]
+ [complex-add-def (+.c (complex a b) (complex c d)) (complex (+ a c) (+ b d))]
+ [complex-def-add (complex (+ a c) (+ b d)) (+.c (complex a b) (complex c d))]
+ [complex-sub-def (-.c (complex a b) (complex c d)) (complex (- a c) (- b d))]
+ [complex-def-sub (complex (- a c) (- b d)) (-.c (complex a b) (complex c d))]
+ [complex-neg-def (neg.c (complex a b)) (complex (- a) (- b))]
+ [complex-def-neg (complex (- a) (- b)) (neg.c (complex a b))]
+ [complex-mul-def (*.c (complex a b) (complex c d)) (complex (- (* a c) (* b d)) (+ (* a d) (* b c)))]
+ [complex-div-def (/.c (complex a b) (complex c d)) (complex (/ (+ (* a c) (* b d)) (+ (* c c) (* d d))) (/ (- (* b c) (* a d)) (+ (* c c) (* d d))))]
[complex-conj-def (conj (complex a b)) (complex a (- b))]
)
(define-ruleset erf-rules (special simplify)
+ #:type ([x real])
[erf-odd (erf (- x)) (- (erf x))]
[erf-erfc (erfc x) (- 1 (erf x))]
[erfc-erf (- 1 (erf x)) (erfc x)])
-(define (rule-valid-at-type? rule type)
- (match type
- ['complex (set-member? (for/set ([r (*complex-rules*)]) (values (rule-name r))) (rule-name rule))]
- ['real #t]
- [_ #f]))
-
-(module+ test
- (for ([r (*complex-rules*)])
- (check-equal? #t (rule-valid-at-type? r 'complex)))
- (for ([r (*rules*)])
- (check-equal? #t (rule-valid-at-type? r 'real))))
-
-(define (*complex-rules*)
- (for/append ([rec (*rulesets*)])
- (match-define (list rules groups _) rec)
- (if (set-member? groups 'complex) rules '())))
-
(define (*rules*)
(for/append ([rec (*rulesets*)])
(match-define (list rules groups _) rec)
@@ -583,107 +684,3 @@
(set-member? groups 'simplify))
rules
'())))
-
-(module+ test
- (require rackunit math/bigfloat)
- (require "../programs.rkt" "../float.rkt")
- (define num-test-points 2000)
-
- (define *conditions*
- '([acosh-def . (>= x 1)]
- [atanh-def . (< (fabs x) 1)]
- [acosh-2 . (>= x 1)]
- [asinh-2 . (>= x 0)]
- [sinh-acosh . (> (fabs x) 1)]
- [sinh-atanh . (< (fabs x) 1)]
- [cosh-atanh . (< (fabs x) 1)]
- [tanh-acosh . (> (fabs x) 1)]))
-
- (define *skip-tests*
- (append
- ;; All these tests fail due to underflow to 0 and are irrelevant
- '(exp-prod pow-unpow pow-pow pow-exp
- asinh-2 tanh-1/2* sinh-cosh
- hang-p0-tan hang-m0-tan)))
-
- (for* ([test-ruleset (*rulesets*)]
- [test-rule (first test-ruleset)]
- #:unless (set-member? *skip-tests* (rule-name test-rule)))
- (parameterize ([bf-precision 2000])
- (with-check-info (['rule test-rule])
- (with-handlers ([exn:fail? (λ (e)
- ((error-display-handler)
- (exn-message e) e)
- (fail (exn-message e)))])
- (match-define (rule name p1 p2) test-rule)
- ;; Not using the normal prepare-points machinery for speed.
- (define fv (free-variables p1))
- (define valid-point?
- (if (dict-has-key? *conditions* name)
- (eval-prog `(λ ,fv ,(dict-ref *conditions* name)) 'bf)
- (const true)))
-
- (define (make-point)
- (for/list ([v fv])
- (match (dict-ref (third test-ruleset) v 'real)
- ['real (sample-double)]
- ['bool (if (< (random) .5) false true)]
- ['complex (make-rectangular (sample-double) (sample-double))])))
- (define point-sequence (sequence-filter valid-point? (in-producer make-point)))
- (define points (for/list ([n (in-range num-test-points)] [pt point-sequence]) pt))
- (define prog1 (eval-prog `(λ ,fv ,p1) 'bf))
- (define prog2 (eval-prog `(λ ,fv ,p2) 'bf))
- (with-handlers ([exn:fail:contract? (λ (e) (eprintf "~a: ~a\n" name (exn-message e)))])
- (define ex1 (map prog1 points))
- (define ex2 (map prog2 points))
- (define errs
- (for/list ([v1 ex1] [v2 ex2])
- ;; Ignore points not in the input or output domain
- (if (and (ordinary-value? v1) (ordinary-value? v2))
- (ulps->bits (+ (abs (ulp-difference v1 v2)) 1))
- #f)))
- (when (< (length (filter identity errs)) 100)
- (eprintf "Could not sample enough points to test ~a\n" name))
- (define score (/ (apply + (filter identity errs)) (length (filter identity errs))))
- (define max-error
- (argmax car (filter car (map list errs points ex1 ex2 errs))))
- (with-check-info (['max-error (first max-error)]
- ['max-point (map cons fv (second max-error))]
- ['max-input (third max-error)]
- ['max-output (fourth max-error)])
- (check-pred (curryr <= 1) score))))))))
-
-(module+ test
- (require rackunit math/bigfloat)
- (require "../programs.rkt" "../float.rkt")
-
- (for* ([test-ruleset (*rulesets*)]
- [test-rule (first test-ruleset)]
- #:when (set-member? (*fp-safe-simplify-rules*) test-rule))
- (with-check-info (['rule test-rule])
- (with-handlers ([exn:fail? (λ (e) (fail (exn-message e)))])
- (define num-test-points 2000)
- (match-define (rule name p1 p2) test-rule)
- (define fv (free-variables p1))
- (define (make-point)
- (for/list ([v fv])
- (match (dict-ref (third test-ruleset) v 'real)
- ['real (sample-double)]
- ['bool (if (< (random) .5) false true)]
- ['complex (make-rectangular (sample-double) (sample-double))])))
- (define point-sequence (in-producer make-point))
- (define points (for/list ([n (in-range num-test-points)] [pt point-sequence]) pt))
- (define prog1 (eval-prog `(λ ,fv ,p1) 'fl))
- (define prog2 (eval-prog `(λ ,fv, p2) 'fl))
- (with-handlers ([exn:fail:contract? (λ (e) (eprintf "~a: ~a\n" name (exn-message e)))])
- (define ex1 (map prog1 points))
- (define ex2 (map prog2 points))
- (define err
- (for/first ([pt points] [v1 ex1] [v2 ex2]
- #:unless (equal? v1 v2))
- (list pt v1 v2)))
- (when err
- (match-define (list pt v1 v2) err)
- (with-check-info (['point (map list fv pt)] ['input-value v1] ['output-value v2])
- (check-false err))))))))
-;
diff --git a/src/syntax/syntax.rkt b/src/syntax/syntax.rkt
index df0e6a9f1..5f7d1ca55 100644
--- a/src/syntax/syntax.rkt
+++ b/src/syntax/syntax.rkt
@@ -1,30 +1,31 @@
#lang racket
-(require math/flonum)
-(require math/base)
-(require math/bigfloat)
-(require math/special-functions)
-(require "../common.rkt")
-(require "../float.rkt")
-(require "../bigcomplex.rkt")
-
-(provide constant? variable? operator? operator-info constant-info prune-operators!
+(require math/flonum math/base math/bigfloat math/special-functions)
+(require "../common.rkt" "../errors.rkt" "types.rkt")
+(require "../bigcomplex.rkt" "../biginterval.rkt")
+
+(provide constant? variable? operator? operator-info constant-info parametric-operators
+ variary-operators parametric-operators-reverse
*unknown-d-ops* *unknown-f-ops* *loaded-ops*)
+(module+ internals (provide operators constants define-constant define-operator declare-parametric-operator! infix-joiner))
+
+(module+ test (require rackunit))
+
(define *unknown-d-ops* (make-parameter '()))
(define *unknown-f-ops* (make-parameter '()))
(define *loaded-ops* (make-parameter '()))
-(define (type? x) (or (equal? x 'real) (equal? x 'bool) (equal? x 'complex)))
-
;; Constants's values are defined as functions to allow them to
;; depend on (bf-precision) and (flag 'precision 'double).
(define-table constants
[type type?]
- [bf (->* () (or/c bigfloat? boolean?))]
- [fl (->* () (or/c flonum? boolean?))]
+ [bf (->* () bigvalue?)]
+ [fl (->* () value?)]
+ [ival (or/c (->* () ival?) #f)]
+ [nonffi (->* () value?)]
[->c/double string?]
[->c/mpfr (->* (string?) string?)]
[->tex string?])
@@ -38,6 +39,8 @@
(define-constant PI real
[bf (λ () pi.bf)]
[fl (λ () pi)]
+ [ival ival-pi]
+ [nonffi (λ () pi)]
[->c/double "atan2(1.0, 0.0)"]
[->c/mpfr (curry format "mpfr_const_pi(~a, MPFR_RNDN)")]
[->tex "\\pi"])
@@ -45,6 +48,8 @@
(define-constant E real
[bf (λ () (bfexp 1.bf))]
[fl (λ () (exp 1.0))]
+ [ival ival-e]
+ [nonffi (λ () (exp 1.0))]
[->c/double "exp(1.0)"]
[->c/mpfr (λ (x) (format "mpfr_set_si(~a, 1, MPFR_RNDN), mpfr_const_exp(~a, ~a, MPFR_RNDN)" x x x))]
[->tex "e"])
@@ -52,6 +57,8 @@
(define-constant TRUE bool
[bf (const true)]
[fl (const true)]
+ [nonffi (const true)]
+ [ival (λ () (ival-bool true))]
[->c/double "1"]
[->c/mpfr (curry format "mpfr_set_si(~a, 1, MPFR_RNDN)")]
[->tex "\\top"])
@@ -59,10 +66,21 @@
(define-constant FALSE bool
[bf (const false)]
[fl (const false)]
+ [nonffi (const false)]
+ [ival (λ () (ival-bool false))]
[->c/double "0"]
[->c/mpfr (curry format "mpfr_set_si(~a, 0, MPFR_RNDN)")]
[->tex "\\perp"])
+(define-constant I complex
+ [bf (λ () (bigcomplex 0.bf 1.bf))]
+ [fl (const 0+1i)]
+ [nonffi (const 0+1i)]
+ [ival #f]
+ [->c/double "/* Complex numbers not supported in C */"]
+ [->c/mpfr "/* Complex numbers not supported in C */"]
+ [->tex "i"])
+
;; TODO: The contracts for operators are tricky because the number of arguments is unknown
;; There's no easy way to write such a contract in Racket, so I only constrain the output type.
(define (unconstrained-argument-number-> from/c to/c)
@@ -71,9 +89,10 @@
;; TODO: the costs below seem likely to be incorrect, and also do we still need them?
(define-table operators
[args (listof (or/c '* natural-number/c))]
- [bf (unconstrained-argument-number-> (or/c bigfloat? boolean? bigcomplex?) (or/c bigfloat? boolean? bigcomplex?))]
- [fl (unconstrained-argument-number-> (or/c flonum? boolean? complex?) (or/c flonum? boolean? complex?))]
- [nonffi (unconstrained-argument-number-> (or/c real? boolean? complex?) (or/c real? boolean? complex?))]
+ [bf (unconstrained-argument-number-> bigvalue? bigvalue?)]
+ [fl (unconstrained-argument-number-> value? value?)]
+ [nonffi (unconstrained-argument-number-> value? value?)]
+ [ival (or/c #f (unconstrained-argument-number-> ival? ival?))]
[cost natural-number/c]
[type (hash/c (or/c '* natural-number/c) (listof (list/c (or/c (listof type?) (list/c '* type?)) type?)))]
[->c/double (unconstrained-argument-number-> string? string?)]
@@ -86,11 +105,11 @@
(table-remove! operators operator)
(*loaded-ops* (set-remove (*loaded-ops*) operator)))
-(define (prune-operators!)
- (unless (flag-set? 'precision 'fallback)
- (for ([op (if (flag-set? 'precision 'double) (*unknown-d-ops*) (*unknown-f-ops*))])
- (operator-remove! op)))
- (unless (flag-set? 'fn 'cbrt) (operator-remove! 'cbrt)))
+(register-reset
+ (λ ()
+ (unless (flag-set? 'precision 'fallback)
+ (for ([op (if (flag-set? 'precision 'double) (*unknown-d-ops*) (*unknown-f-ops*))])
+ (operator-remove! op)))))
(define-syntax-rule (define-operator (operator atypes ...) rtype [key value] ...)
(let ([type (hash (length '(atypes ...)) (list (list '(atypes ...) 'rtype)))]
@@ -106,114 +125,148 @@
(current-continuation-marks))))
(define-operator (+ real real) real
- [args '(2)] [type (hash 2 '(((real real) real) ((complex complex) complex)))]
- [fl +] [bf exact+] [cost 40]
+ [fl +] [bf bf+] [ival ival-add] [cost 40]
[->c/double (curry format "~a + ~a")]
[->c/mpfr (curry format "mpfr_add(~a, ~a, ~a, MPFR_RNDN)")]
[->tex (curry format "~a + ~a")]
[nonffi +])
+(define-operator (+.c complex complex) complex
+ [fl +] [bf bf-complex-add] [ival #f] [cost 80]
+ [->c/double (curry format "~a + ~a")]
+ [->c/mpfr (const "/* ERROR: no complex support in C */")]
+ [->tex (curry format "~a + ~a")]
+ [nonffi +])
+
(define-operator (- real [real]) real
;; Override the normal argument handling because - can be unary
- [args '(1 2)] [type (hash 1 '(((real) real) ((complex) complex)) 2 '(((real real) real) ((complex complex) complex)))]
- [fl -] [bf exact-] [cost 40]
+ [args '(1 2)] [type (hash 1 '(((real) real)) 2 '(((real real) real)))]
+ [fl -] [bf bf-] [cost 40] [ival (λ args (if (= (length args) 2) (apply ival-sub args) (apply ival-neg args)))]
[->c/double (λ (x [y #f]) (if y (format "~a - ~a" x y) (format "-~a" x)))]
[->c/mpfr (λ (out x [y #f]) (if y (format "mpfr_sub(~a, ~a, ~a, MPFR_RNDN)" out x y) (format "mpfr_neg(~a, ~a, MPFR_RNDN)" out x)))]
[->tex (λ (x [y #f]) (if y (format "~a - ~a" x y) (format "-~a" x)))]
[nonffi -])
+(define-operator (neg.c complex) complex
+ [fl -] [bf bf-complex-neg] [ival #f] [cost 80]
+ [->c/double (curry format "-~a")]
+ [->c/mpfr (const "/* ERROR: no complex support in C */")]
+ [->tex (curry format "-~a")]
+ [nonffi -])
+
+(define-operator (-.c complex complex) complex
+ [fl -] [bf bf-complex-sub] [ival #f] [cost 80]
+ [->c/double (λ (x [y #f]) (if y (format "~a - ~a" x y) (format "-~a" x)))]
+ [->c/mpfr (const "/* ERROR: no complex support in C */")]
+ [->tex (λ (x [y #f]) (if y (format "~a - ~a" x y) (format "-~a" x)))]
+ [nonffi -])
+
(define-operator (* real real) real
- [args '(2)] [type (hash 2 '(((real real) real) ((complex complex) complex)))]
- [fl *] [bf exact*] [cost 40]
+ [fl *] [bf bf*] [ival ival-mult] [cost 40]
[->c/double (curry format "~a * ~a")]
[->c/mpfr (curry format "mpfr_mul(~a, ~a, ~a, MPFR_RNDN)")]
[->tex (curry format "~a \\cdot ~a")]
[nonffi *])
+(define-operator (*.c complex complex) complex
+ [fl *] [bf bf-complex-mult] [ival #f] [cost 320]
+ [->c/double (curry format "~a * ~a")]
+ [->c/mpfr (const "/* ERROR: no complex support in C */")]
+ [->tex (curry format "~a \\cdot ~a")]
+ [nonffi *])
+
(define-operator (/ real real) real
- [args '(2)] [type (hash 2 '(((real real) real) ((complex complex) complex)))]
- [fl /] [bf exact/] [cost 40]
+ [fl /] [bf bf/] [ival ival-div] [cost 40]
[->c/double (curry format "~a / ~a")]
[->c/mpfr (curry format "mpfr_div(~a, ~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\frac{~a}{~a}")]
[nonffi /])
+(define-operator (/.c complex complex) complex
+ [fl /] [bf bf-complex-div] [ival #f] [cost 440]
+ [->c/double (curry format "~a / ~a")]
+ [->c/mpfr (const "/* ERROR: no complex support in C */")]
+ [->tex (curry format "\\frac{~a}{~a}")]
+ [nonffi /])
+
(require ffi/unsafe)
(define-syntax (define-operator/libm stx)
(syntax-case stx (real libm)
[(_ (operator real ...) real [libm id_d id_f] [key value] ...)
(let ([num-args (length (cdr (syntax-e (cadr (syntax-e stx)))))])
#`(begin
+ (define (fallback . args)
+ (warn 'fallback #:url "faq.html#native-ops"
+ "native `~a` not supported on your system, using fallback; ~a"
+ 'operator
+ "use --disable precision:fallback to disable fallbacks")
+ (apply (operator-info 'operator 'nonffi) args))
(define double-proc (get-ffi-obj 'id_d #f (_fun #,@(build-list num-args (λ (_) #'_double)) -> _double)
- (lambda ()
- (*unknown-d-ops* (cons 'operator (*unknown-d-ops*)))
- (λ args (apply (operator-info 'operator 'nonffi) args)))))
+ (lambda () (*unknown-d-ops* (cons 'operator (*unknown-d-ops*))) fallback)))
(define float-proc (get-ffi-obj 'id_f #f (_fun #,@(build-list num-args (λ (_) #'_float)) -> _float)
- (lambda ()
- (*unknown-f-ops* (cons 'operator (*unknown-f-ops*)))
- (λ args (apply (operator-info 'operator 'nonffi) args)))))
+ (lambda () (*unknown-f-ops* (cons 'operator (*unknown-f-ops*))) fallback)))
(define-operator (operator #,@(build-list num-args (λ (_) #'real))) real
[fl (λ args (apply (if (flag-set? 'precision 'double) double-proc float-proc) args))]
[key value] ...)))]))
(define-operator/libm (acos real) real
- [libm acos acosf] [bf bfacos] [cost 90]
+ [libm acos acosf] [bf bfacos] [ival ival-acos] [cost 90]
[->c/double (curry format "acos(~a)")]
[->c/mpfr (curry format "mpfr_acos(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\cos^{-1} ~a")]
[nonffi acos])
(define-operator/libm (acosh real) real
- [libm acosh acoshf] [bf bfacosh] [cost 55]
+ [libm acosh acoshf] [bf bfacosh] [ival ival-acosh] [cost 55]
[->c/double (curry format "acosh(~a)")]
[->c/mpfr (curry format "mpfr_acosh(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\cosh^{-1} ~a")]
[nonffi acosh])
(define-operator/libm (asin real) real
- [libm asin asinf] [bf bfasin] [cost 105]
+ [libm asin asinf] [bf bfasin] [ival ival-asin] [cost 105]
[->c/double (curry format "asin(~a)")]
[->c/mpfr (curry format "mpfr_asin(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\sin^{-1} ~a")]
[nonffi asin])
(define-operator/libm (asinh real) real
- [libm asinh asinhf] [bf bfasinh] [cost 55]
+ [libm asinh asinhf] [bf bfasinh] [ival ival-asinh] [cost 55]
[->c/double (curry format "asinh(~a)")]
[->c/mpfr (curry format "mpfr_asinh(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\sinh^{-1} ~a")]
[nonffi asinh])
(define-operator/libm (atan real) real
- [libm atan atanf] [bf bfatan] [cost 105]
+ [libm atan atanf] [bf bfatan] [ival ival-atan] [cost 105]
[->c/double (curry format "atan(~a)")]
[->c/mpfr (curry format "mpfr_atan(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\tan^{-1} ~a")]
[nonffi atan])
(define-operator/libm (atan2 real real) real
- [libm atan2 atan2f] [bf bfatan2] [cost 140]
+ [libm atan2 atan2f] [bf bfatan2] [ival ival-atan2] [cost 140]
[->c/double (curry format "atan2(~a, ~a)")]
[->c/mpfr (curry format "mpfr_atan2(~a, ~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\tan^{-1}_* \\frac{~a}{~a}")]
[nonffi atan])
(define-operator/libm (atanh real) real
- [libm atanh atanhf] [bf bfatanh] [cost 55]
+ [libm atanh atanhf] [bf bfatanh] [ival ival-atanh] [cost 55]
[->c/double (curry format "atanh(~a)")]
[->c/mpfr (curry format "mpfr_atanh(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\tanh^{-1} ~a")]
[nonffi atanh])
(define-operator/libm (cbrt real) real
- [libm cbrt cbrtf] [bf bfcbrt] [cost 80]
+ [libm cbrt cbrtf] [bf bfcbrt] [ival ival-cbrt] [cost 80]
[->c/double (curry format "cbrt(~a)")]
[->c/mpfr (curry format "mpfr_cbrt(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\sqrt[3]{~a}")]
[nonffi (λ (x) (expt x (/ 1 3)))])
(define-operator/libm (ceil real) real
- [libm ceil ceilf] [bf bfceiling] [cost 80]
+ [libm ceil ceilf] [bf bfceiling] [ival #f] [cost 80]
[->c/double (curry format "ceil(~a)")]
[->c/mpfr (curry format "mpfr_ceil(~a, ~a)")]
[->tex (curry format "\\left\\lceil~a\\right\\rceil")]
@@ -223,64 +276,73 @@
(bf* (bfabs x) (bf (expt -1 (bigfloat-signbit y)))))
(define-operator/libm (copysign real real) real
- [libm copysign copysignf] [bf bfcopysign] [cost 80]
+ [libm copysign copysignf] [bf bfcopysign] [ival #f] [cost 80]
[->c/double (curry format "copysign(~a, ~a)")]
[->c/mpfr (curry format "mpfr_copysign(~a, ~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\mathsf{copysign}\\left(~a, ~a\\right)")]
[nonffi (λ (x y) (if (>= y 0) (abs x) (- (abs x))))])
(define-operator/libm (cos real) real
- [libm cos cosf] [bf bfcos] [cost 60]
+ [libm cos cosf] [bf bfcos] [ival ival-cos] [cost 60]
[->c/double (curry format "cos(~a)")]
[->c/mpfr (curry format "mpfr_cos(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\cos ~a")]
[nonffi cos])
(define-operator/libm (cosh real) real
- [libm cosh coshf] [bf bfcosh] [cost 55]
+ [libm cosh coshf] [bf bfcosh] [ival ival-cosh] [cost 55]
[->c/double (curry format "cosh(~a)")]
[->c/mpfr (curry format "mpfr_cosh(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\cosh ~a")]
[nonffi cosh])
(define-operator/libm (erf real) real
- [libm erf erff] [bf bferf] [cost 70]
+ [libm erf erff] [bf bferf] [ival ival-erf] [cost 70]
[->c/double (curry format "erf(~a)")]
[->c/mpfr (curry format "mpfr_erf(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\mathsf{erf} ~a")]
[nonffi erf])
(define-operator/libm (erfc real) real
- [libm erfc erfcf] [bf bferfc] [cost 70]
+ [libm erfc erfcf] [bf bferfc] [ival ival-erfc] [cost 70]
[->c/double (curry format "erfc(~a)")]
[->c/mpfr (curry format "mpfr_erfc(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\mathsf{erfc} ~a")]
[nonffi erfc])
(define-operator/libm (exp real) real
- [libm exp expf]
- [bf exact-exp] [cost 70]
+ [libm exp expf] [bf bfexp] [ival ival-exp] [cost 70]
[->c/double (curry format "exp(~a)")]
[->c/mpfr (curry format "mpfr_exp(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "e^{~a}")]
[nonffi exp])
+(define-operator (exp.c complex) complex
+ [fl exp] [bf bf-complex-exp] [ival #f] [cost 70]
+ [->c/double (curry format "exp(~a)")]
+ [->c/mpfr (const "/* ERROR: no complex support in C */")]
+ [->tex (curry format "e^{~a}")]
+ [nonffi exp])
+
(define-operator/libm (exp2 real) real
- [libm exp2 exp2f] [bf bfexp2] [cost 70]
+ [libm exp2 exp2f] [bf bfexp2] [ival #f] [cost 70]
[->c/double (curry format "exp2(~a)")]
[->c/mpfr (curry format "mpfr_exp2(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "2^{~a}")]
[nonffi (λ (x) (expt 2 x))])
+(define (from-bigfloat bff)
+ (λ args (bigfloat->flonum (apply bff (map bf args)))))
+
(define-operator/libm (expm1 real) real
- [libm expm1 expm1f] [bf bfexpm1] [cost 70]
+ [libm expm1 expm1f] [bf bfexpm1] [ival ival-expm1] [cost 70]
[->c/double (curry format "expm1(~a)")]
[->c/mpfr (curry format "mpfr_expm1(~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "(e^{~a} - 1)^*")]
- [nonffi (λ (x) (bigfloat->flonum (bfexpm1 (bf x))))])
+ [->tex (curry format "\\mathsf{expm1}\\left(~a\\right)")]
+ [nonffi (from-bigfloat bfexpm1)])
(define-operator/libm (fabs real) real
- [libm fabs fabsf] [bf bfabs] [cost 40]
+ [libm fabs fabsf] [bf bfabs] [ival ival-fabs] [cost 40]
[->c/double (curry format "fabs(~a)")]
[->c/mpfr (curry format "mpfr_abs(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\left|~a\\right|")]
@@ -292,14 +354,14 @@
0.bf))
(define-operator/libm (fdim real real) real
- [libm fdim fdimf] [bf bffdim] [cost 55]
+ [libm fdim fdimf] [bf bffdim] [ival #f] [cost 55]
[->c/double (curry format "fdim(~a, ~a)")]
[->c/mpfr (curry format "mpfr_dim(~a, ~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\mathsf{fdim}\\left(~a, ~a\\right)")]
[nonffi (λ (x y) (max (- x y) 0))])
(define-operator/libm (floor real) real
- [libm floor floorf] [bf bffloor] [cost 55]
+ [libm floor floorf] [bf bffloor] [ival #f] [cost 55]
[->c/double (curry format "floor(~a)")]
[->c/mpfr (curry format "mpfr_floor(~a, ~a)")]
[->tex (curry format "\\left\\lfloor~a\\right\\rfloor")]
@@ -309,213 +371,216 @@
(bf+ (bf* x y) z))
(define-operator/libm (fma real real real) real
- [libm fma fmaf] [bf bffma] [cost 55]
+ [libm fma fmaf] [bf bffma] [ival ival-fma] [cost 55]
[->c/double (curry format "fma(~a, ~a, ~a)")]
[->c/mpfr (curry format "mpfr_fma(~a, ~a, ~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "(~a \\cdot ~a + ~a)_*")]
+ [->tex (curry format "\\mathsf{fma}\\left(~a, ~a, ~a\\right)")]
[nonffi (λ (x y z) (bigfloat->flonum (bf+ (bf* (bf x) (bf y)) (bf z))))])
(define-operator/libm (fmax real real) real
- [libm fmax fmaxf] [bf bfmax] [cost 55]
+ [libm fmax fmaxf] [bf bfmax] [ival #f] [cost 55]
[->c/double (curry format "fmax(~a, ~a)")]
[->c/mpfr (curry format "mpfr_fmax(~a, ~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "\\mathsf{fmax}\\left(~a, ~a\\right)")]
+ [->tex (curry format "\\mathsf{max}\\left(~a, ~a\\right)")]
[nonffi (λ (x y) (cond [(nan? x) y] [(nan? y) x] [else (max x y)]))])
(define-operator/libm (fmin real real) real
- [libm fmin fminf] [bf bfmin] [cost 55]
+ [libm fmin fminf] [bf bfmin] [ival #f] [cost 55]
[->c/double (curry format "fmin(~a, ~a)")]
[->c/mpfr (curry format "mpfr_fmin(~a, ~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "\\mathsf{fmin}\\left(~a, ~a\\right)")]
+ [->tex (curry format "\\mathsf{min}\\left(~a, ~a\\right)")]
[nonffi (λ (x y) (cond [(nan? x) y] [(nan? y) x] [else (min x y)]))])
(define (bffmod x mod)
- (bf- x (bf* mod (bffloor (bf/ x mod)))))
+ (bf- x (bf* (bftruncate (bf/ x mod)) mod)))
(define-operator/libm (fmod real real) real
- [libm fmod fmodf] [bf bffmod] [cost 70]
+ [libm fmod fmodf] [bf bffmod] [ival ival-fmod] [cost 70]
[->c/double (curry format "fmod(~a, ~a)")]
[->c/mpfr (curry format "mpfr_fmod(~a, ~a, ~a, MPFR_RNDN)")]
[->tex (curry format "~a \\bmod ~a")]
- [nonffi (λ (x y) (bigfloat->flonum (bffmod (bf x) (bf y))))])
+ [nonffi (from-bigfloat bffmod)])
(define-operator/libm (hypot real real) real
- [libm hypot hypotf] [bf bfhypot] [cost 55]
+ [libm hypot hypotf] [bf bfhypot] [ival ival-hypot] [cost 55]
[->c/double (curry format "hypot(~a, ~a)")]
[->c/mpfr (curry format "mpfr_hypot(~a, ~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "\\sqrt{~a^2 + ~a^2}^*")]
- [nonffi (λ (x y) (bigfloat->flonum (bfhypot (bf x) (bf y))))])
+ [->tex (curry format "\\mathsf{hypot}\\left(~a, ~a\\right)")]
+ [nonffi (from-bigfloat bfhypot)])
(define-operator/libm (j0 real) real
- [libm j0 j0f] [bf bfbesj0] [cost 55]
+ [libm j0 j0f] [bf bfbesj0] [ival #f] [cost 55]
[->c/double (curry format "j0(~a)")]
[->c/mpfr (curry format "mpfr_j0(~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "\\mathsf{j0} ~a")]
- [nonffi (λ (x) (bigfloat->flonum (bfbesj0 (bf x))))])
+ [->tex (curry format "j_0\\left(~a\\right)")]
+ [nonffi (from-bigfloat bfbesj0)])
(define-operator/libm (j1 real) real
- [libm j1 j1f] [bf bfbesj1] [cost 55]
+ [libm j1 j1f] [bf bfbesj1] [ival #f] [cost 55]
[->c/double (curry format "j1(~a)")]
[->c/mpfr (curry format "mpfr_j1(~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "\\mathsf{j1} ~a")]
- [nonffi (λ (x) (bigfloat->flonum (bfbesj1 (bf x))))])
+ [->tex (curry format "j_1\\left(~a\\right)")]
+ [nonffi (from-bigfloat bfbesj1)])
(define-operator/libm (lgamma real) real
- [libm lgamma lgammaf] [bf bflog-gamma] [cost 55]
+ [libm lgamma lgammaf] [bf bflog-gamma] [ival #f] [cost 55]
[->c/double (curry format "lgamma(~a)")]
[->c/mpfr (curry format "mpfr_lngamma(~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "\\log_* \\left( \\mathsf{gamma} ~a \\right)")]
+ [->tex (curry format "\\mathsf{lgamma} \\left( ~a \\right)")]
[nonffi log-gamma])
(define-operator/libm (log real) real
- [libm log logf]
- [bf exact-log] [cost 70]
+ [libm log logf] [bf bflog] [ival ival-log] [cost 70]
[->c/double (curry format "log(~a)")]
[->c/mpfr (curry format "mpfr_log(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\log ~a")]
[nonffi log])
+(define-operator (log.c complex) complex
+ [fl log] [bf bf-complex-log] [ival #f] [cost 265]
+ [->c/double (curry format "log(~a)")]
+ [->c/mpfr (const "/* ERROR: no complex support in C */")]
+ [->tex (curry format "\\log ~a")]
+ [nonffi log])
+
(define-operator/libm (log10 real) real
- [libm log10 log10f] [bf bflog10] [cost 70]
+ [libm log10 log10f] [bf bflog10] [ival #f] [cost 70]
[->c/double (curry format "log10(~a)")]
[->c/mpfr (curry format "mpfr_log10(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\log_{10} ~a")]
[nonffi (λ (x) (log x 10))])
(define-operator/libm (log1p real) real
- [libm log1p log1pf] [bf bflog1p] [cost 90]
+ [libm log1p log1pf] [bf bflog1p] [ival ival-log1p] [cost 90]
[->c/double (curry format "log1p(~a)")]
[->c/mpfr (curry format "mpfr_log1p(~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "\\log_* (1 + ~a)")]
- [nonffi (λ (x) (bigfloat->flonum (bflog1p (bf x))))])
+ [->tex (curry format "\\mathsf{log1p}\\left(~a\\right)")]
+ [nonffi (from-bigfloat bflog1p)])
(define-operator/libm (log2 real) real
- [libm log2 log2f] [bf bflog2] [cost 70]
+ [libm log2 log2f] [bf bflog2] [ival #f] [cost 70]
[->c/double (curry format "log2(~a)")]
[->c/mpfr (curry format "mpfr_log2(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\log_{2} ~a")]
- [nonffi (λ (x) (bigfloat->flonum (bflog2 (bf x))))])
+ [nonffi (from-bigfloat bflog2)])
(define (bflogb x)
(bffloor (bflog2 (bfabs x))))
(define-operator/libm (logb real) real
- [libm logb logbf] [bf bflogb] [cost 70]
+ [libm logb logbf] [bf bflogb] [ival #f] [cost 70]
[->c/double (curry format "logb(~a)")]
[->c/mpfr (curry format "mpfr_set_si(~a, mpfr_get_exp(~a), MPFR_RNDN)")]
- [->tex (curry format "\\log^{*}_{b} ~a")]
+ [->tex (curry format "\\log_{b} ~a")]
[nonffi (λ (x) (floor (bigfloat->flonum (bflog2 (bf (abs x))))))])
(define-operator/libm (pow real real) real
- [libm pow powf]
- [args '(2)] [type (hash 2 '(((real real) real) ((complex complex) complex)))]
- [bf exact-pow] [cost 210]
+ [libm pow powf] [bf bfexpt] [ival ival-pow] [cost 210]
[->c/double (curry format "pow(~a, ~a)")]
[->c/mpfr (curry format "mpfr_pow(~a, ~a, ~a, MPFR_RNDN)")]
[->tex (curry format "{~a}^{~a}")]
[nonffi expt])
+(define-operator (pow.c complex complex) complex
+ [fl expt] [bf bf-complex-pow] [ival #f] [cost 210]
+ [->c/double (curry format "pow(~a, ~a)")]
+ [->c/mpfr (const "/* ERROR: no complex support in C */")]
+ [->tex (curry format "{~a}^{~a}")]
+ [nonffi expt])
+
+(define (bfremainder x mod)
+ (bf- x (bf* (bfround (bf/ x mod)) mod)))
+
(define-operator/libm (remainder real real) real
- [libm remainder remainderf] [bf bfremainder] [cost 70]
+ [libm remainder remainderf] [bf bfremainder] [ival ival-remainder] [cost 70]
[->c/double (curry format "remainder(~a, ~a)")]
[->c/mpfr (curry format "mpfr_remainder(~a, ~a, ~a, MPFR_RNDN)")]
[->tex (curry format "~a \\mathsf{rem} ~a")]
[nonffi remainder])
(define-operator/libm (rint real) real
- [libm rint rintf] [bf bfrint] [cost 70]
+ [libm rint rintf] [bf bfrint] [ival #f] [cost 70]
[->c/double (curry format "rint(~a)")]
[->c/mpfr (curry format "mpfr_rint(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\mathsf{rint} ~a")]
[nonffi round])
(define-operator/libm (round real) real
- [libm round roundf] [bf bfround] [cost 70]
+ [libm round roundf] [bf bfround] [ival #f] [cost 70]
[->c/double (curry format "round(~a)")]
[->c/mpfr (curry format "mpfr_round(~a, ~a)")]
[->tex (curry format "\\mathsf{round} ~a")]
[nonffi round])
(define-operator/libm (sin real) real
- [libm sin sinf] [bf bfsin] [cost 60]
+ [libm sin sinf] [bf bfsin] [ival ival-sin] [cost 60]
[->c/double (curry format "sin(~a)")]
[->c/mpfr (curry format "mpfr_sin(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\sin ~a")]
[nonffi sin])
(define-operator/libm (sinh real) real
- [libm sinh sinhf] [bf bfsinh] [cost 55]
+ [libm sinh sinhf] [bf bfsinh] [ival ival-sinh] [cost 55]
[->c/double (curry format "sinh(~a)")]
[->c/mpfr (curry format "mpfr_sinh(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\sinh ~a")]
[nonffi sinh])
(define-operator/libm (sqrt real) real
- [libm sqrt sqrtf]
- [bf exact-sqrt] [cost 40]
+ [libm sqrt sqrtf] [bf bfsqrt] [ival ival-sqrt] [cost 40]
[->c/double (curry format "sqrt(~a)")]
[->c/mpfr (curry format "mpfr_sqrt(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\sqrt{~a}")]
[nonffi sqrt])
+(define-operator (sqrt.c complex) complex
+ [fl sqrt] [bf bf-complex-sqrt] [ival #f] [cost 40]
+ [->c/double (curry format "sqrt(~a)")]
+ [->c/mpfr (const "/* ERROR: no complex support in C */")]
+ [->tex (curry format "\\sqrt{~a}")]
+ [nonffi sqrt])
+
(define-operator/libm (tan real) real
- [libm tan tanf] [bf bftan] [cost 95]
+ [libm tan tanf] [bf bftan] [ival ival-tan] [cost 95]
[->c/double (curry format "tan(~a)")]
[->c/mpfr (curry format "mpfr_tan(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\tan ~a")]
[nonffi tan])
(define-operator/libm (tanh real) real
- [libm tanh tanhf] [bf bftanh] [cost 55]
+ [libm tanh tanhf] [bf bftanh] [ival ival-tanh] [cost 55]
[->c/double (curry format "tanh(~a)")]
[->c/mpfr (curry format "mpfr_tanh(~a, ~a, MPFR_RNDN)")]
[->tex (curry format "\\tanh ~a")]
[nonffi tanh])
(define-operator/libm (tgamma real) real
- [libm tgamma tgammaf] [bf bfgamma] [cost 55]
+ [libm tgamma tgammaf] [bf bfgamma] [ival #f] [cost 55]
[->c/double (curry format "tgamma(~a)")]
[->c/mpfr (curry format "mpfr_gamma(~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "\\mathsf{gamma} ~a")]
+ [->tex (curry format "\\Gamma\\left(~a\\right)")]
[nonffi gamma])
(define-operator/libm (trunc real) real
- [libm trunc truncf] [bf bftruncate] [cost 55]
+ [libm trunc truncf] [bf bftruncate] [ival #f] [cost 55]
[->c/double (curry format "trunc(~a)")]
[->c/mpfr (curry format "mpfr_trunc(~a, ~a)")]
- [->tex (curry format "\\mathsf{trunc} ~a")]
+ [->tex (curry format "\\mathsf{trunc}\\left(~a\\right)")]
[nonffi truncate])
(define-operator/libm (y0 real) real
- [libm y0 y0f] [bf bfbesy0] [cost 55]
+ [libm y0 y0f] [bf bfbesy0] [ival #f] [cost 55]
[->c/double (curry format "y0(~a)")]
[->c/mpfr (curry format "mpfr_y0(~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "\\mathsf{y0} ~a")]
- [nonffi (λ (x) (bigfloat->flonum (bfbesy0 (bf x))))])
+ [->tex (curry format "y_0\\left(~a\\right)")]
+ [nonffi (from-bigfloat bfbesy0)])
(define-operator/libm (y1 real) real
- [libm y1 y1f] [bf bfbesy1] [cost 55]
+ [libm y1 y1f] [bf bfbesy1] [ival #f] [cost 55]
[->c/double (curry format "y1(~a)")]
[->c/mpfr (curry format "mpfr_y1(~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "\\mathsf{y1} ~a")]
- [nonffi (λ (x) (bigfloat->flonum (bfbesy1 (bf x))))])
-
-;; DEPRECATED
-
-(define-operator (sqr real) real
- [type (hash 1 '(((real) real) ((complex) complex)))]
- [fl sqr] [bf exact-sqr] [cost 40]
- [->c/double (λ (x) (format "~a * ~a" x x))]
- [->c/mpfr (curry format "mpfr_sqr(~a, ~a, MPFR_RNDN)")]
- [->tex (curry format "{~a}^2")]
- [nonffi (λ (x) (* x x))])
-
-(define-operator (cube real) real
- [fl (λ (x) (* x (* x x)))] [bf (λ (x) (bf* x (bf* x x)))] [cost 80]
- [->c/double (λ (x) (format "~a * (~a * ~a)" x x x))]
- [->c/mpfr (λ (out x) (format "mpfr_sqr(~a, ~a, MPFR_RNDN); mpfr_mul(~a, ~a, ~a, MPFR_RNDN)" out x out out x))]
- [->tex (curry format "{~a}^3")]
- [nonffi (λ (x) (* x x x))])
+ [->tex (curry format "y_1\\left(~a\\right)")]
+ [nonffi (from-bigfloat bfbesy1)])
(define (if-fn test if-true if-false) (if test if-true if-false))
(define (and-fn . as) (andmap identity as))
@@ -527,12 +592,8 @@
(define (bf!=-fn . args)
(not (check-duplicates args bf=)))
-(define ((comparator test) . args)
- (for/and ([left args] [right (cdr args)])
- (test left right)))
-
(define-operator (if bool real real) real ; types not used, special cased in type checker
- [fl if-fn] [bf if-fn] [cost 65]
+ [fl if-fn] [bf if-fn] [cost 65] [ival ival-if]
[->c/double (curry format "~a ? ~a : ~a")]
[->c/mpfr
(λ (out c a b)
@@ -540,13 +601,13 @@
[->tex (curry format "~a ? ~a : ~a")]
[nonffi if-fn])
-(define ((infix-joiner str) . args)
- (string-join args str))
+(define ((infix-joiner x) . args)
+ (string-join args x))
(define-operator (== real real) bool
; Override number of arguments
[type #hash((* . (((* real) bool))))] [args '(*)]
- [fl (comparator =)] [bf (comparator bf=)] [cost 65]
+ [fl (comparator =)] [bf (comparator bf=)] [cost 65] [ival ival-==]
[->c/double (curry format "~a == ~a")]
[->c/mpfr (curry format "mpfr_set_si(~a, mpfr_cmp(~a, ~a) == 0, MPFR_RNDN)")] ; TODO: cannot handle variary =
[->tex (infix-joiner " = ")]
@@ -554,7 +615,7 @@
(define-operator (complex real real) complex
; Override number of arguments
- [fl make-rectangular] [bf bigcomplex] [cost 0]
+ [fl make-rectangular] [bf bigcomplex] [cost 0] [ival #f]
[->c/double (const "/* ERROR: no complex support in C */")]
[->c/mpfr (const "/* ERROR: no complex support in C */")]
[->tex (curry format "~a + ~a i")]
@@ -562,7 +623,7 @@
(define-operator (re complex) real
; Override number of arguments
- [fl real-part] [bf bigcomplex-re] [cost 0]
+ [fl real-part] [bf bigcomplex-re] [cost 0] [ival #f]
[->c/double (const "/* ERROR: no complex support in C */")]
[->c/mpfr (const "/* ERROR: no complex support in C */")]
[->tex (curry format "\\Re(~a)")]
@@ -570,15 +631,15 @@
(define-operator (im complex) real
; Override number of arguments
- [fl imag-part] [bf bigcomplex-im] [cost 0]
+ [fl imag-part] [bf bigcomplex-im] [cost 0] [ival #f]
[->c/double (const "/* ERROR: no complex support in C */")]
[->c/mpfr (const "/* ERROR: no complex support in C */")]
[->tex (curry format "\\Im(~a)")]
[nonffi imag-part])
-(define-operator (conj complex) real
+(define-operator (conj complex) complex
; Override number of arguments
- [fl conjugate] [bf bf-complex-conjugate] [cost 0]
+ [fl conjugate] [bf bf-complex-conjugate] [cost 0] [ival #f]
[->c/double (const "/* ERROR: no complex support in C */")]
[->c/mpfr (const "/* ERROR: no complex support in C */")]
[->tex (curry format "\\overline{~a}")]
@@ -587,7 +648,7 @@
(define-operator (!= real real) bool
; Override number of arguments
[type #hash((* . (((* real) bool))))] [args '(*)]
- [fl !=-fn] [bf bf!=-fn] [cost 65]
+ [fl !=-fn] [bf bf!=-fn] [cost 65] [ival ival-!=]
[->c/double (curry format "~a != ~a")]
[->c/mpfr (curry format "mpfr_set_si(~a, mpfr_cmp(~a, ~a) != 0, MPFR_RNDN)")] ; TODO: cannot handle variary !=
[->tex (infix-joiner " \\ne ")]
@@ -596,7 +657,7 @@
(define-operator (< real real) bool
; Override number of arguments
[type #hash((* . (((* real) bool))))] [args '(*)]
- [fl (comparator <)] [bf (comparator bf<)] [cost 65]
+ [fl (comparator <)] [bf (comparator bf<)] [cost 65] [ival ival-<]
[->c/double (curry format "~a < ~a")]
[->c/mpfr (curry format "mpfr_set_si(~a, mpfr_cmp(~a, ~a) < 0, MPFR_RNDN)")] ; TODO: cannot handle variary <
[->tex (infix-joiner " \\lt ")]
@@ -605,7 +666,7 @@
(define-operator (> real real) bool
; Override number of arguments
[type #hash((* . (((* real) bool))))] [args '(*)]
- [fl (comparator >)] [bf (comparator bf>)] [cost 65]
+ [fl (comparator >)] [bf (comparator bf>)] [cost 65] [ival ival->]
[->c/double (curry format "~a > ~a")]
[->c/mpfr (curry format "mpfr_set_si(~a, mpfr_cmp(~a, ~a) > 0, MPFR_RNDN)")] ; TODO: cannot handle variary >
[->tex (infix-joiner " \\gt ")]
@@ -614,7 +675,7 @@
(define-operator (<= real real) bool
; Override number of arguments
[type #hash((* . (((* real) bool))))] [args '(*)]
- [fl (comparator <=)] [bf (comparator bf<=)] [cost 65]
+ [fl (comparator <=)] [bf (comparator bf<=)] [cost 65] [ival ival-<=]
[->c/double (curry format "~a <= ~a")]
[->c/mpfr (curry format "mpfr_set_si(~a, mpfr_cmp(~a, ~a) <= 0, MPFR_RNDN)")] ; TODO: cannot handle variary <=
[->tex (infix-joiner " \\le ")]
@@ -623,14 +684,14 @@
(define-operator (>= real real) bool
; Override number of arguments
[type #hash((* . (((* real) bool))))] [args '(*)]
- [fl (comparator >=)] [bf (comparator bf>=)] [cost 65]
+ [fl (comparator >=)] [bf (comparator bf>=)] [cost 65] [ival ival->=]
[->c/double (curry format "~a >= ~a")]
[->c/mpfr (curry format "mpfr_set_si(~a, mpfr_cmp(~a, ~a) >= 0, MPFR_RNDN)")] ; TODO: cannot handle variary >=
[->tex (infix-joiner " \\ge ")]
[nonffi (comparator >=)])
(define-operator (not bool) bool
- [fl not] [bf not] [cost 65]
+ [fl not] [bf not] [cost 65] [ival ival-not]
[->c/double (curry format "!~a")]
[->c/mpfr (curry format "mpfr_set_si(~a, !mpfr_get_si(~a, MPFR_RNDN), MPFR_RNDN)")]
[->tex (curry format "\\neg ~a")]
@@ -639,7 +700,7 @@
(define-operator (and bool bool) bool
; Override number of arguments
[type #hash((* . (((* bool) bool))))] [args '(*)]
- [fl and-fn] [bf and-fn] [cost 55]
+ [fl and-fn] [bf and-fn] [cost 55] [ival ival-and]
[->c/double (curry format "~a && ~a")]
[->c/mpfr (curry format "mpfr_set_si(~a, mpfr_get_si(~a, MPFR_RNDN) && mpfr_get_si(~a, MPFR_RNDN), MPFR_RNDN)")]
[->tex (infix-joiner " \\land ")]
@@ -648,7 +709,7 @@
(define-operator (or bool bool) bool
; Override number of arguments
[type #hash((* . (((* bool) bool))))] [args '(*)]
- [fl or-fn] [bf or-fn] [cost 55]
+ [fl or-fn] [bf or-fn] [cost 55] [ival ival-or]
[->c/double (curry format "~a || ~a")]
[->c/mpfr (curry format "mpfr_set_si(~a, mpfr_get_si(~a, MPFR_RNDN) || mpfr_get_si(~a, MPFR_RNDN), MPFR_RNDN)")]
[->tex (infix-joiner " \\lor ")]
@@ -658,9 +719,51 @@
(and (symbol? op) (dict-has-key? (cdr operators) op)))
(define (constant? var)
- (or (number? var)
- (and (symbol? var)
- (dict-has-key? (cdr constants) var))))
+ (or (value? var) (and (symbol? var) (dict-has-key? (cdr constants) var))))
(define (variable? var)
(and (symbol? var) (not (constant? var))))
+
+(define parametric-operators (make-hash))
+(define (declare-parametric-operator! name op inputs output)
+ (hash-update! parametric-operators name (curry cons (list* op output inputs)) '()))
+
+(declare-parametric-operator! '+ '+ '(real real) 'real)
+(declare-parametric-operator! '- '- '(real real) 'real)
+(declare-parametric-operator! '- '- '(real) 'real)
+(declare-parametric-operator! '* '* '(real real) 'real)
+(declare-parametric-operator! '/ '/ '(real real) 'real)
+(declare-parametric-operator! 'pow 'pow '(real real) 'real)
+(declare-parametric-operator! 'exp 'exp '(real) 'real)
+(declare-parametric-operator! 'log 'log '(real) 'real)
+(declare-parametric-operator! 'sqrt 'sqrt '(real) 'real)
+(declare-parametric-operator! '< '< '(real real) 'bool)
+(declare-parametric-operator! '<= '<= '(real real) 'bool)
+(declare-parametric-operator! '> '> '(real real) 'bool)
+(declare-parametric-operator! '>= '>= '(real real) 'bool)
+(declare-parametric-operator! '== '== '(real real) 'bool)
+(declare-parametric-operator! '!= '!= '(real real) 'bool)
+
+(declare-parametric-operator! '+ '+.c '(complex complex) 'complex)
+(declare-parametric-operator! '- '-.c '(complex complex) 'complex)
+(declare-parametric-operator! '- 'neg.c '(complex) 'complex)
+(declare-parametric-operator! '* '*.c '(complex complex) 'complex)
+(declare-parametric-operator! '/ '/.c '(complex complex) 'complex)
+(declare-parametric-operator! 'pow 'pow.c '(complex complex) 'complex)
+(declare-parametric-operator! 'exp 'exp.c '(complex) 'complex)
+(declare-parametric-operator! 'log 'log.c '(complex) 'complex)
+(declare-parametric-operator! 'sqrt 'sqrt.c '(complex) 'complex)
+
+(define variary-operators '(< <= > >= == !=))
+
+(define parametric-operators-reverse
+ (make-hash (append* (for/list ([(key-val) (hash->list parametric-operators)])
+ (define key (car key-val))
+ (define vals (cdr key-val))
+ (for/list ([val vals])
+ (cons (car val) key))))))
+
+(module+ test
+ (for ([(k r) (in-hash (cdr constants))] #:when true
+ [(f c) (in-dict (car constants))] [v (in-list r)] #:when (flat-contract? c))
+ (check-pred (flat-contract-predicate c) v)))
diff --git a/src/syntax/test-rules.rkt b/src/syntax/test-rules.rkt
new file mode 100644
index 000000000..761bf9422
--- /dev/null
+++ b/src/syntax/test-rules.rkt
@@ -0,0 +1,108 @@
+#lang racket
+
+(require rackunit math/bigfloat)
+(require "../common.rkt" "../programs.rkt" (submod "../points.rkt" internals))
+(require "rules.rkt" (submod "rules.rkt" internals) "../interface.rkt")
+(require "../programs.rkt" "../float.rkt" "../bigcomplex.rkt" "../type-check.rkt")
+
+(define num-test-points 1000)
+
+;; WARNING: These aren't treated as preconditions, they are only used for range inference
+(define *conditions*
+ `([acosh-def . (>= x 1)]
+ [atanh-def . (< (fabs x) 1)]
+ [asin-acos . (<= -1 x 1)]
+ [acos-asin . (<= -1 x 1)]
+ [acosh-2 . (>= x 1)]
+ [asinh-2 . (>= x 0)]
+ [sinh-acosh . (> (fabs x) 1)]
+ [sinh-atanh . (< (fabs x) 1)]
+ [cosh-atanh . (< (fabs x) 1)]
+ [tanh-acosh . (> (fabs x) 1)]
+ ;; These next three unquote the pi computation so that range analysis will work
+ [asin-sin-s . (<= (fabs x) ,(/ pi 2))]
+ [acos-cos-s . (<= 0 x ,pi)]
+ [atan-tan-s . (<= (fabs x) ,(/ pi 2))]))
+
+(define (ival-ground-truth fv p repr)
+ (λ (x) (ival-eval (eval-prog `(λ ,fv ,p) 'ival) x (representation-name repr))))
+
+(define ((with-hiprec f) x)
+ (parameterize ([bf-precision 2000]) (f x)))
+
+(define (bf-ground-truth fv p repr)
+ (with-hiprec (compose (representation-bf->repr repr) (eval-prog `(λ ,fv ,p) 'bf))))
+
+(define (check-rule-correct test-rule ground-truth)
+ (match-define (rule name p1 p2 itypes otype) test-rule)
+ (define fv (dict-keys itypes))
+ (define repr (get-representation (match otype ['real 'binary64] [x x])))
+
+ (define make-point
+ (let ([sample (make-sampler `(λ ,fv ,(dict-ref *conditions* name 'TRUE)))])
+ (λ ()
+ (if (dict-has-key? *conditions* name)
+ (sample)
+ (for/list ([v fv] [i (in-naturals)])
+ (match (dict-ref (rule-itypes test-rule) v)
+ ['real (sample-double)]
+ ['complex (make-rectangular (sample-double) (sample-double))]
+ [rname (random-generate (get-representation rname))]))))))
+
+ (define points (for/list ([n (in-range num-test-points)]) (make-point)))
+ (define prog1 (ground-truth fv p1 repr))
+ (define prog2 (ground-truth fv p2 repr))
+
+ (define ex1 (map prog1 points))
+ (define ex2 (map prog2 points))
+ (define errs
+ (for/list ([pt points] [v1 ex1] [v2 ex2]
+ #:when (and (ordinary-value? v1) (ordinary-value? v2)))
+ (with-check-info (['point (map cons fv pt)] ['method (object-name ground-truth)]
+ ['input v1] ['output v2])
+ (check-eq? (ulp-difference v1 v2) 0))))
+ (when (< (length errs) 100)
+ (fail-check "Not enough points sampled to test rule")))
+
+(define (check-rule-fp-safe test-rule)
+ (match-define (rule name p1 p2 _ _) test-rule)
+ (define fv (free-variables p1))
+ (define (make-point)
+ (for/list ([v fv])
+ (match (dict-ref (rule-itypes test-rule) v)
+ ['real (sample-double)]
+ ['bool (if (< (random) .5) false true)]
+ ['complex (make-rectangular (sample-double) (sample-double))])))
+ (define point-sequence (in-producer make-point))
+ (define points (for/list ([n (in-range num-test-points)] [pt point-sequence]) pt))
+ (define prog1 (eval-prog `(λ ,fv ,p1) 'fl))
+ (define prog2 (eval-prog `(λ ,fv, p2) 'fl))
+ (define ex1 (map prog1 points))
+ (define ex2 (map prog2 points))
+ (for ([pt points] [v1 ex1] [v2 ex2])
+ (with-check-info (['point (map list fv pt)])
+ (check-equal? v1 v2))))
+
+(module+ test
+ (for* ([test-ruleset (*rulesets*)] [test-rule (first test-ruleset)])
+
+ (define ground-truth
+ (cond
+ [(and (expr-supports? (rule-input test-rule) 'ival)
+ (expr-supports? (rule-output test-rule) 'ival))
+ ival-ground-truth]
+ [else
+ (unless (set-member? (second test-ruleset) 'complex)
+ (fail-check "Real or boolean rule not supported by intervals"))
+ (when (dict-has-key? *conditions* (rule-name test-rule))
+ (fail-check "Using bigfloat sampling on a rule with a condition"))
+ bf-ground-truth]))
+
+ (test-case (~a (rule-name test-rule))
+ (check-rule-correct test-rule ground-truth)))
+
+ (for* ([test-ruleset (*rulesets*)]
+ [test-rule (first test-ruleset)]
+ #:when (set-member? (*fp-safe-simplify-rules*) test-rule))
+ (test-case (~a (rule-name test-rule))
+ (check-rule-fp-safe test-rule))))
diff --git a/src/syntax/types.rkt b/src/syntax/types.rkt
new file mode 100644
index 000000000..636e453b2
--- /dev/null
+++ b/src/syntax/types.rkt
@@ -0,0 +1,23 @@
+#lang racket
+
+(require math/bigfloat)
+(require "../common.rkt" "../bigcomplex.rkt")
+
+(provide type-dict type? value? bigvalue? value-of bigvalue-of)
+(module+ internals (provide define-type))
+
+(define type-dict (make-hash))
+(define-syntax-rule (define-type name val? bigval?)
+ (hash-set! type-dict 'name (cons val? bigval?)))
+
+(define (type? x) (hash-has-key? type-dict x))
+
+(define (value-of type) (car (hash-ref type-dict type)))
+(define (bigvalue-of type) (cdr (hash-ref type-dict type)))
+
+(define (value? x) (for/or ([(type rec) (in-hash type-dict)]) ((car rec) x)))
+(define (bigvalue? x) (for/or ([(type rec) (in-hash type-dict)]) ((cdr rec) x)))
+
+(define-type real real? bigfloat?)
+(define-type bool boolean? boolean?)
+(define-type complex (conjoin complex? (negate real?)) bigcomplex?)
diff --git a/src/timeline.rkt b/src/timeline.rkt
new file mode 100644
index 000000000..949658263
--- /dev/null
+++ b/src/timeline.rkt
@@ -0,0 +1,33 @@
+#lang racket
+(require "config.rkt")
+(provide timeline-event! timeline-log! timeline-push! *timeline-disabled*)
+(module+ debug (provide *timeline*))
+
+;; This is a box so we can get a reference outside the engine, and so
+;; access its value even in a timeout.
+(define *timeline* (box '()))
+(define *timeline-disabled* (make-parameter false))
+
+(register-reset (λ () (set-box! *timeline* '())))
+
+(define (timeline-event! type)
+ (unless (*timeline-disabled*)
+ (define initial (hash 'type type 'time (current-inexact-milliseconds)))
+ (define b (make-hash (hash->list initial))) ; convert to mutable hash
+ (set-box! *timeline* (cons b (unbox *timeline*)))))
+
+(define (timeline-log! key value)
+ (unless (*timeline-disabled*)
+ (define h (car (unbox *timeline*)))
+ (when (hash-has-key? h key)
+ (error 'timeline "Attempting to log key ~a to timeline twice (value ~a)" key value))
+ (hash-set! h key value)))
+
+(define (timeline-push! key . values)
+ (unless (*timeline-disabled*)
+ (define val (if (= (length values) 1) (car values) values))
+ (define (try-cons x)
+ (if (list? x)
+ (cons val x)
+ (error 'timeline "Attempting to push onto a timeline non-list ~a (value ~a)" key x)))
+ (hash-update! (car (unbox *timeline*)) key try-cons '())))
diff --git a/src/type-check.rkt b/src/type-check.rkt
index 2d7968cb4..3e038359f 100644
--- a/src/type-check.rkt
+++ b/src/type-check.rkt
@@ -1,5 +1,5 @@
#lang racket
-(require "common.rkt" "syntax/syntax.rkt" "errors.rkt")
+(require "common.rkt" "syntax/syntax.rkt" "errors.rkt" "syntax/types.rkt" "float.rkt" "interface.rkt")
(provide assert-program-type! assert-expression-type! type-of get-sigs argtypes->rtype)
(define (get-sigs fun-name num-args)
@@ -16,10 +16,6 @@
[`((,expected-types ...) ,rtype)
(and (andmap equal? argtypes expected-types) rtype)]))
-;; Unit tests
-;; Rewrite expression->type so that expr is a syntax object
-;; Collect errors somewhere
-;; error! is a function that takes (stx format . args) and puts it somewhere
(define (assert-program-type! stx)
(match-define (list (app syntax-e 'FPCore) (app syntax-e (list vars ...)) props ... body) (syntax-e stx))
(assert-expression-type! body 'real #:env (for/hash ([var vars]) (values (syntax-e var) 'real))))
@@ -36,11 +32,18 @@
(raise-herbie-syntax-error "Program has type errors" #:locations errs)))
(define (type-of expr env)
- (expression->type (datum->syntax #f expr) env
- (lambda (stx msg . args)
- (error "Unexpected call to error! within type-of"
- stx (apply format msg args)))))
-
+ ;; Fast version does not recurse into functions applications
+ (match expr
+ [(? real?) 'real]
+ [(? complex?) 'complex]
+ [(? value?) (match (representation-name (infer-representation expr)) [(or 'binary32 'binary64) 'real] [x x])]
+ [(? constant?) (constant-info expr 'type)]
+ [(? variable?) (dict-ref env expr)]
+ [(list 'if cond ift iff)
+ (type-of ift env)]
+ [(list op args ...)
+ ;; Assumes single return type for any function
+ (second (first (first (hash-values (operator-info op 'type)))))]))
(define (expression->type stx env error!)
(match stx
@@ -55,9 +58,38 @@
(unless (equal? t actual-type)
(error! stx "~a expects argument ~a of type ~a (not ~a)" op (+ i 1) t actual-type)))
t]
+ [#`(,(? (curry hash-has-key? parametric-operators) op) #,exprs ...)
+ (define sigs (hash-ref parametric-operators op))
+ (define actual-types (for/list ([arg exprs]) (expression->type arg env error!)))
+
+ (define res
+ (for/or ([sig sigs])
+ (match-define (list* true-name rtype atypes) sig)
+ (and
+ (if (symbol? atypes)
+ (andmap (curry equal? atypes) actual-types)
+ (equal? atypes actual-types))
+ (cons true-name rtype))))
+ (if res
+ (let ([true-name (car res)]
+ [rtype (cdr res)])
+ (unless rtype
+ (error! stx "Invalid arguments to ~a; expects ~a but got (~a ~a)" op
+ (string-join
+ (for/list ([sig sigs])
+ (match sig
+ [(list _ rtype atypes ...)
+ (format "(~a ~a)" op (string-join (map (curry format "<~a>") atypes) " "))]
+ [(list* _ rtype atype)
+ (format "(~a <~a> ...)" op atype)]))
+ " or ")
+ op (string-join (map (curry format "<~a>") actual-types) " ")))
+ rtype)
+ #f)]
[#`(,(? operator? op) #,exprs ...)
(define sigs (get-sigs op (length exprs)))
- (unless sigs (error "Operator ~a has no type signature of length ~a" op (length exprs)))
+ (unless sigs (error! stx "Operator ~a has no type signature of length ~a" op (length exprs)))
+
(define actual-types (for/list ([arg exprs]) (expression->type arg env error!)))
(define rtype
diff --git a/src/web/arrow-chart.js b/src/web/arrow-chart.js
index ea5069e80..db9585cec 100644
--- a/src/web/arrow-chart.js
+++ b/src/web/arrow-chart.js
@@ -1,10 +1,3 @@
-margin = 10;
-barheight = 10;
-width = 450;
-textbar = 20;
-precision = 64;
-precision_step = 8;
-
function sort_by(type) {
return function(a, b) {
return b[type] - a[type];
@@ -16,9 +9,16 @@ function r10(d) {
}
function make_graph(node, data, start, end) {
+ var margin = 10;
+ var barheight = 10;
+ var width = 450;
+ var textbar = 20;
+ var precision = 64;
+ var precision_step = 8;
+
var len = data.length;
- var svg = node
+ var svg = d3.select(node)
.attr("width", width + 2 * margin)
.attr("height", len * barheight + 2 * margin + textbar)
.append("g").attr("transform", "translate(" + margin + "," + margin + ")");
@@ -53,7 +53,9 @@ function make_graph(node, data, start, end) {
.attr("class", function(d) {
return d[start] > d[end] + 1 ? "arrow good" : d[start] < d[end] - 1 ? "arrow bad" : "arrow nodiff" });
- g.append("line")
+ g.append("a")
+ .attr("xlink:href", function(d) { return "./" + d.link + "/graph.html" })
+ .append("line")
.attr("x1", function(d) {return (precision - Math.max(d[start], d[end])) / precision * width})
.attr("x2", function(d) { return (precision - Math.min(d[start], d[end])) / precision * width })
.attr("y1", line_y)
@@ -74,7 +76,6 @@ function make_graph(node, data, start, end) {
}
function draw_results(node) {
- window.width = node.attr("width") - 2 * margin;
d3.json("results.json", function(err, data) {
if (err) return console.error(err);
precision = data.bit_width;
@@ -105,7 +106,14 @@ function draw_results(node) {
var badges = document.querySelectorAll(".badge");
for (var i = 0; i < badges.length; i++) {
var idx = +badges[i].attributes["data-id"].value;
- BADGES[idx] = badges[i]
+ var url = document.getElementById("link" + idx).href;
+ var a = document.createElement("a");
+ // Only a text thing
+ var t = badges[i].childNodes[0];
+ a.href = url;
+ a.appendChild(t);
+ badges[i].appendChild(a);
+ BADGES[idx] = badges[i];
}
function clear() {
@@ -124,22 +132,17 @@ function draw_results(node) {
});
BADGES[i].addEventListener("mouseout", clear);
- BADGES[i].addEventListener("click", function() {
- var id = "link" + BADGES[i].attributes["data-id"].value;
- document.getElementById(id).click();
- });
-
ARROWS[i].addEventListener("mouseover", function() {
clear();
BADGES[i].classList.add("highlight");
BADGES.container.classList.add("highlight-one");
});
ARROWS[i].addEventListener("mouseout", clear);
- ARROWS[i].addEventListener("click", function() {
- var id = "link" + ARROWS[i].attributes["data-id"].value;
- document.getElementById(id).click();
- });
})(i);
}
});
}
+
+var ArrowChart = new Component("svg.arrow-chart", {
+ setup: function() { draw_results(this.elt); }
+});
diff --git a/src/web/common.rkt b/src/web/common.rkt
index 04dff536f..6a5b8b2aa 100644
--- a/src/web/common.rkt
+++ b/src/web/common.rkt
@@ -1,21 +1,64 @@
#lang racket
+(require (only-in xml write-xexpr xexpr?))
+(require "../common.rkt" "../formats/test.rkt" "../sandbox.rkt")
+(require "../formats/c.rkt" "../formats/tex.rkt")
+(provide render-menu render-warnings render-large render-program)
-(provide herbie-page)
+(define/contract (render-menu sections links)
+ (-> (listof (cons/c string? string?)) (listof (cons/c string? string?)) xexpr?)
+ `(nav ([id "links"])
+ (div
+ ,@(for/list ([(text url) (in-dict links)])
+ `(a ([href ,url]) ,text)))
+ (div
+ ,@(for/list ([(text url) (in-dict sections)])
+ `(a ([href ,url]) ,text)))))
-(define (herbie-page #:title title #:show-title [title? true]
- #:scripts [scripts '()] #:styles [styles '()] #:head-include [other-include-head '()] . body)
- `(html
- (head
- (meta ([charset "utf-8"]))
- (title ,title)
- ,@other-include-head
- ,@(for/list ([script scripts])
- `(script ([src ,script] [type "text/javascript"])))
- (link ([rel "stylesheet"] [type "text/css"] [href "/main.css"]))
- ,@(for/list ([style styles])
- `(link ([rel "stylesheet"] [type "text/css"] [href ,style]))))
- (body
- (header
- (img ([class "logo"] [src "/logo.png"]))
- ,@(if title? `((h1 ,title)) `()))
- ,@body)))
+(define/contract (render-warnings warnings)
+ (-> (listof (list/c symbol? string? (listof any/c) (or/c string? #f) (listof string?))) xexpr?)
+ (if (null? warnings)
+ ""
+ `(ul ([class "warnings"])
+ ,@(for/list ([warning warnings])
+ (match-define (list type message args url extra) warning)
+ `(li (h2 ,(apply format message args)
+ ,(if url `(a ([href ,url]) " (more)") ""))
+ ,(if (null? extra)
+ ""
+ `(ol ([class "extra"])
+ ,@(for/list ([line extra])
+ `(li ,line)))))))))
+
+(define (render-large #:title [title #f] name . values)
+ `(div ,name ": " (span ([class "number"]
+ ,@(if title `([title ,title]) '()))
+ ,@values)))
+
+(define languages
+ `(("TeX" . ,texify-prog)
+ ("C" . ,program->c)))
+
+(define (render-program #:to [result #f] test)
+ `(section ([id "program"])
+ ,(if (equal? (test-precondition test) 'TRUE)
+ ""
+ `(div ([id "precondition"])
+ (div ([class "program math"])
+ "\\[" ,(texify-expr (test-precondition test)) "\\]")))
+ (select ([id "language"])
+ (option "Math")
+ ,@(for/list ([(lang fn) (in-dict languages)])
+ `(option ,lang)))
+ (div ([class "implementation"] [data-language "Math"])
+ (div ([class "program math"]) "\\[" ,(texify-prog (test-program test)) "\\]")
+ ,@(if result
+ `((div ([class "arrow"]) "↓")
+ (div ([class "program math"]) "\\[" ,(texify-prog result) "\\]"))
+ `()))
+ ,@(for/list ([(lang fn) (in-dict languages)])
+ `(div ([class "implementation"] [data-language ,lang])
+ (pre ([class "program"]) ,(fn (test-program test)))
+ ,@(if result
+ `((div ([class "arrow"]) "↓")
+ (pre ([class "program"]) ,(fn result)))
+ `())))))
diff --git a/src/web/demo.js b/src/web/demo.js
index 4d68bbdeb..09be4ad96 100644
--- a/src/web/demo.js
+++ b/src/web/demo.js
@@ -1,60 +1,91 @@
-CONSTANTS = ["PI", "E"]
-FUNCTIONS = {
- "+": [2], "-": [1, 2], "*": [2], "/": [2], "fabs": [1],
- "sqrt": [1], "sqr": [1], "exp": [1], "log": [1], "pow": [2],
- "sin": [1], "cos": [1], "tan": [1], "cot": [1],
- "asin": [1], "acos": [1], "atan": [1],
- "sinh": [1], "cosh": [1], "tanh": [1],
- "asinh": [1], "acosh": [1], "atanh": [1],
- "cbrt": [1], "cube": [1], "ceil": [1], "copysign": [2],
- "erf": [1], "erfc": [1], "exp2": [1], "expm1": [1],
- "fdim": [2], "floor": [1], "fma": [3], "fmax": [2],
- "fmin": [2], "fmod": [2], "hypot": [2],
- "j0": [1], "j1": [1], "lgamma": [1], "log10": [1],
- "log1p": [1], "log2": [1], "logb": [1],
- "remainder": [2], "rint": [1], "round": [1],
- "tgamma": [1], "trunc": [1], "y0": [1], "y1": [1]
-}
+CONSTANTS = {"PI": "real", "E": "real", "TRUE": "bool", "FALSE": "bool"}
+
+FUNCTIONS = {}
+
+"+ - * / pow copysign fdim fmin fmax fmod hypot remainder".split(" ").forEach(function(op) {
+ FUNCTIONS[op] = [["real", "real"], "real"];
+});
+("fabs sqrt exp log sin cos tan asin acos atan sinh cosh tanh asinh acosh atanh" +
+ "cbrt ceil erf erfc exp2 expm1 floor j0 j1 lgamma log10 log1p log2 logb rint" +
+ "round tgama trunc y0 y1").split(" ").forEach(function(op) {
+ FUNCTIONS[op] = [["real"], "real"];
+});
+FUNCTIONS["fma"] = [["real", "real", "real"], "real"];
+"< > == != <= >=".split(" ").forEach(function(op) {
+ FUNCTIONS[op] = [["real", "real"], "bool"];
+});
+"and or".split(" ").forEach(function(op) {
+ FUNCTIONS[op] = [["bool", "bool"], "bool"];
+});
-SECRETFUNCTIONS = {"^": "pow", "**": "pow", "abs": "fabs"}
+SECRETFUNCTIONS = {"^": "pow", "**": "pow", "abs": "fabs", "min": "fmin", "max": "fmax", "mod": "fmod"}
-function tree_errors(tree) /* tree -> list */ {
+function tree_errors(tree, expected) /* tree -> list */ {
var messages = [];
var names = [];
- bottom_up(tree, function(node, path, parent) {
+ var rtype = bottom_up(tree, function(node, path, parent) {
switch(node.type) {
case "ConstantNode":
- if (node.valueType !== "number")
+ if (["number", "boolean"].indexOf(node.valueType) === -1) {
messages.push("Constants that are " + node.valueType + "s not supported.");
- break;
+ }
+ return ({"number": "real", "boolean": "bool"})[node.valueType] || "real";
case "FunctionNode":
node.name = SECRETFUNCTIONS[node.name] || node.name;
if (!FUNCTIONS[node.name]) {
messages.push("Function " + node.name + "
unsupported.");
- } else if (FUNCTIONS[node.name].indexOf(node.args.length) === -1) {
+ } else if (FUNCTIONS[node.name][0].length !== node.args.length) {
messages.push("Function " + node.name + "
expects " +
- FUNCTIONS[node.name].join(" or ") + " arguments");
+ FUNCTIONS[node.name][0].length + " arguments");
+ } else if (""+extract(node.args) !== ""+FUNCTIONS[node.name][0]) {
+ messages.push("Function " + node.name + "
" +
+ " expects arguments of type " +
+ FUNCTIONS[node.name][0].join(", ") +
+ ", got " + extract(node.args).join(", "));
}
- break;
+ return (FUNCTIONS[node.name] || [[], "real"])[1];
case "OperatorNode":
node.op = SECRETFUNCTIONS[node.op] || node.op;
if (!FUNCTIONS[node.op]) {
messages.push("Operator " + node.op + "
unsupported.");
- } else if (FUNCTIONS[node.op].indexOf(node.args.length) === -1) {
+ } else if (FUNCTIONS[node.op][0].length !== node.args.length &&
+ !(node.op === "-" && node.args.length === 1)) {
messages.push("Operator " + node.op + "
expects " +
- FUNCTIONS[node.op].join(" or ") + " arguments");
+ FUNCTIONS[node.op][0].length + " arguments");
+ } else if (""+extract(node.args) !== ""+FUNCTIONS[node.op][0] &&
+ !(node.op === "-" && ""+extract(node.args) === "real") &&
+ !(is_comparison(node.op) /* TODO improve */)) {
+ messages.push("Operator " + node.op + "
" +
+ " expects arguments of type " +
+ FUNCTIONS[node.op][0].join(", ") +
+ ", got " + extract(node.args).join(", "));
}
- break;
+ return (FUNCTIONS[node.op] || [[], "real"])[1];
case "SymbolNode":
- if (CONSTANTS.indexOf(node.name) === -1)
+ if (!CONSTANTS[node.name]) {
names.push(node.name);
- break;
+ return "real";
+ } else {
+ return CONSTANTS[node.name];
+ }
+ case "ConditionalNode":
+ if (node.condition.res !== "bool") {
+ messages.push("Conditional has type " + node.condition.res + " instead of bool");
+ }
+ if (node.trueExpr.res !== node.falseExpr.res) {
+ messages.push("Conditional branches have different types " + node.trueExpr.res + " and " + node.falseExpr.res);
+ }
+ return node.trueExpr.res;
default:
messages.push("Unsupported syntax; found unexpected " + node.type + "
.")
- break;
+ return "real";
}
- });
+ }).res;
+
+ if (rtype !== expected) {
+ messages.push("Expected an expression of type " + expected + ", got " + rtype);
+ }
return messages;
}
@@ -62,17 +93,72 @@ function tree_errors(tree) /* tree -> list */ {
function bottom_up(tree, cb) {
if (tree.args) {
tree.args = tree.args.map(function(node) {return bottom_up(node, cb)});
- tree.res = cb(tree);
- } else {
- tree.res = cb(tree);
+ } else if (tree.condition) {
+ tree.condition = bottom_up(tree.condition, cb);
+ tree.trueExpr = bottom_up(tree.trueExpr, cb);
+ tree.falseExpr = bottom_up(tree.falseExpr, cb);
}
+ tree.res = cb(tree);
return tree;
}
-function dump_tree(tree, txt) /* tree string -> string */ {
- function extract(args) {return args.map(function(n) {return n.res});}
+function dump_fpcore(formula, pre, precision) {
+ var tree = math.parse(formula);
+ var ptree = math.parse(pre);
+
var names = [];
- var body = bottom_up(tree, function(node) {
+ var body = dump_tree(tree, names);
+ var precondition = dump_tree(ptree, names);
+
+ var dnames = [];
+ for (var i = 0; i < names.length; i++) {
+ if (dnames.indexOf(names[i]) === -1) dnames.push(names[i]);
+ }
+
+ var name = formula.replace("\\", "\\\\").replace("\"", "\\\"");
+ var fpcore = "(FPCore (" + dnames.join(" ") + ") :name \"" + name + "\"";
+ if (pre) fpcore += " :pre " + precondition;
+ if (precision) fpcore += " :precision " + precision;
+
+ return fpcore + " " + body + ")";
+}
+
+function is_comparison(name) {
+ return ["==", "!=", "<", ">", "<=", ">="].indexOf(name) !== -1;
+}
+
+function flatten_comparisons(node) {
+ var terms = [];
+ (function collect_terms(node) {
+ if (node.type == "OperatorNode" && is_comparison(node.op)) {
+ collect_terms(node.args[0]);
+ collect_terms(node.args[1]);
+ } else {
+ terms.push(node.res);
+ }
+ })(node);
+ var conjuncts = [];
+ (function do_flatten(node) {
+ if (node.type == "OperatorNode" && is_comparison(node.op)) {
+ do_flatten(node.args[0]);
+ var i = conjuncts.length;
+ conjuncts.push("(" + node.op + " " + terms[i] + " " + terms[i+1] + ")");
+ do_flatten(node.args[1]);
+ }
+ })(node);
+ if (conjuncts.length == 0) {
+ return "TRUE";
+ } else if (conjuncts.length == 1) {
+ return conjuncts[0];
+ } else {
+ return "(and " + conjuncts.join(" ") + ")";
+ }
+}
+
+function extract(args) {return args.map(function(n) {return n.res});}
+
+function dump_tree(tree, names) {
+ return bottom_up(tree, function(node) {
switch(node.type) {
case "ConstantNode":
return "" + node.value;
@@ -81,66 +167,93 @@ function dump_tree(tree, txt) /* tree string -> string */ {
return "(" + node.name + " " + extract(node.args).join(" ") + ")";
case "OperatorNode":
node.op = SECRETFUNCTIONS[node.op] || node.op;
- return "(" + node.op + " " + extract(node.args).join(" ") + ")";
+ if (is_comparison(node.op)) {
+ return flatten_comparisons(node);
+ } else {
+ return "(" + node.op + " " + extract(node.args).join(" ") + ")";
+ }
case "SymbolNode":
- if (CONSTANTS.indexOf(node.name) === -1)
+ if (!CONSTANTS[node.name])
names.push(node.name);
return node.name;
+ case "ConditionalNode":
+ return "(if " + node.condition.res +
+ " " + node.trueExpr.res +
+ " " + node.falseExpr.res + ")";
default:
throw SyntaxError("Invalid tree!");
}
- });
+ }).res;
+}
- var dnames = [];
- for (var i = 0; i < names.length; i++) {
- if (dnames.indexOf(names[i]) === -1) dnames.push(names[i]);
+function get_errors() {
+ var tree, errors = [];
+ for (var i = 0; i < arguments.length; i++) {
+ try {
+ tree = math.parse(arguments[i][0]);
+ errors = errors.concat(tree_errors(tree, arguments[i][1]));
+ } catch (e) {
+ errors.push("" + e);
+ }
+ }
+ return errors;
+}
+
+function check_errors() {
+ var input = document.querySelector("#formula input[name=formula-math]");
+ var pre = document.querySelector("#formula input[name=pre-math]");
+ var errors = get_errors([input.value, "real"], [pre.value || "TRUE", "bool"]);
+
+ if (input.value && errors.length > 0) {
+ document.getElementById("errors").innerHTML = "" + errors.join(" ") + " ";
+ } else {
+ document.getElementById("errors").innerHTML = "";
}
+}
- var name = txt.replace("\\", "\\\\").replace("\"", "\\\"");
- return "(FPCore (" + dnames.join(" ") + ") :name \"" + name + "\" " + body.res + ")";
+function hide_extra_fields() {
+ var $extra = document.querySelector("#formula .extra-fields");
+ var inputs = $extra.querySelectorAll("input, select");
+ for (var i = 0; i < inputs.length; i++) {
+ if (inputs[i].tagName == "INPUT" && inputs[i].value) return;
+ if (inputs[i].tagName == "SELECT" && inputs[i].selectedIndex) return;
+ }
+ var $a = document.createElement("a");
+ $a.textContent = "Additional options »";
+ $a.classList.add("show-extra");
+ $extra.parentNode.insertBefore($a, $extra.nextSibling);
+ $extra.style.display = "none";
+ $a.addEventListener("click", function() {
+ $extra.style.display = "block";
+ $a.style.display = "none";
+ });
}
-function onload() /* null -> null */ {
+function onload() {
var form = document.getElementById("formula");
- var input = document.querySelector("#formula input");
+ var input = document.querySelector("#formula input[name=formula]");
input.setAttribute("name", "formula-math");
input.setAttribute("placeholder", "sqrt(x + 1) - sqrt(x)");
input.removeAttribute("disabled");
- var hidden = document.createElement("input");
- hidden.type = "hidden";
- hidden.setAttribute("name", "formula");
- form.appendChild(hidden);
+ var pre = document.querySelector("#formula input[name=pre]");
+ pre.setAttribute("name", "pre-math");
+ pre.setAttribute("placeholder", "TRUE");
+ pre.removeAttribute("disabled");
+ var prec = document.querySelector("#formula select[name=precision]");
+ var hinput = document.createElement("input");
+ hinput.type = "hidden";
+ hinput.setAttribute("name", "formula");
+ form.appendChild(hinput);
+ hide_extra_fields();
document.getElementById("mathjs-instructions").style.display = "block";
document.getElementById("lisp-instructions").style.display = "none";
- input.addEventListener("keyup", function(evt) {
- var txt = input.value;
- var tree, errors = [];
- try {
- tree = math.parse(txt);
- errors = tree_errors(tree);
- } catch (e) {
- errors = ["" + e];
- }
-
- if (txt && errors.length > 0) {
- document.getElementById("errors").innerHTML = "" + errors.join(" ") + " ";
- } else {
- document.getElementById("errors").innerHTML = "";
- }
- });
+ input.addEventListener("keyup", check_errors);
+ pre.addEventListener("keyup", check_errors);
form.addEventListener("submit", function(evt) {
- var txt = input.value;
- var tree, errors;
- try {
- tree = math.parse(txt);
- errors = tree_errors(tree);
- } catch (e) {
- errors = ["" + e];
- }
-
+ var errors = get_errors([input.value, "real"], [pre.value || "TRUE", "bool"]);
if (errors.length > 0) {
document.getElementById("errors").innerHTML = "" + errors.join(" ") + " ";
evt.preventDefault();
@@ -149,13 +262,13 @@ function onload() /* null -> null */ {
document.getElementById("errors").innerHTML = "";
}
- var lisp = dump_tree(tree, txt);
- hidden.setAttribute("value", lisp);
+ var fpcore = dump_fpcore(input.value, pre.value, prec.value);
+ hinput.setAttribute("value", fpcore);
var url = document.getElementById("formula").getAttribute("data-progress");
if (url) {
input.disabled = "true";
- ajax_submit(url, txt, lisp);
+ ajax_submit(url, fpcore);
evt.preventDefault();
return false;
} else {
@@ -169,24 +282,20 @@ function clean_progress(str) {
var outlines = [];
for (var i = 0; i < lines.length; i++) {
var line = lines[i];
- var words = line.split(" ");
+ var words = line.split(": ");
var word0 = words.shift();
- outlines.push(htmlescape((word0.substring(0, 6) === "* * * " ? "* " : "") + words.join(" ")));
+ outlines.push(words.join(": "));
}
return outlines.join("\n");
}
-function htmlescape(str) {
- return ("" + str).replace("&", "&").replace("<", "<").replace(">", ">");
-}
-
function get_progress(loc) {
var req2 = new XMLHttpRequest();
req2.open("GET", loc);
req2.onreadystatechange = function() {
if (req2.readyState == 4) {
if (req2.status == 202) {
- document.getElementById("progress").innerHTML = clean_progress(req2.responseText);
+ document.getElementById("progress").textContent = clean_progress(req2.responseText);
setTimeout(function() {get_progress(loc)}, 100);
} else if (req2.status == 201) {
var loc2 = req2.getResponseHeader("Location");
@@ -199,7 +308,7 @@ function get_progress(loc) {
req2.send();
}
-function ajax_submit(url, text, lisp) {
+function ajax_submit(url, lisp) {
document.getElementById("progress").style.display = "block";
var req = new XMLHttpRequest();
req.open("POST", url);
@@ -209,7 +318,7 @@ function ajax_submit(url, text, lisp) {
if (req.status == 201) {
var jobcount = req.getResponseHeader("X-Job-Count");
var jobelt = document.getElementById("num-jobs")
- if (jobelt) jobelt.innerHTML = jobcount - 1;
+ if (jobelt) jobelt.innerHTML = Math.max(jobcount - 1, 0);
var loc = req.getResponseHeader("Location");
get_progress(loc);
} else {
@@ -217,7 +326,7 @@ function ajax_submit(url, text, lisp) {
}
}
}
- var content = "formula=" + encodeURIComponent(lisp) + "&formula-math=" + encodeURIComponent(text);
+ var content = "formula=" + encodeURIComponent(lisp);
req.send(content);
}
diff --git a/src/web/demo.rkt b/src/web/demo.rkt
index 8e374281e..1a86feffc 100644
--- a/src/web/demo.rkt
+++ b/src/web/demo.rkt
@@ -5,11 +5,10 @@
web-server/http/bindings web-server/configuration/responders
web-server/managers/none)
(require "../sandbox.rkt")
-(require "../formats/datafile.rkt" "../reports/make-graph.rkt" "../reports/make-report.rkt" "../reports/thread-pool.rkt")
+(require "../formats/datafile.rkt" "make-graph.rkt" "make-report.rkt" "thread-pool.rkt")
(require "../formats/tex.rkt")
(require "../syntax-check.rkt" "../type-check.rkt")
(require "../common.rkt" "../config.rkt" "../programs.rkt" "../formats/test.rkt" "../errors.rkt")
-(require "../web/common.rkt")
(provide run-demo)
@@ -17,6 +16,7 @@
(define *demo-prefix* (make-parameter "/"))
(define *demo-output* (make-parameter false))
(define *demo-log* (make-parameter false))
+(define *demo-debug?* (make-parameter false))
(define (add-prefix url)
(string-replace (string-append (*demo-prefix*) url) "//" "/"))
@@ -38,10 +38,22 @@
[("improve-start") #:method "post" improve-start]
[("improve") #:method (or "post" "get" "put") improve]
[("check-status" (string-arg)) check-status]
- [((hash-arg) "interactive.js") generate-interactive]
- [((hash-arg) "graph.html") generate-report]
- [((hash-arg) "debug.txt") generate-debug]
- [((hash-arg) (string-arg)) generate-plot]))
+ [("up") check-up]
+ [((hash-arg) (string-arg)) generate-page]))
+
+(define (generate-page req results page)
+ (match-define (cons result debug) results)
+ (cond
+ [(set-member? (all-pages result) page)
+ (response 200 #"OK" (current-seconds) #"text"
+ (list (header #"X-Job-Count" (string->bytes/utf-8 (~a (hash-count *jobs*)))))
+ (λ (out) (make-page page out result #f)))]
+ [(equal? page "debug.log")
+ (response 200 #"OK" (current-seconds) #"text/plain"
+ (list (header #"X-Job-Count" (string->bytes/utf-8 (~a (hash-count *jobs*)))))
+ (λ (out) (display debug out)))]
+ [else
+ (next-dispatcher)]))
(define url (compose add-prefix url*))
@@ -57,6 +69,24 @@
`(dl ([class "function-list"])
,@(append-map fn-class fn-classes)))
+(define (herbie-page #:title title #:show-title [title? true]
+ #:scripts [scripts '()] #:styles [styles '()] #:head-include [other-include-head '()] . body)
+ `(html
+ (head
+ (meta ([charset "utf-8"]))
+ (title ,title)
+ ,@other-include-head
+ ,@(for/list ([script scripts])
+ `(script ([src ,script] [type "text/javascript"])))
+ (link ([rel "stylesheet"] [type "text/css"] [href "main.css"]))
+ ,@(for/list ([style styles])
+ `(link ([rel "stylesheet"] [type "text/css"] [href ,style]))))
+ (body
+ (header
+ (img ([class "logo"] [src "/logo.png"]))
+ ,@(if title? `((h1 ,title)) `()))
+ ,@body)))
+
(define (main req)
(when (and (*demo-output*) (not (directory-exists? (*demo-output*))))
(make-directory (*demo-output*)))
@@ -71,8 +101,16 @@
`(form ([action ,(url improve)] [method "post"] [id "formula"]
[data-progress ,(url improve-start)])
(input ([name "formula"] [autofocus "true"] [placeholder "(FPCore (x) (- (sqrt (+ x 1)) (sqrt x)))"]))
+ (pre ([id "progress"] [style "display: none;"]))
+ (div ([class "extra-fields"])
+ (label ([for "pre"]) "Precondition")
+ (input ([name "pre"] [id "pre"] [placeholder "TRUE"]))
+ (label ([for "precision"]) "Precision")
+ (select ([name "precision"] [id "precision"])
+ (option ([value "binary64"]) "Double-precision floats")
+ (option ([value "binary32"]) "Single-precision floats")))
(ul ([id "errors"]))
- (pre ([id "progress"] [style "display: none;"])))
+ (input ([type "submit"])))
(if (*demo?*)
`(p "To handle the high volume of requests, web requests are queued; "
@@ -88,28 +126,24 @@
"using only the following supported functions:")
`(p ([id "mathjs-instructions"] [style "display: none;"])
"You can write ordinary mathematical expressions (parsed with "
- (a ([href "https://mathjs.org"]) "math.js") ") using:")
+ (a ([href "https://mathjs.org"]) "math.js") ") using the standard "
+ (code "math.h") " functions, including:")
(function-list
'((+ - * / abs) "The usual arithmetic functions")
- '((sqrt sqr) "Squares and square roots")
- '((cbrt cube) "Cubes and cube roots")
+ '((sqrt cbrt) "Square and cube roots")
'((exp log) "Natural exponent and natural log")
- '((expt) "Raising a value to an exponent (also called " (code "pow") ")")
+ '((pow) "Raising a value to a power")
'((sin cos tan) "The trigonometric functions")
'((asin acos atan) "The inverse trigonometric functions")
'((sinh cosh tanh) "The hyperbolic trigonometric functions")
'((asinh acosh atanh) "The inverse hyperbolic trigonometric functions")
- '((ceil floor rint round trunc) "Rounding functions")
'((erf erfc) "Error function and complementary error function")
- '((exp2 log2 log10) "Exponential base 2, log base 2, and log base 10")
- '((fmod remainder) "Mod and remainder functions")
'((j0 j1 y0 y1) "Bessel functions of the first and second kind")
- '((tgamma lgamma) "The gamma function and log gamma function")
- '((fmin fmax) "The min and max functions")
- '((fdim copysign) "The positive difference and copysign functions")
+ '((tgamma lgamma) "The gamma function and log-gamma function")
+ '((min max) "The min and max functions")
'((expm1 log1p) "The exponent of " (code "x - 1") " and the log of " (code "1 + x"))
- '((fma hypot logb) "The fma, hypotenuse (distance from origin), and logb functions")
+ '((fma) "The fused multiply-add, with the additive term last")
'((PI E) "The mathematical constants"))
`(p (em "Note") ": "
@@ -131,7 +165,8 @@
(let loop ([seed #f])
(match (thread-receive)
[`(init rand ,vec flags ,flag-table num-iters ,iterations points ,points
- timeout ,timeout output-dir ,output reeval ,reeval demo? ,demo?)
+ timeout ,timeout output-dir ,output reeval ,reeval demo? ,demo?
+ debug? ,debug?)
(set! seed vec)
(*flags* flag-table)
(*num-iterations* iterations)
@@ -139,7 +174,8 @@
(*timeout* timeout)
(*demo-output* output)
(*reeval-pts* reeval)
- (*demo?* demo?)]
+ (*demo?* demo?)
+ (*demo-debug?* debug?)]
[(list 'improve hash formula sema)
(define path (format "~a.~a" hash *herbie-commit*))
(cond
@@ -153,8 +189,9 @@
(define result
(get-test-result
#:seed seed
- #:setup! (λ () (set-debug-level! 'progress '(3 4)))
- #:debug (hash-ref *jobs* hash)
+ #:debug-level (cons 'progress '(3 4))
+ #:debug-port (hash-ref *jobs* hash)
+ #:debug (*demo-debug?*)
(parse-test formula)))
(hash-set! *completed-jobs* hash (cons result (get-output-string (hash-ref *jobs* hash))))
@@ -162,20 +199,11 @@
(when (*demo-output*)
;; Output results
(make-directory (build-path (*demo-output*) path))
- (define make-page
- (cond [(test-result? result) (λ args
- (apply make-graph
- (append args
- (list (string? (get-interactive-js result)))))
- (apply make-plots args))]
- [(test-timeout? result) make-timeout]
- [(test-failure? result) make-traceback]))
- (with-output-to-file (build-path (*demo-output*) path "graph.html")
- (λ () (make-page result (build-path (*demo-output*) path) #f)))
-
- (with-output-to-file (build-path (*demo-output*) path "debug.txt")
- (λ () (display (get-output-string (hash-ref *jobs* hash)))))
-
+ (for ([page (all-pages result)])
+ (call-with-output-file (build-path (*demo-output*) path page)
+ (λ (out) (make-page page out result #f))))
+ (write-file (build-path (*demo-output*) path "debug.txt")
+ (display (get-output-string (hash-ref *jobs* hash))))
(update-report result path seed
(build-path (*demo-output*) "results.json")
(build-path (*demo-output*) "results.html")))
@@ -187,14 +215,14 @@
(define (update-report result dir seed data-file html-file)
(define link (path-element->string (last (explode-path dir))))
- (match-define (cons _ data) (get-table-data result link))
+ (define data (get-table-data result link))
(define info
(if (file-exists? data-file)
(let ([info (read-datafile data-file)])
(struct-copy report-info info [tests (cons data (report-info-tests info))]))
(make-report-info (list data) #:seed seed #:note (if (*demo?*) "Web demo results" ""))))
(write-datafile data-file info)
- (make-report-page html-file info))
+ (call-with-output-file html-file #:exists 'replace (curryr make-report-page info)))
(define (run-improve hash formula)
(hash-set! *jobs* hash (open-output-string))
@@ -228,7 +256,7 @@
(body hash formula))]
[_
(response/error "Demo Error"
- `(p "You didn't specify a formula (or you specified serveral). "
+ `(p "You didn't specify a formula (or you specified several). "
"Please " (a ([href ,go-back]) "go back") " and try again."))]))
(define (improve-start req)
@@ -240,7 +268,7 @@
(response/full 201 #"Job started" (current-seconds) #"text/plain"
(list (header #"Location" (string->bytes/utf-8 (url check-status hash)))
(header #"X-Job-Count" (string->bytes/utf-8 (~a (hash-count *jobs*)))))
- '(#"")))
+ '()))
(url main)))
(define (check-status req hash)
@@ -255,6 +283,13 @@
(header #"X-Job-Count" (string->bytes/utf-8 (~a (hash-count *jobs*)))))
'())]))
+(define (check-up req)
+ (response/full (if (thread-running? *worker-thread*) 200 500)
+ (if (thread-running? *worker-thread*) #"Up" #"Down")
+ (current-seconds) #"text/plain"
+ (list (header #"X-Job-Count" (string->bytes/utf-8 (~a (hash-count *jobs*)))))
+ '()))
+
(define (improve req)
(improve-common
req
@@ -265,70 +300,29 @@
(redirect-to (add-prefix (format "~a.~a/graph.html" hash *herbie-commit*)) see-other))
(url main)))
-(define (generate-interactive req results)
- (match-define (cons result debug) results)
-
- (response 200 #"OK" (current-seconds) #"text"
- (list (header #"X-Job-Count" (string->bytes/utf-8 (~a (hash-count *jobs*)))))
- (λ (out)
- (parameterize ([current-output-port out])
- (output-interactive-js result (format "~a.~a" hash *herbie-commit*) #f)))))
-
-(define (generate-report req results)
- (match-define (cons result debug) results)
-
- (response 200 #"OK" (current-seconds) #"text/html"
- (list (header #"X-Job-Count" (string->bytes/utf-8 (~a (hash-count *jobs*)))))
- (λ (out)
- (parameterize ([current-output-port out])
- (make-graph result
- (format "~a.~a" hash *herbie-commit*)
- #f
- (string? (get-interactive-js result)))))))
-
-(define (generate-plot req results plotname)
- (match-define (cons result debug) results)
-
- (define responder
- (match (regexp-match #rx"^plot-([0-9]+)([rbg]?).png$" plotname)
- [#f (next-dispatcher)]
- [(list _ (app string->number idx) "")
- ;; TODO: rdir?
- (curry make-axis-plot result idx)]
- [(list _ (app string->number idx) (and (or "r" "g" "b") (app string->symbol letter)))
- (curry make-points-plot result idx letter)]))
- (response 200 #"OK" (current-seconds) #"text/html"
- (list (header #"X-Job-Count" (string->bytes/utf-8 (~a (hash-count *jobs*)))))
- responder))
-
-(define (generate-debug req results)
- (match-define (cons result debug) results)
-
- (response 200 #"OK" (current-seconds) #"text/plain"
- (list (header #"X-Job-Count" (string->bytes/utf-8 (~a (hash-count *jobs*)))))
- (λ (out) (display debug out))))
-
(define (response/error title body)
(response/full 400 #"Bad Request" (current-seconds) TEXT/HTML-MIME-TYPE '()
(list (string->bytes/utf-8 (xexpr->string (herbie-page #:title title body))))))
-(define (run-demo #:quiet [quiet? #f] #:output output #:demo? demo? #:prefix prefix #:log log #:port port)
+(define (run-demo #:quiet [quiet? #f] #:output output #:demo? demo? #:prefix prefix #:debug debug? #:log log #:port port #:public? public)
(*demo?* demo?)
(*demo-output* output)
(*demo-prefix* prefix)
(*demo-log* log)
+ (*demo-debug?* debug?)
(define config
`(init rand ,(get-seed) flags ,(*flags*) num-iters ,(*num-iterations*) points ,(*num-points*)
- timeout ,(*timeout*) output-dir ,(*demo-output*) reeval ,(*reeval-pts*) demo? ,(*demo?*)))
+ timeout ,(*timeout*) output-dir ,(*demo-output*) reeval ,(*reeval-pts*) demo? ,(*demo?*)
+ debug? ,(*demo-debug?*)))
(thread-send *worker-thread* config)
(eprintf "Herbie ~a with seed ~a\n" *herbie-version* (get-seed))
- (eprintf "Find help on , exit with Ctrl-C\n")
+ (eprintf "Find help on https://herbie.uwplse.org/, exit with Ctrl-C\n")
(serve/servlet
dispatch
- #:listen-ip (if (*demo?*) #f "127.0.0.1")
+ #:listen-ip (if public #f "127.0.0.1")
#:port port
#:servlet-current-directory (current-directory)
#:manager (create-none-manager #f)
@@ -336,19 +330,16 @@
#:command-line? true
#:launch-browser? (not quiet?)
#:banner? true
- #:servlets-root web-resource-path
- #:server-root-path web-resource-path
+ #:servlets-root (web-resource)
+ #:server-root-path (web-resource)
#:servlet-path "/"
#:servlet-regexp #rx""
#:extra-files-paths
- (if (*demo-output*)
- (list web-resource-path (*demo-output*))
- (list web-resource-path))
+ (list/true (web-resource) (*demo-output*))
#:log-file (*demo-log*)
#:file-not-found-responder
- (gen-file-not-found-responder
- (build-path web-resource-path "404.html"))))
+ (gen-file-not-found-responder (web-resource "404.html"))))
(module+ main
(run-demo #t))
diff --git a/src/web/graph.css b/src/web/graph.css
deleted file mode 100644
index ceb51c2e7..000000000
--- a/src/web/graph.css
+++ /dev/null
@@ -1,117 +0,0 @@
-/* Standard Herbie header */
-
-body { width: 800px; margin: 1em auto; font-family: sans; }
-
-a {color: #2A6496; text-decoration: none; cursor: pointer}
-a:hover {text-decoration: underline; color: #295785}
-
-#large { margin: 2em 0; text-align: center; }
-#large div { margin: 0 1em; display: inline-block; vertical-align: top; }
-#large .number { font-size: 3em; display: block; }
-@media print { #large { margin-top: 0; }}
-
-/* Detail page layout */
-
-section { margin: 5em 0; position: relative; }
-@media print { section { margin: 3em 0; } }
-section h1 {
- position: absolute; width: 300px; text-align: left; right: -340px; top: -15px;
- font-size: 24px; color: #aaa; transform: rotate(90deg); transform-origin: top left;
-}
-
-#program { background: #ddd; padding: 1em; text-align: center; font-size: 24px; }
-@media print { #program { padding: 0; background: transparent; margin: 2em 0; } }
-#program .program { display: inline-block; }
-#program .arrow { color: transparent; font-size: 0; }
-#program .arrow:after { content: "↓"; color: black; font-size: 24px; }
-#program.horizontal .arrow { display: inline-block; }
-#program.horizontal .arrow:after { margin: 0 1em; content: "→"; font-size: 40px; }
-
-#graphs figure { margin: 1em auto; position: relative; padding-top: 300px; width: 800px; }
-#graphs figcaption { text-align: left; }
-#graphs figure img { position: absolute; top: 0; left: 0; }
-#graphs figcaption button {
- float: right; margin: 0 .25em; cursor: pointer;
- border: 3px solid black; background: gray; color: transparent;
- height: 1.5em; width: 1.5em; border-radius: .75em;
- overflow: hidden;
-}
-#graphs figcaption button.Result { border-color: blue; background: lightblue; }
-#graphs figcaption button.Target { border-color: green; background: lightgreen; }
-#graphs figcaption button.Input { border-color: red; background: pink; }
-#graphs figcaption button.inactive { background: white; }
-
-#try-result output { font-size: 108%; margin: 0 .5em; float: right; }
-#try-result div { overflow: auto; }
-#try-result table { line-height: 1.5; margin-top: .25em; }
-#try-result { width: 39%; float: right; }
-#try-result p.header { margin: 0 0 .5em; font-size: 120%; color: #444; border-bottom: 1px solid #ccc; line-height: 1.5; }
-#try-result label:after { content: ":"; }
-
-#try-inputs-wrapper { width: 59%; display: inline-block; }
-
-#try-inputs ol { list-style: none; padding: 0; display: inline-block; margin: 0 0 0 -1em; }
-#try-inputs ol label { min-width: 4ex; text-align: right; margin-right: .5em; display: inline-block; }
-#try-inputs li { margin-left: 1em; display: inline-block; font-size: 110%; font-family: monospace; line-height: 2; }
-#try-inputs label:after { content: ":"; }
-#try-inputs input { padding: 1px 4px; width: 25ex; }
-#try-inputs p.header { margin: 0 0 .5em; font-size: 120%; color: #444; border-bottom: 1px solid #ccc; line-height: 1.5; }
-
-#try-error { color: red; font-size: 120%; display: none; }
-
-.error #try-error { display: block; }
-#try-result.error table { display: none; }
-
-.tabbar { margin: -1.25em 0 0; padding: 0; list-style-type: none; list-style-position: inside; text-align: left; }
-.tabbar p { display: inline-block; margin: 0 .5em 0 0}
-.tabbar li { padding: .5ex; display: inline-block; margin: .1em; cursor: pointer; }
-.tabbar li:hover { background: #e4e4e4; }
-.tabbar li.selected { background: #d3d3d3; }
-h1 { margin: .67em .33em; text-align: center; vertical-align: top; font-size: 3em; font-weight: normal; }
-
-.history, .history ol { list-style: none inside; width: 800px; margin: 0 0 2em; padding: 0; }
-
-.history li p { width: 150px; display: inline-block; margin: 0 25px 0 0; }
-.history li .error { display: block; color: #666; }
-.history li > div { display: inline-block; margin: 0; width: 600px; vertical-align: middle; }
-.history li > div > div { margin: 0; display: inline-block; text-align: right !important; }
-
-.history h2 { margin: 1.333em 0 .333em; }
-.history li {margin: .5em 0; border-top: 1px solid #ddd; padding-top: .5em; }
-.history li:first-child { border-top: none; padding-top: 0; }
-.history .rule { text-decoration: underline; }
-.history .event { display: block; margin: .5em 0; }
-
-#process-info { background: #ddd; }
-#process-info p.header { font-size: 110%; padding: 1em 1em .5em; margin: 0; }
-#process-info p.header .attachment { float: right; margin: 0 0 0 1em; }
-#process-info pre { padding: 1em; margin: 0; font-family: monospace; overflow-x: auto; }
-#process-info p { margin: 1em .75em 0; }
-pre.shell code:before { content: "$ "; font-weight: bold; }
-
-#comparison table { width: 300px; display: inline-table; vertical-align: top; }
-#comparison table th { text-align: left; }
-#comparison table td { text-align: right; }
-#comparison div { display: inline-block; width: 500px; }
-
-.timeline { height: 2em; border-top: 1px solid #888; border-bottom: 1px solid #888; }
-.timeline-phase { height: 2em; display: inline-block; }
-.timeline-phase.start { background: #d3d7cf; }
-.timeline-phase.setup { background: #edd400; }
-.timeline-phase.localize { background: #729fcf; }
-.timeline-phase.series { background: #fcaf3e; }
-.timeline-phase.rewrite { background: #e9b96e; }
-.timeline-phase.simplify { background: #8ae234; }
-.timeline-phase.prune { background: #ad7fa8; }
-.timeline-phase.regimes { background: #a40000; }
-@media print {
- .timeline { border: none; }
- .timeline-phase { outline: 1px solid black; }
-}
-
-#backtrace table { width: 100%; }
-#backtrace th[colspan] { text-align: left; }
-#backtrace th { text-align: right; }
-#backtrace td:nth-child(3), #backtrace td:nth-child(4) { text-align: right; }
-#backtrace td.procedure { font-family: monospace; }
-
diff --git a/src/web/input.js b/src/web/input.js
deleted file mode 100644
index 630a936c5..000000000
--- a/src/web/input.js
+++ /dev/null
@@ -1,148 +0,0 @@
-CONSTANTS = ["PI", "E"]
-FUNCTIONS = {
- "+": [2], "-": [1, 2], "*": [2], "/": [2], "abs": [1],
- "sqrt": [1], "sqr": [1], "exp": [1], "log": [1], "expt": [2],
- "sin": [1], "cos": [1], "tan": [1],
- "asin": [1], "acos": [1], "atan": [1],
- "sinh": [1], "cosh": [1], "tanh": [1]
-}
-
-SECRETFUNCTIONS = {"pow": "expt", "^": "expt", "**": "expt"}
-
-function onload() {
- var form = document.getElementById("formula");
- var input = document.querySelector("#formula input")
- input.setAttribute("name", "formula-math")
- input.removeAttribute("disabled");
-
- var hidden = document.createElement("input");
- hidden.type = "hidden";
- hidden.setAttribute("name", "lisp_formula")
- form.appendChild(hidden);
-
- input.addEventListener("keyup", function(evt) {
- var txt = input.value;
- var tree, errors = [];
- try {
- tree = math.parse(txt);
- errors = tree_errors(tree);
- } catch (e) {
- errors = ["" + e];
- }
-
- if (txt && errors.length > 0) {
- document.getElementById("errors").innerHTML = "" + errors.join(" ") + " ";
- } else {
- document.getElementById("errors").innerHTML = "";
- }
- });
-
- form.addEventListener("submit", function(evt) {
- var txt = input.value;
- var tree, errors;
- try {
- tree = math.parse(txt);
- errors = tree_errors(tree);
- } catch (e) {
- errors = ["" + e];
- }
-
- if (errors.length > 0) {
- document.getElementById("errors").innerHTML = "" + errors.join(" ") + " ";
- evt.preventDefault();
- return false;
- } else {
- document.getElementById("errors").innerHTML = "";
- }
-
- var lisp = dump_tree(tree);
- hidden.setAttribute("value", lisp);
- });
-
-}
-
-
-function bottom_up(tree, cb) {
- if (tree.args) {
- tree.args = tree.args.map(function(node) {return bottom_up(node, cb)});
- tree.res = cb(tree);
- } else {
- tree.res = cb(tree);
- }
- return tree;
-}
-
-function dump_tree(tree) /* tree -> string */ {
- function extract(args) {return args.map(function(n) {return n.res});}
- var names = [];
- var body = bottom_up(tree, function(node) {
- switch(node.type) {
- case "ConstantNode":
- return "" + node.value;
- case "FunctionNode":
- node.name = SECRETFUNCTIONS[node.name] || node.name;
- return "(" + node.name + " " + extract(node.args).join(" ") + ")";
- case "OperatorNode":
- node.op = SECRETFUNCTIONS[node.op] || node.op;
- return "(" + node.op + " " + extract(node.args).join(" ") + ")";
- case "SymbolNode":
- if (CONSTANTS.indexOf(node.name) === -1)
- names.push(node.name);
- return node.name;
- default:
- throw SyntaxError("Invalid tree!");
- }
- });
-
- var dnames = [];
- for (var i = 0; i < names.length; i++) {
- if (dnames.indexOf(names[i]) === -1) dnames.push(names[i]);
- }
-
- return "(lambda (" + dnames.join(" ") + ") " + body.res + ")";
-}
-function tree_errors(tree) /* tree -> list */ {
- var messages = [];
- var names = [];
-
- bottom_up(tree, function(node, path, parent) {
- switch(node.type) {
- case "ConstantNode":
- if (node.valueType !== "number")
- messages.push("Constants that are " + node.valueType + "s not supported.");
- break;
- case "FunctionNode":
- node.name = SECRETFUNCTIONS[node.name] || node.name;
- if (!FUNCTIONS[node.name]) {
- messages.push("Function " + node.name + "
unsupported.");
- } else if (FUNCTIONS[node.name].indexOf(node.args.length) === -1) {
- messages.push("Function " + node.name + "
expects " +
- FUNCTIONS[node.name].join(" or ") + " arguments");
- }
- break;
- case "OperatorNode":
- node.op = SECRETFUNCTIONS[node.op] || node.op;
- if (!FUNCTIONS[node.op]) {
- messages.push("Operator " + node.op + "
unsupported.");
- } else if (FUNCTIONS[node.op].indexOf(node.args.length) === -1) {
- messages.push("Operator " + node.op + "
expects " +
- FUNCTIONS[node.op].join(" or ") + " arguments");
- }
- break;
- case "SymbolNode":
- if (CONSTANTS.indexOf(node.name) === -1)
- names.push(node.name);
- break;
- default:
- messages.push("Unsupported syntax; found unexpected " + node.type + "
.")
- break;
- }
- });
-
- if (names.length == 0) {
- messages.push("No variables mentioned.");
- }
-
- return messages;
-}
-window.addEventListener("load", onload);
diff --git a/src/web/main.css b/src/web/main.css
index 007d21757..86fc95c6f 100644
--- a/src/web/main.css
+++ b/src/web/main.css
@@ -9,7 +9,7 @@ h3 {font-size: 14px; line-height: 1.286; margin-bottom: .2em; clear: both;}
p, li, dd, blockquote, figcaption {
text-align: justify; -moz-hyphens: auto; -webkit-hyphens: auto; hyphens: auto;
- margin: .5em;
+ margin: .5em 0;
}
.showcase { background: #ddd; padding: 1em; margin: 5em 0; clear: both;}
@@ -46,7 +46,15 @@ ul {padding-left: 1em;}
a {color: #2A6496; text-decoration: none}
a:hover {text-decoration: underline; color: #295785}
-#formula input { width: 100%; font-size: 125%; }
+#formula input[autofocus] { width: 100%; font-size: 125%; }
+.extra-fields { margin-top: 1em; }
+.show-extra {
+ display: block; text-align: right; margin-top: .5em;
+ cursor: pointer;
+}
+#formula input[type=submit] { display: none; }
+label { display: inline-block; width: 20%; line-height: 3; }
+input, select { width: 80%; }
#errors li { color: #800; }
#progress {
font-size: 14px; font-family: sans-serif; background-color: #f1f1f1;
diff --git a/src/web/make-graph.rkt b/src/web/make-graph.rkt
new file mode 100644
index 000000000..e9bbf1305
--- /dev/null
+++ b/src/web/make-graph.rkt
@@ -0,0 +1,521 @@
+#lang racket
+
+(require (only-in xml write-xexpr xexpr?))
+(require "../common.rkt" "../points.rkt" "../float.rkt" "../programs.rkt")
+(require "../alternative.rkt" "../errors.rkt" "../plot.rkt")
+(require "../formats/test.rkt" "../formats/datafile.rkt" "../formats/tex.rkt" "../formats/c.rkt")
+(require "../core/matcher.rkt" "../core/regimes.rkt" "../sandbox.rkt")
+(require "../fpcore/core2js.rkt" "timeline.rkt" "common.rkt")
+
+(provide all-pages make-page)
+
+(define (unique-values pts idx)
+ (length (remove-duplicates (map (curryr list-ref idx) pts))))
+
+(define (all-pages result)
+ (define test (test-result-test result))
+ (define good? (test-success? result))
+
+ (define pages
+ `("graph.html"
+ ,(and good? "interactive.js")
+ "timeline.html" "timeline.json"
+ ,@(for/list ([v (test-vars test)] [idx (in-naturals)]
+ #:when good? [type '("" "r" "g" "b")]
+ #:unless (and (equal? type "g") (not (test-output test)))
+ ;; Don't generate a plot with only one X value else plotting throws an exception
+ #:when (> (unique-values (test-success-newpoints result) idx) 1))
+ (format "plot-~a~a.png" idx type))))
+ (filter identity pages))
+
+(define ((page-error-handler test page) e)
+ ((error-display-handler)
+ (format "In \"~a\":\n ~a: ~a" (test-name test) page (exn-message e))
+ e))
+
+(define (make-page page out result profile?)
+ (with-handlers ([exn:fail? (page-error-handler (test-result-test result) page)])
+ (match page
+ ["graph.html"
+ (match result
+ [(? test-success?) (make-graph result out (get-interactive-js result) profile?)]
+ [(? test-timeout?) (make-timeout result out profile?)]
+ [(? test-failure?) (make-traceback result out profile?)])]
+ ["interactive.js"
+ (make-interactive-js result out)]
+ ["timeline.html"
+ (make-timeline result out)]
+ ["timeline.json"
+ (make-timeline-json result out)]
+ [(regexp #rx"^plot-([0-9]+).png$" (list _ idx))
+ (make-axis-plot result out (string->number idx))]
+ [(regexp #rx"^plot-([0-9]+)([rbg]).png$" (list _ idx letter))
+ (make-points-plot result out (string->number idx) (string->symbol letter))])))
+
+(define/contract (regime-info altn)
+ (-> alt? (or/c (listof sp?) #f))
+ (let loop ([altn altn])
+ (match altn
+ [(alt _ `(regimes ,splitpoints) prevs) splitpoints]
+ [(alt _ _ (list)) #f]
+ [(alt _ _ (list prev _ ...)) (loop prev)])))
+
+(define (regime-splitpoints altn)
+ (map sp-point (drop-right (regime-info altn) 1)))
+
+(define/contract (regime-var altn)
+ (-> alt? (or/c expr? #f))
+ (define info (regime-info altn))
+ (and info (sp-bexpr (car info))))
+
+(define/contract (render-command-line)
+ (-> string?)
+ (format
+ "herbie shell --seed ~a ~a"
+ (if (vector? (get-seed)) (format "'~a'" (get-seed)) (get-seed))
+ (string-join
+ (for/list ([rec (changed-flags)])
+ (match rec
+ [(list 'enabled class flag) (format "+o ~a:~a" class flag)]
+ [(list 'disabled class flag) (format "-o ~a:~a" class flag)]))
+ " ")))
+
+(define/contract (render-fpcore test)
+ (-> test? string?)
+ (string-join
+ (filter
+ identity
+ (list
+ (format "(FPCore ~a" (test-vars test))
+ (format " :name ~s" (test-name test))
+ (if (equal? (test-precondition test) 'TRUE)
+ #f
+ (format " :pre ~a" (resugar-program (test-precondition test))))
+ (if (equal? (test-expected test) #t)
+ #f
+ (format " :herbie-expected ~a" (test-expected test)))
+ (if (test-output test)
+ (format "\n :herbie-target\n ~a\n" (resugar-program (test-output test))) ; Extra newlines for clarity
+ #f)
+ (format " ~a)" (resugar-program (test-input test)))))
+ "\n"))
+
+(define/contract (render-reproduction test #:bug? [bug? #f])
+ (->* (test?) (#:bug? boolean?) xexpr?)
+
+ `(section ((id "reproduce"))
+ (h1 "Reproduce")
+ ,(if bug?
+ `(p "Please include this information when filing a "
+ (a ((href "https://github.com/uwplse/herbie/issues")) "bug report") ":")
+ "")
+ (pre ((class "shell"))
+ (code
+ ,(render-command-line) "\n"
+ ,(render-fpcore test) "\n"))))
+
+(define (alt2fpcore alt)
+ (match-define (list _ args expr) (alt-program alt))
+ (list 'FPCore args ':name 'alt expr))
+
+(define (get-interactive-js result)
+ (with-handlers ([exn:fail? (λ (e) #f)])
+ (define start-fpcore (alt2fpcore (test-success-start-alt result)))
+ (define end-fpcore (alt2fpcore (test-success-end-alt result)))
+ (define start-js (compile-program start-fpcore #:name "start"))
+ (define end-js (compile-program end-fpcore #:name "end"))
+ (string-append start-js end-js)))
+
+(define (make-interactive-js result out)
+ (define js-text (get-interactive-js result))
+ (when (string? js-text)
+ (display js-text out)))
+
+(define/contract (render-interactive start-prog point)
+ (-> alt? (listof number?) xexpr?)
+ `(section ([id "try-it"])
+ (h1 "Try it out")
+ (div ([id "try-inputs-wrapper"])
+ (form ([id "try-inputs"])
+ (p ([class "header"]) "Your Program's Arguments")
+ (ol
+ ,@(for/list ([var-name (program-variables (alt-program start-prog))] [i (in-naturals)] [val point])
+ `(li (label ([for ,(string-append "var-name-" (~a i))]) ,(~a var-name))
+ (input ([type "text"] [class "input-submit"]
+ [name ,(string-append "var-name-" (~a i))]
+ [value ,(~a val)])))))))
+ (div ([id "try-result"] [class "no-error"])
+ (p ([class "header"]) "Results")
+ (table
+ (tbody
+ (tr (td (label ([for "try-original-output"]) "In"))
+ (td (output ([id "try-original-output"]))))
+ (tr (td (label ([for "try-herbie-output"]) "Out"))
+ (td (output ([id "try-herbie-output"]))))))
+ (div ([id "try-error"]) "Enter valid numbers for all inputs"))))
+
+(define (points->doubles pts)
+ (cond
+ [(or (real? (caar pts)) (complex? (caar pts))) pts]
+ [else
+ (define repr (infer-representation (caar pts)))
+ (map (curry map (curryr repr->fl repr)) pts)]))
+
+(define (make-axis-plot result out idx)
+ (define var (list-ref (test-vars (test-result-test result)) idx))
+ (define split-var? (equal? var (regime-var (test-success-end-alt result))))
+ (define pts (points->doubles (test-success-newpoints result)))
+ (herbie-plot
+ #:port out #:kind 'png
+ (error-axes pts #:axis idx)
+ (map error-mark (if split-var? (regime-splitpoints (test-success-end-alt result)) '()))))
+
+(define (make-points-plot result out idx letter)
+ (define-values (theme accessor)
+ (match letter
+ ['r (values *red-theme* test-success-start-error)]
+ ['g (values *green-theme* test-success-target-error)]
+ ['b (values *blue-theme* test-success-end-error)]))
+
+ (define pts (points->doubles (test-success-newpoints result)))
+ (define err (accessor result))
+
+ (herbie-plot
+ #:port out #:kind 'png
+ (error-points err pts #:axis idx #:color theme)
+ (error-avg err pts #:axis idx #:color theme)))
+
+(define (make-alt-plots point-alt-idxs alt-idxs title out)
+ (define best-alt-point-renderers (best-alt-points point-alt-idxs alt-idxs))
+ (alt-plot best-alt-point-renderers #:port out #:kind 'png #:title title))
+
+(define (make-point-alt-idxs result)
+ (define all-alts (test-success-all-alts result))
+ (define all-alt-bodies (map (λ (alt) (eval-prog (alt-program alt) 'fl)) all-alts))
+ (define newpoints (test-success-newpoints result))
+ (define newexacts (test-success-newexacts result))
+ (oracle-error-idx all-alt-bodies newpoints newexacts))
+
+(define (make-contour-plot point-colors var-idxs title out)
+ (define point-renderers (herbie-ratio-point-renderers point-colors var-idxs))
+ (alt-plot point-renderers #:port out #:kind 'png #:title title))
+
+#;
+(define (make-plots result rdir profile? debug?)
+ (define (open-file #:type [type #f] idx fun . args)
+ (call-with-output-file (build-path rdir (format "plot-~a~a.png" idx (or type ""))) #:exists 'replace
+ (apply curry fun args)))
+
+ (define vars (program-variables (alt-program (test-success-start-alt result))))
+ (when (and debug? (>= (length vars) 2))
+ (define point-alt-idxs (make-point-alt-idxs result))
+ (define newpoints (test-success-newpoints result))
+ (define baseline-errs (test-success-baseline-error result))
+ (define herbie-errs (test-success-end-error result))
+ (define oracle-errs (test-success-oracle-error result))
+ (define point-colors (herbie-ratio-point-colors newpoints baseline-errs herbie-errs oracle-errs))
+ (for* ([i (range (- (length vars) 1))] [j (range 1 (length vars))])
+ (define alt-idxs (list i j))
+ (define title (format "~a vs ~a" (list-ref vars j) (list-ref vars i)))
+ (open-file (- (+ j (* i (- (length vars)))) 1) #:type 'best-alts
+ make-alt-plots point-alt-idxs alt-idxs title)
+ (open-file (- (+ j (* i (- (length vars)))) 1) #:type 'contours
+ make-contour-plot point-colors alt-idxs title)))
+
+ (for ([var (test-vars (test-result-test result))] [idx (in-naturals)])
+ (when (> (length (remove-duplicates (map (curryr list-ref idx) (test-success-newpoints result)))) 1)
+ ;; This is bad code
+ (open-file idx make-axis-plot result idx)
+ (open-file idx #:type 'r make-points-plot result idx 'r)
+ (when (test-success-target-error result)
+ (open-file idx #:type 'g make-points-plot result idx 'g))
+ (open-file idx #:type 'b make-points-plot result idx 'b))))
+
+(define (make-graph result out valid-js-prog profile?)
+ (match-define
+ (test-success test bits time timeline warnings
+ start-alt end-alt points exacts start-est-error end-est-error
+ newpoints newexacts start-error end-error target-error
+ baseline-error oracle-error all-alts)
+ result)
+ (define precision (test-precision test))
+ ;; render-history expects the precision to be 'real rather than 'binary64 or 'binary32
+ ;; remove this when the number system interface is added
+ (define precision* (if (set-member? '(binary64 binary32) precision)
+ 'real
+ precision))
+
+ (fprintf out "\n")
+ (write-xexpr
+ `(html
+ (head
+ (meta ([charset "utf-8"]))
+ (title "Result for " ,(~a (test-name test)))
+ (link ([rel "stylesheet"] [type "text/css"] [href "../report.css"]))
+ ,@js-tex-include
+ (script ([src "../report.js"]))
+ (script ([src "interactive.js"]))
+ (script ([src "https://unpkg.com/mathjs@4.4.2/dist/math.min.js"])))
+ (body
+ ,(render-menu
+ (list/true
+ '("Error" . "#graphs")
+ (and valid-js-prog (for/and ([p points]) (andmap number? p))
+ '("Try it out!" . "#try-it"))
+ (and (test-output test)
+ '("Target" . "#comparison"))
+ '("Derivation" . "#history")
+ '("Reproduce" . "#reproduce"))
+ (list/true
+ '("Report" . "../results.html")
+ '("Log" . "debug.txt")
+ (and profile? '("Profile" . "profile.txt"))
+ '("Metrics" . "timeline.html")))
+
+ (section ([id "large"])
+ ,(render-large "Average Error"
+ (format-bits (errors-score start-error) #:unit #f)
+ " → "
+ (format-bits (errors-score end-error) #:unit #f)
+ #:title
+ (format "Maximum error: ~a → ~a"
+ (format-bits (apply max (map ulps->bits start-error)) #:unit #f)
+ (format-bits (apply max (map ulps->bits end-error)) #:unit #f)))
+ ,(render-large "Time" (format-time time))
+ ,(render-large "Precision" (format-bits (*bit-width*) #:unit #f)))
+
+ ,(render-warnings warnings)
+
+ ,(render-program test #:to (alt-program end-alt))
+
+ (section ([id "graphs"])
+ (h1 "Error")
+ (div
+ ,@(for/list ([var (test-vars test)] [idx (in-naturals)])
+ (cond
+ [(> (length (remove-duplicates (map (curryr list-ref idx) newpoints))) 1)
+ (define split-var? (equal? var (regime-var end-alt)))
+ (define title "The X axis uses an exponential scale")
+ `(figure ([id ,(format "fig-~a" idx)] [class ,(if split-var? "default" "")])
+ (img ([width "800"] [height "300"] [title ,title]
+ [src ,(format "plot-~a.png" idx)]))
+ (img ([width "800"] [height "300"] [title ,title] [data-name "Input"]
+ [src ,(format "plot-~ar.png" idx)]))
+ ,(if target-error
+ `(img ([width "800"] [height "300"] [title ,title] [data-name "Target"]
+ [src ,(format "plot-~ag.png" idx)]))
+ "")
+ (img ([width "800"] [height "300"] [title ,title] [data-name "Result"]
+ [src ,(format "plot-~ab.png" idx)]))
+ (figcaption (p "Bits error versus " (var ,(~a var)))))]
+ [else ""]))))
+
+ ,(if (and valid-js-prog (for/and ([p points]) (andmap number? p)))
+ (render-interactive start-alt (car points))
+ "")
+
+ ,(if (test-output test)
+ `(section ([id "comparison"])
+ (h1 "Target")
+ (table
+ (tr (th "Original") (td ,(format-bits (errors-score start-error))))
+ (tr (th "Target") (td ,(format-bits (errors-score target-error))))
+ (tr (th "Herbie") (td ,(format-bits (errors-score end-error)))))
+ (div ([class "math"]) "\\[" ,(texify-prog `(λ ,(test-vars test) ,(test-output test))) "\\]"))
+ "")
+
+ (section ([id "history"])
+ (h1 "Derivation")
+ (ol ([class "history"])
+ ,@(render-history end-alt (mk-pcontext newpoints newexacts) (mk-pcontext points exacts) precision*)))
+
+ ,(render-reproduction test)))
+ out))
+
+(define (make-traceback result out profile?)
+ (match-define (test-failure test bits time timeline warnings exn) result)
+ (fprintf out "\n")
+ (write-xexpr
+ `(html
+ (head
+ (meta ((charset "utf-8")))
+ (title "Exception for " ,(~a (test-name test)))
+ (link ((rel "stylesheet") (type "text/css") (href "../report.css")))
+ ,@js-tex-include
+ (script ([src "../report.js"])))
+ (body
+ ,(render-menu
+ (list/true)
+ (list/true
+ '("Report" . "../results.html")
+ '("Log" . "debug.txt")
+ (and profile? '("Profile" . "profile.txt"))
+ '("Metrics" . "timeline.html")))
+
+ ,(render-warnings warnings)
+
+ ,(if (exn:fail:user:herbie? exn)
+ `(section ([id "user-error"])
+ (h2 ,(~a (exn-message exn)) (a ([href ,(herbie-error-url exn)]) " (more)"))
+ ,(if (exn:fail:user:herbie:syntax? exn)
+ `(table
+ (thead
+ (th ([colspan "2"]) ,(exn-message exn)) (th "L") (th "C"))
+ (tbody
+ ,@(for/list ([(stx msg) (in-dict (exn:fail:user:herbie:syntax-locations exn))])
+ `(tr
+ (td ([class "procedure"]) ,(~a msg))
+ (td ,(~a (syntax-source stx)))
+ (td ,(or (~a (syntax-line stx) "")))
+ (td ,(or (~a (syntax-column stx)) (~a (syntax-position stx))))))))
+ ""))
+ "")
+
+ ,(render-program test)
+
+ ,(if (not (exn:fail:user:herbie? exn))
+ `(,@(render-reproduction test #:bug? #t)
+ (section ([id "backtrace"])
+ (h1 "Backtrace")
+ ,(render-traceback exn)))
+ "")))
+ out))
+
+(define (render-traceback exn)
+ `(table
+ (thead
+ (th ([colspan "2"]) ,(exn-message exn)) (th "L") (th "C"))
+ (tbody
+ ,@(for/list ([tb (continuation-mark-set->context (exn-continuation-marks exn))])
+ (match (cdr tb)
+ [(srcloc file line col _ _)
+ `(tr
+ (td ([class "procedure"]) ,(~a (or (car tb) "(unnamed)")))
+ (td ,(~a file))
+ (td ,(~a line))
+ (td ,(~a col)))]
+ [#f
+ `(tr
+ (td ([class "procedure"]) ,(~a (or (car tb) "(unnamed)")))
+ (td ([colspan "3"]) "unknown"))])))))
+
+(define (make-timeout result out profile?)
+ (match-define (test-timeout test bits time timeline warnings) result)
+ (fprintf out "\n")
+ (write-xexpr
+ `(html
+ (head
+ (meta ((charset "utf-8")))
+ (title ,(format "Timeout for ~a" (test-name test)))
+ (link ([rel "stylesheet"] [type "text/css"] [href "../report.css"]))
+ ,@js-tex-include
+ (script ([src "../report.js"])))
+ (body
+ ,(render-menu
+ (list/true)
+ (list/true
+ '("Report" . "../results.html")
+ '("Log" . "debug.txt")
+ (and profile? '("Profile" . "profile.txt"))
+ '("Metrics" . "timeline.html")))
+ ,(render-warnings warnings)
+
+ (h1 "Timeout in " ,(format-time time))
+ (p "Use the " (code "--timeout") " flag to change the timeout.")
+
+ ,(render-program test)
+
+ ,(render-reproduction test)))
+ out))
+
+(struct interval (alt-idx start-point end-point expr))
+
+(define (interval->string ival)
+ (define start (interval-start-point ival))
+ (define end (interval-end-point ival))
+ (string-join
+ (list
+ (if start
+ (format "~a < " (repr->fl start (infer-representation start)))
+ "")
+ (~a (interval-expr ival))
+ (if (equal? end +nan.0)
+ ""
+ (format " < ~a" (repr->fl end (infer-representation end)))))))
+
+(define (split-pcontext pcontext splitpoints alts)
+ (define preds (splitpoints->point-preds splitpoints alts))
+
+ (for/list ([pred preds])
+ (define-values (pts* exs*)
+ (for/lists (pts exs)
+ ([(pt ex) (in-pcontext pcontext)] #:when (pred pt))
+ (values pt ex)))
+
+ ;; TODO: The (if) here just corrects for the possibility that we
+ ;; might have sampled new points that include no points in a given
+ ;; regime. Instead it would be best to continue sampling until we
+ ;; actually have many points in each regime. That would require
+ ;; breaking some abstraction boundaries right now so we haven't
+ ;; done it yet.
+ (if (null? pts*) pcontext (mk-pcontext pts* exs*))))
+
+(define (render-history altn pcontext pcontext2 precision)
+ (define err
+ (format-bits (errors-score (errors (alt-program altn) pcontext))))
+ (define err2
+ (format "Internally ~a" (format-bits (errors-score (errors (alt-program altn) pcontext2)))))
+
+ (match altn
+ [(alt prog 'start (list))
+ (list
+ `(li (p "Initial program " (span ([class "error"] [title ,err2]) ,err))
+ (div ([class "math"]) "\\[" ,(texify-prog prog) "\\]")))]
+ [(alt prog `(start ,strategy) `(,prev))
+ `(,@(render-history prev pcontext pcontext2 precision)
+ (li ([class "event"]) "Using strategy " (code ,(~a strategy))))]
+
+ [(alt _ `(regimes ,splitpoints) prevs)
+ (define intervals
+ (for/list ([start-sp (cons (sp -1 -1 #f) splitpoints)] [end-sp splitpoints])
+ (interval (sp-cidx end-sp) (sp-point start-sp) (sp-point end-sp) (sp-bexpr end-sp))))
+
+ `((li ([class "event"]) "Split input into " ,(~a (length prevs)) " regimes")
+ (li
+ ,@(apply
+ append
+ (for/list ([entry prevs] [idx (in-naturals)]
+ [new-pcontext (split-pcontext pcontext splitpoints prevs)]
+ [new-pcontext2 (split-pcontext pcontext2 splitpoints prevs)])
+ (define entry-ivals (filter (λ (intrvl) (= (interval-alt-idx intrvl) idx)) intervals))
+ (define condition (string-join (map interval->string entry-ivals) " or "))
+ `((h2 (code "if " (span ([class "condition"]) ,condition)))
+ (ol ,@(render-history entry new-pcontext new-pcontext2 precision))))))
+ (li ([class "event"]) "Recombined " ,(~a (length prevs)) " regimes into one program."))]
+
+ [(alt prog `(taylor ,pt ,loc) `(,prev))
+ `(,@(render-history prev pcontext pcontext2 precision)
+ (li (p "Taylor expanded around " ,(~a pt) " " (span ([class "error"] [title ,err2]) ,err))
+ (div ([class "math"]) "\\[\\leadsto " ,(texify-prog prog #:loc loc #:color "blue") "\\]")))]
+
+ [(alt prog `(simplify ,loc) `(,prev))
+ `(,@(render-history prev pcontext pcontext2 precision)
+ (li (p "Simplified" (span ([class "error"] [title ,err2]) ,err))
+ (div ([class "math"]) "\\[\\leadsto " ,(texify-prog prog #:loc loc #:color "blue") "\\]")))]
+
+ [(alt prog `initial-simplify `(,prev))
+ `(,@(render-history prev pcontext pcontext2 precision)
+ (li (p "Initial simplification" (span ([class "error"] [title ,err2]) ,err))
+ (div ([class "math"]) "\\[\\leadsto " ,(texify-prog prog) "\\]")))]
+
+ [(alt prog `final-simplify `(,prev))
+ `(,@(render-history prev pcontext pcontext2 precision)
+ (li (p "Final simplification" (span ([class "error"] [title ,err2]) ,err))
+ (div ([class "math"]) "\\[\\leadsto " ,(texify-prog prog) "\\]")))]
+
+ [(alt prog (list 'change cng) `(,prev))
+ `(,@(render-history prev pcontext pcontext2 precision)
+ (li (p "Applied " (span ([class "rule"]) ,(~a (rule-name (change-rule cng))))
+ (span ([class "error"] [title ,err2]) ,err))
+ (div ([class "math"]) "\\[\\leadsto " ,(texify-prog prog #:loc (change-location cng) #:color "blue") "\\]")))]
+ ))
diff --git a/src/web/make-report.rkt b/src/web/make-report.rkt
new file mode 100644
index 000000000..71d08e702
--- /dev/null
+++ b/src/web/make-report.rkt
@@ -0,0 +1,144 @@
+#lang racket
+
+(require racket/date (only-in xml write-xexpr) json)
+(require "../common.rkt" "../formats/datafile.rkt" "common.rkt")
+
+(provide make-report-page)
+
+(define (badge-label result)
+ (match (table-row-status result)
+ ["error" "ERR"]
+ ["crash" "!!!"]
+ ["timeout" "TIME"]
+ [_ (format-bits (- (table-row-start result) (table-row-result result)) #:sign #t)]))
+
+(define (make-report-page out info)
+ (match-define (report-info date commit branch hostname seed flags points iterations bit-width note tests) info)
+
+ (define table-labels
+ '("Test" "Start" "Result" "Target" "∞ ↔ ℝ" "Time"))
+
+ (define help-text
+ #hash(("Result" . "Color key:\nGreen: improved accuracy\nLight green: no initial error\nOrange: no accuracy change\nRed: accuracy worsened")
+ ("Target" . "Color key:\nDark green: better than target\nGreen: matched target\nOrange: improved but did not match target\nYellow: no accuracy change\n")))
+
+ (define total-time (apply + (map table-row-time tests)))
+ (define total-passed
+ (for/sum ([row tests])
+ (if (member (table-row-status row) '("gt-target" "eq-target" "imp-start")) 1 0)))
+ (define total-available
+ (for/sum ([row tests])
+ (if (not (equal? (table-row-status row) "ex-start")) 1 0)))
+ (define total-crashes
+ (for/sum ([row tests])
+ (if (equal? (table-row-status row) "crash") 1 0)))
+
+ (define total-gained
+ (for/sum ([row tests])
+ (or (table-row-result row) 0)))
+ (define total-start
+ (for/sum ([row tests])
+ (or (table-row-start row) 0)))
+
+ (define (round* x)
+ (inexact->exact (round x)))
+
+ (define any-has-target? (ormap table-row-target tests))
+ (define any-has-inf+/-?
+ (for*/or ([test tests] [field (list table-row-inf- table-row-inf+)])
+ (and (field test) (> (field test) 0))))
+
+ (define sorted-tests
+ (sort (map cons tests (range (length tests))) >
+ #:key (λ (x) (or (table-row-start (car x)) 0))))
+
+ (define classes
+ (filter identity
+ (list (if any-has-target? #f 'no-target)
+ (if any-has-inf+/-? #f 'no-inf))))
+
+ ;; HTML cruft
+ (fprintf out "\n")
+ (write-xexpr
+ `(html
+ (head
+ (title "Herbie results")
+ (meta ((charset "utf-8")))
+ (link ((rel "stylesheet") (type "text/css") (href "report.css")))
+ (script ((src "report.js")))
+ (script ((src "http://d3js.org/d3.v3.min.js") (charset "utf-8")))
+ (script ((type "text/javascript") (src "arrow-chart.js"))))
+
+ (body
+ (nav ([id "links"])
+ (div
+ (a ([href "timeline.html"]) "Metrics"))
+ (div
+ (a ([href "#about"]) "Flags")
+ (a ([href "#results"]) "Results")))
+
+ (div ((id "large"))
+ ,(render-large "Time" (format-time total-time))
+ ,(render-large "Passed" (~a total-passed) "/" (~a total-available))
+ ,(if (> total-crashes 0) (render-large "Crashes" (~a total-crashes)) "")
+ ,(render-large "Tests" (~a (length tests)))
+ ,(render-large "Bits" (~a (round* (- total-start total-gained))) "/" (~a (round* total-start))))
+
+ (figure (svg ((id "graph") (class "arrow-chart") (width "400"))))
+
+ (ul ((id "test-badges"))
+ ,@(for/list ([(result id) (in-dict sorted-tests)])
+ `(li ((class ,(format "badge ~a" (table-row-status result)))
+ (title ,(format "~a (~a to ~a)"
+ (table-row-name result)
+ (format-bits (table-row-start result))
+ (format-bits (table-row-result result))))
+ (data-id ,(~a id)))
+ ,(badge-label result))))
+ (hr ((style "clear:both;visibility:hidden")))
+
+ (table ((id "about"))
+ (tr (th "Date:") (td ,(date->string date)))
+ (tr (th "Commit:") (td (abbr ([title ,commit]) ,(with-handlers ([exn:fail:contract? (const commit)]) (substring commit 0 8))) " on " ,branch))
+ (tr (th "Hostname:") (td ,hostname " with Racket " ,(version)))
+ (tr (th "Seed:") (td ,(~a seed)))
+ (tr (th "Parameters:") (td ,(~a (*num-points*)) " points "
+ "for " ,(~a (*num-iterations*)) " iterations"))
+ (tr (th "Flags:")
+ (td ((id "flag-list"))
+ (div ((id "all-flags"))
+ ,@(for*/list ([(class flags) (*flags*)] [flag flags])
+ `(kbd ,(~a class) ":" ,(~a flag))))
+ (div ((id "changed-flags"))
+ ,@(if (null? (changed-flags))
+ '("default")
+ (for/list ([rec (changed-flags)])
+ (match-define (list delta class flag) rec)
+ `(kbd ,(match delta ['enabled "+o"] ['disabled "-o"])
+ " " ,(~a class) ":" ,(~a flag))))))))
+
+ (table ((id "results") (class ,(string-join (map ~a classes) " ")))
+ (thead
+ (tr ,@(for/list ([label table-labels])
+ (if (dict-has-key? help-text label)
+ `(th ,label " " (span ([class "help-button"] [title ,(dict-ref help-text label)]) "?"))
+ `(th ,label)))))
+ (tbody
+ ,@(for/list ([result tests] [id (in-naturals)])
+ `(tr ((class ,(~a (table-row-status result))))
+ (td ,(or (table-row-name result) ""))
+ (td ,(format-bits (table-row-start result)))
+ (td ,(format-bits (table-row-result result)))
+ (td ,(format-bits (table-row-target result)))
+ (td ,(let ([inf- (table-row-inf- result)])
+ (if (and inf- (> inf- 0)) (format "+~a" inf-) ""))
+ ,(let ([inf+ (table-row-inf+ result)])
+ (if (and inf+ (> inf+ 0)) (format "-~a" inf+) "")))
+ (td ,(format-time (table-row-time result)))
+ ,(if (table-row-link result)
+ `(td
+ (a ((id ,(format "link~a" id))
+ (href ,(format "~a/graph.html" (table-row-link result))))
+ "»"))
+ "")))))))
+ out))
diff --git a/src/web/report.css b/src/web/report.css
index 2d72fc920..0b4efb72b 100644
--- a/src/web/report.css
+++ b/src/web/report.css
@@ -1,6 +1,6 @@
/* Standard Herbie header */
-body { width: 800px; margin: 1em auto; font-family: sans; }
+body { width: 800px; margin: 0 auto; font-family: sans; line-height: 1.25; }
a {color: #2A6496; text-decoration: none; cursor: pointer}
a:hover {text-decoration: underline; color: #295785}
@@ -10,7 +10,7 @@ a:hover {text-decoration: underline; color: #295785}
#large .number { font-size: 3em; display: block; }
@media print { #large { margin-top: 0; }}
-/* Detail page layout */
+/* Arrow chart */
figure { float: left; margin: 0; }
#graph { cursor: pointer; }
@@ -26,8 +26,12 @@ figure { float: left; margin: 0; }
#graph.highlight-one .arrow {opacity: .5;}
#graph.highlight-one .arrow.highlight {opacity: 1;}
+/* Per-input badges */
+
#test-badges { cursor: pointer; list-style: none inside none; padding: 0; width: 300px; float: right; margin: 10px 0; font-size: 12pt; }
#test-badges li { height: 40px; line-height: 40px; width: 75px; float: left; text-align: center; }
+#test-badges a { color: black; }
+#test-badges a:hover { color: black; text-decoration: none; }
#test-badges li:hover { font-size: 15pt; }
#test-badges.highlight-one li { opacity: .333; }
#test-badges.highlight-one li.highlight { opacity: 1; }
@@ -42,16 +46,21 @@ li.eq-target {background-color: #87fc70;}
li.lt-target {background-color: #ffdb4c;}
li.eq-start {background-color: #ff9500;}
li.lt-start {background-color: #ff5e3a; color: #f7f7f7;}
-#test-badges li.crash {background-color:#ff9d87; color:#ed2b00; border: 2px solid #ff5e3a; width: 71px; height: 36px; line-height: 36px; }
-li.error {background-color: #4a4a4a; color: #f7f7f7;}
+#test-badges li.crash {
+ background-color: #ff9d87; color:#ed2b00; border: 2px solid #ff5e3a;
+ width: 71px; height: 36px; line-height: 36px;
+}
+#test-badges li.error {background-color: #4a4a4a; color: #f7f7f7;}
li.timeout {background-color: #8e8e93; color: #f7f7f7;}
-#about { margin: 3em auto; }
+/* Flag list / configuration */
+
+#about { margin: 3em 0; }
#about th { font-weight: bold; text-align: left; padding-right: 1em; }
#flag-list { position: relative; }
-#flag-list kbd:not(:last-child):after {content: ", ";}
-#flag-list a {float: right; margin: 0 .5em;}
+#flag-list kbd:not(:last-child):after { content: ", "; }
+#flag-list a { float: right; margin: 0 .5em; }
#flag-list a:before { content: "("; }
#flag-list a:after { content: ")"; }
#flag-list #changed-flags { display: none; }
@@ -59,11 +68,11 @@ li.timeout {background-color: #8e8e93; color: #f7f7f7;}
#flag-list.changed-flags #changed-flags { display: block; }
#flag-list.changed-flags #all-flags { display: none; }
+/* Table of results */
+
#results { border-collapse: collapse; width:100%; }
#results th { white-space: pre; }
#results td { text-align: right; padding: .5em; overflow: hidden; font-size: 15pt; }
-/* Removed because it was confusing and rarely useful */
-/*#results td.bad-est {border-right: 5px solid #c86edf;}*/
#results tbody tr:hover {background-color: #e0f8d8; cursor: pointer;}
#results a {
@@ -99,11 +108,177 @@ tr.timeout td:nth-child(3) {background-color:#8e8e93;color:#f7f7f7;}
#results.no-inf td:nth-child(5) {display: none;}
#results.no-inf th:nth-child(5) {display: none;}
+/* Help button */
+
.help-button {
display: inline-block; background: #888;
font-size: .8em; color: #eee; line-height: 1.3em;
height: 1.25em; width: 1.25em; border-radius: .625em;
- vertical-align: top;
+ vertical-align: top; text-align: center;
}
-
.help-button:hover { background: #444; cursor: pointer; }
+
+/* Links at the top */
+
+#links { border-bottom: 1px solid #ddd; line-height: 2; overflow: auto; }
+#links div:first-child { float: right; }
+#links a + a { margin-left: 1em; }
+
+/* Detail page layout */
+
+section { margin: 5em 0; position: relative; }
+@media print { section { margin: 3em 0; } }
+section h1 {
+ position: absolute; width: 300px; text-align: left; right: -340px; top: -15px;
+ transform: rotate(90deg); transform-origin: top left;
+ font-size: 24px; font-weight: normal; color: #aaa;
+}
+
+/* Warnings */
+
+.warnings { list-style: inside none; padding: 0; }
+.warnings > li {
+ margin: .25em 0; padding: .5em; background: #ffdb4c; border: 2px solid #ff9500;
+}
+.warnings h2 { font-size: 100%; font-weight: normal; margin: 0; }
+.warnings h2:before { content: "Warning: "; font-weight: bold; }
+.warnings h2 a { float: right; }
+.warnings ol { list-style: inside none; padding: 0 1em; }
+.warnings ol li { margin: .25em 0; }
+
+/* Big block for program input output */
+
+#program {
+ background: #ddd; text-align: center; font-size: 24px;
+ position: relative; padding: 1em;
+}
+@media print { #program { padding: 0; background: transparent; margin: 2em 0; } }
+#program .program { display: inline-block; text-align: left; }
+#program .arrow { color: transparent; font-size: 0; }
+#program .arrow:after { content: "↓"; color: black; font-size: 24px; }
+#program.horizontal .arrow { display: inline-block; }
+#program.horizontal .arrow:after { margin: 0 1em; content: "→"; font-size: 40px; }
+#language { position: absolute; right: 1em; }
+#precondition { padding: 0 1em 1em; margin: 0 -1em 1em; border-bottom: 2px solid white; }
+#precondition:before { content: "Precondition"; float: left; color: #444; }
+
+/* Error graphs */
+
+#graphs figure { margin: 1em auto; position: relative; padding-top: 300px; width: 800px; }
+#graphs figcaption { text-align: left; }
+#graphs figure img { position: absolute; top: 0; left: 0; }
+#graphs figcaption button {
+ float: right; margin: 0 .25em; cursor: pointer;
+ border: 3px solid black; background: gray; color: transparent;
+ height: 1.5em; width: 1.5em; border-radius: .75em;
+ overflow: hidden;
+}
+#graphs figcaption button.Result { border-color: blue; background: lightblue; }
+#graphs figcaption button.Target { border-color: green; background: lightgreen; }
+#graphs figcaption button.Input { border-color: red; background: pink; }
+#graphs figcaption button.inactive { background: white; }
+
+.tabbar { margin: -1.25em 0 0; padding: 0; list-style-type: none; list-style-position: inside; text-align: left; }
+.tabbar p { display: inline-block; margin: 0 .5em 0 0}
+.tabbar li { padding: .5ex; display: inline-block; margin: .1em; cursor: pointer; }
+.tabbar li:hover { background: #e4e4e4; }
+.tabbar li.selected { background: #d3d3d3; }
+
+/* Try it out section */
+
+#try-result output { font-size: 108%; margin: 0 .5em; float: right; }
+#try-result div { overflow: auto; }
+#try-result table { line-height: 1.5; margin-top: .25em; }
+#try-result { width: 39%; float: right; }
+#try-result p.header { margin: 0 0 .5em; font-size: 120%; color: #444; border-bottom: 1px solid #ccc; line-height: 1.5; }
+#try-result label:after { content: ":"; }
+
+#try-inputs-wrapper { width: 59%; display: inline-block; }
+
+#try-inputs ol { list-style: none; padding: 0; display: inline-block; margin: 0 0 0 -1em; }
+#try-inputs ol label { min-width: 4ex; text-align: right; margin-right: .5em; display: inline-block; }
+#try-inputs li { margin-left: 1em; display: inline-block; font-size: 110%; font-family: monospace; line-height: 2; }
+#try-inputs label:after { content: ":"; }
+#try-inputs input { padding: 1px 4px; width: 25ex; }
+#try-inputs p.header { margin: 0 0 .5em; font-size: 120%; color: #444; border-bottom: 1px solid #ccc; line-height: 1.5; }
+
+#try-error { color: red; font-size: 120%; display: none; }
+.error #try-error { display: block; }
+#try-result.error table { display: none; }
+
+/* Derivation */
+
+.history, .history ol { list-style: none inside; width: 800px; margin: 0 0 2em; padding: 0; }
+
+.history li p { width: 150px; display: inline-block; margin: 0 25px 0 0; }
+.history li .error { display: block; color: #666; }
+.history li > div { display: inline-block; margin: 0; width: 600px; vertical-align: middle; }
+.history li > div > div { margin: 0; display: inline-block; text-align: right !important; }
+
+.history h2 { margin: 1.333em 0 .333em; }
+.history li { margin: .5em 0; border-top: 1px solid #ddd; padding-top: .5em; }
+.history li:first-child { border-top: none; padding-top: 0; }
+.history .rule { text-decoration: underline; }
+.history .event { display: block; margin: .5em 0; }
+
+/* Process / debug info */
+
+#process-info { background: #ddd; }
+#process-info p.header { font-size: 110%; padding: 1em 1em .5em; margin: 0; }
+#process-info p.header .attachment { float: right; margin: 0 0 0 1em; }
+#process-info > p { margin: 1em .75em 0; }
+
+.timeline { height: 2em; border: 1px solid #888; border-width: 1px 0px; margin-bottom: 1em; }
+.timeline-phase { height: 2em; border-left-style: solid; display: inline-block;}
+@media print {
+ .timeline { border: none; }
+ .timeline-phase { outline: 1px solid black; }
+}
+
+/* Blocks of information */
+
+.timeline-block { border-left: 1ex solid transparent; padding: 1px 1ex;}
+.timeline-block h3 { margin: 0; font-size: 110%; font-weight: normal; }
+.timeline-block p { margin: 0; }
+.timeline-block h3 .time { float: right; }
+
+.timeline-block dl { font-size: 90%; }
+.timeline-block dt { min-width: 6em; float: left; font-size: 100%; }
+.timeline-block dd { margin: 0 0 1ex 6em; max-width: 100%; overflow: auto; }
+table.times { border-spacing: 15px 5px; }
+table th { text-align: left; }
+table.times td { text-align: right; min-width: 8ex; vertical-align: baseline; }
+table.times td:last-child { text-align: left; }
+table pre { padding: 0; margin: 0; text-align: left; font-size: 110%; }
+
+/* Timeline colors */
+
+.timeline-sample { border-left-color: #edd400; }
+.timeline-localize { border-left-color: #729fcf; }
+.timeline-series { border-left-color: #fcaf3e; }
+.timeline-rewrite { border-left-color: #8f5902; }
+.timeline-simplify { border-left-color: #8ae234; }
+.timeline-prune { border-left-color: #ad7fa8; }
+.timeline-regimes { border-left-color: #a40000; }
+.timeline-bsearch { border-left-color: #8c0000; }
+
+/* Code sample to reproduce */
+
+#reproduce pre { padding: 1em; margin: 0; font-family: monospace; overflow-x: auto; }
+pre.shell code:before { content: "$ "; font-weight: bold; }
+
+/* Target / expected code block */
+
+#comparison table { width: 300px; display: inline-table; vertical-align: top; }
+#comparison table th { text-align: left; }
+#comparison table td { text-align: right; }
+#comparison div { display: inline-block; width: 500px; }
+
+/* Formatting backtraces */
+
+#backtrace table { width: 100%; }
+#backtrace th[colspan] { text-align: left; }
+#backtrace th { text-align: right; }
+#backtrace td:nth-child(3), #backtrace td:nth-child(4) { text-align: right; }
+#backtrace td.procedure { font-family: monospace; }
+
diff --git a/src/web/report.js b/src/web/report.js
index 2c088e99e..67cbfd616 100644
--- a/src/web/report.js
+++ b/src/web/report.js
@@ -1,21 +1,42 @@
-function toggle_flag_list() {
- var flags = document.getElementById("flag-list");
- flags.classList.toggle("changed-flags");
- var changed_only = flags.classList.contains("changed-flags");
- var button = document.getElementById("flag-list-toggle");
- button.innerText = changed_only ? "see all" : "see diff";
+window.COMPONENTS = []
+
+function Component(selector, fns) {
+ this.selector = selector;
+ this.fns = fns;
+ window.COMPONENTS.push(this);
}
-function togglable_flags() {
- var flags = document.getElementById("flag-list");
- flags.classList.add("changed-flags");
- var button = document.createElement("a");
- button.setAttribute("id", "flag-list-toggle");
- button.innerText = "see all";
- button.addEventListener("click", toggle_flag_list);
- flags.insertBefore(button, flags.children[0]);
+function ComponentInstance(elt, component) {
+ for (var i in component.fns) {
+ if (component.fns.hasOwnProperty(i)) {
+ this[i] = component.fns[i].bind(this);
+ }
+ }
+ this.elt = elt;
}
+var TogglableFlags = new Component("#flag-list", {
+ setup: function() {
+ this.elt.classList.add("changed-flags");
+ this.button = document.createElement("a");
+ this.button.setAttribute("id", "flag-list-toggle");
+ this.button.innerText = "see all";
+ this.button.addEventListener("click", this.toggle);
+ this.elt.insertBefore(this.button, this.elt.children[0]);
+ },
+ toggle: function() {
+ this.elt.classList.toggle("changed-flags");
+ var changed_only = this.elt.classList.contains("changed-flags");
+ this.button.innerText = changed_only ? "see all" : "see diff";
+ }
+});
+
+var Figure = new Component("#graphs figure", {
+ setup: function() {
+ setup_figure(this.elt);
+ },
+});
+
function figure_names(figure) {
var imgs = figure.querySelectorAll("img");
var names = {};
@@ -55,6 +76,47 @@ function setup_figure(figure) {
}
}
+var TryIt = new Component("#try-it", {
+ depends: function() {
+ if (typeof window.start === "undefined") throw "start() function not defined";
+ if (typeof window.end === "undefined") throw "end() function not defined";
+ },
+ setup: function() {
+ this.origOut = this.elt.querySelector("#try-original-output");
+ this.herbieOut = this.elt.querySelector("#try-herbie-output");
+ this.result = this.elt.querySelector("#try-result");
+ this.inputs = this.elt.querySelectorAll("#try-inputs input");
+ this.submit();
+ for (var i = 0; i < this.inputs.length; i++) {
+ this.inputs[i].addEventListener("input", this.submit);
+ }
+ },
+ submit: function() {
+ var values = [];
+ for (var i = 0; i < this.inputs.length; i++) {
+ var val = parseFloat(this.inputs[i].value);
+ if (isNaN(val)) {
+ if (this.inputs[i].value.length != 0) {
+ // Don't update error message if there is no input
+ this.result.className = 'error'
+ }
+ return;
+ } else {
+ this.result.className = 'no-error'
+ values.push(val);
+ }
+ }
+ this.origOut.innerHTML = start.apply(null, values);
+ this.herbieOut.innerHTML = end.apply(null, values);
+ },
+});
+
+var FigureTabs = new Component("#graphs > div", {
+ setup: function() {
+ setup_figure_tabs(this.elt);
+ },
+});
+
function select_tab(id) {
var tab = document.getElementById("tab-" + id);
var pane = document.getElementById(id);
@@ -70,28 +132,6 @@ function select_tab(id) {
pane.style.display = "block";
}
-function submit_inputs() {
- var originalOutputElem = document.querySelector('#try-original-output');
- var herbieOutputElem = document.querySelector('#try-herbie-output');
- var inputs = document.querySelectorAll('#try-inputs input');
- var inputVals = [];
- for (var i = 0; i < inputs.length; i++) {
- var val = parseFloat(inputs[i].value);
- if (isNaN(val)) {
- if (inputs[i].value.length != 0) {
- // Don't update error message if there is no input
- document.querySelector('#try-result').className = 'error'
- }
- return;
- } else {
- document.querySelector('#try-result').className = 'no-error'
- inputVals.push(val);
- }
- }
- originalOutputElem.innerHTML = start.apply(null, inputVals);
- herbieOutputElem.innerHTML = end.apply(null, inputVals);
-}
-
function setup_figure_tabs(figure_container) {
var figures = figure_container.getElementsByTagName("figure");
var figure_array = {};
@@ -104,7 +144,7 @@ function setup_figure_tabs(figure_container) {
figures[i].style.display = "none";
figures[i].querySelector("figcaption > p").style.display = "none";
}
- if (default_figure === null) default_figure = figures[0].id;
+ if (default_figure === null && figures.length > 0) default_figure = figures[0].id;
var tab_bar = document.createElement("ul");
tab_bar.classList.add("tabbar");
@@ -122,56 +162,147 @@ function setup_figure_tabs(figure_container) {
tab_bar.appendChild(tab_button);
}
- select_tab(default_figure);
+ if (default_figure) select_tab(default_figure);
}
-function setup_timeline() {
- var ts = document.getElementsByClassName("timeline-phase");
- var total_time = 0;
- for (var i = 0; i < ts.length; i++) {
- total_time += +ts[i].getAttribute("data-timespan");
- }
- for (var i = 0; i < ts.length; i++) {
- ts[i].style.width = (+ts[i].getAttribute("data-timespan")) / total_time * 100 + "%";
- ts[i].title = ts[i].getAttribute("data-type");
- }
-}
+var RenderMath = new Component(".math", {
+ depends: function() {
+ if (typeof window.renderMathInElement === "undefined") throw "KaTeX unavailable";
+ },
+ setup: function() {
+ renderMathInElement(this.elt);
+ },
+});
-function setup_program_arrow() {
- var progelt = document.getElementById("program");
- var progs = progelt.getElementsByClassName("program");
- var arrs = progelt.getElementsByClassName("arrow");
+var Timeline = new Component(".timeline", {
+ setup: function() {
+ var ts = this.elt.querySelectorAll(".timeline-phase");
+ var total_time = 0;
+ for (var i = 0; i < ts.length; i++) {
+ total_time += +ts[i].getAttribute("data-timespan");
+ }
+ var total_width = ts[0].parentNode.offsetWidth;
+ for (var i = 0; i < ts.length; i++) {
+ ts[i].style.borderLeftWidth = (+ts[i].getAttribute("data-timespan")) / total_time * total_width + "px";
+ var s = ts[i].getAttribute("data-type") + " (" + Math.round(+ts[i].getAttribute("data-timespan")/100)/10 + "s)";
+ ts[i].title = s;
+ }
+ }
+});
- progelt.classList.add("horizontal");
- var progBot = progs[0].offsetTop + progs[0].offsetHeight;
- for (var i in progs) {
- if (progs[i].offsetTop >= progBot) {
- return progelt.classList.remove("horizontal");
+var Implementations = new Component("#program", {
+ setup: function() {
+ this.dropdown = this.elt.querySelector("select");
+ this.programs = this.elt.querySelectorAll(".implementation");
+ this.elt.addEventListener("change", this.change);
+ this.change();
+ },
+ change: function() {
+ var lang = this.dropdown.options[this.dropdown.selectedIndex].text;
+ for (var i = 0; i < this.programs.length; i++) {
+ var $prog = this.programs[i];
+ if ($prog.dataset["language"] == lang) {
+ $prog.style.display = "block";
+ this.arrow($prog);
+ } else {
+ $prog.style.display = "none";
+ }
}
+ },
+ arrow: function($prog) {
+ var progs = $prog.querySelectorAll(".program");
+ $prog.classList.add("horizontal");
+ for (var i = 0; i < progs.length; i++) {
+ var progBot = progs[i].offsetTop + progs[i].offsetHeight;
+ if (progs[i].offsetTop >= progBot) {
+ return $prog.classList.remove("horizontal");
+ }
+ }
+ },
+});
+
+function histogram(id, data) {
+ var width = 676;
+ var height = 60
+ var margin = 5;
+ var labels = 10;
+ var ticks = 5;
+ var bucketwidth = 25;
+
+ var canvas = document.getElementById(id);
+ if (data.length == 0) { return canvas.remove(); } // Early exit
+
+ canvas.setAttribute("width", margin + width + margin + "px");
+ canvas.setAttribute("height", labels + margin + height + ticks + margin + labels + "px");
+ var ctx = canvas.getContext("2d");
+
+ ctx.beginPath();
+ ctx.strokeStyle = "black";
+ ctx.moveTo(margin, labels + margin + height);
+ ctx.lineTo(margin + width, labels + margin + height);
+ ctx.stroke();
+
+ var xma = Math.max.apply(null, data);
+
+ var buckets = Array(Math.round(width / bucketwidth));
+ var sum = 0;
+ buckets.fill(0);
+ for (var i = 0; i < data.length; i++) {
+ var j = Math.floor(data[i] / xma * buckets.length);
+ buckets[Math.min(j, buckets.length-1)] += data[i];
+ sum += data[i];
+ }
+ var yma = Math.max.apply(null, buckets);
+
+ ctx.fillStyle = "rgba(0, 0, 0, .2)";
+ for (var i = 0; i < buckets.length; i++) {
+ ctx.fillRect(margin + i/buckets.length*width, labels + margin + height, width/buckets.length, -height*buckets[i]/yma);
}
-}
-function load_graph() {
- var figs = document.querySelectorAll("#graphs figure");
- for (var i = 0; i < figs.length; i++) {
- setup_figure(figs[i]);
+ ctx.fillStyle = "black";
+ ctx.textBaseline = "bottom";
+ ctx.textAlign = "center";
+ for (var i = 0; i < buckets.length; i++) {
+ ctx.fillText(Math.round(buckets[i] / sum * 100) + "%", margin + (i + .5)/buckets.length * width, labels + height*(1 - buckets[i]/yma));
+ }
+
+ ctx.textBaseline = "top";
+ var step = Math.pow(10, Math.round(Math.log10(xma)) - 1);
+ if (xma / step > 20) step *= 2;
+ if (xma / step < 10) step /= 2;
+ for (var i = 0; i < 10 * Math.sqrt(10); i++) {
+ var pos = i * step;
+ if (pos > yma) break;
+ ctx.beginPath();
+ ctx.moveTo(pos / xma * width + margin, labels + margin + height);
+ ctx.lineTo(pos / xma * width + margin, labels + margin + height + ticks);
+ ctx.fillText(pos, pos / xma * width + margin, labels + margin + height + ticks + margin);
+ ctx.stroke();
}
- setup_figure_tabs(document.querySelector("#graphs div"));
- setup_timeline();
- // Run the program_arrow after rendering happens
- MathJax.Hub.Queue(setup_program_arrow);
- // Submit the default vals in the "Try it out" section
- submit_inputs()
}
-function load_report() {
- togglable_flags();
-}
+function run_components() {
+ for (var i = 0; i < window.COMPONENTS.length; i++) {
+ var component = window.COMPONENTS[i];
+ var elts = document.querySelectorAll(component.selector);
-function load_index() {
- // Nothing
+ try {
+ if (elts.length > 0 && component.fns.depends) component.fns.depends();
+ } catch (e) {
+ console.error(e);
+ continue;
+ }
+
+ for (var j = 0; j < elts.length; j++) {
+ var instance = new ComponentInstance(elts[j], component);
+ console.log("Initiating", component.selector, "component at", elts[j]);
+ try {
+ instance.setup();
+ } catch (e) {
+ console.error(e);
+ }
+ }
+ }
}
-function report() {load_report();}
-function graph() {load_graph();}
-function index() {load_index();}
+window.addEventListener("load", run_components);
diff --git a/src/web/run.rkt b/src/web/run.rkt
new file mode 100644
index 000000000..498960f3e
--- /dev/null
+++ b/src/web/run.rkt
@@ -0,0 +1,57 @@
+#lang racket
+
+(require "../common.rkt" "../formats/test.rkt" "../formats/datafile.rkt")
+(require "make-report.rkt" "thread-pool.rkt" "timeline.rkt")
+
+(provide make-report rerun-report)
+
+(define (make-report bench-dirs #:dir dir #:profile profile? #:debug debug? #:note note #:threads threads)
+ (define tests (reverse (sort (append-map load-tests bench-dirs) test)))
+ (run-tests tests #:dir dir #:profile profile? #:debug debug? #:note note #:threads threads))
+
+(define (rerun-report json-file #:dir dir #:profile profile? #:debug debug? #:note note #:threads threads)
+ (define data (read-datafile json-file))
+ (define tests
+ (for/list ([row (report-info-tests data)])
+ (test (table-row-name row) (table-row-vars row)
+ (table-row-input row) (table-row-output row) #f (table-row-pre row))))
+ (*flags* (report-info-flags data))
+ (set-seed! (report-info-seed data))
+ (*num-points* (report-info-points data))
+ (*num-iterations* (report-info-iterations data))
+ (run-tests tests #:dir dir #:profile profile? #:debug debug? #:note note #:threads threads))
+
+(define (run-tests tests #:dir dir #:profile profile? #:debug debug? #:note note #:threads threads)
+ (define seed (get-seed))
+ (when (not (directory-exists? dir)) (make-directory dir))
+
+ (define results
+ (get-test-results tests #:threads threads #:seed seed #:profile profile? #:debug debug? #:dir dir))
+ (define info (make-report-info (filter values results) #:note note #:seed seed))
+
+ (write-datafile (build-path dir "results.json") info)
+ (call-with-output-file (build-path dir "timeline.html")
+ #:exists 'replace (curryr make-summary-html info dir))
+ (copy-file (web-resource "report.js") (build-path dir "report.js") #t)
+ (copy-file (web-resource "report.css") (build-path dir "report.css") #t)
+ (copy-file (web-resource "arrow-chart.js") (build-path dir "arrow-chart.js") #t)
+ (call-with-output-file (build-path dir "results.html")
+ #:exists 'replace (curryr make-report-page info))
+
+ ; Delete old files
+ (let* ([expected-dirs (map string->path (filter identity (map table-row-link (report-info-tests info))))]
+ [actual-dirs (filter (λ (name) (directory-exists? (build-path dir name))) (directory-list dir))]
+ [extra-dirs (filter (λ (name) (not (member name expected-dirs))) actual-dirs)])
+ (for ([subdir extra-dirs])
+ (with-handlers ([exn:fail:filesystem? (const true)])
+ (delete-directory/files (build-path dir subdir))))))
+
+(define (test t1 t2)
+ (cond
+ [(and (test-output t1) (test-output t2))
+ (string (test-name t1) (test-name t2))]
+ [(and (not (test-output t1)) (not (test-output t2)))
+ (string (test-name t1) (test-name t2))]
+ [else
+ ; Put things with an output first
+ (test-output t1)]))
diff --git a/src/web/session.rkt b/src/web/session.rkt
deleted file mode 100644
index 5515ed1ae..000000000
--- a/src/web/session.rkt
+++ /dev/null
@@ -1,153 +0,0 @@
-#lang racket
-
-;;======== Dependencies ===========
-(require "../common.rkt")
-(require "../glue.rkt")
-(require "../float.rkt")
-(require "../points.rkt")
-(require "../programs.rkt")
-(require "../alternative.rkt")
-(require "../core/localize.rkt")
-
-(require "tools.rkt")
-
-;;========= Structures and Parameters ===========
-(struct sdat (alts pcontext pcontext-extended children locations chosen-alt-idx cur-combo best-axis first-time?))
-(define (sdat-chosen-alt data)
- (list-ref (sdat-alts data) (sdat-chosen-alt-idx data)))
-
-(define *graph-name* (make-parameter "graph.png"))
-
-;;========= Top Level Interface ============
-(provide start-session select-location choose-children pick-next finish)
-
-;; Starts a session with the herbie-web-viz. Returns a list of two
-;; things: a table of objects to respond with mapped to their names,
-;; and a session-data object representing the state of their session.
-(define (start-session prog)
- (parameterize ([*start-prog* prog])
- (define pcontext-extended (parameterize ([*num-points* 1024]) (prepare-points prog 'TRUE)))
- (define pcontext (random-subsample pcontext-extended 64))
- (parameterize ([*pcontext* pcontext] [*analyze-context* pcontext])
- (define alt (simplify-alt (make-alt prog)))
- (define locs (get-locs alt))
- ;; The axis finding procedure is stochastic, and is a lot more
- ;; reliable if you use the full point set.
- (define axis (find-best-axis alt pcontext-extended))
- (define session-data (sdat (list alt) pcontext pcontext-extended '() locs 0 alt axis #t))
- (define response
- (hash
- 'formula (texify-formula (program-body (alt-program alt)) locs)
- 'error_graph "&embedimage{0}"
- 'axis_label (symbol->string axis)
- 'loc_ranges (make-ranges pcontext alt locs axis)))
- (define images (list (graph-error pcontext-extended alt axis)))
- (values response images session-data))))
-
-;; Starts phase two, candidate selection. Takes the session from the
-;; session, and a location to improve at, and returns two values: the
-;; content table to send back to the user as specified above, and the
-;; new session state.
-(define (select-location data location-idx)
- (let ([loc (list-ref (sdat-locations data) location-idx)]
- [alt (sdat-chosen-alt data)]
- [pcontext-extended (sdat-pcontext-extended data)]
- [cur-combo (sdat-cur-combo data)])
- (define children (parameterize ([*pcontext* (sdat-pcontext data)])
- (expand-at-loc alt loc)))
- (define response
- (hash
- 'selected_formula (texify-formula (program-body (alt-program alt)) (list loc))
- 'calts (for/list ([child children] [idx (in-naturals)])
- (hash
- 'steps (make-steps child alt)
- 'graph (format "&embedimage{~a}" idx)
- 'id idx))))
- (define images (for/list ([child children])
- (graph-error pcontext-extended child
- (sdat-best-axis data) cur-combo
- #:first-time (sdat-first-time? data)
- #:children? #t)))
- (define session-data (sdat (sdat-alts data)
- (sdat-pcontext data) pcontext-extended
- children
- (list loc)
- (sdat-chosen-alt-idx data)
- cur-combo
- (sdat-best-axis data)
- (sdat-first-time? data)))
- (values response
- images
- session-data)))
-
-;; Starts phase three, choosing the next alt to work on. Takes in
-;; addition to session data a list of indicies into the list of
-;; children to keep. Returns as above.
-(define (choose-children data child-idxs)
- (let* ([alts*
- (remove-duplicates
- (append (sdat-alts data)
- (for/list ([idx child-idxs])
- (list-ref (sdat-children data) idx)))
- #:key alt-program)]
- [pcontext* (sdat-pcontext data)]
- [pcontext-extended* (sdat-pcontext-extended data)]
- [children* '()]
- [locations* '()]
- [chosen-alt-idx* '()]
- [cur-combo* (parameterize ([*pcontext* (random-subsample pcontext-extended* 128)])
- (make-combo alts* (sdat-best-axis data)))]
- [best-axis* (sdat-best-axis data)])
- (define session-data
- (sdat alts* pcontext* pcontext-extended* children* locations*
- chosen-alt-idx* cur-combo* best-axis* (sdat-first-time? data)))
- (define response
- (hash
- 'combo_graph "&embedimage{0}"
- 'candidates (for/list ([alt alts*] [image-idx (in-naturals 1)])
- (hash
- 'id (sub1 image-idx)
- 'formula (texify-formula (program-body (alt-program alt)))
- 'graph (format "&embedimage{~a}" image-idx)))))
- (define images
- (cons (graph-error pcontext-extended* cur-combo* best-axis* #t)
- (for/list ([alt alts*])
- (graph-error pcontext-extended* alt best-axis* cur-combo*))))
- (values response images session-data)))
-
-;; Ends phase three and starts over, by picking the next candidate to
-;; work on. Takes a candidate index of the candidate to work on, and
-;; returns as above.
-(define (pick-next data cand-idx)
- (let ([alt (list-ref (sdat-alts data) cand-idx)]
- [pcontext (sdat-pcontext data)]
- [pcontext-extended (sdat-pcontext-extended data)]
- [axis (sdat-best-axis data)]
- [combo (sdat-cur-combo data)])
- (parameterize ([*pcontext* pcontext]
- [*analyze-context* pcontext])
- (let([locs* (get-locs alt)])
- (define session-data
- (sdat (sdat-alts data) pcontext pcontext-extended
- '() locs* cand-idx
- combo axis
- #f))
- (define response
- (hash
- 'formula (texify-formula (program-body (alt-program alt)) locs*)
- 'error_graph "&embedimage{0}"
- 'axis_label (symbol->string axis)
- 'loc_ranges (make-ranges pcontext alt locs* axis)))
- (define images
- (list (graph-error (sdat-pcontext-extended data) alt axis combo)))
- (values response images session-data)))))
-
-(define (finish data)
- (let ([final-combo (parameterize ([*pcontext* (random-subsample (sdat-pcontext-extended data) 256)])
- (make-combo (sdat-alts data) (sdat-best-axis data)))])
- (define response
- (hash
- 'formula (texify-formula (program-body (alt-program final-combo)))))
- (define images
- (list (graph-error (sdat-pcontext-extended data) final-combo (sdat-best-axis data) #t)))
- (values response images data)))
diff --git a/src/web/thread-pool.rkt b/src/web/thread-pool.rkt
new file mode 100644
index 000000000..f1b97014b
--- /dev/null
+++ b/src/web/thread-pool.rkt
@@ -0,0 +1,165 @@
+#lang racket
+
+(require racket/place profile)
+(require "../common.rkt" "../points.rkt" "../programs.rkt")
+(require "../sandbox.rkt" "make-graph.rkt" "../formats/test.rkt" "../formats/datafile.rkt")
+
+(provide get-test-results)
+
+(define (graph-folder-path tname index)
+ (format "~a-~a" index (string-prefix (string-replace tname #px"\\W+" "") 50)))
+
+(define (run-test index test #:seed seed #:profile profile? #:debug debug? #:dir dir)
+ (cond
+ [dir
+ (define dirname
+ (format "~a-~a" index (string-prefix (string-replace (test-name test) #px"\\W+" "") 50)))
+
+ (define rdir (build-path dir dirname))
+ (when (not (directory-exists? rdir)) (make-directory rdir))
+
+ (define result
+ (call-with-output-files
+ (list (build-path rdir "debug.txt") (and profile? (build-path rdir "profile.txt")))
+ (λ (dp pp) (get-test-result test #:seed seed #:profile pp #:debug debug? #:debug-port dp #:debug-level (cons #t #t)))))
+
+ (set-seed! seed)
+ (for ([page (all-pages result)])
+ (call-with-output-file (build-path rdir page)
+ #:exists 'replace
+ (λ (out) (make-page page out result profile?))))
+
+ (get-table-data result dirname)]
+ [else
+ (define result (get-test-result test #:seed seed))
+ (get-table-data result "")]))
+
+(define (make-worker)
+ (place ch
+ (let loop ([seed #f] [profile? #f] [debug? #f] [dir #f])
+ (match (place-channel-get ch)
+ [`(init
+ rand ,vec
+ flags ,flag-table
+ num-iters ,iterations
+ points ,points
+ profile? ,profile
+ debug? ,debug
+ dir ,path
+ timeout ,timeout
+ reeval ,reeval)
+
+ (set! seed vec)
+ (set! profile? profile)
+ (set! debug? debug)
+ (set! dir path)
+ (*flags* flag-table)
+ (*num-iterations* iterations)
+ (*num-points* points)
+ (*timeout* timeout)
+ (*reeval-pts* reeval)]
+ [`(apply ,self ,id ,test)
+ (let ([result (run-test id test #:seed seed #:profile profile? #:debug debug? #:dir dir)])
+ (place-channel-put ch
+ `(done ,id ,self ,result)))])
+ (loop seed profile? debug? dir))))
+
+(define (print-test-result i n data)
+ (eprintf "~a/~a\t" (~a i #:width 3 #:align 'right) n)
+ (match (table-row-status data)
+ ["error"
+ (eprintf "[ ERROR ]\t\t~a\n" (table-row-name data))]
+ ["crash"
+ (eprintf "[ CRASH ]\t\t~a\n" (table-row-name data))]
+ ["timeout"
+ (eprintf "[ TIMEOUT]\t\t~a\n" (table-row-name data))]
+ [_
+ (eprintf "[ ~as] ~a→~a\t~a\n"
+ (~r (/ (table-row-time data) 1000) #:min-width 7 #:precision '(= 3))
+ (~r (table-row-start data) #:min-width 2 #:precision 0)
+ (~r (table-row-result data) #:min-width 2 #:precision 0)
+ (table-row-name data))]))
+
+(define (run-workers progs threads #:seed seed #:profile profile? #:debug debug? #:dir dir)
+ (define config
+ `(init rand ,seed
+ flags ,(*flags*)
+ num-iters ,(*num-iterations*)
+ points ,(*num-points*)
+ profile? ,profile?
+ debug? ,debug?
+ dir ,dir
+ timeout ,(*timeout*)
+ reeval ,(*reeval-pts*)))
+
+ (define workers
+ (for/list ([wid (in-range threads)])
+ (define worker (make-worker))
+ (place-channel-put worker config)
+ worker))
+
+ (define work
+ (for/list ([id (in-naturals)] [prog progs])
+ (list id prog)))
+
+ (eprintf "Starting ~a Herbie workers on ~a problems (seed: ~a)...\n" threads (length progs) seed)
+ (for ([worker workers])
+ (place-channel-put worker `(apply ,worker ,@(car work)))
+ (set! work (cdr work)))
+
+ (define outs
+ (let loop ([out '()])
+ (with-handlers ([exn:break?
+ (λ (_)
+ (eprintf "Terminating after ~a problem~a!\n"
+ (length out) (if (= (length out) 1) "" "s"))
+ out)])
+ (match-define `(done ,id ,more ,tr) (apply sync workers))
+
+ (when (not (null? work))
+ (place-channel-put more `(apply ,more ,@(car work)))
+ (set! work (cdr work)))
+
+ (define out* (cons (cons id tr) out))
+
+ (print-test-result (length out*) (length progs) tr)
+
+ (if (= (length out*) (length progs))
+ out*
+ (loop out*)))))
+
+ (map place-kill workers)
+
+ outs)
+
+(define (run-nothreads progs #:seed seed #:profile profile? #:debug debug? #:dir dir)
+ (eprintf "Starting Herbie on ~a problems (seed: ~a)...\n" (length progs) seed)
+ (define out '())
+ (with-handlers ([exn:break?
+ (λ (_)
+ (eprintf "Terminating after ~a problem~a!\n"
+ (length out) (if (= (length out) 1) "s" "")))])
+ (for ([test progs] [i (in-naturals)])
+ (define tr (run-test i test #:seed seed #:profile profile? #:debug debug? #:dir dir))
+ (print-test-result (+ 1 i) (length progs) tr)
+ (set! out (cons (cons i tr) out))))
+ out)
+
+(define/contract (get-test-results progs #:threads threads #:seed seed #:profile profile? #:debug debug? #:dir dir)
+ (-> (listof test?) #:threads (or/c #f natural-number/c)
+ #:seed (or/c pseudo-random-generator-vector? (integer-in 0 (sub1 (expt 2 31))))
+ #:profile boolean? #:debug boolean? #:dir (or/c #f path-string?)
+ (listof (or/c #f table-row?)))
+ (when (and threads (> threads (length progs)))
+ (set! threads (length progs)))
+
+ (define outs
+ (if threads
+ (run-workers progs threads #:seed seed #:profile profile? #:debug debug? #:dir dir)
+ (run-nothreads progs #:seed seed #:profile profile? #:debug debug? #:dir dir)))
+
+ (define out (make-vector (length progs) #f))
+ (for ([(idx result) (in-dict outs)])
+ (vector-set! out idx result))
+
+ (vector->list out))
diff --git a/src/web/timeline.rkt b/src/web/timeline.rkt
new file mode 100644
index 000000000..e9a7d7864
--- /dev/null
+++ b/src/web/timeline.rkt
@@ -0,0 +1,317 @@
+#lang racket
+(require json (only-in xml write-xexpr xexpr?))
+(require "../common.rkt" "../formats/test.rkt" "../sandbox.rkt" "../formats/datafile.rkt" "common.rkt" "../float.rkt")
+(provide make-timeline make-timeline-json make-summary-html)
+
+(define timeline-phase? (hash/c symbol? any/c))
+(define timeline? (listof timeline-phase?))
+
+;; This first part handles timelines for a single Herbie run
+
+(define (make-timeline result out)
+ (match-define (test-result test bits fulltime timeline warnings) result)
+ (unless (andmap (curryr hash-has-key? 'time) timeline)
+ (pretty-print timeline))
+
+ (define time
+ (apply + (for/list ([phase timeline] [next (cdr timeline)])
+ (- (dict-ref next 'time) (dict-ref phase 'time)))))
+
+ (fprintf out "\n")
+ (write-xexpr
+ `(html
+ (head
+ (meta ([charset "utf-8"]))
+ (title "Metrics for " ,(~a (test-name test)))
+ (link ([rel "stylesheet"] [type "text/css"] [href "../report.css"]))
+ (script ([src "../report.js"])))
+ (body
+ ,(render-menu '() '(("Report" . "graph.html")))
+ (section ((id "process-info"))
+ (h1 "Details")
+ (p ((class "header"))
+ "Time bar (total: " (span ((class "number")) ,(format-time time)) ")")
+ ,(render-timeline timeline)
+ ,@(for/list ([curr timeline] [n (in-naturals)] [next (cdr timeline)])
+ (render-phase curr n next)))))
+ out))
+
+(define/contract (render-timeline timeline)
+ (-> timeline? xexpr?)
+ `(div ((class "timeline"))
+ ,@(for/list ([curr timeline] [n (in-naturals)] [next (cdr timeline)])
+ `(div
+ ([class ,(format "timeline-phase timeline-~a" (dict-ref curr 'type))]
+ [data-id ,(format "timeline~a" n)]
+ [data-type ,(~a (dict-ref curr 'type))]
+ [data-timespan ,(~a (- (dict-ref next 'time) (dict-ref curr 'time)))])
+ ))))
+
+(define/contract (render-phase curr n next)
+ (-> timeline-phase? integer? timeline-phase? xexpr?)
+ `(div ([class ,(format "timeline-block timeline-~a" (dict-ref curr 'type))]
+ [id ,(format "timeline~a" n)])
+ (h3 ,(~a (dict-ref curr 'type))
+ (span ([class "time"])
+ ,(format-time (- (dict-ref next 'time) (dict-ref curr 'time)))))
+ (dl
+ ,@(dict-call curr #:default '() render-phase-method 'method)
+ ,@(dict-call curr #:default '() render-phase-locations 'locations)
+ ,@(dict-call curr #:default '() render-phase-accuracy 'accuracy 'oracle 'baseline)
+ ,@(dict-call curr #:default '() render-phase-pruning 'kept-alts 'done-alts 'min-error)
+ ,@(dict-call curr #:default '() render-phase-rules 'rules)
+ ,@(dict-call curr #:default '() render-phase-counts 'inputs 'outputs)
+ ,@(dict-call curr #:default '() render-phase-times 'times #:extra (list n))
+ ,@(dict-call curr #:default '() render-phase-bstep 'bstep)
+ ,@(dict-call curr #:default '() render-phase-egraph 'egraph)
+ ,@(dict-call curr #:default '() render-phase-outcomes 'outcomes))))
+
+(define (dict-call d f #:default [default #f] #:extra [extra '()] . args)
+ (if (andmap (curry dict-has-key? d) args)
+ (apply f (append extra (map (curry dict-ref d) args)))
+ default))
+
+(define (render-phase-method method)
+ `((dt "Algorithm") (dd ,(~a method))))
+
+(define (render-phase-locations locations)
+ `((dt "Local error")
+ (dd (p "Found " ,(~a (length locations)) " expressions with local error:")
+ (table ([class "times"])
+ ,@(for/list ([(expr err) (in-dict locations)])
+ `(tr (td ,(format-bits (car err)) "b") (td (pre ,(~a expr)))))))))
+
+(define (render-phase-bstep iters)
+ `((dt "Steps")
+ (dd (table ([class "times"])
+ (tr (th "Iters") (th ([colspan "2"]) "Range") (th "Point"))
+ ,@(for/list ([iter iters])
+ (match-define (list v1 v2 iters pt) iter)
+ `(tr (td ,(~a iters))
+ (td (pre ,(~a v1))) (td (pre ,(~a v2)))
+ (td (pre ,(~a pt)))))))))
+
+(define (render-phase-egraph iters)
+ `((dt "Iterations")
+ (dd (table ([class "times"])
+ (tr (th "Iter") (th "Nodes"))
+ ,@(for/list ([iter iters])
+ `(tr (td ,(~a (car iter)))
+ (td ,(~a (second iter)))))))))
+
+
+(define (render-phase-accuracy accuracy oracle baseline)
+ (define percentage
+ (if (= baseline oracle)
+ (if (= baseline accuracy) "100" "-∞")
+ (~r (* (/ (- baseline accuracy) (- baseline oracle)) 100) #:precision 1)))
+
+ `((dt "Accuracy")
+ (dd (p ,percentage "% (" ,(format-bits (- accuracy oracle)) "b" " remaining)")
+ (p "Error of " ,(format-bits accuracy) "b"
+ " against oracle of " ,(format-bits oracle) "b"
+ " and baseline of " ,(format-bits baseline) "b"))))
+
+(define (render-phase-pruning kept-alts done-alts min-error)
+ `((dt "Pruning")
+ (dd (p ,(~a (+ kept-alts done-alts)) " alts after pruning (" ,(~a kept-alts) " fresh and " ,(~a done-alts) " done)")
+ (p "Merged error: " ,(format-bits min-error) "b"))))
+
+(define (render-phase-rules rules)
+ (define counts (make-hash))
+ (for ([(rule count) (in-dict rules)])
+ (dict-update! counts count (curry cons rule) '()))
+
+ `((dt "Rules")
+ (dd (table ([class "times"])
+ ,@(for/list ([(count rules) (in-dict (sort (hash->list counts) > #:key car))])
+ `(tr (td ,(~a count) "×")
+ (td ,@(for/list ([rule rules]) `(code ,(~a rule) " ")))))))))
+
+(define (render-phase-counts inputs outputs)
+ `((dt "Counts") (dd ,(~a inputs) " → " ,(~a outputs))))
+
+(define (render-phase-times n times)
+ `((dt "Calls")
+ (dd ,(~a (length times)) " calls:"
+ (canvas ([id ,(format "calls-~a" n)]
+ [title "Weighted histogram; height corresponds to percentage of runtime in that bucket."]))
+ (script "histogram(\"" ,(format "calls-~a" n) "\", " ,(jsexpr->string (map second times)) ")")
+ (table ([class "times"])
+ ,@(for/list ([(expr time) (in-dict times)])
+ `(tr (td ,(format-time (car time))) (td (pre ,(~a expr)))))))))
+
+(define (render-phase-outcomes outcomes)
+ `((dt "Results")
+ (dd (table ([class "times"])
+ ,@(for/list ([(outcome number) (in-sorted-dict outcomes #:key cdr)])
+ (match-define (cons count time) number)
+ (match-define (list prog category prec) outcome)
+ `(tr (td ,(format-time time)) (td ,(~a count) "×")
+ (td ,(~a prog)) (td ,(~a prec)) (td ,(~a category))))))))
+
+(define (make-timeline-json result out)
+ (define timeline (test-result-timeline result))
+ (define ((cons->hash k1 f1 k2 f2) c) (hash k1 (f1 (car c)) k2 (f2 (cdr c))))
+
+ (define/match (value-map k v)
+ [('method v) (~a v)]
+ [('type v) (~a v)]
+ [('locations v) (map (cons->hash 'expr ~a 'error identity) v)]
+ [('rules v) (map (cons->hash 'rule ~a 'count identity) v)]
+ [('times v) (map (λ (x) (cons (~a (car x)) (cdr x))) v)]
+ [('outcomes v)
+ (for/list ([(outcome number) (in-dict v)])
+ (match-define (cons count time) number)
+ (match-define (list prog category prec) outcome)
+ (hash 'count count 'time time
+ 'program (~a prog) 'category (~a category) 'precision prec))]
+ [('bstep v) (map (λ (x) (map (curryr apply '()) (list flval flval identity flval) x)) v)]
+ [(_ v) v])
+
+ (define data
+ (for/list ([event timeline])
+ (for/hash ([(k v) (in-dict event)])
+ (values k (value-map k v)))))
+
+ (write-json data out))
+
+;; This next part handles summarizing several timelines into one details section for the report page.
+
+(define (make-summary-html out info dir)
+ (fprintf out "\n")
+ (write-xexpr
+ `(html
+ (head
+ (title "Herbie results")
+ (meta ((charset "utf-8")))
+ (link ((rel "stylesheet") (type "text/css") (href "report.css")))
+ (script ((src "report.js"))))
+ (body
+ ,(render-timeline-summary info (summarize-timelines info dir))))
+ out))
+
+(define (phase-time phase)
+ (apply + (map cdr (dict-ref phase 'time))))
+
+(define (render-timeline-summary info summary)
+ (define total-time (apply + (map phase-time (dict-values summary))))
+
+ (define blocks
+ (for/list ([(type phase) (in-dict summary)])
+ (define time (phase-time phase))
+ `(div ([class ,(format "timeline-block timeline-~a" type)])
+ (h3 ,(~a type)
+ (span ([class "time"]) ,(format-time time)
+ " (" ,(~r (* (/ time total-time) 100) #:precision '(= 1)) "%)"))
+ (dl
+ ,@(dict-call phase #:default '() render-summary-algorithm 'method)
+ ,@(dict-call phase #:default '() render-summary-outcomes 'outcomes)
+ ,@(dict-call phase #:default '() #:extra (list type) render-summary-times 'times)
+ ,@(dict-call phase #:default '() #:extra (list info) render-summary-accuracy 'accuracy 'oracle 'baseline)
+ ,@(dict-call phase #:default '() render-summary-rules 'rules)))))
+
+ `(section ([id "process-info"])
+ (h1 "Details")
+ ,@blocks))
+
+(define (render-summary-algorithm algorithm)
+ `((dt "Algorithm")
+ (dd (table ([class "times"])
+ ,@(for/list ([alg (group-by identity (map cdr algorithm))])
+ `(tr (td ,(~a (length alg)) "×") (td ,(~a (car alg)))))))))
+
+(define (render-summary-times type times)
+ (define top-slowest
+ (take-up-to (sort (append-map cdr times) > #:key cadr) 5))
+
+ `((dt "Calls")
+ (dd (p ,(~a (length (append-map cdr times))) " calls:")
+ (canvas ([id ,(format "calls-~a" type)]
+ [title "Weighted histogram; height corresponds to percentage of runtime in that bucket."]))
+ (script "histogram(\"" ,(format "calls-~a" type) "\", " ,(jsexpr->string (map second (append-map cdr times))) ")")
+ (dd (table ([class "times"])
+ ,@(for/list ([(expr time) (in-dict top-slowest)])
+ `(tr (td ,(format-time (car time))) (td (pre ,(~a expr))))))))))
+
+(define (render-summary-rules rules)
+ (define counts (make-hash))
+ (for ([rc (append-map cdr rules)])
+ (hash-update! counts (dict-ref rc 'rule) (curry + (dict-ref rc 'count)) 0))
+ (define counts-grouped (make-hash))
+ (for ([(rule count) (in-dict counts)])
+ (dict-update! counts-grouped count (curry cons rule) '()))
+
+ `((dt "Rules")
+ (dd (table ([class "times"])
+ ,@(for/list ([(count rules) (in-dict (sort (hash->list counts-grouped) > #:key car))])
+ `(tr (td ,(~a count) "×")
+ (td ,@(for/list ([rule rules]) `(code ,(~a rule) " ")))))))))
+
+(define (render-summary-accuracy info accuracy oracle baseline)
+ (define rows
+ (for/list ([(res acc) (in-dict accuracy)]
+ [(_1 ora) (in-dict oracle)]
+ [(_2 bas) (in-dict baseline)])
+ (list (- acc ora)
+ (if (= bas ora)
+ (if (= bas acc) 1 -inf.0)
+ (/ (- bas acc) (- bas ora)))
+ res)))
+
+ (define top-bits-remaining
+ (take-up-to (sort rows > #:key first) 5))
+
+ (define total-gained
+ (for/sum ([row (report-info-tests info)])
+ (or (table-row-result row) 0)))
+
+ `((dt "Accuracy")
+ (dd (p "Total " ,(format-bits (apply + (map first rows))) "b" " remaining"
+ " (" ,(~r (* (/ (apply + (map first rows)) total-gained) 100) #:precision 1) "%)")
+ (p "Threshold costs " ,(format-bits (apply + (filter (curry > 1) (map first rows)))) "b"
+ " (" ,(~r (* (/ (apply + (filter (curry > 1) (map first rows))) total-gained) 100) #:precision 1) "%)")
+ (table ([class "times"])
+ ,@(for/list ([row (in-list top-bits-remaining)])
+ `(tr (td ,(format-bits (first row)) "b")
+ (td ,(if (rational? (second row))
+ (~r (* (second row) 100) #:precision 1)
+ "-∞")
+ "%")
+ (td (a ([href ,(format "~a/graph.html" (table-row-link (third row)))])
+ ,(or (table-row-name (third row)) "")))))))))
+
+(define (render-summary-outcomes outcomes)
+ (define entries (append-map cdr outcomes))
+ (define (key x) (map (curry hash-ref x) '(program category precision)))
+
+ (define merged
+ (for/hash ([rows (group-by key entries)])
+ (values (key (first rows))
+ (cons (apply + (map (curryr hash-ref 'count) rows))
+ (apply + (map (curryr hash-ref 'time) rows))))))
+
+ `((dt "Results")
+ (dd (table ([class "times"])
+ ,@(for/list ([(outcome number) (in-sorted-dict merged #:key cdr)])
+ (match-define (cons count time) number)
+ (match-define (list prog category prec) outcome)
+ `(tr (td ,(format-time time)) (td ,(~a count) "×")
+ (td ,(~a prog)) (td ,(~a prec)) (td ,(~a category))))))))
+
+(define (summarize-timelines info dir)
+ (define tls
+ (filter identity
+ (for/list ([res (report-info-tests info)])
+ (with-handlers ([(const #t) (const #f)])
+ (cons res (call-with-input-file (build-path dir (table-row-link res) "timeline.json") read-json))))))
+
+ (define types (make-hash))
+ (for ([(res tl) (in-dict tls)] #:when true [event tl] [next (cdr tl)])
+ (define data (dict-ref! types (dict-ref event 'type) make-hash))
+ (define time (- (dict-ref next 'time) (dict-ref event 'time)))
+ (dict-set! data 'time (cons (cons res time) (dict-ref data 'time '())))
+ (for ([(k v) (in-dict event)] #:unless (equal? k 'time))
+ (dict-set! data k (cons (cons res v) (dict-ref data k '())))))
+ (sort (hash->list types) >
+ #:key (λ (x) (apply + (map cdr (dict-ref (cdr x) 'time))))))
diff --git a/src/web/tools.rkt b/src/web/tools.rkt
deleted file mode 100644
index 86904f526..000000000
--- a/src/web/tools.rkt
+++ /dev/null
@@ -1,298 +0,0 @@
-#lang racket
-
-;; ================== Dependencies ===================
-
-;; For converting floating point numbers into their ordinal
-;; representation, for clustering.
-(require math/flonum)
-
-(require "../common.rkt")
-(require "../alternative.rkt")
-(require "../programs.rkt")
-(require "../plot.rkt")
-(require "../points.rkt")
-(require "../float.rkt")
-(require "../glue.rkt")
-(require "../syntax/syntax.rkt")
-(require "../formats/tex.rkt")
-(require "../core/matcher.rkt")
-(require "../core/regimes.rkt")
-(require "../core/localize.rkt")
-
-;; ================== Interface =======================
-
-(provide find-best-axis texify-formula make-ranges graph-error
- expand-at-loc make-steps make-combo get-locs)
-
-;; ================== Parameters ======================
-
-;; How many clusters to attempt to cluster points into to determine
-;; which axis is best.
-(define *num-clusters* (make-parameter 5))
-;; The number of trials of k-means scoring to use.
-(define *num-scores* (make-parameter 3))
-(define *bin-distance* (make-parameter 4))
-
-;; Find the axis that best portrays the error behavior
-(define (find-best-axis alt pcontext)
- (let ([bad-points (for/list ([(p ex) (in-pcontext pcontext)]
- [e (parameterize ([*pcontext* pcontext])
- (alt-errors alt))]
- #:when (> e (expt 2 10)))
- p)]
- [vars (program-variables (alt-program alt))])
- (if (null? bad-points) ;; If everythings good, just display the
- ;; first axis.
- (car vars)
- (list-ref
- vars
- (argmax (λ (pidx)
- ;; Rank the variables by how relevant they are
- ;; to the error. Higher is more relevant.
- (cluster-rank (map (compose flonum->ordinal
- (curryr list-ref pidx))
- bad-points)))
- (build-list (length vars) identity))))))
-;; Generate the tex for the given prog, with the given locations
-;; highlighted and given MathJax ID's
-(define (texify-formula expr [locs '()])
- (texify-expr expr
- #:highlight-ops
- (for/list ([loc locs] [idx (in-naturals)])
- (cons loc idx))))
-;; Given a context and an alt and some locations, identify which
-;; ranges of error coorespond to which locations along the given axis,
-;; and generate list of hash table objects for them.
-(define (make-ranges context alt locs axis)
- (let* ([prog (alt-program alt)]
- [vars (program-variables prog)]
- [axis-idx (if (number? axis) axis
- (lookup-idx axis vars))]
- [pts (for/list ([(p e) (in-pcontext context)]) p)]
- [getpt (curryr list-ref axis-idx)]
- [min-x (apply min (map getpt pts))]
- [max-x (apply max (map getpt pts))])
- (define (get-ranges loc)
- (let* ([subexpr (location-get loc prog)]
- [local-errors
- (for/list ([p (in-list pts)])
- (let* ([exact-args (for/list ([arg (in-list (cdr subexpr))])
- ((eval-exact `(λ ,vars ,arg)) p))]
- [f-exact (operator-info (car subexpr) 'bf)]
- [f-approx (operator-info (car subexpr) 'fl)]
- [exact (->flonum (apply f-exact exact-args))]
- [approx (apply f-approx (map ->flonum exact-args))]
- [local-err (add1 (abs (ulp-difference exact approx)))])
- local-err))])
- (get-clusters axis-idx pts local-errors)))
- (apply append
- (for/list ([loc locs]
- [loc-id (in-naturals)])
- (for/list ([range (get-ranges loc)])
- (hash
- 'start (coord->image-ratio (car range) min-x max-x)
- 'end (coord->image-ratio (cdr range) min-x max-x)
- 'locid loc-id))))))
-
-;; Draw the graph of average error using the given points for the
-;; given alt, along the given axis. If combo is given draw it also on
-;; the same graph in a different color.
-(define (graph-error context alt axis [combo #f]
- #:first-time [first-time #f] #:children? [children? #f])
- (let* ([points (for/list ([(p e) (in-pcontext context)]) p)]
- [vars (program-variables (alt-program alt))]
- [renderers
- (parameterize ([*pcontext* context])
- (reap [sow]
- (when (alt? combo)
- (sow (error-avg (alt-errors combo) points #:axis axis
- #:vars vars #:color
- (if first-time *red-theme* *blue-theme*))))
- (sow (error-avg (alt-errors alt) points #:axis axis
- #:vars vars
- #:color (cond [(equal? #t combo)
- *blue-theme*]
- [children? *yellow-theme*]
- [#t *red-theme*])))
- ))])
- (λ (out) (apply herbie-plot #:port out #:kind 'png renderers))))
-;; Generate at most three or four children for the given alt at the
-;; given location.
-(define (expand-at-loc alt loc)
- (general-filter
- (map simplify-alt
- (append (taylor-filter (taylor-alt alt loc))
- (rewrite-filter (alt-rewrite-rm alt #:root loc))))
- alt))
-;; Generate the list of steps hash objects representing the changes
-;; between the parent and the child.
-(define (make-steps child parent)
- (let steps-left ([cur child] [steps '()])
- (cond [(equal? (alt-program cur) (alt-program parent))
- steps]
- [(not cur) (print-history child) (error "The given parent is not a parent of the child!2")]
- [(alt-event? cur)
- (steps-left
- (alt-prev cur)
- (cons
- (hash
- 'rule "taylor"
- 'prog (texify-formula (program-body (alt-program cur))))
- steps))]
- [(not (alt-change cur)) (error "The given parent is not a parent of the child!")]
- [#t (steps-left
- (alt-prev cur)
- (cons
- (hash
- 'rule (let ([rule (change-rule (alt-change cur))])
- (if (equal? (rule-name rule) 'simplify)
- "simplify"
- (let ([rule (change-rule (alt-change cur))])
- (format "~a \\to ~a"
- (texify-formula (rule-input rule))
- (texify-formula (rule-output rule))))))
- 'prog (texify-formula (program-body (alt-program cur))))
- steps))])))
-
-(define (print-history alt)
- (let loop ([cur alt])
- (if (not cur) (void)
- (begin (loop (alt-prev cur))
- (eprintf (format "~a -> " (alt-program cur)))))))
-
-;; Combine the given alternatives into the best combination.
-(define (make-combo alts axis)
- (parameterize ([*start-prog* (alt-program (car alts))])
- (match-let ([`(,splitpoints ,involved-alts) (infer-splitpoints alts axis)])
- (if (= (length involved-alts) 1)
- (car involved-alts)
- (combine-alts splitpoints involved-alts)))))
-
-(define (get-locs alt)
- (let ([locs (localize-error (alt-program alt))])
- (if ((length locs) . < . 2) locs
- (take (localize-error (alt-program alt)) 2))))
-
-;; =============== Lower level helper functions =============
-
-(define (lookup-idx item lst)
- (for/first ([i lst] [idx (in-naturals)]
- #:when (equal? item i))
- idx))
-
-;; Filter children
-(define (general-filter alts parent)
- (let-values ([(bad-pts bad-exs)
- (for/lists (pts exs)
- ([(p ex) (in-pcontext (*pcontext*))]
- [e (alt-errors parent)]
- #:when (> e (expt 2 10)))
- (values p ex))])
- (parameterize ([*pcontext* (mk-pcontext bad-pts bad-exs)])
- (take (sort alts < #:key (compose errors-score alt-errors)) 3))))
-(define (taylor-filter alts)
- (filter (negate has-nan?) alts))
-(define (has-nan? expr)
- (or (and (number? expr) (nan? expr))
- (and (list? expr)
- (ormap has-nan? (cdr expr)))))
-
-(define *banned-toplevel-rules*
- '(+-commutative
- *-commutative
- sub-neg
- neg-sub0
- *-un-lft-identity
- div-inv
- neg-mul-1
- clear-num
- expt1))
-
-(define (rewrite-filter alts)
- (filter
- (λ (alt) (not (member (rule-name (change-rule (alt-change alt)))
- *banned-toplevel-rules*)))
- alts))
-
-;; Ranks a set of numbers by how well they group into clusters.
-(define (cluster-rank xs)
- (for/sum ([idx (in-range (*num-scores*))])
- (k-means-score xs (*num-clusters*))))
-;; Scores how well the given numbers can be clustered into
-;; num-clusters clusters using k-means.
-(define (k-means-score xs num-clusters)
- (let ([initial-means
- (for/list ([idx (in-range num-clusters)])
- (list-ref xs (random (length xs))))])
- (let loop ([means initial-means])
- (let* ([clustered-samples
- (for/list ([x xs])
- (cons x (argmin (λ (mean) (abs (- mean x))) means)))]
- [means* (for/list ([mean means])
- (let ([cluster-xs (filter (compose (curry equal? mean) cdr) clustered-samples)])
- (round (/ (apply + (map car cluster-xs)) (length cluster-xs)))))])
- (if (equal? means* means)
- (exact->inexact (/ (apply + (for/list ([sample clustered-samples])
- (sqr (- (car sample) (cdr sample)))))))
- (loop means*))))))
-
-(define (coord->image-ratio coord min-x max-x)
- (let ([ord-min (flonum->ordinal min-x)]
- [ord-max (flonum->ordinal max-x)]
- [ord-coord (flonum->ordinal coord)])
- (exact->inexact (/ (- ord-coord ord-min) (- ord-max ord-min)))))
-
-;; Takes an axis, some points, and some value for each of those
-;; points, and attempts to break the points into clusters which
-;; represent the higher ys, returning pairs of min and maxs for each
-;; cluster.
-(define (get-clusters axis pts ys)
- (define curve-pow 5)
- (define (bin vec idx)
- (expt (exact->inexact
- (/ (cond
- ;; Handle the ends of the array in a halfway decent way
- [(< idx (*bin-distance*))
- (+ (* (add1 (*bin-distance*)) (vector-ref vec idx))
- (for/sum ([i (in-range (*bin-distance*))])
- (expt (vector-ref vec (+ idx (add1 i))) (/ curve-pow))))]
- [(>= (+ idx (*bin-distance*)) (vector-length vec))
- (+ (* (add1 (*bin-distance*)) (vector-ref vec idx))
- (for/sum ([i (in-range (*bin-distance*))])
- (expt (vector-ref vec (- idx (add1 i))) (/ curve-pow))))]
- [#t
- (for/sum ([i (in-range (- idx (*bin-distance*)) (+ idx (*bin-distance*)))])
- (expt (vector-ref vec i) (/ curve-pow)))])
- (add1 (* 2 (*bin-distance*)))))
- curve-pow))
- (let* ([sorted-pairs (sort (map cons (map (curryr list-ref axis) pts) ys) < #:key car)]
- [xs (list->vector (map car sorted-pairs))]
- ;; Shadowing the old definition so we don't accidentally use
- ;; the unsorted ones.
- [ys (list->vector (map cdr sorted-pairs))]
- [binned-ys (for/vector ([idx (in-range (vector-length ys))]) (bin ys idx))]
- [picked-threshold (exact->inexact (/ (for/sum ([y ys]) y) (vector-length ys)))]
- [included-threshold (/ picked-threshold 100)])
- (let loop ([cur-ys binned-ys] [clusters-found '()])
- (let ([picked (car (argmax cdr (for/list ([idx (in-range (vector-length ys))]
- [y (in-vector cur-ys)])
- (cons idx y))))])
- (if ((vector-ref cur-ys picked) . < . picked-threshold) clusters-found
- (let* ([cluster-range
- (cons (or (for/first ([idx (in-range picked -1 -1)]
- #:when ((vector-ref cur-ys idx) . < . included-threshold))
- idx)
- 0)
- (or (for/first ([idx (in-range picked (vector-length cur-ys))]
- #:when ((vector-ref cur-ys idx) . < . included-threshold))
- idx)
- (sub1 (vector-length cur-ys))))]
- ;; Take out the items in this cluster from consideration.
- [cur-ys* (for/vector ([y cur-ys] [idx (in-naturals)])
- (if (and ((car cluster-range) . <= . idx)
- (idx . <= . (cdr cluster-range)))
- 0 y))])
- (loop cur-ys*
- (cons (cons (vector-ref xs (car cluster-range))
- (vector-ref xs (cdr cluster-range)))
- clusters-found))))))))
diff --git a/src/web/viz.rkt b/src/web/viz.rkt
deleted file mode 100644
index c3e1770c3..000000000
--- a/src/web/viz.rkt
+++ /dev/null
@@ -1,151 +0,0 @@
-#lang racket
-
-(require openssl/md5)
-(require (rename-in xml [location? xml-location?]))
-(require web-server/servlet web-server/servlet-env web-server/dispatch web-server/page)
-(require web-server/configuration/responders)
-(require json)
-
-(require "../config.rkt")
-(require "../formats/tex.rkt")
-(require "common.rkt")
-(require "session.rkt")
-
-(define *frontend-path* (make-parameter #f))
-(define *style-path* (make-parameter #f))
-(define *input-path* (make-parameter "src/viz/input.js"))
-
-(define/page (start-page)
- (when (not (and (*frontend-path*) (*style-path*)))
- (error "You didn't pass a javascript frontend and a stylesheet!"))
- (define imagedir (build-path viz-output-path "images"))
- (when (not (directory-exists? viz-output-path))
- (make-directory viz-output-path)
- (make-directory imagedir))
- (for ([file (directory-list imagedir)])
- (delete-file (build-path imagedir file)))
- (copy-file (*frontend-path*) (build-path viz-output-path "viz.js") #t)
- (copy-file (*style-path*) (build-path viz-output-path "style.css") #t)
- (copy-file (*input-path*) (build-path viz-output-path "input.js") #t)
-
- (response/xexpr
- (herbie-page
- #:title "Herbie Visual Shell"
- #:scripts '("//cdnjs.cloudflare.com/ajax/libs/mathjs/1.6.0/math.min.js" "input.js")
- `(p "Enter a formula to explore it.")
- `(form ([action ,(embed/url interact)] [method "post"] [id "formula"])
- (input ([name "formula"] [autofocus "true"]
- [placeholder "(λ (x) (+ 1 x))"]))
- (ul ([id "errors"]))))))
-
-(define/page (interact)
- (let ([formula (get-binding 'lisp_formula)])
- (let-values ([(response image-funcs session-data)
- (start-session (read (open-input-string formula)))])
- (response/xexpr
- (herbie-page
- #:title "Herbie Visual Shell"
- #:head-include
- `((script ([type "text/x-mathjax-config"])
- "MathJax.Hub.Config({ TeX: { extensions: [\"enclose.js\"] } });"))
- #:scripts (list mathjax-url
- "http://d3js.org/d3.v3.min.js")
- #:styles '("style.css")
- `(div ([class "placeholder"]
- [data-json
- ,(embed/url
- (curryr serve-json
- (hash-set response 'next_link
- (embed/url (curryr choose-children-page session-data)))
- image-funcs))]))
- `(script ([type "text/javascript"] [src "viz.js"])))))))
-
-(define (splice-image-urls response image-funcs)
- (for/fold ([response* response])
- ([image-func image-funcs] [idx (in-naturals)])
- (let* ([filename (symbol->string (gensym "image"))]
- [path (build-path "images" filename)]
- [full-path (build-path viz-output-path path)])
- (image-func full-path)
- (string-replace response* (format "&embedimage{~a}" idx)
- (path->string path)))))
-
-(define/page (choose-children-page data)
- (match-let ([(list location-idx) (get-bindings 'location-idx)])
- (let-values ([(response image-funcs session-data)
- (select-location
- data (string->number location-idx))])
- (json-response (hash-set response
- 'next_link
- (embed/url (curryr pick-next-page session-data)))
- image-funcs))))
-
-(define/page (pick-next-page data)
- (match-let ([chosen-idxs (get-bindings 'chosen-idx)])
- (let-values ([(response image-funcs session-data)
- (choose-children
- data (map string->number chosen-idxs))])
- (json-response (hash-set*
- response
- 'next_link (embed/url (curryr interact-more-page
- session-data))
- 'done_link (embed/url (curryr done-page session-data)))
- image-funcs))))
-
-(define/page (done-page data)
- (let-values ([(response image-funcs session-data)
- (finish data)])
- (response/xexpr
- (herbie-page
- #:title "Herbie Visual Shell"
- #:scripts (list mathjax-url)
- `(h1 "Here's the final result:")
- `(p ,(hash-ref response 'formula))
- (let* ([filename (symbol->string (gensym "image"))]
- [path (build-path "images" filename)]
- [full-path (build-path viz-output-path path)])
- ((car image-funcs) full-path)
- `(img ([src ,(path->string path)])))))))
-
-(define/page (interact-more-page data)
- (let ([cand-idx (get-binding 'cand-idx)])
- (let-values ([(response image-funcs session-data)
- (pick-next data (string->number cand-idx))])
- (json-response (hash-set*
- response
- 'next_link (embed/url (curryr choose-children-page session-data))
- 'repick_link (embed/url (curryr interact-more-page session-data)))
- image-funcs))))
-
-(define (json-response json images)
- (define parsed (string->bytes/utf-8 (splice-image-urls (jsexpr->string json) images)))
- (call-with-output-file (build-path viz-output-path "last-json.tmp") #:exists 'replace
- (curry write-bytes parsed))
- (response/full 200 #"OK" (current-seconds) #"application/json" '()
- (list parsed)))
-
-
-(define/page (serve-json json images)
- (json-response json images))
-
-(define (start-server frontend-path style-path)
- (parameterize ([*frontend-path* frontend-path] [*style-path* style-path])
- (printf "Starting server\n")
- (serve/servlet
- start-page
- #:file-not-found-responder
- (gen-file-not-found-responder
- (build-path viz-output-path "../404.html"))
- #:port 3234
- #:listen-ip #f
- #:command-line? #t
- #:servlets-root (build-path viz-output-path "../..")
- #:server-root-path (build-path viz-output-path "..")
- #:servlet-path "/viz/"
- #:extra-files-paths (list (build-path viz-output-path "..")))))
-
-(module+ main
-(command-line
- #:program "herbie-viz"
- #:args arguments
- (apply start-server arguments)))
diff --git a/www/doc.html b/www/doc.html
new file mode 100644
index 000000000..4acabe0f1
--- /dev/null
+++ b/www/doc.html
@@ -0,0 +1,78 @@
+
+
+
+
+ Herbie: Automatically Improving Floating Point Accuracy
+
+
+
+
+
+
+ Herbie Documentation
+
+
+ Documentation
+
+
+
+ Blog posts about Herbie
+
+
+
+ Long-term
+ Goals for Herbie :
+ Herbie's lead developer
+ lays out some of the biggest Herbie changes in the last couple
+ of years, and gives us a look at what's coming down the pipe.
+
+
+ Remembering
+ the Herbie Visualizer :
+ Pavel remembers a
+ tool Alex wrote to help
+ understand how Herbie works.
+
+
+ Statistics on
+ alt picking :
+ David
+ designed and ran a series of experiments to evaluate
+ how well Herbie's "alt" (candidate) picking heuristics work.
+
+
+ Testing
+ regime
+ inference :
+ David
+ has been poking at Herbie's regime inference to measure how
+ effective it is and characterize situations where we could improve.
+
+
+ Summer 2018 plan :
+ What David Thien
+ will be working on in Herbie this summer!
+
+ Introducing Herbgrind : what is our sister project Herbgrind all about?
+ Let Herbie Make Your Floating Point Better : why programmers who deal with floating point should use Herbie.
+ Improving Accuracy: a Look at Sums : why floating point summation is hard, and how compensated summation works.
+ Measuring the Error of Floating Point Programs : how Herbie measures the error of a floating point program, and how we're working to extend that to programs with loops.
+ Logarithms of Taylor Expansions : how Herbie takes Taylor expansions of logarithms.
+ Hyperbolic sines in math.js : how Herbie fixed an accuracy bug in math.js using series expansion.
+ Taylor Expansions of Taylor Expansions : how Herbie takes Taylor expansions of exponential and trigonometric functions.
+ Arbitrary Precision, not Arbitrary Accuracy : why arbitrary-precision libraries aren’t an answer to rounding error.
+ Complex Square Roots in math.js : how Herbie automatically fixed an accuracy bug in math.js , an open source mathematics library.
+ Floating Point Guarantees : how floating point rounding and primitive operators work.
+
diff --git a/www/doc/0.9/installing-herbie.html b/www/doc/0.9/installing-herbie.html
index 1098a9369..c46c5b440 100644
--- a/www/doc/0.9/installing-herbie.html
+++ b/www/doc/0.9/installing-herbie.html
@@ -86,7 +86,7 @@ Installing Herbie
Once Herbie is installed and working correctly,
- check out the tutorial .
+ check out the tutorial .
diff --git a/www/doc/1.0/installing-herbie.html b/www/doc/1.0/installing-herbie.html
index e6824764d..cfeded577 100644
--- a/www/doc/1.0/installing-herbie.html
+++ b/www/doc/1.0/installing-herbie.html
@@ -86,7 +86,7 @@ Installing Herbie
Once Herbie is installed and working correctly,
- check out the tutorial .
+ check out the tutorial .
diff --git a/www/doc/1.0/using-herbie.html b/www/doc/1.0/using-herbie.html
index 8dc1f4595..3fda81300 100644
--- a/www/doc/1.0/using-herbie.html
+++ b/www/doc/1.0/using-herbie.html
@@ -25,7 +25,7 @@ The benchmark programs
Herbie ships a collection of binaries in its bench/
- directory. For example, bench/tutorial.rkt
contains the following code:
+ directory. For example, bench/tutorial.fpcore
contains the following code:
(FPCore (x)
@@ -79,7 +79,7 @@ Running Herbie
Alternatively, you can run Herbie on a file with expressions with:
- $ racket src/herbie.rkt bench/tutorial.rkt > out.rkt
+ $ racket src/herbie.rkt bench/tutorial.fpcore > out.rkt
Seed: #(1637424072 4209802118 1686524629 1009825284 4285017075 2209820745)
[ 1563.552ms] Cancel like terms (29→ 0)
[ 4839.121ms] Expanding a square (38→ 0)
diff --git a/www/doc/1.1/installing.html b/www/doc/1.1/installing.html
index 7915a707b..f0eb79d04 100644
--- a/www/doc/1.1/installing.html
+++ b/www/doc/1.1/installing.html
@@ -69,7 +69,7 @@ Installing Herbie from source
Do a trial run of Herbie to make sure everything is installed and working correctly:
- racket src/herbie.rkt report bench/tutorial.rkt graphs/
+ racket src/herbie.rkt report bench/tutorial.fpcore graphs/
This command will take approximately a minute to run.
@@ -89,7 +89,7 @@
Installing Herbie from source
Once Herbie is installed and working correctly,
- check out the tutorial .
+ check out the tutorial .
Installing Herbie from Docker
diff --git a/www/doc/1.2/compare.js b/www/doc/1.2/compare.js
deleted file mode 100644
index ac1862950..000000000
--- a/www/doc/1.2/compare.js
+++ /dev/null
@@ -1,91 +0,0 @@
-margin = 10;
-barheight = 10;
-width = 505;
-textbar = 20;
-
-function sort_by(i1, i2) {
- return function(a, b) {
- return b[i1][i2] - a[i1][i2];
- }
-}
-
-function r10(d) {
- return "" + (Math.round(d * 10) / 10);
-}
-
-function make_graph(node, data, start, end) {
- var len = data.length;
- var precision = 64; // TODO
-
- var a = d3.selectAll("script");
- var script = a[0][a[0].length - 1];
-
- var svg = node
- .attr("width", width + 2 * margin)
- .attr("height", len * barheight + 2 * margin + textbar)
- .append("g").attr("transform", "translate(" + margin + "," + margin + ")");
-
- for (var i = 0; i <= precision; i += 4) {
- svg.append("line")
- .attr("class", "gridline")
- .attr("x1", i / precision * width)
- .attr("x2", i / precision * width)
- .attr("y1", 0)
- .attr("y2", len * barheight);
-
- svg.append("text").text(i)
- .attr("x", i / precision * width)
- .attr("width", 80)
- .attr("y", len * barheight + textbar);
- }
-
- var bar = svg.selectAll("g").data(data).enter();
-
- function line_y(d, i) { return (i + .5) * barheight; }
- function title(d, i) { return d.name + " (" + r10(precision - d["Old"][start]) + " to " + r10(precision - d["Old"][end]) + ")"; }
-
- bar.append("line")
- .attr("class", "guide")
- .attr("x1", 0)
- .attr("x2", function(d) { return (precision - Math.max(d["Old"][start], d["Old"][end])) / precision * width })
- .attr("y1", line_y)
- .attr("y2", line_y);
-
- var g = bar.append("g").attr("title", title);
-
- g.append("line").attr("class", "old")
- .attr("x1", function(d) {return (precision - d["Old"][start]) / precision * width})
- .attr("x2", function(d) { return (precision - d["Old"][end]) / precision * width })
- .attr("y1", line_y)
- .attr("y2", line_y);
-
- g.append("line").attr("class", "new")
- .attr("x1", function(d) {return (precision - d["Old"][end]) / precision * width})
- .attr("x2", function(d) { return (precision - d["New"][end]) / precision * width })
- .attr("y1", line_y)
- .attr("y2", line_y);
-
- g.append("g")
- .attr("class", function(d) { return d["New"][end] < d["Old"][end] - .5 ? "new" : "old" })
- .attr("transform", function(d, i) {
- return "translate(" + ((precision - d["New"][end]) / precision * width) + ", " + line_y(d, i) + ")";
- })
- .append("polygon").attr("points", "0,-3,0,3,5,0");
-}
-
-function draw_results(node) {
- d3.json("results-old.json", function(err, old_data) {
- d3.json("results-new.json", function(err, new_data) {
- if (err) return console.error(err);
- data = [];
- old_data.tests.sort(function(a, b) { return (a.input < b.input) ? -1 : (a.input == b.input) ? 0 : 1});
- new_data.tests.sort(function(a, b) { return (a.input < b.input) ? -1 : (a.input == b.input) ? 0 : 1});
- for (var i = 0; i < old_data.tests.length; i++) {
- data.push({Old: old_data.tests[i], New: new_data.tests[i]});
- }
-
- data.sort(sort_by("Old", "start"));
- make_graph(node, data, "start", "end");
- });
- });
-}
diff --git a/www/doc/1.2/docker.html b/www/doc/1.2/docker.html
index f521ed65a..756873a16 100644
--- a/www/doc/1.2/docker.html
+++ b/www/doc/1.2/docker.html
@@ -4,6 +4,7 @@
Herbie on Docker
+
diff --git a/www/doc/1.2/faq.html b/www/doc/1.2/faq.html
index 71f8f0290..2019d4d6b 100644
--- a/www/doc/1.2/faq.html
+++ b/www/doc/1.2/faq.html
@@ -4,6 +4,7 @@
Herbie FAQ
+
diff --git a/www/doc/1.2/input.html b/www/doc/1.2/input.html
index eae4c075a..00d1a5a08 100644
--- a/www/doc/1.2/input.html
+++ b/www/doc/1.2/input.html
@@ -4,6 +4,7 @@
Herbie Input Format
+
diff --git a/www/doc/1.2/installing.html b/www/doc/1.2/installing.html
index 8f8c9b8dc..92d8021ff 100644
--- a/www/doc/1.2/installing.html
+++ b/www/doc/1.2/installing.html
@@ -4,6 +4,7 @@
Installing Herbie
+
@@ -71,7 +72,7 @@ Installing Herbie from source
Do a trial run of Herbie to make sure everything is installed and working correctly:
- racket src/herbie.rkt report bench/tutorial.rkt graphs/
+ racket src/herbie.rkt report bench/tutorial.fpcore graphs/
This command will take approximately a minute to run.
@@ -89,11 +90,6 @@
Installing Herbie from source
raco make src/herbie.rkt
-
- Once Herbie is installed and working correctly,
- check out the tutorial .
-
-
Installing Herbie from Docker
diff --git a/www/doc/1.2/options.html b/www/doc/1.2/options.html
index 76ae6a248..998e69256 100644
--- a/www/doc/1.2/options.html
+++ b/www/doc/1.2/options.html
@@ -4,6 +4,7 @@
Herbie Command-line Options
+
diff --git a/www/doc/1.2/release-notes.html b/www/doc/1.2/release-notes.html
index 4533049da..c6b102bf5 100644
--- a/www/doc/1.2/release-notes.html
+++ b/www/doc/1.2/release-notes.html
@@ -4,8 +4,8 @@
Herbie 1.2 Release Notes
-
+
@@ -106,9 +106,9 @@ Beta-quality features
\;\;\;\;c0 \cdot \frac{\sqrt{A}}{\sqrt{V \cdot \ell}}\\
\end{array}\]
- A program produced by the new, more create branch
- inference system in Herbie 1.2. Herbie 1.2 is more creative and
- produces more accurate output than prior versions.
+ A program produced by the new branch inference system
+ in Herbie 1.2. Herbie 1.2 is more creative and produces more
+ accurate output than prior versions.
Usability improvements
@@ -119,7 +119,7 @@ Usability improvements
version on argument values of your choice.
Herbie can now efficiently sample from preconditions such
as (or (< 1 x 2) (< 1001 x 1002))
. Previously
- such preconditions would produce to the dreaded
+ such preconditions would produce the dreaded
“could not sample ”
error message.
Herbie's web output now includes additional descriptive text,
@@ -140,12 +140,12 @@ Usability improvements
Code Cleanup
- Many bugs fixed, including adding missing rules, infinite
- loops, and a few crashes in exceptional circumstances.
+ Many bugs fixed, including missing rules, infinite loops, and
+ a few crashes in exceptional circumstances.
Herbie’s HTML output now uses the Racket XML library,
eliminating the possibility of generating invalid HTML.
Herbie uses a new mechanism for defining supported functions,
- which should adding functions in the future easier.
+ which should make it easier to add functions in the future.
Try it out!
diff --git a/www/doc/1.2/report.html b/www/doc/1.2/report.html
index 1643801b9..2ffe70138 100644
--- a/www/doc/1.2/report.html
+++ b/www/doc/1.2/report.html
@@ -4,6 +4,7 @@
Herbie reports
+
diff --git a/www/doc/1.2/results-new.json b/www/doc/1.2/results-new.json
deleted file mode 100644
index 24fd81d3c..000000000
--- a/www/doc/1.2/results-new.json
+++ /dev/null
@@ -1 +0,0 @@
-{"flags":["precision:double","setup:simplify","reduce:regimes","reduce:taylor","reduce:simplify","reduce:avg-error","rules:arithmetic","rules:polynomials","rules:fractions","rules:exponents","rules:trigonometry","rules:hyperbolic","generate:rr","generate:taylor","generate:simplify"],"seed":"#(772101555 1905824529 294602591 2478279198 2123125427 4197813737)","points":256,"date":1493418730,"commit":"a6770931126e0702f83b80fffb3cdf362d9e07c9","branch":"develop","iterations":3,"note":false,"bit_width":64,"tests":[{"bits":1408,"start":39.78563602870575,"input":"(sqrt (/ (- (exp (* 2 x)) 1) (- (exp x) 1)))","output":"(sqrt (/ (+ (exp x) 1) 1))","link":"0-sqrtexpproblem344","ninf":0,"pinf":0,"end-est":0.0078125,"name":"sqrtexp (problem 3.4.4)","samplers":["default"],"time":53697.2470703125,"status":"imp-start","vars":["x"],"target":false,"end":0.014412722522414014},{"bits":2432,"start":31.277522201292555,"input":"(/ (- x (sin x)) (- x (tan x)))","output":"(if (<= x -9.950485992669078e-09) (- (/ x (- x (tan x))) (/ (sin x) (- x (tan x)))) (if (<= x 0.16631490308113306) (- (* 9/40 (sqr x)) (+ (* 27/2800 (pow x 4)) 1/2)) (/ (- x (sin x)) (- x (tan x)))))","link":"1-sintanproblem345","ninf":0,"pinf":0,"end-est":0.36733237039018785,"name":"sintan (problem 3.4.5)","samplers":["default"],"time":135208.11889648438,"status":"imp-start","vars":["x"],"target":false,"end":0.1040637469913252},{"bits":2432,"start":36.53944527020705,"input":"(/ (+ (- b/2) (sqrt (- (sqr b/2) (* a c)))) a)","output":"(if (<= b/2 -1.751131060884064e+136) (* -2 (/ b/2 a)) (if (<= b/2 8.548826144111727e-60) (/ 1 (/ a (+ (- b/2) (sqrt (- (sqr b/2) (* a c)))))) (- (/ (+ b/2 (- b/2)) a) (/ (* 1/2 c) b/2))))","link":"2-quad2pproblem321positive","ninf":0,"pinf":0,"end-est":8.759031935807828,"name":"quad2p (problem 3.2.1, positive)","samplers":["default","default","default"],"time":119061.97412109375,"status":"imp-start","vars":["a","b/2","c"],"target":false,"end":5.966762651991987},{"bits":2944,"start":37.82838784287472,"input":"(/ (- (- b/2) (sqrt (- (sqr b/2) (* a c)))) a)","output":"(if (<= b/2 -3.093544874321455e-77) (* (/ -1/2 b/2) c) (if (<= b/2 5.845042913155354e+61) (/ 1 (/ a (- (- b/2) (sqrt (- (sqr b/2) (* a c)))))) (+ (* (/ c b/2) 1/2) (/ (- (- b/2) b/2) a))))","link":"3-quad2mproblem321negative","ninf":0,"pinf":0,"end-est":8.241281491524308,"name":"quad2m (problem 3.2.1, negative)","samplers":["default","default","default"],"time":126471.29907226562,"status":"imp-start","vars":["a","b/2","c"],"target":false,"end":5.326392364138352},{"bits":2432,"start":31.059705602958424,"input":"(/ (- 1 (cos x)) (sqr x))","output":"(* (/ (sin x) x) (/ (/ (sin x) (+ 1 (cos x))) x))","link":"4-cos2problem341","ninf":0,"pinf":0,"end-est":0.3600447888363383,"name":"cos2 (problem 3.4.1)","samplers":["default"],"time":82701.72485351562,"status":"imp-start","vars":["x"],"target":false,"end":0.27141353358701925},{"bits":1408,"start":31.55214583076247,"input":"(- (pow (+ x 1) (/ 1 n)) (pow x (/ 1 n)))","output":"(if (<= n -2.672258838309128e-11) (- (- (/ (/ 1 x) n) (/ (/ 1/2 n) (sqr x))) (/ (log x) (* n (* n x)))) (if (<= n 19699878403.887928) (exp (cube (cbrt (log (- (pow (+ x 1) (/ 1 n)) (pow x (/ 1 n))))))) (- (- (/ (/ 1 x) n) (/ (/ 1/2 n) (sqr x))) (/ (log x) (* n (* n x))))))","link":"5-2nthrtproblem346","ninf":0,"pinf":0,"end-est":21.21301382692941,"name":"2nthrt (problem 3.4.6)","samplers":["default","default"],"time":143232.169921875,"status":"imp-start","vars":["x","n"],"target":false,"end":6.774720844192645},{"bits":1408,"start":40.755841804999065,"input":"(- (log (+ N 1)) (log N))","output":"(if (<= N 9328.390986348908) (log (/ (+ N 1) N)) (+ (/ (- (/ 1/3 N) 1/2) (sqr N)) (/ 1 N)))","link":"6-2logproblem336","ninf":0,"pinf":0,"end-est":0.11448705279133702,"name":"2log (problem 3.3.6)","samplers":["default"],"time":41444.029052734375,"status":"imp-start","vars":["N"],"target":false,"end":19.49352325492048},{"bits":896,"start":14.049500988425633,"input":"(- (/ 1 (+ x 1)) (/ 1 x))","output":"(if (<= x -209135036385.79047) (- (/ 1 (pow x 3)) (+ (pow x (- 2)) (/ 1 (pow x 4)))) (if (<= x 290639.63932394225) (/ (- x (+ 1 x)) (* (+ x 1) x)) (- (/ 1 (pow x 3)) (+ (pow x (- 2)) (/ 1 (pow x 4))))))","link":"7-2fracproblem331","ninf":0,"pinf":0,"end-est":0.0234375,"name":"2frac (problem 3.3.1)","samplers":["default"],"time":30894.91796875,"status":"imp-start","vars":["x"],"target":false,"end":0.014198120312590145},{"bits":2432,"start":38.890098631337246,"input":"(- (cos (+ x eps)) (cos x))","output":"(if (<= eps -3.645937152382937e+19) (- (- (* (cos x) (cos eps)) (* (sin x) (sin eps))) (cos x)) (if (<= eps 4.729663737457019e-05) (* -2 (* (sin (/ eps 2)) (sin (/ (+ (+ x eps) x) 2)))) (- (* (cos x) (cos eps)) (+ (* (sin x) (sin eps)) (cos x)))))","link":"8-2cosproblem335","ninf":0,"pinf":0,"end-est":0.6303043448114194,"name":"2cos (problem 3.3.5)","samplers":["default","default"],"time":104279.31079101562,"status":"imp-start","vars":["x","eps"],"target":false,"end":1.2578573335845715},{"bits":1408,"start":29.805220676286638,"input":"(- (pow (+ x 1) (/ 1 3)) (pow x (/ 1 3)))","output":"(/ 1 (+ (sqr (pow (+ x 1) (/ 1 3))) (+ (sqr (exp (/ (log x) 3))) (* (pow (+ x 1) (/ 1 3)) (pow x (/ 1 3))))))","link":"9-2cbrtproblem334","ninf":0,"pinf":0,"end-est":2.8592450383022707,"name":"2cbrt (problem 3.3.4)","samplers":["default"],"time":86841.42700195312,"status":"imp-start","vars":["x"],"target":false,"end":2.63051098758136},{"bits":2432,"start":30.222464775570813,"input":"(/ (- 1 (cos x)) (sin x))","output":"(* 1 (/ (sin x) (+ (cos x) 1)))","link":"10-tanhfexample34","ninf":0,"pinf":0,"end-est":0.5284202760025005,"name":"tanhf (example 3.4)","samplers":["default"],"time":51172.2109375,"status":"eq-target","vars":["x"],"target":0.000625,"end":0.4384920000497587},{"bits":2432,"start":34.16168973131298,"input":"(/ (+ (- b) (sqrt (- (sqr b) (* 4 (* a c))))) (* 2 a))","output":"(if (<= b -1.751131060884064e+136) (/ (- b) a) (if (<= b -5.335815531470738e-240) (/ 1 (/ (* 2 a) (+ (- b) (sqrt (- (sqr b) (* 4 (* a c))))))) (if (<= b 5.845042913155354e+61) (/ 1 (* (- (- b) (sqrt (- (* b b) (* (* 4 a) c)))) (/ (/ 2 4) c))) (- (/ (+ b (- b)) (+ a a)) (/ c b)))))","link":"11-quadpp42positive","ninf":0,"pinf":0,"end-est":6.078206418658915,"name":"quadp (p42, positive)","samplers":["default","default","default"],"time":124200.916015625,"status":"gt-target","vars":["a","b","c"],"target":21.51568349447677,"end":5.376176978102462},{"bits":2944,"start":34.438091592742474,"input":"(/ (- (- b) (sqrt (- (sqr b) (* 4 (* a c))))) (* 2 a))","output":"(if (<= b -2.049536640230252e+150) (/ (* (/ c 2) 4) (- (/ (+ c c) (/ b a)) (- b (- b)))) (if (<= b 3.902728914492509e-158) (* (/ 4 2) (/ c (+ (- b) (sqrt (- (* b b) (* a (* c 4))))))) (if (<= b 5.845042913155354e+61) (/ 1 (/ (* 2 a) (- (- b) (sqrt (- (sqr b) (* 4 (* a c))))))) (- (/ c b) (/ b a)))))","link":"12-quadmp42negative","ninf":0,"pinf":0,"end-est":5.090534681871955,"name":"quadm (p42, negative)","samplers":["default","default","default"],"time":127442.75390625,"status":"gt-target","vars":["a","b","c"],"target":21.537857357826326,"end":5.5027912650509085},{"bits":1408,"start":61.40424674064236,"input":"(/ (log (- 1 x)) (log (+ 1 x)))","output":"(- (+ (* 1/2 (sqr x)) (+ 1 x)))","link":"13-qlogexample310","ninf":0,"pinf":0,"end-est":0.5716777813221573,"name":"qlog (example 3.10)","samplers":["default"],"time":22658.823974609375,"status":"eq-target","vars":["x"],"target":0.4463297341631591,"end":0.008125},{"bits":1408,"start":63.323661641605746,"input":"(- (- (* (+ n 1) (log (+ n 1))) (* n (log n))) 1)","output":"(- (* (log (+ n 1)) (+ n 1)) (+ (* (log n) (- n)) 1))","link":"14-logsexample38","ninf":0,"pinf":0,"end-est":60.73435355682203,"name":"logs (example 3.8)","samplers":["default"],"time":43125.350830078125,"status":"gt-target","vars":["n"],"target":60.78763823817359,"end":0.2685},{"bits":1408,"start":59.443513693513,"input":"(log (/ (- 1 eps) (+ 1 eps)))","output":"(- (+ (* 2/3 (pow eps 3)) (+ (* 2/5 (pow eps 5)) (* 2 eps))))","link":"15-logqproblem343","ninf":0,"pinf":0,"end-est":0.13714055965779817,"name":"logq (problem 3.4.3)","samplers":["default"],"time":91070.09790039062,"status":"eq-target","vars":["eps"],"target":0.06565423716474932,"end":0.08804107935288033},{"bits":2432,"start":59.91793067942972,"input":"(- (/ 1 x) (/ 1 (tan x)))","output":"(+ (* 2/945 (pow x 5)) (+ (* 1/3 x) (* 1/45 (pow x 3))))","link":"16-invcotexample39","ninf":0,"pinf":0,"end-est":0.34765625,"name":"invcot (example 3.9)","samplers":["default"],"time":26213.670166015625,"status":"eq-target","vars":["x"],"target":0.0759660601543468,"end":0.3295731203125902},{"bits":2432,"start":61.9783442604534,"input":"(/ (* eps (- (exp (* (+ a b) eps)) 1)) (* (- (exp (* a eps)) 1) (- (exp (* b eps)) 1)))","output":"(if (<= (/ (* eps (- (exp (* (+ a b) eps)) 1)) (* (- (exp (* a eps)) 1) (- (exp (* b eps)) 1))) -1.4449365230670285e-180) (+ (/ 1 b) (/ 1 a)) (if (<= (/ (* eps (- (exp (* (+ a b) eps)) 1)) (* (- (exp (* a eps)) 1) (- (exp (* b eps)) 1))) 2.5007607876802412e-113) (+ (/ 1 b) (/ 1 a)) (+ (/ 1 b) (/ 1 a))))","link":"17-expq3problem342","ninf":0,"pinf":0,"end-est":4.24688513434934,"name":"expq3 (problem 3.4.2)","samplers":["default","default","default"],"time":233948.95581054688,"status":"gt-target","vars":["a","b","eps"],"target":14.651067317747806,"end":0.014198120312590145},{"bits":1408,"start":45.739517733726835,"input":"(/ (exp x) (- (exp x) 1))","output":"(if (<= x -9.950485992669078e-09) (/ 1 (- 1 (exp (- x)))) (if (<= x 0.16631490308113306) (+ (/ 1 x) (+ 1/2 (* 1/12 x))) (/ 1 (- 1 (exp (- x))))))","link":"18-expq2section311","ninf":0,"pinf":0,"end-est":0.22577593043685318,"name":"expq2 (section 3.11)","samplers":["default"],"time":20018.59912109375,"status":"gt-target","vars":["x"],"target":30.12948710533904,"end":0.05791712397806687},{"bits":1408,"start":59.33343129621902,"input":"(- (exp x) 1)","output":"(+ (* (* x x) (+ 1/2 (* x 1/6))) x)","link":"19-expm1example37","ninf":0,"pinf":0,"end-est":0.3642608971118385,"name":"expm1 (example 3.7)","samplers":["default"],"time":35543.492919921875,"status":"eq-target","vars":["x"],"target":0.06436560156295071,"end":0.06598364687698317},{"bits":1408,"start":33.44360243099122,"input":"(- (exp (* a x)) 1)","output":"(if (<= (* a x) -1.6665755921255327e-09) (- (exp (* a x)) 1) (+ (* x a) (* 1/2 (* (* x a) (* x a)))))","link":"20-expaxsection35","ninf":0,"pinf":0,"end-est":0.30826629080627144,"name":"expax (section 3.5)","samplers":["default","default"],"time":31542.9580078125,"status":"gt-target","vars":["a","x"],"target":7.952127997421758,"end":0.18645915544792366},{"bits":1408,"start":33.99583817370671,"input":"(+ (- (exp x) 2) (exp (- x)))","output":"(+ (* 1/12 (pow x 4)) (+ (* 1/360 (pow x 6)) (sqr x)))","link":"21-exp2problem337","ninf":0,"pinf":0,"end-est":0.7811424888959018,"name":"exp2 (problem 3.3.7)","samplers":["default"],"time":51116.8779296875,"status":"gt-target","vars":["x"],"target":8.659910873648657,"end":0.11144644300676601},{"bits":1152,"start":9.49656829978195,"input":"(+ (- (/ 1 (+ x 1)) (/ 2 x)) (/ 1 (- x 1)))","output":"(/ (/ (- (/ 2 x) 0) (- x 1)) (+ 1 x))","link":"22-3fracproblem333","ninf":0,"pinf":0,"end-est":0.060878759768442016,"name":"3frac (problem 3.3.3)","samplers":["default"],"time":139599.76000976562,"status":"eq-target","vars":["x"],"target":0.23795078190808433,"end":0.06871936093777044},{"bits":2432,"start":36.40936010427848,"input":"(- (tan (+ x eps)) (tan x))","output":"(if (<= eps -2.4610266585566768e-113) (/ (- (sqr (/ (+ (tan x) (tan eps)) (- 1 (* (tan x) (tan eps))))) (sqr (tan x))) (+ (/ (+ (tan x) (tan eps)) (- 1 (* (tan x) (tan eps)))) (tan x))) (if (<= eps 3.1547769921923584e-35) (+ (* (sqr x) (cube eps)) (+ eps (* (cube x) (pow eps 4)))) (- (* (/ (+ (tan eps) (tan x)) (- 1 (/ (cube (* (tan eps) (sin x))) (cube (cos x))))) (+ (sqr 1) (+ (sqr (* (tan x) (tan eps))) (* 1 (* (tan x) (tan eps)))))) (tan x))))","link":"23-2tanproblem332","ninf":0,"pinf":0,"end-est":16.79675543908866,"name":"2tan (problem 3.3.2)","samplers":["default","default"],"time":153829.44311523438,"status":"gt-target","vars":["x","eps"],"target":24.868488975311955,"end":11.1570419418963},{"bits":1408,"start":29.901471078747512,"input":"(- (sqrt (+ x 1)) (sqrt x))","output":"(/ 1 (+ (sqrt (+ x 1)) (sqrt x)))","link":"24-2sqrtexample31","ninf":0,"pinf":0,"end-est":0.19988251953688405,"name":"2sqrt (example 3.1)","samplers":["default"],"time":20755.375,"status":"eq-target","vars":["x"],"target":0.16316052656439306,"end":0.16316052656439306},{"bits":2432,"start":36.71325510564527,"input":"(- (sin (+ x eps)) (sin x))","output":"(if (<= eps -3.645937152382937e+19) (- (+ (* (sin x) (cos eps)) (* (cos x) (sin eps))) (sin x)) (if (<= eps 6.326235572596747e-15) (* 2 (* (sin (/ eps 2)) (cos (/ (+ (+ x eps) x) 2)))) (- (+ (* (sin x) (cos eps)) (* (cos x) (sin eps))) (sin x))))","link":"25-2sinexample33","ninf":0,"pinf":0,"end-est":0.40463013074677723,"name":"2sin (example 3.3)","samplers":["default","default"],"time":82629.40185546875,"status":"gt-target","vars":["x","eps"],"target":14.900038199925003,"end":1.0798819096901375},{"bits":1152,"start":19.330732255826693,"input":"(- (/ 1 (sqrt x)) (/ 1 (sqrt (+ x 1))))","output":"(* (/ 1 (+ (sqrt (+ 1 x)) (sqrt x))) (/ 1 (* (sqrt x) (sqrt (+ x 1)))))","link":"26-2isqrtexample36","ninf":0,"pinf":0,"end-est":0.3721339476841681,"name":"2isqrt (example 3.6)","samplers":["default"],"time":35296.56103515625,"status":"eq-target","vars":["x"],"target":0.714170361427429,"end":0.3941741281572718},{"bits":1408,"start":14.541859386925417,"input":"(- (atan (+ N 1)) (atan N))","output":"(atan2 (+ 1 0) (+ (* (+ N 1) N) 1))","link":"27-2atanexample35","ninf":0,"pinf":0,"end-est":0.29506882110978144,"name":"2atan (example 3.5)","samplers":["default"],"time":15547.489990234375,"status":"eq-target","vars":["N"],"target":0.39299853686879893,"end":0.39174853686879885}]}
\ No newline at end of file
diff --git a/www/doc/1.2/results-old.json b/www/doc/1.2/results-old.json
deleted file mode 100755
index 49893537b..000000000
--- a/www/doc/1.2/results-old.json
+++ /dev/null
@@ -1 +0,0 @@
-{"bit_width":64,"date":1490840216,"commit":"58bf255242aa4ff0c47bb93e3c2ea80079b951c5","branch":"master","flags":["precision:double","setup:simplify","reduce:regimes","reduce:taylor","reduce:simplify","reduce:avg-error","rules:arithmetic","rules:polynomials","rules:fractions","rules:exponents","rules:trigonometry","generate:rr","generate:taylor","generate:simplify"],"points":256,"iterations":3,"tests":[{"status":"imp-start","target":false,"start":30.72710658756978,"vars":["x","n"],"samplers":["default","default"],"input":"(- (pow (+ x 1) (/ 1 n)) (pow x (/ 1 n)))","output":"(if (<= n -2.3031253660826823e+26) (- (- (/ (/ 1 x) n) (/ (log x) (* n (* n x)))) (/ (/ 1/2 n) (sqr x))) (if (<= n 479155699082691.3) (cbrt (cube (cbrt (cube (cbrt (cube (- (pow (+ x 1) (/ 1 n)) (pow x (/ 1 n))))))))) (- (- (/ (/ 1 x) n) (/ (log x) (* n (* n x)))) (/ (/ 1/2 n) (sqr x)))))","bits":128,"pinf":0,"ninf":0,"end-est":26.115579094525142,"name":"NMSE problem 3.4.6","end":8.352001623029237,"time":96880.43798828125,"link":"0-NMSEproblem346"},{"status":"imp-start","target":false,"start":31.62500906332104,"vars":["x"],"samplers":["default"],"input":"(/ (- x (sin x)) (- x (tan x)))","output":"(if (<= x -3.150653682326084e-06) (- (/ x (- x (tan x))) (/ (sin x) (- x (tan x)))) (if (<= x 0.1680384430276768) (- (* 9/40 (sqr x)) (+ (* 27/2800 (pow x 4)) 1/2)) (- (/ x (- x (tan x))) (/ (sin x) (- x (tan x))))))","bits":128,"pinf":0,"ninf":0,"end-est":0.16733880207871452,"name":"NMSE problem 3.4.5","end":0.1104513958526418,"time":47490.5791015625,"link":"1-NMSEproblem345"},{"status":"imp-start","target":false,"start":45.09950437667379,"vars":["x"],"samplers":["default"],"input":"(sqrt (/ (- (exp (* 2 x)) 1) (- (exp x) 1)))","output":"(if (<= x -8.867720861083589e-13) (sqrt (/ (- (exp (* 2 x)) 1) (- (exp x) 1))) (sqrt (+ (* 1/2 (sqr x)) (+ 2 x))))","bits":128,"pinf":0,"ninf":0,"end-est":0.7376765013424993,"name":"NMSE problem 3.4.4","end":7.500544686712205,"time":26112.76806640625,"link":"2-NMSEproblem344"},{"status":"imp-start","target":false,"start":31.356953350333576,"vars":["x"],"samplers":["default"],"input":"(/ (- 1 (cos x)) (sqr x))","output":"(* (/ (sin x) x) (/ (/ (sin x) (+ 1 (cos x))) x))","bits":128,"pinf":0,"ninf":0,"end-est":0.192046331613414,"name":"NMSE problem 3.4.1","end":0.30161782915000535,"time":43265.260986328125,"link":"3-NMSEproblem341"},{"status":"imp-start","target":false,"start":40.184769151759774,"vars":["N"],"samplers":["default"],"input":"(- (log (+ N 1)) (log N))","output":"(if (<= N 519383.0646430557) (log (/ (+ N 1) N)) (+ (/ (- (/ 1/3 N) 1/2) (sqr N)) (/ 1 N)))","bits":128,"pinf":0,"ninf":0,"end-est":0.09151380401675037,"name":"NMSE problem 3.3.6","end":19.38968452894342,"time":18756.22607421875,"link":"4-NMSEproblem336"},{"status":"imp-start","target":false,"start":37.07285680541725,"vars":["x","eps"],"samplers":["default","default"],"input":"(- (cos (+ x eps)) (cos x))","output":"(if (<= eps -1.3296779497386022e-08) (/ (- (cube (* (cos eps) (cos x))) (cube (+ (* (sin eps) (sin x)) (cos x)))) (+ (sqr (* (cos eps) (cos x))) (* (+ (* (cos eps) (cos x)) (+ (* (sin x) (sin eps)) (cos x))) (+ (* (sin x) (sin eps)) (cos x))))) (if (<= eps 7.134416671297405e-12) (- (* (* eps 1/6) (cube x)) (* eps (+ (* 1/2 eps) x))) (/ (- (cube (* (cos eps) (cos x))) (cube (+ (* (sin eps) (sin x)) (cos x)))) (+ (sqr (* (cos eps) (cos x))) (* (+ (* (cos eps) (cos x)) (+ (* (sin x) (sin eps)) (cos x))) (+ (* (sin x) (sin eps)) (cos x)))))))","bits":128,"pinf":0,"ninf":0,"end-est":15.049825158123982,"name":"NMSE problem 3.3.5","end":3.8473381505495694,"time":68603.96508789062,"link":"5-NMSEproblem335"},{"status":"apx-start","target":false,"start":29.326846493043334,"vars":["x"],"samplers":["default"],"input":"(- (pow (+ x 1) (/ 1 3)) (pow x (/ 1 3)))","output":"(exp (cube (cbrt (log (- (pow (+ x 1) (/ 1 3)) (pow x (/ 1 3)))))))","bits":128,"pinf":0,"ninf":0,"end-est":26.112737951959613,"name":"NMSE problem 3.3.4","end":29.330084230611476,"time":48849.850830078125,"link":"6-NMSEproblem334"},{"status":"imp-start","target":false,"start":14.327571332282405,"vars":["x"],"samplers":["default"],"input":"(- (/ 1 (+ x 1)) (/ 1 x))","output":"(if (<= x -6572693219723.217) (- (/ (/ 1 x) (sqr x)) (/ (/ 1 x) x)) (if (<= x 14125114759858.025) (/ (- x (+ 1 x)) (* (+ x 1) x)) (- (/ (/ 1 x) (sqr x)) (/ (/ 1 x) x))))","bits":128,"pinf":0,"ninf":0,"end-est":0.078125,"name":"NMSE problem 3.3.1","end":0.07644812031259013,"time":19662.1669921875,"link":"7-NMSEproblem331"},{"status":"imp-start","target":false,"start":37.568586126435775,"vars":["a","b/2","c"],"samplers":["default","default","default"],"input":"(/ (+ (- b/2) (sqrt (- (sqr b/2) (* a c)))) a)","output":"(if (<= b/2 -5.149274995892533e+86) (- (* (/ 1/2 b/2) c) (* 2 (/ b/2 a))) (if (<= b/2 9.946391916507581e-83) (/ 1 (/ a (+ (- b/2) (sqrt (- (sqr b/2) (* a c)))))) (- (/ (+ b/2 (- b/2)) a) (* 1/2 (/ c b/2)))))","bits":128,"pinf":0,"ninf":0,"end-est":6.760667970562651,"name":"NMSE problem 3.2.1, positive","end":4.75003112024967,"time":50862.839111328125,"link":"8-NMSEproblem321positive"},{"status":"imp-start","target":false,"start":35.67879826787097,"vars":["a","b/2","c"],"samplers":["default","default","default"],"input":"(/ (- (- b/2) (sqrt (- (sqr b/2) (* a c)))) a)","output":"(if (<= b/2 -0.004102676064970259) (* (/ c b/2) -1/2) (if (<= b/2 -7.674146973599803e-149) (/ (/ (* a c) (+ (- b/2) (sqrt (- (sqr b/2) (* a c))))) a) (if (<= b/2 9.060571198789832e+80) (/ (- (- b/2) (sqrt (- (sqr b/2) (* a c)))) a) (* -2 (/ b/2 a)))))","bits":128,"pinf":0,"ninf":0,"end-est":6.283356310763793,"name":"NMSE problem 3.2.1, negative","end":5.53668681524491,"time":41098.823974609375,"link":"9-NMSEproblem321negative"},{"status":"gt-target","target":12.539481177734315,"start":35.88674549677141,"vars":["a","x"],"samplers":["default","default"],"input":"(- (exp (* a x)) 1)","output":"(if (<= (* a x) -2.6715888843965976e-09) (- (exp (* a x)) 1) (* x a))","bits":128,"pinf":0,"ninf":0,"end-est":0.43938819654193784,"name":"NMSE section 3.5","end":0.09584099696101328,"time":19852.485107421875,"link":"10-NMSEsection35"},{"status":"gt-target","target":45.33809150635401,"start":45.32749786530321,"vars":["x"],"samplers":["default"],"input":"(/ (exp x) (- (exp x) 1))","output":"(if (<= x -3.150653682326084e-06) (/ 1 (- 1 (exp (- x)))) (+ (* 1/12 x) (+ 1/2 (/ 1 x))))","bits":128,"pinf":0,"ninf":0,"end-est":0.6084361289342824,"name":"NMSE section 3.11","end":0.12805703358889042,"time":23151.529052734375,"link":"11-NMSEsection311"},{"status":"eq-target","target":0.06576167289182676,"start":59.41688754122086,"vars":["eps"],"samplers":["default"],"input":"(log (/ (- 1 eps) (+ 1 eps)))","output":"(- (+ (+ (* (cube eps) 2/3) (* 2/5 (pow eps 5))) (* 2 eps)))","bits":128,"pinf":0,"ninf":0,"end-est":0.15924746790050592,"name":"NMSE problem 3.4.3","end":0.08275227445477747,"time":31097.13818359375,"link":"12-NMSEproblem343"},{"status":"gt-target","target":14.14172034209319,"start":61.97294495933572,"vars":["a","b","eps"],"samplers":["default","default","default"],"input":"(/ (* eps (- (exp (* (+ a b) eps)) 1)) (* (- (exp (* a eps)) 1) (- (exp (* b eps)) 1)))","output":"(if (<= (/ (* eps (- (exp (* (+ a b) eps)) 1)) (* (- (exp (* a eps)) 1) (- (exp (* b eps)) 1))) -9.296169205569568e-188) (+ (/ 1 a) (/ 1 b)) (if (<= (/ (* eps (- (exp (* (+ a b) eps)) 1)) (* (- (exp (* a eps)) 1) (- (exp (* b eps)) 1))) 7.819285243784398e-190) (+ (/ 1 a) (/ 1 b)) (+ (/ 1 a) (/ 1 b))))","bits":128,"pinf":0,"ninf":0,"end-est":3.590759504240281,"name":"NMSE problem 3.4.2","end":0.012948120312590145,"time":200928.28002929688,"link":"13-NMSEproblem342"},{"status":"gt-target","target":8.680496323252925,"start":34.42699152807259,"vars":["x"],"samplers":["default"],"input":"(+ (- (exp x) 2) (exp (- x)))","output":"(+ (sqr x) (+ (* 1/12 (pow x 4)) (* 1/360 (pow x 6))))","bits":128,"pinf":0,"ninf":0,"end-est":0.28275930527467336,"name":"NMSE problem 3.3.7","end":0.1067912674976738,"time":18596.828125,"link":"14-NMSEproblem337"},{"status":"eq-target","target":0.24535050244616535,"start":9.51064615742219,"vars":["x"],"samplers":["default"],"input":"(+ (- (/ 1 (+ x 1)) (/ 2 x)) (/ 1 (- x 1)))","output":"(/ 2 (* (+ x (sqr x)) (- x 1)))","bits":128,"pinf":0,"ninf":0,"end-est":0.0625,"name":"NMSE problem 3.3.3","end":0.25036234463429635,"time":57014.72998046875,"link":"15-NMSEproblem333"},{"status":"gt-target","target":26.24923754199063,"start":36.519809893592864,"vars":["x","eps"],"samplers":["default","default"],"input":"(- (tan (+ x eps)) (tan x))","output":"(if (<= eps -6.169079171368681e-49) (/ (/ (- (sqr (cos x)) (sqr (cube (cbrt (* (cotan (+ x eps)) (sin x)))))) (+ (* (cotan (+ eps x)) (sin x)) (cos x))) (* (cotan (+ x eps)) (cos x))) (if (<= eps 2.0116360245016707e-26) (+ (* (sqr x) (cube eps)) (+ eps (* (cube x) (pow eps 4)))) (/ (/ (- (sqr (cos x)) (sqr (cube (cbrt (* (cotan (+ x eps)) (sin x)))))) (+ (* (cotan (+ eps x)) (sin x)) (cos x))) (* (cotan (+ x eps)) (cos x)))))","bits":128,"pinf":0,"ninf":0,"end-est":27.67891718929942,"name":"NMSE problem 3.3.2","end":24.756494557676795,"time":63485.365966796875,"link":"16-NMSEproblem332"},{"status":"gt-target","target":25.77374001912148,"start":37.72618589177047,"vars":["a","b","c"],"samplers":["default","default","default"],"input":"(/ (+ (- b) (sqrt (- (sqr b) (* 4 (* a c))))) (* 2 a))","output":"(if (<= b -5.149274995892533e+86) (- (/ c b) (/ b a)) (if (<= b 9.946391916507581e-83) (/ 1 (/ (* 2 a) (+ (- b) (sqrt (- (sqr b) (* 4 (* a c))))))) (/ (* (/ 4 2) c) (- (/ (* c 2) (/ b a)) (* b 2)))))","bits":128,"pinf":0,"ninf":0,"end-est":6.740241807359317,"name":"NMSE p42, positive","end":6.310074296845912,"time":68592.75610351562,"link":"17-NMSEp42positive"},{"status":"gt-target","target":23.40536923119662,"start":35.66770760005187,"vars":["a","b","c"],"samplers":["default","default","default"],"input":"(/ (- (- b) (sqrt (- (sqr b) (* 4 (* a c))))) (* 2 a))","output":"(if (<= b -0.004102676064970259) (* (/ -2 2) (/ c b)) (if (<= b -7.674146973599803e-149) (/ (/ (* 4 (* a c)) (+ (- b) (sqrt (- (sqr b) (* 4 (* a c)))))) (* 2 a)) (if (<= b 9.060571198789832e+80) (- (/ (- b) (* 2 a)) (/ (sqrt (- (sqr b) (* 4 (* a c)))) (* 2 a))) (- (/ c b) (/ b a)))))","bits":128,"pinf":0,"ninf":0,"end-est":6.283669107106033,"name":"NMSE p42, negative","end":5.544343202430409,"time":74686.93579101562,"link":"18-NMSEp42negative"},{"status":"eq-target","target":0.07492121385885234,"start":59.92910465279442,"vars":["x"],"samplers":["default"],"input":"(- (/ 1 x) (cotan x))","output":"(+ (* 1/45 (cube x)) (+ (* (pow x 5) 2/945) (* x 1/3)))","bits":128,"pinf":0,"ninf":0,"end-est":0.31640625,"name":"NMSE example 3.9","end":0.341125,"time":19957.39599609375,"link":"19-NMSEexample39"},{"status":"lt-target","target":0,"start":62.983165481898844,"vars":["N"],"samplers":["default"],"input":"(- (- (* (+ N 1) (log (+ N 1))) (* N (log N))) 1)","output":"(- (exp (- (log (- (sqr (cube (* (cbrt (+ N 1)) (cbrt (log (+ N 1)))))) (sqr (* N (log N))))) (log (+ (* (log N) N) (* (log (+ N 1)) (+ N 1)))))) 1)","bits":128,"pinf":0,"ninf":0,"end-est":61.26976387791292,"name":"NMSE example 3.8","end":61.339891393664374,"time":120993.76293945312,"link":"20-NMSEexample38"},{"status":"eq-target","target":0.06211560156295071,"start":59.381589721029606,"vars":["x"],"samplers":["default"],"input":"(- (exp x) 1)","output":"(+ x (* (sqr x) (+ (* 1/6 x) 1/2)))","bits":128,"pinf":0,"ninf":0,"end-est":0.41917203895823363,"name":"NMSE example 3.7","end":0.06528552656439303,"time":9809.6240234375,"link":"21-NMSEexample37"},{"status":"eq-target","target":0.6404688144198558,"start":19.20459512853389,"vars":["x"],"samplers":["default"],"input":"(- (/ 1 (sqrt x)) (/ 1 (sqrt (+ x 1))))","output":"(* (/ 1 (+ (sqrt (+ 1 x)) (sqrt x))) (/ 1 (* (sqrt x) (sqrt (+ x 1)))))","bits":128,"pinf":0,"ninf":0,"end-est":0.38355263675818835,"name":"NMSE example 3.6","end":0.3995771199558376,"time":22303.14697265625,"link":"22-NMSEexample36"},{"status":"eq-target","target":0.3535924396191792,"start":14.816015150117126,"vars":["N"],"samplers":["default"],"input":"(- (atan (+ N 1)) (atan N))","output":"(atan2 (+ 1 0) (+ (+ (sqr N) N) 1))","bits":128,"pinf":0,"ninf":0,"end-est":0.28737647630464624,"name":"NMSE example 3.5","end":0.3545099208695398,"time":13250.199951171875,"link":"23-NMSEexample35"},{"status":"eq-target","target":0.00025,"start":30.564429941581903,"vars":["x"],"samplers":["default"],"input":"(/ (- 1 (cos x)) (sin x))","output":"(* 1 (/ (sin x) (+ (cos x) 1)))","bits":128,"pinf":0,"ninf":0,"end-est":0.3672159192193488,"name":"NMSE example 3.4","end":0.4536472361174264,"time":29972.529052734375,"link":"24-NMSEexample34"},{"status":"gt-target","target":26.637778727998082,"start":36.25290408910504,"vars":["x","eps"],"samplers":["default","default"],"input":"(- (sin (+ x eps)) (sin x))","output":"(if (<= eps -6.169079171368681e-49) (/ (- (sqr (+ (* (sin x) (cos eps)) (* (cos x) (sin eps)))) (sqr (sin x))) (+ (+ (* (sin x) (cos eps)) (* (cos x) (sin eps))) (sin x))) (if (<= eps 2.0116360245016707e-26) (- eps (* (* (+ x eps) (* x eps)) 1/2)) (+ (* (sin x) (cos eps)) (/ (- (sqr (* (cos x) (sin eps))) (sqr (sin x))) (+ (* (cos x) (sin eps)) (sin x))))))","bits":128,"pinf":0,"ninf":0,"end-est":14.515236082978266,"name":"NMSE example 3.3","end":2.0782981277949357,"time":62088.2919921875,"link":"25-NMSEexample33"},{"status":"eq-target","target":0.4427242395058597,"start":61.373439946309574,"vars":["x"],"samplers":["default"],"input":"(/ (log (- 1 x)) (log (+ 1 x)))","output":"(- (+ (+ (* 1/2 (sqr x)) x) 1))","bits":128,"pinf":0,"ninf":0,"end-est":0.35614265339161655,"name":"NMSE example 3.10","end":0.000875,"time":15522.3759765625,"link":"26-NMSEexample310"},{"status":"eq-target","target":0.164660526564393,"start":29.410104469288694,"vars":["x"],"samplers":["default"],"input":"(- (sqrt (+ x 1)) (sqrt x))","output":"(/ 1 (+ (sqrt (+ x 1)) (sqrt x)))","bits":128,"pinf":0,"ninf":0,"end-est":0.15234375,"name":"NMSE example 3.1","end":0.164660526564393,"time":8996.474853515625,"link":"27-NMSEexample31"}],"note":false,"seed":"#(2606739721 3337331833 2041942718 3037006954 1385554395 1942462848)"}
\ No newline at end of file
diff --git a/www/doc/1.2/tutorial-2.html b/www/doc/1.2/tutorial-2.html
deleted file mode 100644
index 64d2a8dc9..000000000
--- a/www/doc/1.2/tutorial-2.html
+++ /dev/null
@@ -1,282 +0,0 @@
-
-
-
-
- Herbie Tutorial, Part 2
-
-
-
-
-
-
- Part 1 of this tutorial described how
- Herbie can be used to automatically rewrite
- floating point expressions, to make them more accurate.
- Part 1 focused on running Herbie and reading its results;
- this Part 2 will instead work through applying Herbie to a realistic program.
-
-
- Finding numerical expressions
-
-
- As an example realistic program, we'll use math.js ,
- an extensive math library for JavaScript.
- In particular, we'll walk through bug 208 ,
- which found inaccuracy in the implementation of complex square root;
- for a full write-up of the bug itself,
- check out this blog post
- by one of the Herbie authors.
-
-
-
- To use Herbie, you first need to find some floating-point expressions to feed to Herbie.
- In the case of math.js, the floating-point expressions of interest
- are the various functions that compute mathematical functions;
- in your code, there's a good chance
- that a small core of your application does the mathematical computations,
- and the rest sets up parameters, handles control flow, visualizes or print results, and so on.
- The mathematical core is what Herbie will be interested in.
-
-
-
- For example, in the case of math.js, the mathematical core
- is in lib/function/
.
- Each file in each subdirectory contains a collection of mathematical functions,
- each of which is potentially inaccurate.
- You can start by sending all of them into Herbie, or only the most important ones.
- Here, let's look at just the file
- arithmetic/sqrt.js
,
- which contains real and complex square roots.
- In full, the code of interest is:
-
-
- math.sqrt = function sqrt (x) {
- if (arguments.length != 1) {
- throw new math.error.ArgumentsError('sqrt', arguments.length, 1);
- }
-
- if (isNumber(x)) {
- if (x >= 0) {
- return Math.sqrt(x);
- }
- else {
- return sqrt(new Complex(x, 0));
- }
- }
-
- if (isComplex(x)) {
- var r = Math.sqrt(x.re * x.re + x.im * x.im);
- if (x.im >= 0) {
- return new Complex(
- 0.5 * Math.sqrt(2.0 * (r + x.re)),
- 0.5 * Math.sqrt(2.0 * (r - x.re))
- );
- }
- else {
- return new Complex(
- 0.5 * Math.sqrt(2.0 * (r + x.re)),
- -0.5 * Math.sqrt(2.0 * (r - x.re))
- );
- }
- }
-
- if (x instanceof BigNumber) {
- if (x.isNegative()) {
- // negative value -> downgrade to number to do complex value computation
- return sqrt(x.toNumber());
- }
- else {
- return x.sqrt();
- }
- }
-
- if (isCollection(x)) {
- return collection.deepMap(x, sqrt);
- }
-
- if (isBoolean(x) || x === null) {
- return sqrt(+x);
- }
-
- throw new math.error.UnsupportedTypeError('sqrt', math['typeof'](x));
-};
-
- Extracting expressions
-
-
- The code above is complex,
- with argument checks, dispatching over five possible types, and error handling.
- Herbie does not handle complex data structures (only floating-point values),
- so we'll want to break up the code above into multiple inputs,
- one for each type of data structure.
- Let's look at the isComplex(x)
case:
-
-
- var r = Math.sqrt(x.re * x.re + x.im * x.im);
-if (x.im >= 0) {
- return new Complex(
- 0.5 * Math.sqrt(2.0 * (r + x.re)),
- 0.5 * Math.sqrt(2.0 * (r - x.re))
- );
-}
-else {
- return new Complex(
- 0.5 * Math.sqrt(2.0 * (r + x.re)),
- -0.5 * Math.sqrt(2.0 * (r - x.re))
- );
-}
-
-
- This code contains a branch: one option for non-negative x.im
,
- and one for positive x.im
.
- While Herbie supports an if
construct,
- it's usually better to encode branches as separate inputs to Herbie.
-
-
-
- Finally, each branch access fields of a data structure
- (x
is of type Complex
)
- and constructs new data structures.
- Since Herbie does not understand complex data structures,
- we must write each floating-point value used in constructing the final output
- as its own test case.
-
-
-
- So, this isComplex(x)
case would become four inputs to Herbie:
- a real and an imaginary part, for each negative or non-negative x.im
.
- Note that the r
variable is computed outside the branch;
- it will have to be duplicated in each input.
- Each input is a single floating-point expression
- that computes a single floating-point output without branches, loops, or data structures:
-
-
- var r = Math.sqrt(xre * xre + xim * xim);
-0.5 * Math.sqrt(2.0 * (r + xre)),
-// xim ≥ 0
-
- var r = Math.sqrt(xre * xre + xim * xim);
-0.5 * Math.sqrt(2.0 * (r - xre)),
-// xim ≥ 0
-
- var r = Math.sqrt(xre * xre + xim * xim);
-0.5 * Math.sqrt(2.0 * (r + xre)),
-// xim < 0
-
- var r = Math.sqrt(xre * xre + xim * xim);
--0.5 * Math.sqrt(2.0 * (r - xre)),
-// xim < 0
-
-
- Note that x.im
and x.re
- have changed to xim
and xre
.
- This is to emphasize that there is no longer an x
structure,
- just its floating-point fields.
- The comment below each case reminds us what the bounds on the input variables are.
-
-
- Translating to Herbie's input language
-
-
- Now that we have simple floating-point expressions,
- we can translate them to Herbie's input language.
- The input language is a variant of Scheme.
- For each input, we will write a herbie-test
declaration;
- each declaration will have a list of input variables,
- a description of the input,
- and the floating-point expression itself.
- Here's how we'd start for the first input above:
-
-
- (herbie-test (xim xre)
- "arithmetic/sqrt.js, isComplex(x), x>=0"
- ? )
-
-
- The question mark is what we will fill in with the expression.
- But before we do that, take a look at the other fields.
- The variables are specified as (xim xre)
,
- which tells Herbie that there are two input variables named xim
and xre
;
- the parentheses are mandatory.
- r
isn't on that list, because even though it is a variable in the code above,
- it's not an input variable:
- it's not an argument to our code, but just a value computed internally.
-
-
-
- Now, we must translate the expression itself.
- We can define r
with a let*
expression:
-
-
- (herbie-test (xim xre)
- "arithmetic/sqrt.js, isComplex(x), x>=0"
- (let* ([r (sqrt (+ (sqr xre) (sqr xim)))])
- ? ))
-
-
- Note the peculiar syntax of let*
;
- the first argument is a list of square-bracketed binders ,
- each of which has a variable name (like r
)
- and an expression to bind that variable to (here, (sqrt (+ (sqr xre) (sqr xim)))
).
- There's only one binder here, but you could have more if you wanted.
-
-
-
- Inside the body of the let*
, which is its second argument (the question mark),
- you can write another expression which can refer to any of the bound variable names.
- We'll translate the second line there:
-
-
- (herbie-test (xim xre)
- "arithmetic/sqrt.js, isComplex(x), x>=0"
- (let* ([r (sqrt (+ (sqr xre) (sqr xim)))])
- (* 0.5 (sqrt (* 2.0 (+ r xre))))))
-
-
- Translating expressions is not too hard—Herbie understands many common mathematical functions,
- and even has shortcuts, such as sqr
for squaring numbers.
-
-
-
- The final step is to add our input bound, xim ≥ 0 .
- You do this by changing the variable declaration in the first argument to herbie-test
.
- Instead of just writing xim
,
- write a binder, which has the variable name xim
- and a distribution to sample xim
from:
-
-
- (herbie-test ([xim (>= default 0)] xre)
- "arithmetic/sqrt.js, isComplex(x), x>=0"
- (let* ([r (sqrt (+ (sqr xre) (sqr xim)))])
- (* 0.5 (sqrt (* 2.0 (+ r xre))))))
-
-
- We use the distribution (>= default 0)
,
- which means to sample values from default
- and only keep them if they are greater than 0.
- You usually want to use default
as the input distribution,
- since it specifically tries very large and very small inputs
- in an effort to find inaccurate inputs;
- but there are other distributions as well,
- including integer
for 32-bit integers
- and (uniform a b )
for uniformly-distributed real values.
-
-
-
- This finishes our first input to Herbie.
- We can translate the other four cases at this point, or go ahead with the first case.
- For the sake of the tutorial, let's move ahead with one input for now.
-
-
- Running Herbie
-
-
- Running Herbie is exactly like before:
-
-
-
-
diff --git a/www/doc/1.2/tutorial.html b/www/doc/1.2/tutorial.html
deleted file mode 100644
index 2e4f92f61..000000000
--- a/www/doc/1.2/tutorial.html
+++ /dev/null
@@ -1,190 +0,0 @@
-
-
-
-
- Herbie Tutorial
-
-
-
-
-
-
- Herbie is a tool
- that automatically rewrites floating point expressions to make them more accurate.
- It's well-known that floating point arithmetic is inaccurate;
- hence the jokes that 0.1 + 0.2 ≠ 0.3 for a computer.
- But to understand the inaccuracies and reduce them is a much harder task.
- Usually, programs that use floating point arithmetic
- are just written with the hope that these inaccuracies will not cause bugs,
- and when they do, these bugs are mysterious and hard to fix.
-
-
-
- To get started using Herbie, download and install it,
- including running the test suite (as described in the installation instructions)
- to ensure that you have Herbie working properly.
- Now that Herbie is installed, you're ready to begin using it.
-
-
- The format of input files
-
-
- Herbie is a stand-alone tool, which accepts floating point expressions as inputs
- and produces floating point expressions as output.
- These floating point expressions are written in Herbie's custom input language,
- which is approximately a subset of Racket.
- For an example, open up bench/tutorial.rkt
.
- You'll see three blocks of code, the first of which is
-
-
- (herbie-test (x)
- "Cancel like terms"
- (- (+ 1 x) x))
-
-
- Each of these blocks describes a single input to Herbie;
- the block has a list of variables: (x)
;
- a name: "Cancel like terms"
;
- and the expression itself: (- (+ 1 x) x)
.
- Inputs can also have an optional "target"—an equivalent expression
- for Herbie to compare its results to.
- That's used for tests, but isn't that useful to you.
-
-
-
- Take a look at the three test cases in the file. If you're not
- familiar with Lisp syntax, it might take a bit to get used to the
- way expressions are written. As you can see, Herbie has common
- mathematical operators built in, from arithmetic to more
- complicated functions like as pow
- and sin
.
-
-
- The Herbie main report page
-
- Now run the tutorial file through Herbie by running
-
- racket src/herbie.rkt report bench/tutorial.rkt graphs/
-
-
- from the base Herbie directory.
- A graphs
directory should appear
- (if it already existed, its contents will be replaced),
- which contains a detailed description of Herbie's results and how it got them.
- Open up graphs/report.html
with your web browser to view these results.
-
-
-
-
- A screenshot of the main Herbie reports page for the tutorial file.
-
-
-
- There's a lot going on in this page, so let's break it down.
- On top, you see a quick summary of the results:
- the running time, the number of expressions improved,
- the total number of expressions run on, and the starting/ending bits of accuracy.
- You should see that Herbie considers itself to have improved 2/2 expressions,
- even though it ran on three.
- The reason is that Herbie doesn't consider itself to have “improved” an expression
- until it improves it accuracy by at least one bit.
- Since one of the expressions was pretty accurate to start (less than a bit of error),
- it isn't even a contender, and the improved version doesn't count as an improvement.
-
-
-
- Next, there's a graph summarizing the test results.
- Each horizontal row is a single expression,
- and the line stretches from the original accuracy of that expression
- to the accuracy of Herbie's output.
- You should see one long arrow (for the expression (x + 1)2 - 1 ),
- one short arrow (for the expression (1 + x) - x )
- and one bare arrowhead (for the expression ((x + y) + z) - (x + (y + z)) ).
- This corresponds to the fact that the first expression is pretty inaccurate (for small x ),
- the second is also inaccurate (for large x ),
- and the last one is pretty accurate (though not exactly so).
-
-
-
- Next to the graph is a grid of blocks, each one listing the bits improved for a test case.
- These are in the same order as the arrows;
- mouse over one to see the associated arrow light up.
- The colors describe how Herbie scores itself:
- white for already accurate, green for improved, orange for not improved, and red for made worse.
- You won't be seeing the last one (if you do, report it as a bug).
-
-
-
- Below that, you have a lot of information about Herbie's internal configuration.
- You can usually skip it, but many of these parameters are configurable from the command line.
- The most useful one is the seed.
- Herbie uses random sampling internally, so different runs can yield slightly different results.
- and can be set with the --seed
flag to Herbie.
-
-
-
- Finally, the page has a table of each expression,
- with the starting error, final error, runtime, and a link to details.
-
-
- The Herbie details page
-
-
- Click on the last row, for the expression (x + 1)2 - 1 .
- This page explains what Herbie did to that expression,
- including how the error is distributed for that expression,
- the final expression Herbie came up with,
- and how it derived that expression.
-
-
-
-
- A screenshot of a details page in the Herbie report for the tutorial file.
-
-
-
- At the top, like before, you see some run-specific data, which probably isn't that useful to you.
- (The debug output, and profiling data,
- could all help the developers track down any problems you have).
- On the right, there is a plot.
- This plot shows where the original expression, and Herbie's result, have error.
- The horizontal axis is the input; in this case, it is the value of x ,
- and if your expression has multiple input variables, you'll see several plots,
- one for each input variable.
- Note that this axis is logarithmic;
- one is about halfway between zero and infinity.
- The vertical axis is the error, in number of bits; it ranges from 0 at the bottom to 64 at the top.
- In this example, you can see that the error of the original program (in red)
- is large near zero and small far from zero.
- On the other hand, Herbie's output (barely visible in blue) is approximately 0 for all inputs.
-
-
-
- Finally, on the left, you have Herbie's derivation of its result.
- Usually you skip to the bottom of this and look at the result:
- (λ (x) (+ (* x x) (* x 2)))
, or x2 + 2 x .
- But sometimes it is useful to look at the derivation.
- In my case, the derivation uses simplification
- to expand the expression into (2 + x) x ,
- then uses Taylor expansion to expand this into 1 x2 + 2 x ,
- and then simplifies again to get rid of the unnecessary multiplication by 1.
- Again, you usually don't care about this derivation,
- but when a result seems strange, it can be helpful to look at the derivation.
-
-
- Next Steps
-
-
- If you've made it this far, you've now run Herbie and know how to read its output.
- The next step is to use it on some more realistic programs.
- Pick a floating point expression you care about and try it out,
- or check out Part 2 of the tutorial,
- which walks through a more-realistic example.
-
-
-
-
diff --git a/www/doc/1.2/using-cli.html b/www/doc/1.2/using-cli.html
index 08e62a91d..bc66327f0 100644
--- a/www/doc/1.2/using-cli.html
+++ b/www/doc/1.2/using-cli.html
@@ -4,6 +4,7 @@
Using Herbie from the Command Line
+
diff --git a/www/doc/1.2/using-web.html b/www/doc/1.2/using-web.html
index 42b6be500..4ec215838 100644
--- a/www/doc/1.2/using-web.html
+++ b/www/doc/1.2/using-web.html
@@ -4,6 +4,7 @@
Using Herbie from the Browser
+
diff --git a/www/doc/1.3/docker.html b/www/doc/1.3/docker.html
new file mode 100644
index 000000000..ab9e8b5ad
--- /dev/null
+++ b/www/doc/1.3/docker.html
@@ -0,0 +1,111 @@
+
+
+
+
+ Herbie on Docker
+
+
+
+
+
+
+
+ Installing with Docker
+
+
+
+ Herbie 's is available
+ through Docker , which is a
+ sort of like an easily-scriptable virtual machine. This page
+ describes how to install
+ the official Docker
+ image for Herbie.
+
+
+
+ Herbie can also be installed
+ normally .
+
+
+ Installing the Herbie image
+
+
+ First, install
+ Docker . Docker supports Windows, macOS, and Linux. Depending
+ on how you install Docker, you may need to prefix
+ the docker
command with sudo
or run them
+ as the administrative user.
+
+
+ With Docker installed, download the Herbie image:
+
+ docker pull uwplse/herbie
+
+ You can now run Herbie:
+
+ docker run -it uwplse/herbie shell
+
+ This will run the Herbie shell ,
+ reading input from the standard input.
+
+ Note that Herbie in Docker is more limited; for example, it will
+ not recognize plugins installed outside the Docker container.
+
+ Running the web shell
+
+ Running the web shell in Docker requires exposing the ports
+ inside the container. The Herbie Docker image binds to port 80 by
+ default; use the -p <hostport>:80
option to
+ Docker to expose Herbie on whatever port you choose.
+
+
+ docker run -it --rm -p 8000:80 uwplse/herbie
+
+
+ If you are using the --log
+ or --save-session
flags for the web shell,
+ you will also need to mount the relevant directories into the
+ Docker container using the -v
Docker option, as in
+ the examples below.
+
+
+ Generating files and reports
+
+
+ To use Herbie in batch mode , you will
+ need to mount the input in the Docker container. Do that with:
+
+
+ docker run -it --rm \
+ -v in-dir :/in \
+ -v out-dir :/out \
+ -u $USER \
+ uwplse/herbie improve /in/in-file /out/out-file
+
+
+ In this command, you are asking Herbie to read input
+ from in-file in in-dir , and write output
+ to out-file in out-dir . The command looks
+ the same if you want Herbie to read input from a directory;
+ just leave in-file blank.
+
+
+
+ To generate reports from Herbie, you can run:
+
+
+ docker run -it --rm \
+ -v in-dir :/in \
+ -v out-dir :/out \
+ -u $USER \
+ uwplse/herbie report /in/in-file /out/
+
+
+ As before, the input and output directories must be mounted inside
+ the Docker container. Note that both here and above, the user is
+ set to the current user. This is to ensure that the files Herbie creates
+ have the correct permissions set.
+
+
+
+
diff --git a/www/doc/1.3/faq.html b/www/doc/1.3/faq.html
new file mode 100644
index 000000000..a2c714a37
--- /dev/null
+++ b/www/doc/1.3/faq.html
@@ -0,0 +1,111 @@
+
+
+
+
+ Herbie FAQ
+
+
+
+
+
+
+
+ Frequently Asked Questions
+
+
+ Herbie automatically transforms floating
+ point expressions into more accurate forms. This page troubleshoots
+ common Herbie errors.
+
+
+ Common errors
+
+
+ Herbie error messages refer here for additional information and
+ debugging tips.
+
+
+ Invalid syntax
+
+
+ This error means you mis-formatted Herbie's input. Common errors
+ include misspelled function names and parenthesized expressions
+ that should not be parenthesized. For example, in
+ (- (exp (x)) 1)
, the expression x
is a
+ variable so shouldn't be parenthesized. (- (exp x) 1)
+ would be the correct way of writing that expression. Please review
+ the input format documentation for more.
+
+
+ Cannot sample enough valid points
+
+ This error occurs when Herbie is unable to find enough valid
+ points. For example, the expression (acos (+ 1000 x))
+ only yields a valid result when x
is between -1001 and
+ -999, a rather narrow range. The solution is to help out Herbie by
+ specifying a precondition: :pre (< -1001 x -999)
.
+ Herbie will use the precondition to improve its sampling strategy.
+
+
+ No valid values
+
+ This error indicates that your precondition excludes all possible
+ inputs. For example, the precondition (< 3 x 2)
+ excludes all inputs. Herbie raises this exception when it can prove
+ that no inputs could work. The solution is to fix the precondition
+ to allow some inputs.
+
+ Exceeded MPFR precision limit
+
+ This rare error indicates that Herbie could not compute a "ground
+ truth" for your expression. For some expressions, like (sin
+ (exp x))
, calculating a correct output for large input values
+ requires exponentially many bits. Herbie raises this error when more
+ than 10,000 bits are required.
+
+
+ Common warnings
+
+ Herbie warnings refer here for explanations and common actions to
+ take.
+
+ Could not determine a ground truth
+
+
+ Herbie will raise this warning when some inputs require more than
+ 10 000 bits to compute an exact ground truth value. For example,
+ to compute (/ (exp x) (exp x))
for very
+ large x
, absurdly large exponents would be required.
+ Herbie discards such inputs and raises this warning. If you see
+ this warning, you should add a restrictive precondition, such
+ as :pre (< -100 x 100)
, to prevent large inputs.
+
+
+ Native operation not supported on your system
+
+
+ Some systems do not have native implementations for all operations
+ that Herbie uses. (For example, Microsoft's math.h
+ does not provide the y0
function.) Herbie provides a
+ fallback implementation, but you can disable the fallback
+ with --disable precision:fallback
.
+
+
+
+ Known bugs
+
+ Some bugs cannot be directly fixed and are documented here.
+
+ Missing reports chart on Chrome
+
+
+ When using Chrome to view web pages on your local machine, Chrome
+ disables certain APIs for security reasons; this prevents the
+ Herbie reports from drawing the
+ chart. Run
+ Chrome with --allow-file-access-from-files
to fix
+ this error.
+
+
+
+
diff --git a/www/doc/1.3/input.html b/www/doc/1.3/input.html
new file mode 100644
index 000000000..763b0652b
--- /dev/null
+++ b/www/doc/1.3/input.html
@@ -0,0 +1,217 @@
+
+
+
+
+ Herbie Input Format
+
+
+
+
+
+
+
+ The Input Format
+
+
+
+ Herbie uses
+ the FPCore input format to
+ specify mathematical expressions, which Herbie searches for
+ accurate implementations of.
+
+
+ General format
+
+ FPCore format looks like this:
+
+ (FPCore (inputs ... ) properties ... expression )
+
+
+ Each input is a variable, like x
, which can be used
+ in the expression, whose accuracy Herbie will try to improve.
+ Properties are described below .
+
+
+
+ The expression is written in prefix form, with every function call
+ parenthesized, as in Lisp. For example, the formula for the
+ hypotenuse of a triangle with legs a and b is
+
+
+ (FPCore (a b) (sqrt (+ (* a a) (* b b))))
+
+
+ We recommend the .fpcore
file extension for Herbie input files.
+
+
+ Supported functions
+
+
+ Herbie supports all functions
+ from math.h
+ with floating-point-only inputs and outputs. The best supported
+ functions, far from the full list, include:
+
+
+
+ +
, -
, *
, /
, fabs
+ The usual arithmetic functions (where -
is both negation and subtraction)
+ sqrt
, cbrt
+ Square and cube roots
+ pow
, exp
, log
+ Various exponentiations and logarithms
+ sin
, cos
, tan
+ The trigonometric functions
+ asin
, acos
, atan
, atan2
+ The inverse trigonometric functions
+ sinh
, cosh
, tanh
+ The hyperbolic functions
+ asinh
, acosh
, atanh
+ The inverse hyperbolic functions
+ fma
, expm1
, log1p
, hypot
+ Specialized numeric functions
+
+
+ Herbie also supports the constants PI
+ and E
. The arithmetic operators associate to the
+ left.
+
+ Herbie links against libm
to ensure that every
+ function has the same behavior in Herbie as in your code. However,
+ on Windows platforms some functions are not available in the
+ system libm
. In these cases Herbie will use a fallback
+ implementation and print a warning; turning off the
+ the precision:fallback option
+ disables those functions instead.
+
+ Conditionals
+
+ FPCore uses if
for conditional expressions:
+
+ (if cond if-true if-false )
+
+
+ The conditional cond
may use:
+
+
+
+ ==
, !=
, <
, >
, <=
, >=
+ The usual comparison operators
+ and
, or
, not
+ The usual logical operators
+ TRUE
, FALSE
+ The two boolean values
+
+
+ The comparison functions can take any number of arguments and
+ implement chained comparisons.
+
+
+
+ Intermediate variables can be defined using let
:
+
+ (let ([variable value ] ... ) body )
+
+ In a let
expression, all the values are evaluated
+ first, and then are bound to their variables in the body. This means
+ that the value of one variable can't refer to another variable in
+ the same let
block; nest let
constructs if
+ you want to do that.
+
+ Note that Herbie treats intermediate values only as a notational
+ convenience, and inlines their values before improving the formula's
+ accuracy. Using intermediate variables will not help Herbie improve
+ a formula's accuracy or speed up its run-time.
+
+ Preconditions
+
+ By default, the arguments to formulas are assumed to be arbitrary
+ floating-point numbers. However, in many cases only a range of
+ argument values are possible. In Herbie, you can describe valid
+ arguments with the :pre
property (for
+ “precondition”).
+
+ Preconditions comparison and boolean operators, just
+ like conditional statements . Herbie is
+ particularly efficient when when the precondition is
+ an and
of ranges for each variable, such as:
+
+ (FPCore (x) :pre (< 1 x 10) (/ 1 (- x 1)))
+
+ More complex preconditions do work, but may cause
+ the “Cannot sample enough
+ valid points” error if it is too hard to find points that
+ satisfy the precondition.
+
+ Precisions
+
+ Herbie supports both single- and double-precision values; you can
+ specify the precision with the :precision
property:
+
+
+ binary32
+ Single-precision IEEE-754 floating point
+ binary64
+ Double-precision IEEE-754 floating point
+
+
+ By default, binary64
is assumed. Herbie also has
+ a plugin system to load additional
+ precisions.
+
+ Complex Numbersβ
+
+ Herbie includes experimental support for complex numbers;
+ however, this support is currently limited to a few basic
+ operations.
+
+ All input parameters to an FPCore are real numbers; complex
+ numbers must be constructed with complex
. The
+ functions re
, im
, and conj
+ are available on complex numbers, along with the arithmetic
+ operators, exp
, log
, pow
,
+ and sqrt
. Complex and real operations use the same
+ syntax, but cannot be mixed: (+ (complex 1 2) 1)
is not
+ valid. Herbie reports type errors in such situations.
+
+ Complex operations use
+ the Racket
+ implementation, so results may differ (slightly) from complex
+ numbers in some other language, especially for non-finite complex
+ numbers. Unfortunately, complex number arithmetic is not as
+ standardized as float-point arithmetic.
+
+ In the future, we hope to support complex-number arguments and
+ fully support all complex-number operations.
+
+ Miscellaneous Properties
+
+ Herbie uses the :name
property to name FPCores in
+ its UI. Its value ought to be a string.
+
+ Herbie's out uses custom FPCore properties to provide additional
+ information about the Herbie improvement process:
+
+
+ :herbie-status status
+ status describes whether Herbie worked: it is one
+ of success
, timeout
, error
,
+ or crash
.
+ :herbie-time ms
+ The time, in milliseconds, used by Herbie to find a more accurate formula.
+ :herbie-error-input ([pts err ] ...)
+ The computed average error of the input program, evaluated on pts points. Multiple entries correspond to multiple training or test sets.
+ :herbie-error-output ([pts err ] ...)
+ The computed average error of the output program, like above.
+
+
+ Herbie's passes through :name
,
+ :pre
, and :precision
properties to its
+ outputs.
+
+ The benchmark suite uses other properties (such
+ as :herbie-target
) for testing, but these are not
+ supported and their use is discouraged.
+
+
+
diff --git a/www/doc/1.3/installing.html b/www/doc/1.3/installing.html
new file mode 100644
index 000000000..870ca7747
--- /dev/null
+++ b/www/doc/1.3/installing.html
@@ -0,0 +1,132 @@
+
+
+
+
+ Installing Herbie
+
+
+
+
+
+
+
+ Installing Herbie
+
+
+ Herbie supports Linux, macOS, and Windows.
+
+
+ Herbie can be installed from a package or
+ from source. (It is also available in
+ a Docker image.) To install Herbie, first install
+ Racket , which Herbie is
+ written in.
+
+
+ Installing Racket
+
+
+ Use the official
+ installer to install Racket, or use distro-provided packages
+ provided they are version 7.0 or later of Racket (earlier versions
+ are not supported).
+
+
+
+ Test that Racket is installed correctly and has a correct version:
+
+
+ racket
+Welcome to Racket v7.3.
+> (exit)
+
+ Installing Herbie from a package
+
+ Once Racket is installed, install Herbie with:
+
+ raco pkg install --auto herbie
+
+
+ This will install Herbie, compile it for faster startup, and place
+ an executable in your Racket user path, likely
+ into ~/.racket/7.3/
. If you add this directory to
+ your PATH
you will be able to run herbie with
+ the herbie command.
+
+
+
+ Once Herbie is installed and working correctly,
+ check out the tutorial .
+
+
+ Installing Herbie from source
+
+
+ Once Racket is installed, download and build the Herbie source
+ from GitHub with:
+
+
+ git clone https://github.com/uwplse/herbie
+
+
+ If you go to the herbie
directory,
+ you should see a README.md
file, a directory named src
,
+ a directory named bench/
, and a few other directories.
+ Do a trial run of Herbie to make sure everything is installed and working correctly:
+
+
+ racket src/herbie.rkt report bench/tutorial.fpcore graphs/
+
+ This command will take approximately a minute to run.
+ After the command completes,
+ a directory named graphs
should be created.
+ Open the report.html
file inside with your browser;
+ you will see a listing of the expressions Herbie was run on,
+ all of which should be green.
+ If not, please check that your Racket installation is at least version 7.3,
+ and if the error still persists,
+ please submit a bug .
+
+
+ For faster startup, to create the herbie command, and
+ to enable plugins, run the following command:
+
+ raco pkg install --name herbie src/
+
+
+ Once Herbie is installed and working correctly,
+ check out the tutorial .
+
+
+ Installing Herbie from Docker
+
+
+ Docker is a container manager,
+ which is sort of like an easily-scriptable virtual machine. We do
+ not recommend using Herbie through Docker without prior Docker
+ experience.
+
+
+
+ First, install
+ Docker . Docker supports Windows, macOS, and Linux. Depending
+ on how you install Docker, you may need to prefix
+ the docker
command with sudo
or run them
+ as the administrative user.
+
+
+
+ With Docker installed, you should be able to download the Herbie image with:
+
+
+ docker pull uwplse/herbie
+
+
+ Check out the Docker page for more on
+ how to run Herbie with Docker. Note that Herbie in Docker is more
+ limited; for example, it will not recognize plugins installed
+ outside the Docker container.
+
+
+
+
diff --git a/www/doc/1.3/options.html b/www/doc/1.3/options.html
new file mode 100644
index 000000000..11c982e5a
--- /dev/null
+++ b/www/doc/1.3/options.html
@@ -0,0 +1,306 @@
+
+
+
+
+ Herbie Command-line Options
+
+
+
+
+
+
+
+ Command-line Options
+
+
+ The herbie
command several
+ subcommands and options that influence both its user interface and
+ the quality of solutions that it finds.
+
+ Herbie commands
+
+ Herbie can be run both interactively and in batch mode, and can
+ generate output intended either for
+ the command line
+ or the web . We call these different
+ ways of running Herbie different tools. Herbie provides four
+ tools:
+
+
+ herbie web
+ Use Herbie through your browser. herbie web
+ starts a web server for running Herbie on your local machine, and
+ directs a browser to visit that server.
+
+ herbie shell
+ Starts a command-line interactive shell for using Herbie.
+ Enter an FPCore expression and Herbie
+ will print its more-accurate version.
+
+ herbie improve input output
+ Runs Herbie on the expressions in the file or
+ directory input , and outputs the result
+ to output , which will be a single file of FPCore
+ outputs.
+
+ herbie report input output
+ Runs Herbie on the expressions in the file or
+ directory input , and produces a
+ directory output of HTML pages that describe Herbie's
+ output, how it derived that output, and additional charts and
+ information about the improvement process. These pages can be
+ viewed in any browser (though with a quirk
+ for Chrome).
+
+
+ We recommend using the web tools, web
+ and report
, since HTML allows Herbie to give you more
+ information about how and why it improved a floating-point
+ expression's accuracy. Particularly useful are the graphs it
+ produces of error versus input, which can help you understand
+ whether Herbie's improvements matter for your user cases.
+
+ For any tool, you can run herbie tool --help
+ to see a listing of all available command-line options. This listing
+ will include unsupported options not listed on this page.
+
+ General options
+
+
+ These options can be set on any tool. Pass them after the tool
+ name but before other arguments, such as:
+
+
+ herbie improve --timeout 60 in.fpcore out.fpcore
+
+ Arguments cannot be put anywhere else.
+
+
+ --seed S
+ The random seed, which changes the randomly-selected points
+ that Herbie evaluates candidate expressions on. The seed is a
+ number between 0 and 231 (exclusive both ends). This
+ option can be used to make Herbie's results reproducible or to
+ compare two different runs. Prior versions of Herbie used a
+ different format for seeds, which is now deprecated.
+
+ --num-iters N
+ The number of improvements Herbie attempts to make to the
+ program. The default, 4, suffices for most programs and helps
+ keep Herbie fast. If this is set very high, Herbie may run out
+ of things to do and terminate before the given number of
+ iterations, but in practice iterations beyond the first few
+ rarely lead to lower error. This option can be increased to 5 or
+ higher to check that there aren't further improvements that Herbie
+ could seek out.
+
+ --num-points N
+ The number of randomly-selected points used to evaluate
+ candidate expressions. The default, 256, gives good behavior for
+ most programs. The more points sampled, the slower Herbie is.
+ This option can be increased to 512 or 1024 if Herbie gives very
+ inconsistent results between runs with different seeds.
+
+ --timeout T
+ The timeout to use per-input, in seconds. A fractional number
+ of seconds can be given.
+
+ --threads N
(for the improve
and report
tools)
+ Enables multi-threaded operation. By default, no threads are
+ used. A number can be passed to this option to use that many
+ threads, or yes
can be passed to tell Herbie to use
+ all of the hardware threads.
+
+
+ Web shell options
+
+ The web
tool runs Herbie as a web server, and
+ connects to it from your browser. It has additional options to
+ control this server.
+
+
+ --port N
+ The port to run the Herbie server on. The default port is 8000.
+
+ --save-session dir
+ Save all the reports for expressions enterred into the web
+ shell to this directory. The directory is also used as a
+ cache of already-computed expressions.
+
+ --log file
+ Write a web access log to this file. The file is formatted
+ similarly to Apache logs. If Herbie crashes for some reason, this
+ log will not contain a traceback.
+
+ --quiet
+ By default, but not when this option is set, a browser is
+ started to point to the Herbie page. This option also shrinks the
+ a banner printed to the command line.
+
+ --public
+ When set, users on other computers can connect to the demo and
+ use it. (In other words, the server listens
+ on 0.0.0.0
.). Also useful when Herbie is run
+ through Docker .
+
+
+ Rulesets
+
+
+ Herbie uses rewrite rules to make changes to formulas and improve
+ their accuracy. These rules can be turned on and off in groups
+ using --disable rules:group
+ and --enable rules:group
. In general,
+ enabling rules improves the accuracy of Herbie's output but may
+ allow it to use functions not available on your platform.
+
+
+ The full list of rule groups is:
+
+
+ Rule Group Topic of rewrite rules
+ arithmetic Basic arithmetic facts
+ polynomials Factoring and powers
+ fractions Fraction arithmetic
+ exponents Exponentiation identities
+ trigonometry Trigonometric identities
+ hyperbolic Hyperbolic trigonometric identities
+ special Special mathematical functions
+ complex Complex number arithmetic
+ numerics Special numerical functions expm1
, log1p
, fma
, and hypot
+ bools Boolean operator identities
+ branches if
statement simplification
+
+
+ All groups except numerics
are enabled by default.
+ We recommend turning numerics
on if these functions are
+ available in your language, and disabling complex
+ or special
if those functions are poorly implemented in
+ your language.
+
+ Search options
+
+
+ These options influence Herbie's search, most importantly the
+ types of transformations that Herbie uses to find candidate
+ programs. They offer fine-grained control and are only recommended
+ for advanced uses of Herbie.
+
+
+
+ Each option can be turned off with the -o
+ or --disable
command-line flag, and turned on with
+ +o
or --enable
. The recommended options
+ are the defaults; turning a default-on option off typically
+ results in less-accurate results, while turning a default-off
+ option on typically results in more-complex and more-surprising
+ output expressions.
+
+
+
+ precision:double
+ This option, on by default, tells Herbie default to
+ double-precision calculations. If turned off, Herbie defaults to
+ single-precision calculations. This option is a legacy option; use
+ the :precision
FPCore
+ property to change precisions instead.
+
+ precision:fallback
+ This option, on by default, tells Herbie to use fallback
+ functions if a native implementation is not found for an operation
+ (and print a warning). If turned off, operations with no native
+ implementation will be disabled entirely. Turn this option off if
+ you require Herbie to be faithful to your system's implementation
+ of libm
.
+
+ setup:simplify
+ This option, on by default, simplifies the expression before
+ passing it to Herbie. If turned off, Herbie will not simplify
+ input programs before improving them. Turn this option off if
+ simplifying the input will create a lot of error, say if the
+ association of operations is cleverly chosen.
+
+ setup:early-exit
+ This option, off by default, causes Herbie to exit without
+ modifying the input program if it determines that the input
+ program has less than 0.1 bits of error. Turn this option on if
+ you are running Herbie on a large corpus of programs that you do
+ not believe to be inaccurate.
+
+ generate:rr
+ This option, on by default, uses Herbie's recursive rewriting
+ algorithm to generate candidate programs. If turned off, Herbie
+ will use a non-recursive rewriting algorithm, which will
+ substantially limit the candidates Herbie finds. You will rarely
+ want to turn this option off.
+
+ generate:taylor
+ This option, on by default, uses series expansion to produce
+ new candidates during the main improvement loop. If turned off,
+ Herbie will not use series expansion. Turn this option off if you
+ want to avoid series-expansion-based rewrites, such as if you need
+ to preserve the equivalence of the input and output expressions as
+ real-number formulas.
+
+ generate:simplify
+ This option, on by default, simplifies candidates during the
+ main improvement loop. If turned off, candidates will not be
+ simplified, which typically results in much less accurate
+ expressions, since simplification is often necessary for
+ cancelling terms. You will rarely want to turn this option
+ off.
+
+ reduce:regimes
+ This option, on by default, uses Herbie's regime inference
+ algorithm to branch between several program candidates. If turned
+ off, branches will not be inferred and the output program will be
+ straight-line code (if the input was). Turn this option off if
+ your programming environment makes branches very expensive, such
+ as in some cases of GPU programming.
+
+ reduce:avg-error
+ This option, on by default, causes Herbie to output the
+ candidate with the best average error over the chosen inputs. If
+ turned off, Herbie will choose the candidate with the least
+ maximum error instead. This usually produces programs with worse
+ overall accuracy. Turn this option off if worst-case accuracy is
+ more important to you than overall accuracy.
+
+ reduce:binary-search
+ This option, on by default, uses binary search to refine the
+ values used in inferred conditionals. This makes different runs of
+ Herbie produce more similar results, and improves accuracy near
+ those values. If turned off, binary search will not be used, and
+ the branch values will be less accurately chosen. Turn this option
+ off if behavior near branches is not important to you.
+
+ reduce:branch-expressions
+ This option, on by default, allows Herbie to branch on
+ expressions, not just variables. This can improve accuracy on
+ regime branching, slows Herbie down, particularly for large
+ programs. If turned off, Herbie will only try to branch on
+ variables. Turn this option off if Herbie runtime is more
+ important to you than expression accuracy.
+
+
+ Upgrading from Herbie 1.0
+
+ Herbie 1.0 used
+ a different command line
+ syntax, without multiple tools. Translate like so:
+
+
+ herbie-1.0
→ herbie-1.3 shell
+ herbie-1.0 file
→ herbie-1.3 improve file -
+ herbie-1.0 files ...
→ cat files ... | herbie-1.3 improve - -
+ Alternatively, collect the files into a directory and run herbie-1.3 improve dir/ -
+
+
+ The new syntax somewhat changes Herbie's behavior, such as by
+ using the input expression as the output if Herbie times out. It
+ also makes it easier to write Herbie's output to a file without
+ using command-line redirection.
+
+
+
+
diff --git a/www/doc/1.3/plugins.html b/www/doc/1.3/plugins.html
new file mode 100644
index 000000000..be0aa0354
--- /dev/null
+++ b/www/doc/1.3/plugins.html
@@ -0,0 +1,47 @@
+
+
+
+
+ Herbie Plugins
+
+
+
+
+
+
+
+ Plugins
+
+
+ Herbie allows plugins to define additional
+ functions, rewrite rules, and even number representations. Plugins
+ are be separately installed. Once installed, Herbie automatically
+ loads and uses them.
+
+ Posit arithmetic
+
+ The softposit-herbie plugin implements support
+ for posit arithmetic. Install it
+ with:
+
+ raco pkg install --auto softposit-herbie
+
+ Note that this plugin uses the SoftPosit library, which only
+ supports Linux platforms, and even then is reported to misbehave on
+ some machines.
+
+ Once softposit-herbie is installed,
+ specify :precision posit16
to inform Herbie that it
+ should assume the core's inputs and outputs are posit numbers. Other
+ posit sizes (from 8 to 128 bits) and also quires (for 8, 16, and 32
+ bits) are available, but are poorly supported.
+
+ Developing plugins
+
+ The plugin functionality is currently highly experimental; if you
+ would like to develop your own plugins, please write to
+ the mailing
+ list .
+
+
+
diff --git a/www/doc/1.3/release-notes.html b/www/doc/1.3/release-notes.html
new file mode 100644
index 000000000..ae2cb342e
--- /dev/null
+++ b/www/doc/1.3/release-notes.html
@@ -0,0 +1,153 @@
+
+
+
+
+ Herbie 1.3 Release Notes
+
+
+
+
+
+
+
+ Herbie 1.3 Release Notes
+
+
+
+ The Herbie developers are excited to announce
+ Herbie 1.3! This release focuses on speed and
+ transparency : Herbie 1.3 is nearly twice as fast as
+ Herbie 1.2, and includes cleaner, more comprehensive HTML output.
+
+
+
+ Herbie automatically improves the accuracy of floating point
+ expressions. This avoids the bugs, errors, and surprises that so
+ often occur when working with floating point. Since
+ our PLDI'15 paper , we've been hard at
+ work making Herbie more versatile and easier to use.
+
+
+
+
+ Major features of this release
+
+ Speed: Herbie is roughly twice as fast as in
+ previous releases. Making this happen has involved changes large and
+ small: a clever change to how we use simplification, a new sampling
+ algorithm, and also lots of work tracking down especially slow
+ expressions.
+
+ Transparency: Herbie's web output has become
+ cleaner and more comprehensive. Herbie can now show you its output
+ in C and TeX as well as mathematical notation. You can now specify
+ preconditions and precisions when inputting expressions. And Herbie
+ has a new "Metrics" tab to show in-depth internal information, which
+ will help us continue to improve Herbie.
+
+ Beta features in this release
+
+ Windows support has graduated from beta. We
+ intend to support Windows going forward; if you run into any bugs,
+ please let us
+ know .
+
+ Plugins can now
+ define new number systems and then teach
+ Herbie to use them. There's a new plugin to add support
+ for posit arithmetic . Right now
+ the plugin system is still in flux, so if you'd like to use it,
+ please write
+ to us .
+
+
+
+ Herbie 1.3 is roughly 2× faster than Herbie 1.2,
+ thanks to efforts throughout the year. This plot shows how long
+ Herbie's CI takes to run, for every passing CI run this release
+ cycle. In April we added more tests, causing the bump in Travis
+ time around then.
+
+
+
+ Improvement to core algorithm
+
+
+ Careful performance work has made Herbie nearly three times
+ faster than the 1.2 release.
+ Herbie now uses interval arithmetic to compute "ground truth"
+ values. This makes Herbie's accuracy estimate for a
+ program more correct.
+ Support for single-precision mode has been significantly improved.
+ Series expansion of pow
s with constant exponents
+ is now much faster.
+ Complex numbers are now handled significantly more quickly.
+ Various fixes have eliminated rare but large slowdowns.
+
+
+ Usability improvements
+
+
+ Herbie's web interface now allows you to change preconditions
+ and precisions (click “additional options” below the formula bar).
+ You can now see C code for Herbie's output—use the drop-down
+ above and to the right of the program box.
+ Herbie has a new website !
+ Hopefully it's a little easier to learn about what Herbie is and
+ how to use it.
+ Herbie now shows preconditions in its HTML output.
+ Herbie now produces somewhat simpler output, for example by
+ simplifying exact constant expressions like (+ 2
+ 2)
.
+ You can now input if statements on the web using
+ conditional-expression syntax.
+ Herbie will now show warnings in its HTML output, including
+ links to more documentation.
+ Herbie now indents and breaks lines when it prints FPCores in
+ the terminal.
+ Herbie now uses KaTeX to
+ render math in the browser, which is significantly faster than
+ the previous MathJax
+ library.
+ Error and timeout pages now show the input program.
+
+
+ Code Cleanup
+
+
+ Reports now link to an extensive collection of quality and
+ performance metrics. This should help improve Herbie's speed and
+ accuracy over time.
+ Documentation has been improved, with tables of content and
+ explanations of preconditions and precisions.
+ The new reproduce tool allows rerunning a
+ report.
+ The timebar on the metrics page now separates regime inference
+ from binary search.
+ Herbie's JavaScript code has been refactored, making it much
+ easier to maintain.
+ Lots of old, unused code has been deleted, including a lot of
+ support code for the
+ obsolete Herbie
+ Visualizer .
+ Glue code has been moved into a single file, clarifying
+ responsibilities for a lot of modules.
+
+
+ Try it out!
+
+
+ We're excited to continue to improve Herbie and make it more
+ useful to scientists, engineers, and programmers around the world.
+ We've got a lot of features we're excited to work on in the coming
+ months. Please
+ report bugs ,
+ join
+ the
+ mailing list ,
+ or contribute .
+
+
+ If you find Herbie useful, let us know!
+
+
diff --git a/www/doc/1.3/report-derivation.png b/www/doc/1.3/report-derivation.png
new file mode 100644
index 000000000..c361212fa
Binary files /dev/null and b/www/doc/1.3/report-derivation.png differ
diff --git a/www/doc/1.3/report-error.png b/www/doc/1.3/report-error.png
new file mode 100644
index 000000000..cf9b9c525
Binary files /dev/null and b/www/doc/1.3/report-error.png differ
diff --git a/www/doc/1.3/report-large.png b/www/doc/1.3/report-large.png
new file mode 100644
index 000000000..224256c7e
Binary files /dev/null and b/www/doc/1.3/report-large.png differ
diff --git a/www/doc/1.3/report-plot2.png b/www/doc/1.3/report-plot2.png
new file mode 100644
index 000000000..86cd24305
Binary files /dev/null and b/www/doc/1.3/report-plot2.png differ
diff --git a/www/doc/1.3/report-prog.png b/www/doc/1.3/report-prog.png
new file mode 100644
index 000000000..ef41f9c5f
Binary files /dev/null and b/www/doc/1.3/report-prog.png differ
diff --git a/www/doc/1.3/report-prog2.png b/www/doc/1.3/report-prog2.png
new file mode 100644
index 000000000..9f93084d6
Binary files /dev/null and b/www/doc/1.3/report-prog2.png differ
diff --git a/www/doc/1.3/report-reproduce.png b/www/doc/1.3/report-reproduce.png
new file mode 100644
index 000000000..7f36144f9
Binary files /dev/null and b/www/doc/1.3/report-reproduce.png differ
diff --git a/www/doc/1.3/report-try-it.png b/www/doc/1.3/report-try-it.png
new file mode 100644
index 000000000..0f7756e97
Binary files /dev/null and b/www/doc/1.3/report-try-it.png differ
diff --git a/www/doc/1.3/report.html b/www/doc/1.3/report.html
new file mode 100644
index 000000000..de4440f2b
--- /dev/null
+++ b/www/doc/1.3/report.html
@@ -0,0 +1,141 @@
+
+
+
+
+ Herbie reports
+
+
+
+
+
+
+
+ Herbie reports
+
+
+
+ The Herbie report
+
+ Herbie can generate HTML reports
+ which give its output expression and also how Herbie found it.
+
+ Summary numbers
+
+ First, a brief summary of the results. For most uses, the
+ “Average Error” number, which summarizes how accurate the input
+ and output expressions are, is the most important number in this
+ section. The other numbers list time Herbie took to improve the
+ program and the precision of
+ floating-point operations.
+
+
+
+
+ Summary numbers from a Herbie report.
+
+
+ Input and output programs
+
+ Second, the input and output programs themselves. These are
+ printed in standard mathematical syntax. In the top-right corner,
+ the drop-down can be used to change to C syntax or raw TeX.
+
+
+
+ Input and output program from a Herbie report.
+
+
+ Error graph
+
+
+ Third, under Error , a graph of floating-point error
+ versus input value. This is helpful for understanding the sorts of
+ inputs Herbie is improving accuracy on. Sometimes, Herbie improved
+ accuracy on some inputs at the cost of accuracy on other inputs
+ that you care more about. In these cases, you can add
+ a :pre
condition
+ to restrict the inputs Herbie reasons about.
+
+
+
+ On these graphs, the red line is the error of the input program,
+ while the blue line is the error of the output program
+ (both can be toggled).
+ For expressions with multiple variables,
+ the variable on the horizontal axis can be selected.
+ If Herbie decided to insert
+ an if
statement into the program,
+ the locations of those if
statements
+ will be marked with vertical bars.
+
+
+
+
+ An error graph from a Herbie report. Note the variable
+ selector (x
is selected) and the toggles for the
+ input and output program (both are toggled on).
+
+
+ Interactive inputs
+
+
+ Fourth, a form where you can try out specific inputs on the input
+ program and Herbie's output program. Enter the argument values on
+ the left, and the input and output programs will be evaulated on
+ those arguments and the results printed on the right.
+
+
+
+
+
+ Try it out section on a simple program.
+
+
+
+ Derivation
+
+ Fifth, a derivation of the output from the input.
+ For complex or unexpected programs, these can be helpful.
+ Each substantive step in the derivation also lists the error,
+ in bits, of that step's output.
+
+ The derivations may name rules built into Herbie,
+ or may claim derivation steps are done by simplification,
+ series expansion, or other Herbie strategies. The derivation will
+ also call out splits of the input into regimes, and strategies
+ Herbie is invoking. When one part of the term is colored blue,
+ that is the only part of the term modified by the operation.
+
+
+
+
+ A short derivation from a Herbie report. Note the
+ error at each step, in bits, in gray.
+
+
+ Reproduction
+
+ Sixth, a command you can use to reproduce this Herbie result.
+ If you find a bug, include the code snippet in this section when
+ filing the
+ bug . Please also include the debug log linked at the top of the
+ page.
+
+
+
+ Reproduction information for a Herbie run.
+
+
+ Additional links
+
+ The top of the page has a right-hand menu bar with additional
+ links. “Log” you to a detailed debug log. “Profile” gives
+ a gprof
-style profile. and “Metrics” gives detailed
+ internal metrics on Herbie's results.
+
+ We expect the report to grow more informative with future
+ versions. Please get in
+ touch if there is more information you'd like to see.
+
+
+
diff --git a/www/doc/1.3/team.png b/www/doc/1.3/team.png
new file mode 100644
index 000000000..88aa18c76
Binary files /dev/null and b/www/doc/1.3/team.png differ
diff --git a/www/doc/1.3/toc.js b/www/doc/1.3/toc.js
new file mode 100644
index 000000000..d1f1a1671
--- /dev/null
+++ b/www/doc/1.3/toc.js
@@ -0,0 +1,22 @@
+function make_toc() {
+ var headings = document.querySelectorAll("h2");
+ var toc = document.createElement("nav");
+ toc.classList.add("toc")
+ var list = document.createElement("ul");
+ for (var i = 0; i < headings.length; i++) {
+ var li = document.createElement("li");
+ var a = document.createElement("a");
+ var h = headings[i];
+ if (! h.id) {
+ h.setAttribute("id", "heading-" + i);
+ }
+ a.setAttribute("href", "#" + h.id);
+ a.innerHTML = h.innerHTML;
+ li.appendChild(a);
+ list.appendChild(li);
+ }
+ toc.appendChild(list);
+ headings[0].parentNode.insertBefore(toc, headings[0]);
+}
+
+window.addEventListener("load", make_toc);
diff --git a/www/doc/1.3/travis-time.png b/www/doc/1.3/travis-time.png
new file mode 100644
index 000000000..536f7d157
Binary files /dev/null and b/www/doc/1.3/travis-time.png differ
diff --git a/www/doc/1.3/tutorial.html b/www/doc/1.3/tutorial.html
new file mode 100644
index 000000000..4baac12b9
--- /dev/null
+++ b/www/doc/1.3/tutorial.html
@@ -0,0 +1,290 @@
+
+
+
+
+ Herbie Tutorial
+
+
+
+
+
+
+ Herbie Tutorial
+
+
+
+ Herbie automatically rewrites
+ floating point expressions to make them more accurate.
+ Floating point arithmetic is inaccurate;
+ hence the jokes that 0.1 + 0.2 ≠ 0.3 for a computer.
+ But it is hard to understand and fix these inaccuracies,
+ creating mysterious and hard-to-fix bugs.
+ Herbie is a tool to help.
+
+
+
+ To get started, download and install
+ Herbie. With Herbie installed, you're ready to begin using it.
+
+
+ Giving Herbie expressions
+
+ Now that Herbie is installed, start it with:
+
+ herbie web
+
+
+ After a brief wait, this ought to open a web browser to a page
+ with Herbie's results. The most important part of the page is this
+ bit:
+
+
+
+
+ The program input field in the Herbie web UI.
+
+
+ Go ahead and type (1 + x) - x into this box and press
+ enter. You should see the entry box gray out, then some additional
+ text appear on the screen describing the various steps Herbie is
+ doing. Eventually (after a few seconds) you'll be redirected to a
+ page with Herbie's results. The most important part of that page is
+ the large gray box in the middle:
+
+
+
+
+ Input and output program from a Herbie report.
+
+
+
+ This shows both the input (1 + x) - x
that you gave
+ Herbie, and also Herbie's idea of a more accurate way to evaluate
+ that expression: 1
. Here, Herbie did a good job,
+ which you can double check using the statistics above that box:
+
+
+
+
+ Statistics and error measures for this Herbie run.
+
+
+
+ Here, Herbie reports that the improved the program has 0 bits of
+ error, on average, whereas the original program had 29.4. That's
+ because, when x
is really big, x + 1 = x
+ in floating-point arithmetic, so (x + 1) - x = 0
.
+
+
+
+ There's lots more information on this
+ results web page to help explain both what the accuracy is on
+ different inputs and to describe how Herbie derived its result.
+
+
+ Programming with Herbie
+
+ Now that you've run Herbie and know how to read its results,
+ let's work through applying Herbie to a realistic program.
+
+
+ When you're working on a numerical program, it's best to keep
+ Herbie open in a browser tab so you can run it easily. That way,
+ when you're writing a complex floating-point expression, you can
+ run Herbie to make sure you use the most accurate version of that
+ expression that you can. Herbie
+ has options to log all the expressions
+ you enter, so that you can refer to them later.
+
+
+ However, if you're tracking down a bug that you think is caused
+ by floating-point error, you'll need to identify the problematic
+ floating-point expression before you can use Herbie on it.
+
+
+ As an example, let's use math.js ,
+ an extensive math library for JavaScript, and walk
+ through bug
+ 208 , which found an inaccuracy in the implementation of complex
+ square root. (For a full write-up of the bug itself, check out
+ a blog
+ post by one of the Herbie authors.)
+
+
+ Finding the problematic expression
+
+
+ Before using Herbie you need to know what floating-point
+ expressions to feed it. In most programs, there's a small core
+ that does the mathematical computations, while the rest of the
+ program sets up parameters, handles control flow, visualizes or
+ print results, and so on. The mathematical core is what Herbie
+ will be interested in.
+
+
+
+ For example, in the case of math.js, the mathematical core
+ is in lib/function/
.
+ Each file in each subdirectory contains a collection of mathematical functions.
+ The bug we're interested in is about complex square root, so let's look at the file
+ arithmetic/sqrt.js
,
+ which contains real and complex square roots.
+
+
+
+ The code handles argument checks, five different number types, and
+ error handling. None of that is of interest to Herbie; we want to
+ extract just the mathematical computation. So let's look at
+ the isComplex(x)
case:
+
+
+ var r = Math.sqrt(x.re * x.re + x.im * x.im);
+if (x.im >= 0) {
+ return new Complex(
+ 0.5 * Math.sqrt(2.0 * (r + x.re)),
+ 0.5 * Math.sqrt(2.0 * (r - x.re))
+ );
+}
+else {
+ return new Complex(
+ 0.5 * Math.sqrt(2.0 * (r + x.re)),
+ -0.5 * Math.sqrt(2.0 * (r - x.re))
+ );
+}
+
+ Converting problematic code to Herbie input
+
+
+ This code contains a branch: one option for non-negative x.im
,
+ and one for positive x.im
.
+ While Herbie supports an if
construct,
+ it's usually better to send each branch to Herbie separately.
+
+
+
+ Also, in this code, x
is of
+ type Complex
, a data structure with multiple fields.
+ Herbie only deals with floating-point numbers, not data
+ structures, so we will treat the input x
as two
+ separate inputs to Herbie: xre
and xim
.
+ We'll also pass each field of the output to Herbie separately.
+
+
+
+ Finally, each field of the final output uses the
+ variable r
, which is defined in the first line of the
+ code snippet. When you're using Herbie, you want to expand or
+ inline intermediate variables like this, because the definition of
+ that variable contains important information that Herbie can use
+ to improve accuracy.
+
+ Putting this all together, let's do the first field of the
+ non-negative x.im
case first. It looks like this:
+
+ 0.5 * sqrt(2.0 * (sqrt(xre * xre + xim * xim) + xre))
+
+ Before running Herbie on this expression, click the “Additional
+ options” link. You should see a box where you can enter a
+ precondition; enter xim <= 0 . This makes sure that
+ Herbie only considers the points this expression will actually be
+ run on when improving the accuracy of this expression.
+
+ Using Herbie's results
+
+ Herbie will churn for a few seconds and produce an output,
+ perhaps something like this:
+
+
+
+ Herbie's version of the complex square root expression.
+
+
+ Herbie's algorithm is randomized, so you likely won't see the
+ exact same thing. For example, the branch expression xre ≤
+ 6.68107529348e-308
will probably have some other really small
+ number. And perhaps Herbie will choose slightly different
+ expressions. But the result should be recognizably similar. In this
+ case, Herbie reports that the initial expression had 38.7 bits of
+ error, and that the output has 29.4.
+
+ It's a little harder to describe what Herbie found wrong with the
+ original expression, and why its new version is better—it is due to
+ a floating-point phenomenon called “cancellation”. But you can get
+ some insight from the error plot just below the program block:
+
+
+
+ Herbie's error plot for the complex square root expression.
+
+
+ There's a lot going on here. Along the horizontal axis, you have
+ the various input values (of xim
). Note that the graph
+ is log-scale, and includes only negative values (thanks to our
+ precondition). So in the middle is the value -1, to the left you have
+ values with large exponents approaching infinity, and to the right
+ you have values with small exponents approaching 0.
+
+ On the vertical axis, you have Herbie's error measure (bits of
+ error), from 0 to 64. There are two lines drawn: a red one for your
+ input expression and a blue one for Herbie's output. Lower is
+ better. You can see from the plot that as xim
gets
+ larger (toward the right, closer to zero), Herbie's improvement
+ becomes more and more important. Below the plot, there is a list of
+ the argument names, with xim
highlighted. If you switch
+ it to xre
, you will see that the two expressions are
+ the same for positive xre
, and that Herbie's output is
+ better for negative xre
. You can also see that the
+ difference is quite large, with Herbie's output expression being
+ much more accurate than its input.
+
+ Note again that Herbie is randomized, and you may see somewhat
+ different output than the screenshots and descriptions here. The
+ overall gist should be similar, however.
+
+ Now that you have the more accurate version of this expression,
+ all you need to do is insert it back into the program:
+
+ var r = Math.sqrt(x.re * x.re + x.im * x.im);
+// Herbie version of 0.5 * Math.sqrt(2.0 * (r + x.re))
+var re;
+if (x.re <= 0) {
+ re = Math.abs(x.im) * Math.sqrt(0.5) / Math.sqrt(r - x.re);
+} else {
+ re = 0.5 * Math.sqrt(2.0 * (r + x.re));
+}
+if (x.im >= 0) {
+ return new Complex(
+ re,
+ 0.5 * Math.sqrt(2.0 * (r - x.re))
+ );
+}
+else {
+ return new Complex(
+ 0.5 * Math.sqrt(2.0 * (r + x.re)),
+ -0.5 * Math.sqrt(2.0 * (r - x.re))
+ );
+}
+
+ Note that I've left the original code in place in a comment.
+ That's because the original code is a bit more readable, and it also
+ means that as Herbie gets better, we can re-run it to get future
+ improvements in accuracy.
+
+ By the way, for some languages, like C, you can use the drop-down
+ in the top-right corner of the gray program block to see Herbie's
+ output in that language. You'll probably need to clean up the
+ resulting program a bit, though.
+
+ Next steps
+
+ With this change, we've made this part of the complex square root
+ function much more accurate, and we could repeat the same steps for
+ the other branches and other fields in this program. You now have a
+ pretty good understanding of Herbie and how to use it.
+ Please let us know if
+ Herbie has helped you, and check out
+ the documentation to learn more about
+ Herbie's various options and outputs.
+
+
+
diff --git a/www/doc/1.3/using-cli.html b/www/doc/1.3/using-cli.html
new file mode 100644
index 000000000..48f3ecb86
--- /dev/null
+++ b/www/doc/1.3/using-cli.html
@@ -0,0 +1,130 @@
+
+
+
+
+ Using Herbie from the Command Line
+
+
+
+
+
+
+
+ Using Herbie from the Command Line
+
+
+
+ Herbie rewrites floating point expressions to
+ make them more accurate. The expressions could come from
+ anywhere—your source code, mathematical papers, or even the output
+ of Herbgrind , our tool for
+ finding inaccurate expressions in binaries.
+
+
+ Herbie can be used from the command-line
+ or from the browser . This page covers
+ using Herbie from the command line.
+
+ Input expressions
+
+ Herbie takes file and command-line input
+ in FPCore syntax . You can find example
+ FPCore files in the bench/
directory in the source
+ code. For example, bench/tutorial.fpcore
contains:
+
+ (FPCore (x)
+ :name "Cancel like terms"
+ (- (+ 1 x) x))
+
+(FPCore (x)
+ :name "Expanding a square"
+ (- (sqr (+ x 1)) 1))
+
+(FPCore (x y z)
+ :name "Commute and associate"
+ (- (+ (+ x y) z) (+ x (+ y z))))
+
+ This code defines three floating point expressions that we want
+ to run Herbie on:
+
+
+ (1 + x) - x
, titled “Cancel like terms”
+ (x + 1)² - 1
, titled “Expanding a square”
+ ((x + y) + z) - (x + (y + z))
, titled “Commute
+ and associate”
+
+
+ The input format documentation contains more details.
+
+ The Herbie shell
+
+
+ The Herbie shell lets you interact with Herbie, typing in
+ benchmark expressions and seeing the outputs. Run the Herbie
+ shell:
+
+
+ herbie shell
+
+
+ After a few seconds, Herbie will start up and wait for input:
+
+
+ herbie shell
+Herbie 1.3 with seed 2098242187
+Find help on https://herbie.uwplse.org/, exit with Ctrl-D
+herbie>
+
+ The printed seed can be used to reproduce a Herbie run. You can
+ now paste inputs directly into your terminal for Herbie to
+ improve:
+
+ herbie> (FPCore (x) :name "Cancel like terms" (- (+ 1 x) x))
+(FPCore
+ (x)
+ ...
+ 1.0)
+
+ The output suggests the expression 1
as a more
+ accurate variant of the original expression. Note that
+ the ... hides lots
+ of additional
+ information from Herbie, including error estimates and runtime
+ information.
+
+ The Herbie shell makes it easy to play with different expressions
+ and try multiple variants, informed by Herbie's advice.
+
+ Batch processing FPCores
+
+
+ Alternatively, you can run Herbie on a file with multiple
+ expressions in it, producing the output expressions to a file.
+ This mode is intended for use by scripts.
+
+
+ herbie improve bench/tutorial.fpcore out.fpcore
+Starting Herbie on 3 problems (seed: 1809676410)...
+ 1/3 [ 2.202s] 29→ 0 Cancel like terms
+ 2/3 [ 14.875s] 39→ 0 Expanding a square
+ 3/3 [ 8.546s] 0→ 0 Commute and associate
+
+
+ The output file out.fpcore
contains more accurate
+ versions of each program:
+
+
+ ;; seed: 1809676410
+
+(FPCore (x) ... 1.0)
+(FPCore (x) ... (+ (* x x) (* 2.0 x)))
+(FPCore (x y z) ... 0.0)
+
+
+ Note that the order of expressions is identical.
+ For more control over Herbie, see the documentation of
+ Herbie's command-line options .
+
+
+
+
diff --git a/www/doc/1.3/using-web.html b/www/doc/1.3/using-web.html
new file mode 100644
index 000000000..d06dd414e
--- /dev/null
+++ b/www/doc/1.3/using-web.html
@@ -0,0 +1,108 @@
+
+
+
+
+ Using Herbie from the Browser
+
+
+
+
+
+
+
+ Using Herbie from the Browser
+
+
+
+ Herbie rewrites floating point expressions to
+ make them more accurate. The expressions could come from
+ anywhere—your source code, mathematical papers, or even the output
+ of Herbgrind , our tool for
+ finding inaccurate expressions in binaries.
+
+
+ Herbie can be used from the
+ command-line or from the browser. This page covers
+ using Herbie from the browser.
+
+
+ The Herbie web shell
+
+
+ The Herbie web shell lets you interact with Herbie through your
+ browser, featuring a convenient input format. Run the Herbie web
+ shell:
+
+
+ herbie web
+
+ After a few seconds, the web shell will rev up and direct your
+ browser to Herbie:
+
+ herbie web
+Herbie 1.3 with seed 841489305
+Find help on https://herbie.uwplse.org/, exit with Ctrl-C
+Your Web application is running at http://localhost:8000/.
+Stop this program at any time to terminate the Web Server.
+
+
+
+ The Herbie web shell.
+
+
+
+ You can type expressions in standard mathematical syntax (parsed
+ by Math.js ), and
+ hit Enter to have Herbie attempt to improve them.
+
+
+
+
+ Herbie shows improvement logs as it works.
+
+
+
+ The web shell will print Herbie's progress, and redirect to a
+ report once Herbie is done.
+
+
+
+ Interactive use of the web shell is the friendliest and easiest
+ way to use Herbie. The web shell has many
+ options , including automatically saving the generated reports.
+
+
+
+ Batch report generation
+
+ A report can also be generated directly
+ from a file of input expressions :
+
+ $ herbie report input.fpcore output/
+Starting Herbie on 3 problems (seed: 1201949741)...
+ 1/3 [ 22.014s] 39→ 0 Expanding a square
+ 2/3 [ 8.616s] 0→ 0 Commute and associate
+ 3/3 [ 1.715s] 29→ 0 Cancel like terms
+
+
+ This command asks Herbie to generate a report from the input
+ expressions in input.fpcore
and save the report in
+ the directory output/
, which ought not exist yet.
+ The printed seed can be used to reproduce a run of Herbie.
+
+
+
+ Once generated, open the output/results.html
page
+ in your favorite browser (but see the FAQ
+ if you're using Chrome). From that page, you can click on the rows
+ in the table at the bottom to see the report for that expression.
+
+
+ Batch report generation is the most informative way to run Herbie
+ on a large collection of inputs. Like the web shell, it can be
+ customized through command-line options ,
+ including parallelizing Herbie with multiple threads.
+
+
+
+
diff --git a/www/doc/1.3/web-input.png b/www/doc/1.3/web-input.png
new file mode 100644
index 000000000..aa0e0487c
Binary files /dev/null and b/www/doc/1.3/web-input.png differ
diff --git a/www/doc/1.3/web-main.png b/www/doc/1.3/web-main.png
new file mode 100644
index 000000000..dcaa5359b
Binary files /dev/null and b/www/doc/1.3/web-main.png differ
diff --git a/www/doc/1.3/web-progress.png b/www/doc/1.3/web-progress.png
new file mode 100644
index 000000000..03da189d1
Binary files /dev/null and b/www/doc/1.3/web-progress.png differ
diff --git a/www/doc/latest b/www/doc/latest
index ea710abb9..a58941b07 120000
--- a/www/doc/latest
+++ b/www/doc/latest
@@ -1 +1 @@
-1.2
\ No newline at end of file
+1.3
\ No newline at end of file
diff --git a/www/graph.js b/www/graph.js
index c984530e0..7f470a489 100644
--- a/www/graph.js
+++ b/www/graph.js
@@ -21,8 +21,6 @@ function make_graph(node, data, start, end) {
var script = a[0][a[0].length - 1];
var svg = node
- .attr("width", width + 2 * margin)
- .attr("height", len * barheight + 2 * margin + textbar)
.append("g").attr("transform", "translate(" + margin + "," + margin + ")");
for (var i = 0; i <= precision; i += 4) {
diff --git a/www/index.html b/www/index.html
index 8cf1d201b..3be28e68d 100644
--- a/www/index.html
+++ b/www/index.html
@@ -5,14 +5,35 @@
Herbie: Automatically Improving Floating Point Accuracy
-
+
+
- Herbie aims to make floating point problems easier to find and fix.
+ Find and fix floating-point problems.
+
+
+
+ sqrt(x+1) - sqrt(x)
+ →
+ 1/(sqrt(x+1) + sqrt(x))
+
+
+ Herbie detects inaccurate expressions
+ and finds more accurate replacements.
+ The red expression is inaccurate when x > 1 ;
+ Herbie's replacement, in green, is accurate for all x .
+
+
+
+
@@ -38,41 +58,11 @@
Contribute
-
-
-
- sqrt(x + 1) - sqrt(x)
- ⬇
- 1/(sqrt(x+1) + sqrt(x))
-
-
- Herbie can detect inaccurate floating point expressions
- and gives you more-accurate replacements.
- The red expression gives inaccurate answers when x > 0 ;
- Herbie rewrites it into the
- green expression, accurate for all x .
-
-
-
- Documentation
-
-
-
+
- Longer arrows are better. Each arrow measures an improvement in accuracy due to Herbie. Each arrow points from the accuracy of the original program, and to the accuracy of Herbie’s output, in each case on random double-precision inputs.
+ Herbie improving accuracy on the “Hamming” benchmark suite. Longer arrows are better. Each arrow starts at the accuracy of the original expression, and ends at the accuracy of Herbie’s output, in each case on random double-precision inputs.
Herbie Project News
+ 1 May Pavel will be joining the University of Utah as an assistant professor next year, joining Ganesh and Zvonimir at what is already a nexus of floating-point research.
+ 13 Mar Zach gave a keynote at CoNGA’19 on multi-precision, multi-format computations and our efforts to support them in Herbie, FPBench , and Titanic .
+
+ 20 Jun Alex gave a talk on our sister project Herbgrind at PLDI’18 . Watch it if you want to know how Herbgrind pulls inaccurate floating-point expressions out of large numeric code bases.
15 Jun After a year of work, Herbie 1.2 has been released. This release focuses on creativity and accuracy, with a new system to infer better branches and more accurate defaults for Herbie's various parameters. Read about all the changes in the release notes .
9 Apr We teamed up with Heiko and Eva on the Daisy team to combine our tools and evaluate how best to use them together—it'll be published at FM’18 . If you're using Herbie with other floating point tools, let us know!
1 Mar Pavel and Zach went to see Herbie Hancock play at the Seattle Center . Watching Herbie play Chameleon on the keytar is sure to inspire the next generation of floating point accuracy improvement!
@@ -121,36 +115,40 @@ Herbie Project News
15 May Pavel is giving a lightning talk on a new project to improve the accuracy of floating point expressions.
31 Mar Pavel is giving a talk on at Dropbox on a new project to improve the accuracy of floating point expressions. (video )
-
- Blog posts about Herbie
-
-
- Introducing Herbgrind : what is our sister project Herbgrind all about?
- Let Herbie Make Your Floating Point Better : why programmers who deal with floating point should use Herbie.
- Improving Accuracy: a Look at Sums : why floating point summation is hard, and how compensated summation works.
- Measuring the Error of Floating Point Programs : how Herbie measures the error of a floating point program, and how we're working to extend that to programs with loops.
- Logarithms of Taylor Expansions : how Herbie takes Taylor expansions of logarithms.
- Hyperbolic sines in math.js : how Herbie fixed an accuracy bug in math.js using series expansion.
- Taylor Expansions of Taylor Expansions : how Herbie takes Taylor expansions of exponential and trigonometric functions.
- Arbitrary Precision, not Arbitrary Accuracy : why arbitrary-precision libraries aren’t an answer to rounding error.
- Complex Square Roots in math.js : how Herbie automatically fixed an accuracy bug in math.js , an open source mathematics library.
- Floating Point Guarantees : how floating point rounding and primitive operators work.
-
+
+
The Herbie Developers
- Herbie is chiefly developed at the University of Washington Programming Languages and Software Engineering group, with contributions from a supportive community.
+ Herbie is developed at UW PLSE , with contributions from a supportive community.
+
+ The main contributors are
+ Pavel Panchekha ,
+ Alex Sanchez-Stern ,
+ David Thien ,
+ Zachary Tatlock ,
+ Jason Qiu ,
+ Jack Firth , and
+ James R. Wilcox .
+
-
+
-
- Pavel Panchekha
- Alex Sanchez-Stern
- Jason Qiu
- Jack Firth
- James R. Wilcox
- Zachary Tatlock
-