├── .gitignore ├── .ocp-indent ├── .travis.yml ├── CODE_OF_CONDUCT.md ├── Dockerfile ├── LICENSE ├── README.md ├── bin ├── array_io.ml ├── benchmark.ml ├── collect.ml ├── data.ml ├── dune ├── eval.ml ├── kalman_utils.ml ├── kalman_utils.mli ├── l1_norm_min_utils.ml ├── l1_norm_min_utils.mli ├── lin_reg_utils.ml ├── repl.ml ├── transpile.ml └── utils.ml ├── dune-project ├── examples ├── bindings.ml ├── dune ├── examples.ml ├── factorial.lt ├── generate.ml ├── kalman.h ├── kalman.lt ├── kalman.ml ├── l1_norm_min.lt ├── l1_norm_min.ml ├── lib │ ├── bind.ml │ └── dune ├── lin_reg.lt ├── lin_reg.ml ├── python_compile.ml ├── square.lt ├── stubgen │ ├── dune │ └── ffi_stubgen.ml ├── sugar.lt ├── sum_array.lt ├── weighted_avg.lt └── weighted_avg_infer.lt ├── jbuild-workspace ├── old ├── src │ ├── ast.ml │ ├── ast.mli │ ├── check_monad.ml │ ├── check_monad.mli │ ├── checker.ml │ ├── combinators.ml │ ├── combinators.mli │ ├── dune │ ├── lexer.mll │ ├── parser.mly │ ├── parser_utils.ml │ ├── proto_comb.ml │ ├── state_or_error.ml │ ├── state_or_error.mli │ └── template.ml └── test │ ├── ast_test.ml │ ├── check_monad_test.ml │ ├── checker_test.ml │ ├── combinators_test.ml │ ├── dune │ ├── parser_test.ml │ ├── test.ml │ └── vars.ml ├── src ├── ast.ml ├── ast.mli ├── check_monad.ml ├── check_monad.mli ├── checker.ml ├── dune ├── error_msg.ml ├── lexer.mll ├── messages.txt ├── parse.ml ├── parse.mli ├── parser.mly ├── state_or_error.ml ├── state_or_error.mli ├── sugar.ml ├── sugar.mli ├── template.ml ├── template.mli ├── transpile.ml └── transpile.mli ├── test ├── ast_test.ml ├── check_monad_test.ml ├── checker_test.ml ├── dune ├── examples_test.ml ├── kalman_test.ml ├── l1_norm_min_test.ml ├── lin_reg_test.ml ├── test.ml └── vars.ml └── write-up ├── Makefile ├── artifact-evaluation-instructions.md ├── default.nix ├── dissertation.pdf ├── dissertation ├── CUni3.eps ├── abstract.tex ├── background.tex ├── conclusion.tex ├── declaration.tex ├── dissertation.tex ├── eval_data.tex ├── evaluation.tex ├── impl_build.png ├── implementation.tex ├── introduction.tex ├── kalman.f90 ├── myclass.cls ├── ott_spec.tex ├── primitives.tex ├── proposal.bib ├── related_work.tex ├── semantics.ott ├── semantics_def.tex ├── timings.tex ├── timings.txt ├── timings2.txt ├── timings_all.tex ├── titlepage.tex └── trace.txt ├── paper.pdf ├── paper ├── appendix.tex ├── cc-by.pdf ├── discussion.tex ├── fig1-eps-converted-to.pdf ├── fig1.eps ├── formal_system.tex ├── impl_build.png ├── implementation.tex ├── intro.tex ├── kalman_timings.tex ├── l1_norm_min_timings.tex ├── lang_and_examples.tex ├── lin_reg_timings.tex ├── lipics-logo-bw.pdf ├── lipics-v2019.cls ├── orcid.pdf ├── other.bib ├── ottlayout.sty ├── ourbib.bib ├── paper.tex ├── pf2.sty └── plainurl.bst ├── proposal.pdf ├── proposal ├── proposal.bib └── proposal.tex ├── response.md ├── reviews.md ├── semantics.pdf ├── semantics ├── interpretation.tex ├── lemmas.tex ├── ottlayout.sty ├── pf2.sty ├── semantics.ott ├── semantics.tex ├── semantics_def.tex └── soundness.tex └── shepherding.md /.gitignore: -------------------------------------------------------------------------------- 1 | *.merlin 2 | *.fls 3 | _build* 4 | build* 5 | _minted* 6 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | JaneStreet 2 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: required 2 | language: c 3 | services: 4 | - docker 5 | script: 6 | - docker build . 7 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | In the interest of fostering an open and welcoming environment, we as 6 | contributors and maintainers pledge to making participation in our project and 7 | our community a harassment-free experience for everyone, regardless of age, body 8 | size, disability, ethnicity, gender identity and expression, level of experience, 9 | education, socio-economic status, nationality, personal appearance, race, 10 | religion, or sexual identity and orientation. 11 | 12 | ## Our Standards 13 | 14 | Examples of behavior that contributes to creating a positive environment 15 | include: 16 | 17 | * Using welcoming and inclusive language 18 | * Being respectful of differing viewpoints and experiences 19 | * Gracefully accepting constructive criticism 20 | * Focusing on what is best for the community 21 | * Showing empathy towards other community members 22 | 23 | Examples of unacceptable behavior by participants include: 24 | 25 | * The use of sexualized language or imagery and unwelcome sexual attention or 26 | advances 27 | * Trolling, insulting/derogatory comments, and personal or political attacks 28 | * Public or private harassment 29 | * Publishing others' private information, such as a physical or electronic 30 | address, without explicit permission 31 | * Other conduct which could reasonably be considered inappropriate in a 32 | professional setting 33 | 34 | ## Our Responsibilities 35 | 36 | Project maintainers are responsible for clarifying the standards of acceptable 37 | behavior and are expected to take appropriate and fair corrective action in 38 | response to any instances of unacceptable behavior. 39 | 40 | Project maintainers have the right and responsibility to remove, edit, or 41 | reject comments, commits, code, wiki edits, issues, and other contributions 42 | that are not aligned to this Code of Conduct, or to ban temporarily or 43 | permanently any contributor for other behaviors that they deem inappropriate, 44 | threatening, offensive, or harmful. 45 | 46 | ## Scope 47 | 48 | This Code of Conduct applies both within project spaces and in public spaces 49 | when an individual is representing the project or its community. Examples of 50 | representing a project or community include using an official project e-mail 51 | address, posting via an official social media account, or acting as an appointed 52 | representative at an online or offline event. Representation of a project may be 53 | further defined and clarified by project maintainers. 54 | 55 | ## Enforcement 56 | 57 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 58 | reported by contacting the project team at dc\_mak@outlook.com. All 59 | complaints will be reviewed and investigated and will result in a response that 60 | is deemed necessary and appropriate to the circumstances. The project team is 61 | obligated to maintain confidentiality with regard to the reporter of an incident. 62 | Further details of specific enforcement policies may be posted separately. 63 | 64 | Project maintainers who do not follow or enforce the Code of Conduct in good 65 | faith may face temporary or permanent repercussions as determined by other 66 | members of the project's leadership. 67 | 68 | ## Attribution 69 | 70 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, 71 | available at https://www.contributor-covenant.org/version/1/4/code-of-conduct.html 72 | 73 | [homepage]: https://www.contributor-covenant.org 74 | 75 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | # Dockerfile to build LT4LA for DEVELOPMENT 2 | # By Dhruv Makwana 3 | ############################################################ 4 | 5 | FROM ocaml/opam2:ubuntu-16.04-opam 6 | MAINTAINER Dhruv Makwana 7 | 8 | # OS Prerequisites 9 | # lipcre3-dev used by patdiff used by expect_tests 10 | RUN sudo apt-get update \ 11 | && sudo apt-get -y install \ 12 | m4 \ 13 | libshp-dev \ 14 | libplplot-dev \ 15 | libopenblas-dev \ 16 | liblapacke-dev \ 17 | # LT4LA \ 18 | libpcre3-dev \ 19 | python3 \ 20 | python3-pip \ 21 | && sudo pip3 install numpy 22 | 23 | # Permissions - recursive takes waaaay too long 24 | RUN chown opam:opam $HOME $HOME/* 25 | WORKDIR $HOME 26 | 27 | # 0) 'opam init -y' runs fine on Travis CI, but not on my Docker CE install. 28 | # 1) Opam 2.0 RC now includes sandboxing using bwrap. Leads to this error: 29 | # bwrap: No permissions to creating new namespace, likely because the kernel does not allow 30 | # non-privileged user namespaces. On e.g. debian this can be enabled with 31 | # 'sysctl kernel.unprivileged_userns_clone=1'. 32 | # 2) Setting 'sysctl kernel.unprivileged_userns_clone=1' as suggested does not work. 33 | # 3) This is because the default Docker profile blocks many system calls, 34 | # including the one required, 'clone' (docs.docker.com/engine/security/seccomp 35 | # /#significant-syscalls-blocked-by-the-default-profile). 36 | # 4) Running 'docker run --security-opt seccomp=unconfined' (I'm not going to 37 | # set up my own security profile for this project) runs into 38 | # 'bwrap: Failed to make / slave: Permission denied' 39 | # 5) Hence --disable-sandboxing 40 | RUN opam init -y --bare --disable-sandboxing && opam switch create 4.07.1 41 | # OCaml Packages Used 42 | RUN opam install -y \ 43 | base \ 44 | ctypes \ 45 | lambda-term \ 46 | lwt \ 47 | lwt_ppx \ 48 | menhir \ 49 | owl \ 50 | ppx_jane \ 51 | ppx_traverse \ 52 | ppxlib \ 53 | pyml \ 54 | sexplib0 \ 55 | stdio \ 56 | && opam env 57 | 58 | # Environment variables 59 | ENV OPAM_SWITCH_PREFIX /home/opam/.opam/4.07.1 60 | ENV CAML_LD_LIBRARY_PATH /home/opam/.opam/4.07.1/lib/stublibs:/home/opam/.opam/4.07.1/lib/ocaml/stublibs:/home/opam/.opam/4.07.1/lib/ocaml 61 | ENV OCAML_TOPLEVEL_PATH /home/opam/.opam/4.07.1/lib/toplevel 62 | ENV MANPATH /home/opam/.opam/default/man:/home/opam/.opam/4.07.1/man 63 | ENV PATH /home/opam/.opam/4.07.1/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin 64 | 65 | # Build LT4LA in the current (host) directory 66 | ENV LT4LAPATH $HOME/lt4la 67 | ADD --chown=opam:opam . $LT4LAPATH 68 | WORKDIR $LT4LAPATH 69 | # RUN sed -i -- 's~(name runtest)~& (locks (/home/opam/owl))~g' test/jbuild old/test/jbuild 70 | RUN dune runtest --display=short && dune build bin/repl.exe 71 | ENTRYPOINT /bin/bash 72 | -------------------------------------------------------------------------------- /bin/array_io.ml: -------------------------------------------------------------------------------- 1 | module Make (M : sig val dir : string end) 2 | : sig 3 | val filename : string -> n:int -> k:int -> string 4 | val input_exn: string -> n:int -> k:int -> Owl.Arr.arr 5 | val output_exn : string -> Owl.Arr.arr -> unit 6 | end = 7 | struct 8 | 9 | if Caml.Sys.big_endian || not Caml.Sys.unix then 10 | begin 11 | Stdio.eprintf "Need little-endian Unix platform to run benchmark.\n"; 12 | Caml.exit 1 13 | end 14 | ;; 15 | 16 | if not @@ Caml.Sys.(file_exists M.dir && is_directory M.dir) then 17 | Unix.mkdir M.dir 0o773 18 | ;; 19 | 20 | let output_float_le otch fv = 21 | let bits = ref (Int64.bits_of_float fv) in 22 | for _ = 1 to 8 do 23 | let byte = Int64.to_int @@ Int64.logand !bits 0xffL in 24 | bits := Int64.shift_right_logical !bits 8; 25 | Stdio.Out_channel.output_byte otch byte 26 | done 27 | ;; 28 | 29 | let output_exn file arr = 30 | Stdio.Out_channel.with_file file 31 | ~binary:true 32 | ~append:true 33 | ~fail_if_exists:true 34 | ~f:(fun file -> Owl.Arr.iter (output_float_le file) arr) 35 | ;; 36 | 37 | let input_exn file ~n ~k = 38 | let fail ~st_size ~total = 39 | failwith @@ 40 | Printf.sprintf "%s is of size: %dB and not of %dB = n:%d * k:%d * 8" 41 | file st_size total n k in 42 | Stdio.In_channel.with_file file ~f:(fun file -> 43 | let file = Unix.descr_of_in_channel file in 44 | let {Unix.st_size; _} = Unix.fstat file in 45 | let () = let total = n * k * 8 in if not (st_size = total) then fail ~st_size ~total in 46 | let shared = false in (* changes in memory are not reflected to file *) 47 | Unix.map_file file Bigarray.float64 Bigarray.c_layout shared [| n; k; |]) 48 | ;; 49 | 50 | let filename file ~n ~k = 51 | Printf.sprintf "./%s/%s_%d_%d.float64_c_layout_le" M.dir file n k 52 | ;; 53 | 54 | let () = 55 | let n, k = 5, 3 in 56 | let sanity = filename "sanity" ~n ~k 57 | and x = Owl.Mat.uniform n k in 58 | let () = Stdio.Out_channel.with_file sanity ~binary:true ~f:(fun file -> 59 | Owl.Arr.iter (output_float_le file) x) in 60 | let y = input_exn sanity ~n ~k in 61 | assert ( Owl.Mat.( x = y ) ) 62 | ;; 63 | 64 | end 65 | -------------------------------------------------------------------------------- /bin/benchmark.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | let run_with_params ?(analyse=true) ~start ~limit ~tests ~micro_quota ~macro_runs = 5 | let base, cols = 5, 3 in 6 | if base >= 1 && cols >= 1 then 7 | let n = limit - start + 1 in 8 | let module F = (val tests : Utils.With_algs) in 9 | let files = F.files ~base ~cols in 10 | let () = Collect.generate_exn files ~base ~start ~limit in 11 | let collected = List.init n ~f:(fun exp -> 12 | F.runtest_exn files ~micro_quota ~macro_runs ~base ~cols ~exp:(start+exp) F.algs) 13 | in 14 | if analyse then ( 15 | List.iter collected ~f:Data.by_size; 16 | List.iter (Data.transpose collected) ~f:Data.by_alg; 17 | ) 18 | ;; 19 | 20 | let run_with_params ~analyse ~start ~limit ~tests ~micro_quota ~macro_runs = 21 | let ok_if bool error = Result.ok_if_true bool ~error in 22 | match Result.combine_errors_unit @@ [ 23 | ok_if (start >= 1) "Start must be at least 1"; 24 | ok_if (limit >= 1) "Limit must be at least 1"; 25 | ok_if (start <= limit) "Start must be less than or equal to limit"; 26 | ok_if Option.(is_none micro_quota || value_exn micro_quota >= 1) 27 | "Micro-benchmark quota must be at least 1"; 28 | ok_if (macro_runs >= 1) "Macro runs must be at least 1"; 29 | ] with 30 | | Ok () -> 31 | run_with_params ~analyse ~start ~limit ~tests ~micro_quota ~macro_runs 32 | | Error err -> 33 | List.iter err ~f:(Stdio.eprintf "%s\n"); 34 | Caml.exit 1 35 | ;; 36 | 37 | let alg = 38 | let open Examples.Kalman in 39 | Core.Command.Arg_type.create @@ 40 | let kalman algs = 41 | (module struct 42 | include Kalman_utils 43 | let algs = algs 44 | end : Utils.With_algs) in 45 | function 46 | | "none" -> kalman [] 47 | | "owl" -> kalman [W Owl] 48 | | "numlin" -> kalman [W NumLin] 49 | | "cblas" -> kalman [W CBLAS] 50 | | "numpy" -> kalman [W NumPy] 51 | | "kalman" -> kalman all 52 | | "l1_norm_min" -> 53 | (module struct 54 | include L1_norm_min_utils 55 | let algs = Examples.L1_norm_min.all 56 | end : Utils.With_algs) 57 | | "lin_reg" -> 58 | (module struct 59 | include Lin_reg_utils 60 | let algs = Examples.Lin_reg.all 61 | end : Utils.With_algs) 62 | | x -> 63 | Stdio.eprintf "'%s' not a supported implementation" x; 64 | Caml.exit 1 65 | ;; 66 | 67 | let command = 68 | let open Core in 69 | Command.basic 70 | ~summary:"Basic NumLin benchmarking program" 71 | Command.Let_syntax.( 72 | let%map_open 73 | 74 | start = 75 | flag "--start" (required int) 76 | ~doc:"int Begin testing at this exponent" 77 | 78 | and limit = 79 | flag "--limit" (required int) 80 | ~doc:"int End testing at this exponent" 81 | 82 | and tests = 83 | flag "--alg" (required alg) 84 | ~doc:"alg Implementation to test\n(kalman, l1_norm_min, lin_reg, none)" 85 | 86 | and no_analyse = 87 | flag "--no-analyse" no_arg 88 | ~doc:" Don't analyse or print out data (for profiling)" 89 | 90 | and micro_quota = 91 | flag "--micro-quota" (optional int) 92 | ~doc:"int How many seconds to run micro-benchmarks (exp <= 3) for" 93 | 94 | and macro_runs = 95 | flag "--macro-runs" (required int) 96 | ~doc:"int How many seconds to run macro-benchmarks (exp >= 3) for" 97 | 98 | in 99 | fun () -> run_with_params ~analyse:(not no_analyse) ~start ~limit ~tests ~micro_quota ~macro_runs 100 | ) 101 | ;; 102 | 103 | let () = 104 | Core.Command.run command 105 | ;; 106 | -------------------------------------------------------------------------------- /bin/collect.ml: -------------------------------------------------------------------------------- 1 | open Owl 2 | ;; 3 | 4 | open Base 5 | ;; 6 | 7 | module Time = 8 | Core_kernel.Time 9 | ;; 10 | 11 | type mat_info = { 12 | name : string; 13 | dim : int -> int * int; 14 | make : scale:int -> Mat.mat; 15 | valid: Mat.mat -> bool; 16 | } 17 | ;; 18 | 19 | (* Step 0: Platform and sanity checks. *) 20 | module IO = 21 | Array_io.Make (struct let dir = "arrays" end) 22 | ;; 23 | 24 | (* Step 1: Generate some data. Saved to disk for the sake of consistency. *) 25 | let generate_exn files ~base ~start ~limit = 26 | assert (base >= 1 && start >= 1 && limit >= 1 && limit >= start); 27 | for i = start to limit do 28 | let scale = Int.pow base (i-1) in 29 | List.iter files ~f:(fun { name; dim; make; valid } -> 30 | let n, k = dim scale in 31 | let file = IO.filename name ~n ~k in 32 | if not @@ Caml.Sys.file_exists file then ( 33 | let x = make ~scale in 34 | if not @@ valid x then failwith ("Matrix " ^ file ^ " not valid."); 35 | IO.output_exn file x; 36 | )) 37 | done 38 | ;; 39 | 40 | let read_in_exn ~scale files = 41 | List.fold_right files ~init:[] ~f:(fun { name; dim; make=_; valid } args -> 42 | let n, k = dim scale in 43 | let file = IO.filename name ~n ~k in 44 | let y = IO.input_exn file ~n ~k in 45 | if valid y then 46 | y :: args 47 | else 48 | failwith ("File " ^ file ^ " failed validation") 49 | ) 50 | ;; 51 | 52 | let micro_exn ~sec ~n ~k get_micro input tests = 53 | assert (n >= 1 && sec >= 1); 54 | let open Core_bench.Bench in 55 | (* Trying to emulate options: -ci-absolute -quota 10 -clear-columns +time samples speedup *) 56 | let run_config = 57 | Run_config.create 58 | ~verbosity:(Core_bench.Verbosity.Quiet) 59 | ~time_quota:(Time.Span.create ~sec ()) () in 60 | (* Ensures we have one (and only one) regression (Array.get _ 0) *) 61 | (* Ensures we have r_square AND a 95% CI (Option.value_exn) *) 62 | let analysis_configs = 63 | Analysis_config.(List.map [nanos_vs_runs] ~f:(with_error_estimation)) in 64 | let data = 65 | tests 66 | |> List.map ~f:(get_micro ~n ~k input) 67 | |> measure ~run_config 68 | |> List.map ~f:(analyze ~analysis_configs) 69 | |> Or_error.combine_errors 70 | |> Or_error.ok_exn 71 | |> List.map ~f:(fun result -> 72 | let open Core_bench.Analysis_result in 73 | let regr = (regressions result).(0) in 74 | let coeff = (Regression.coefficients regr).(0) in 75 | let ci95 = Option.value_exn (Coefficient.ci95 coeff) in 76 | let mean_ns = Coefficient.estimate coeff in 77 | let (minus_err, plus_err) = Ci95.ci95_abs_err ci95 ~estimate:mean_ns in 78 | Data.{ 79 | ind_var = name result; 80 | mean = Time.Span.of_ns mean_ns; 81 | plus_err = Time.Span.of_ns plus_err; 82 | minus_err = Time.Span.of_ns minus_err; 83 | r_sq = Regression.r_square regr; 84 | sample = sample_count result; 85 | } 86 | ) 87 | in 88 | (n, data) 89 | ;; 90 | 91 | let macro ~runs ~n ~k name get_macro input tests = 92 | assert (runs >= 1 && n >= 1 && k >= 1); 93 | let f fun_ = 94 | let times = get_macro ~n ~k ~runs input fun_ in 95 | let mean, std = 96 | let times = Array.map times ~f:(Time.Span.to_us) in 97 | let mean = Stats.mean times in 98 | let std = Stats.std ~mean times in 99 | Time.Span.(of_us mean, of_us std) 100 | in 101 | Data.{ 102 | ind_var = name fun_; 103 | mean = mean; 104 | plus_err = std; 105 | minus_err = Time.Span.neg std; 106 | r_sq = None; 107 | sample = runs; 108 | } 109 | in 110 | (n, List.map ~f tests) 111 | ;; 112 | 113 | -------------------------------------------------------------------------------- /bin/data.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | module Time = 5 | Core_kernel.Time 6 | ;; 7 | 8 | type 'a t = { 9 | ind_var: 'a; 10 | mean: Time.Span.t; 11 | plus_err: Time.Span.t; 12 | minus_err: Time.Span.t; 13 | r_sq: float option; 14 | sample: int; 15 | } 16 | [@@deriving sexp_of] 17 | ;; 18 | 19 | (* Step 5: Process data *) 20 | let transpose data = 21 | data 22 | |> List.concat_map ~f:(fun (n, data) -> 23 | List.map data ~f:(fun ({ind_var; _} as data) -> 24 | (ind_var, {data with ind_var = n;}))) 25 | |> Hashtbl.of_alist_multi (module String) 26 | |> Hashtbl.to_alist 27 | |> List.map ~f:(fun (x,y) -> (x, List.rev y)) 28 | ;; 29 | 30 | let pretty_print ~title ~ind_var (index, data) = 31 | let headers = [ind_var; "Mean (us)"; "Sample"; "Err+"; "Err-"; " R^2"] in 32 | let init = List.map headers ~f:String.length in 33 | let maxf x y = max x (String.length @@ Printf.sprintf "%.0f" y) in 34 | match 35 | List.fold data ~init 36 | ~f:(fun [iv; m; s; pe; me; 4] 37 | {ind_var; mean; sample; plus_err; minus_err; r_sq=_} -> [ 38 | max iv (String.length ind_var); 39 | maxf m (Time.Span.to_us mean); 40 | max s (String.length @@ Int.to_string sample); 41 | maxf pe (Time.Span.to_us plus_err); 42 | maxf me (Time.Span.to_us minus_err); 43 | 4; (* d.dd *) 44 | ] 45 | ) [@ocaml.warning "-8"] with 46 | | [iv; m; s; pe; me; 4] as widths -> 47 | 48 | (* Table and Column Names *) 49 | Stdio.printf "%s = %s\n\n" title index; 50 | List.iter2_exn widths headers ~f:(Stdio.printf "%*s "); 51 | Stdio.print_endline ""; 52 | 53 | (* Column underlines *) 54 | List.iter widths ~f:(fun i -> 55 | for _ = 1 to i do Stdio.Out_channel.(output_char stdout '-') done; 56 | Stdio.Out_channel.(output_char stdout ' ')); 57 | Stdio.print_endline ""; 58 | 59 | (* Data *) 60 | List.iter data ~f:(fun {ind_var; mean; sample; plus_err; minus_err; r_sq} -> 61 | Stdio.printf !"%*s %*.0f %*d %*.0f %*.0f %4s\n" 62 | iv ind_var 63 | m (Time.Span.to_us mean) 64 | s sample 65 | pe (Time.Span.to_us plus_err) 66 | me (Time.Span.to_us minus_err) 67 | Option.(value (map ~f:(Printf.sprintf "%0.2f") r_sq) ~default:"N/A"); 68 | ); 69 | 70 | (* End with # *) 71 | Stdio.print_endline ""; 72 | List.iter widths ~f:(fun i -> 73 | for _ = 1 to i+1 do Stdio.Out_channel.(output_char stdout '#') done); 74 | Stdio.print_endline ""; 75 | Stdio.print_endline ""; 76 | 77 | | _ -> assert false 78 | ;; 79 | 80 | let by_size (n, data) = 81 | pretty_print ~title:"Size N" ~ind_var:"Alg" (Int.to_string n, data) 82 | ;; 83 | 84 | let by_alg (n, data) = 85 | pretty_print ~title:"Alg" ~ind_var:"Size N" 86 | (n, List.map data ~f:(fun x -> { x with ind_var = Int.to_string x.ind_var})) 87 | ;; 88 | -------------------------------------------------------------------------------- /bin/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names repl transpile) 3 | (modules eval repl transpile) 4 | (libraries numlin lwt lambda-term) 5 | (flags :standard -short-paths) 6 | (preprocess 7 | (pps lwt_ppx ppx_jane))) 8 | 9 | (executable 10 | (name benchmark) 11 | (modules benchmark collect utils kalman_utils l1_norm_min_utils 12 | lin_reg_utils data array_io) 13 | (libraries owl examples base core core_bench) 14 | (flags :standard -short-paths) 15 | (ocamlopt_flags :standard -p) 16 | (preprocess 17 | (pps lwt_ppx ppx_jane))) 18 | -------------------------------------------------------------------------------- /bin/eval.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* Eval for REPL *) 3 | (* ------------- *) 4 | 5 | open Base 6 | ;; 7 | 8 | type out = 9 | | Done of int * (string, string) Result.t 10 | | More of int * (Lexing.lexbuf -> out) 11 | ;; 12 | 13 | let handler n lexbuf ~msg = 14 | let open Lexing in 15 | let pos = lexbuf.lex_curr_p in 16 | let cpos = pos.pos_cnum - pos.pos_bol in 17 | let bytes = Bytes.create cpos in 18 | for i = 0 to cpos - 2 do 19 | Bytes.set bytes i ' '; 20 | done; 21 | Bytes.set bytes (cpos-1) '^'; 22 | Bytes.to_string bytes ^ "\n" ^ String.chop_suffix_exn ~suffix:"\n" msg 23 | |> Result.fail 24 | |> fun x -> Done (n, x) 25 | ;; 26 | 27 | let accept n value = 28 | let sexp = Sexp.to_string_hum (Numlin.Ast.sexp_of_exp value) in 29 | let pp = Numlin.Ast.(string_of_pp pp_exp value) 30 | |> String.split ~on:'\n' 31 | |> String.concat ~sep:"\n " in 32 | let check = 33 | match Numlin.Checker.check_expr value ~counter:0 with 34 | | Ok lin -> Numlin.Ast.(string_of_pp pp_lin lin) ^ "\n" 35 | | Error err -> Error.to_string_hum err in 36 | pp ^ "\n" ^ sexp ^ "\n" ^ String.chop_suffix_exn ~suffix:"\n" check 37 | |> Result.return 38 | |> fun x -> Done (n, x) 39 | ;; 40 | 41 | let resume n cont = 42 | More (n, cont) 43 | ;; 44 | 45 | let eval n input = 46 | let lexbuf = Lexing.from_string input in 47 | Lexing.(lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = "repl" }); 48 | Numlin.Parse.(drive lexbuf { 49 | handler = handler (n+1); accept = accept (n+1); resume = Some (resume n); }) 50 | ;; 51 | -------------------------------------------------------------------------------- /bin/kalman_utils.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | module Mat = 5 | Owl.Mat 6 | ;; 7 | 8 | module Time = 9 | Core_kernel.Time 10 | ;; 11 | 12 | type input = { 13 | sigma : Mat.mat; 14 | h: Mat.mat; 15 | mu: Mat.mat; 16 | r : Mat.mat; 17 | data : Mat.mat; 18 | } 19 | ;; 20 | 21 | module F = 22 | Examples.Kalman 23 | ;; 24 | 25 | type wrap = 26 | F.wrap 27 | ;; 28 | 29 | let make_microbench_tests ~n ~k { sigma; h; mu; r; data } (F.W fun_) = 30 | let f = F.get fun_ in 31 | let name = F.(name @@ W fun_) in 32 | let open Core_bench.Bench in 33 | match fun_ with 34 | 35 | | F.NumPy -> 36 | (* Not super valid because of marshalling overhead *) 37 | (* For consistency with others *) 38 | let f = snd f in 39 | Test.create ~name (fun () -> 40 | let mu, r, data = Mat.copy mu, Mat.copy r, Mat.copy data in 41 | f ~sigma ~h ~mu ~r ~data) 42 | 43 | | F.Owl -> 44 | (* For consistency with others *) 45 | Test.create ~name (fun () -> 46 | let mu, r, data = Mat.copy mu, Mat.copy r, Mat.copy data in 47 | f ~sigma ~h ~mu ~r ~data) 48 | 49 | | F.NumLin -> 50 | (* [mu], [r] and [data] are overrwritten *) 51 | (* Adds overhead because of copying during test but oh well *) 52 | Test.create ~name (fun () -> 53 | let mu, r, data = Mat.copy mu, Mat.copy r, Mat.copy data in 54 | f.f ~sigma ~h ~mu ~r ~data) 55 | 56 | | F.CBLAS -> 57 | (* Not super valid because of marshalling overhead *) 58 | (* [mu], [r] and [data] are overrwritten *) 59 | (* Adds overhead because of copying during test but oh well *) 60 | let f = snd f in 61 | Test.create ~name (fun () -> 62 | let mu, r, data = Mat.copy mu, Mat.copy r, Mat.copy data in 63 | f ~n ~k ~sigma ~h ~mu ~r ~data) 64 | ;; 65 | 66 | let macro ~f ?(clean=(fun () -> ())) ~runs { sigma; h; mu; r; data } = 67 | assert (runs >= 1); 68 | Array.init runs ~f:(fun _ -> 69 | let () = Caml.Gc.full_major () in 70 | let {Unix.tms_utime=start;_} = Unix.times () in 71 | let _ = f ~sigma ~h ~mu ~r ~data in 72 | let {Unix.tms_utime=end_;_} = Unix.times () in 73 | let () = clean () in 74 | Time.Span.(of_sec end_ - of_sec start) 75 | ) 76 | ;; 77 | 78 | let make_macro_timing_array ~n ~k ~runs input (F.W fun_) = 79 | let f = F.get fun_ in 80 | match fun_ with 81 | 82 | | F.NumPy -> 83 | let { sigma; h; mu; r; data } = input in 84 | let f = fst f in 85 | Array.init runs ~f:(fun _ -> 86 | Time.Span.of_us @@ f ~sigma ~h ~mu ~r ~data) 87 | 88 | | F.Owl -> 89 | macro ~f ~runs input 90 | 91 | | F.NumLin -> 92 | let { sigma=_; h=_; mu; r; data } = input in 93 | let mu' = Mat.copy mu 94 | and r' = Mat.copy r 95 | and data' = Mat.copy data in 96 | (* [mu], [r] and [data] are overrwritten *) 97 | let clean () = 98 | Mat.copy_ mu' ~out:mu; 99 | Mat.copy_ r' ~out:r; 100 | Mat.copy_ data' ~out:data; in 101 | macro input ~runs ~f:f.f ~clean 102 | 103 | | F.CBLAS -> 104 | (* Not super valid because of marshalling overhead *) 105 | let { sigma; h; mu; r; data } = input in 106 | let mu' = Mat.copy mu 107 | and r' = Mat.copy r 108 | and data' = Mat.copy data in 109 | (* [mu], [r] and [data] are overrwritten *) 110 | let clean () = 111 | Mat.copy_ mu' ~out:mu; 112 | Mat.copy_ r' ~out:r; 113 | Mat.copy_ data' ~out:data; in 114 | let f = fst f in 115 | Array.init runs ~f:(fun _ -> 116 | let t = Time.Span.of_us @@ f ~n ~k ~sigma ~h ~mu ~r ~data in 117 | clean (); t) 118 | ;; 119 | 120 | let check_dims ~n ~k {sigma; h; mu; r; data} = 121 | assert (n >= 1 && k >= 1); 122 | let (=) = Caml.(=) and shape = Mat.shape in 123 | assert (( n, n ) = shape sigma); 124 | assert (( k, n ) = shape h); 125 | assert (( n, 1 ) = shape mu); 126 | assert (( k, k ) = shape r); 127 | assert (( k, 1 ) = shape data); 128 | ;; 129 | 130 | (* Step 4: Select appropriate test and gather data. *) 131 | let runtest_exn files ~macro_runs:runs ~micro_quota:sec ~base:n' ~cols:k' ~exp:i tests = 132 | let scale = Int.pow n' (i-1) in 133 | match Collect.read_in_exn ~scale files with 134 | | [sigma; h; mu; r; data] -> 135 | let input = { sigma; h; mu; r; data } in 136 | let n, k = scale * n', scale * k' in 137 | let () = check_dims ~n ~k input in 138 | begin match sec with 139 | | Some sec -> 140 | if i <= 3 (* micro-benchmark for small values only *) then 141 | Collect.micro_exn ~sec ~n ~k make_microbench_tests input tests 142 | else 143 | Collect.macro ~runs ~n ~k F.name make_macro_timing_array input tests 144 | | None -> 145 | Collect.macro ~runs ~n ~k F.name make_macro_timing_array input tests 146 | end 147 | | _ -> assert false 148 | ;; 149 | 150 | (* Mat.semidef isn't guaranteed to be perfectly symmetric 151 | Probably remove once cause of posv_flip errors has been identified *) 152 | let semidef n = 153 | let tmp = Mat.semidef n in 154 | for i = 0 to n-1 do 155 | for j = 0 to i-1 do 156 | Mat.set tmp i j (Mat.get tmp j i) 157 | done 158 | done; 159 | tmp 160 | ;; 161 | 162 | let files ~base:n' ~cols:k' = 163 | (* Mat.semidef doesn't produce exactly symmetric matrices for size 61 or greater ..? 164 | Thankfully, results not relevant to measurement, only consistency and computation. *) 165 | let pos_def_sym x = Owl.Linalg.D.(is_posdef x && is_symmetric x) 166 | and uniform = Mat.for_all (fun x -> Float.(0. <= x && x <= 1.)) 167 | in 168 | Collect.[ 169 | { 170 | name ="sigma"; 171 | dim = (fun x -> n'*x , n'*x); 172 | make = (fun ~scale:x -> semidef (n' * x)); 173 | valid = pos_def_sym; 174 | }; 175 | 176 | { 177 | name = "h"; 178 | dim = (fun x -> k'*x , n'*x); 179 | make = (fun ~scale:x -> Mat.uniform (k'*x) (n'*x)); 180 | valid = uniform; 181 | }; 182 | 183 | { 184 | name = "mu"; 185 | dim = (fun x -> n'*x , 1); 186 | make = (fun ~scale:x -> Mat.uniform (n'*x) 1); 187 | valid = uniform; 188 | }; 189 | 190 | { 191 | name = "r"; 192 | dim = (fun x -> k'*x , k'*x); 193 | make = (fun ~scale:x -> semidef (k'*x)); 194 | valid = pos_def_sym; 195 | }; 196 | 197 | { 198 | name = "data"; 199 | dim = (fun x -> k'*x , 1); 200 | make = (fun ~scale:x -> Mat.uniform (k'*x) 1); 201 | valid = uniform; 202 | }; 203 | 204 | ] 205 | ;; 206 | -------------------------------------------------------------------------------- /bin/kalman_utils.mli: -------------------------------------------------------------------------------- 1 | include Utils.Intf with type wrap = Examples.Kalman.wrap 2 | -------------------------------------------------------------------------------- /bin/l1_norm_min_utils.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | module Mat = 5 | Owl.Mat 6 | ;; 7 | 8 | type input = { 9 | q : Mat.mat; 10 | u : Mat.mat; 11 | } 12 | ;; 13 | 14 | module F = 15 | Examples.L1_norm_min 16 | ;; 17 | 18 | type wrap = 19 | F.wrap 20 | ;; 21 | 22 | let make_microbench_tests ~n:_ ~k:_ {q; u} (F.W fun_) = 23 | let f = F.get fun_ in 24 | let name = F.(name @@ W fun_) in 25 | let open Core_bench.Bench in 26 | match fun_ with 27 | 28 | | F.Owl -> 29 | (* For consistency with others *) 30 | Test.create ~name (fun () -> 31 | let q, u = Mat.(copy q, copy u) in f ~q ~u) 32 | 33 | | F.NumPy -> 34 | let f = snd f in 35 | Test.create ~name (fun () -> 36 | let q, u = Mat.(copy q, copy u) in f ~q ~u) 37 | 38 | | F.NumLin -> 39 | (* [q] and [u] are overrwritten *) 40 | (* Adds overhead because of copying during test but oh well *) 41 | Test.create ~name (fun () -> 42 | let q, u = Mat.(copy q, copy u) in f ~q ~u) 43 | ;; 44 | 45 | let macro ~f ?(clean=(fun () -> ())) ~runs {q; u} = 46 | assert (runs >= 1); 47 | Array.init runs ~f:(fun _ -> 48 | let () = Caml.Gc.full_major () in 49 | let {Unix.tms_utime=start;_} = Unix.times () in 50 | let _ = f ~q ~u in 51 | let {Unix.tms_utime=end_;_} = Unix.times () in 52 | let () = clean () in 53 | Core_kernel.Time.Span.(of_sec end_ - of_sec start) 54 | ) 55 | ;; 56 | 57 | let make_macro_timing_array ~n:_ ~k:_ ~runs input (F.W fun_) = 58 | let f = F.get fun_ in 59 | match fun_ with 60 | 61 | | F.Owl -> 62 | macro ~f ~runs input 63 | 64 | | F.NumPy -> 65 | let {q; u} = input in 66 | let f = fst f in 67 | Array.init runs ~f:(fun _ -> 68 | Core.Time.Span.of_us @@ f ~q ~u) 69 | 70 | | F.NumLin -> 71 | let {q; u} = input in 72 | let q' = Mat.copy q and u' = Mat.copy u in 73 | let clean () = 74 | Mat.copy_ q' ~out:q; 75 | Mat.copy_ u' ~out:u; in 76 | macro input ~runs ~f ~clean 77 | ;; 78 | 79 | let check_dims ~n ~k {q; u} = 80 | assert (n >= 1 && k >= 1); 81 | let (=) = Caml.(=) and shape = Mat.shape in 82 | assert (( n, n ) = shape q); 83 | assert (( n, k ) = shape u); 84 | ;; 85 | 86 | (* Step 4: Select appropriate test and gather data. *) 87 | let runtest_exn files ~macro_runs:runs ~micro_quota:sec ~base:n' ~cols:k' ~exp:i tests = 88 | let scale = Int.pow n' (i-1) in 89 | match Collect.read_in_exn ~scale files with 90 | | [q; u] -> 91 | let input = {q; u} in 92 | let n, k = scale * n', scale * k' in 93 | let () = check_dims ~n ~k input in 94 | begin match sec with 95 | | Some sec -> 96 | if i <= 3 (* micro-benchmark for small values only *) then 97 | Collect.micro_exn ~sec ~n ~k make_microbench_tests input tests 98 | else 99 | Collect.macro ~runs ~n ~k F.name make_macro_timing_array input tests 100 | | None -> 101 | Collect.macro ~runs ~n ~k F.name make_macro_timing_array input tests 102 | end 103 | | _ -> assert false 104 | ;; 105 | 106 | let files ~base:n' ~cols:k' = 107 | let uniform = Mat.for_all (fun x -> Float.(0. <= x && x <= 1.)) in 108 | Collect.[ 109 | 110 | { 111 | name ="q"; 112 | dim = (fun x -> n'*x , n'*x); 113 | make = (fun ~scale:x -> Mat.uniform (n' *x) (n' * x)); 114 | valid = uniform; 115 | }; 116 | 117 | { 118 | name = "u"; 119 | dim = (fun x -> n'*x , k'*x); 120 | make = (fun ~scale:x -> Mat.uniform (n'*x) (k'*x)); 121 | valid = uniform; 122 | }; 123 | 124 | ] 125 | ;; 126 | -------------------------------------------------------------------------------- /bin/l1_norm_min_utils.mli: -------------------------------------------------------------------------------- 1 | include Utils.Intf with type wrap = Examples.L1_norm_min.wrap 2 | -------------------------------------------------------------------------------- /bin/lin_reg_utils.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | module Mat = 5 | Owl.Mat 6 | ;; 7 | 8 | type input = { 9 | x : Mat.mat; 10 | y : Mat.mat; 11 | } 12 | ;; 13 | 14 | module F = 15 | Examples.Lin_reg 16 | ;; 17 | 18 | type wrap = 19 | F.wrap 20 | ;; 21 | 22 | let make_microbench_tests ~n:_ ~k:_ {x; y} (F.W fun_) = 23 | let f = F.get fun_ in 24 | let name = F.(name @@ W fun_) in 25 | let open Core_bench.Bench in 26 | match fun_ with 27 | 28 | | F.Owl -> 29 | Test.create ~name (fun () -> f ~x ~y) 30 | 31 | | F.NumPy -> 32 | let f = snd f in 33 | Test.create ~name (fun () -> f ~x ~y) 34 | 35 | | F.NumLin -> 36 | let f = f.f in 37 | Test.create ~name (fun () -> f ~x ~y) 38 | ;; 39 | 40 | let macro ~f ?(clean=(fun () -> ())) ~runs {x; y} = 41 | assert (runs >= 1); 42 | Array.init runs ~f:(fun _ -> 43 | let () = Caml.Gc.full_major () in 44 | let {Unix.tms_utime=start;_} = Unix.times () in 45 | let _ = f ~x ~y in 46 | let {Unix.tms_utime=end_;_} = Unix.times () in 47 | let () = clean () in 48 | Core_kernel.Time.Span.(of_sec end_ - of_sec start) 49 | ) 50 | ;; 51 | 52 | let make_macro_timing_array ~n:_ ~k:_ ~runs input (F.W fun_) = 53 | let f = F.get fun_ in 54 | match fun_ with 55 | 56 | | F.Owl -> 57 | macro ~f ~runs input 58 | 59 | | F.NumPy -> 60 | let {x; y} = input in 61 | let f = fst f in 62 | Array.init runs ~f:(fun _ -> 63 | Core.Time.Span.of_us @@ f ~x ~y) 64 | 65 | | F.NumLin -> 66 | let f = f.f in 67 | macro ~f ~runs input 68 | 69 | ;; 70 | 71 | let check_dims ~n ~k {x; y} = 72 | assert (n >= 1 && k >= 1); 73 | let (=) = Caml.(=) and shape = Mat.shape in 74 | assert (( n, k ) = shape x); 75 | assert (( n, 1 ) = shape y); 76 | ;; 77 | 78 | (* Step 4: Select appropriate test and gather data. *) 79 | let runtest_exn files ~macro_runs:runs ~micro_quota:sec ~base:n' ~cols:k' ~exp:i tests = 80 | let scale = Int.pow n' (i-1) in 81 | match Collect.read_in_exn ~scale files with 82 | | [x; y] -> 83 | let input = {x; y} in 84 | let n, k = scale * n', scale * k' in 85 | let () = check_dims ~n ~k input in 86 | begin match sec with 87 | | Some sec -> 88 | if i <= 3 (* micro-benchmark for small values only *) then 89 | Collect.micro_exn ~sec ~n ~k make_microbench_tests input tests 90 | else 91 | Collect.macro ~runs ~n ~k F.name make_macro_timing_array input tests 92 | | None -> 93 | Collect.macro ~runs ~n ~k F.name make_macro_timing_array input tests 94 | end 95 | | _ -> assert false 96 | ;; 97 | 98 | let files ~base:n' ~cols:k' = 99 | 100 | (* Memory leak! *) 101 | let make_x = 102 | let x_table = Hashtbl.create (module Int) in fun x -> 103 | Hashtbl.find_or_add x_table x ~default:(fun () -> Mat.uniform (n' * x) (k' * x)) in 104 | 105 | let valid = Mat.for_all (fun x -> Float.(0. <= x && x <= 1.)) in 106 | Collect.[ 107 | 108 | { 109 | name ="x"; 110 | dim = (fun x -> n'*x , k'*x); 111 | make = (fun ~scale:x -> make_x x); 112 | valid; 113 | }; 114 | 115 | { 116 | name = "y"; 117 | dim = (fun x -> n'*x , 1); 118 | make = (fun ~scale:x -> Mat.(make_x x *@ uniform ~a:1. Int.(k' * x) 1)); 119 | valid = (fun _ -> true); 120 | }; 121 | 122 | ] 123 | ;; 124 | -------------------------------------------------------------------------------- /bin/repl.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* REPL *) 3 | (* ---- *) 4 | (* Copyright : (c) 2015, Martin DeMello 5 | Licence : BSD3 6 | This file was adapted from examples/repl.ml of Lambda-Term. *) 7 | 8 | open React 9 | ;; 10 | 11 | open Lwt 12 | ;; 13 | 14 | open LTerm_style 15 | ;; 16 | 17 | open LTerm_text 18 | ;; 19 | 20 | (* Prompt based on current interpreter state *) 21 | let make_prompt state = 22 | let prompt = Printf.sprintf "In [%d]: " state in 23 | eval [B_fg cyan; S prompt; E_fg] 24 | ;; 25 | 26 | (* Format the interpreter output for REPL display *) 27 | let make_output state out = 28 | let pre = Printf.sprintf "Out [%d]: " (state - 1) in 29 | let out, col = match out with 30 | | Ok str -> str, green 31 | | Error str -> str, red in 32 | eval [B_fg col; S pre; E_fg; S out] 33 | ;; 34 | 35 | (* Customization of the read-line engine *) 36 | class read_line ~term ~history ~state = 37 | object(self) 38 | inherit LTerm_read_line.read_line ~history () 39 | inherit [Zed_string.t] LTerm_read_line.term term 40 | method! show_box = false 41 | initializer self#set_prompt (S.const (make_prompt state)) 42 | end 43 | ;; 44 | 45 | let get_line term history state = 46 | 47 | try%lwt 48 | let history = LTerm_history.contents history in 49 | let rl = new read_line ~term ~history ~state in 50 | rl#run >|= Base.Option.return 51 | with 52 | | Sys.Break -> return None 53 | | exn -> Lwt.fail exn 54 | 55 | ;; 56 | 57 | (* Main loop *) 58 | let rec loop term history ?cont state = 59 | 60 | match%lwt get_line term history state with 61 | 62 | | Some command -> 63 | step term history command @@ 64 | let command = Zed_string.to_utf8 command in 65 | begin match cont with 66 | | Some cont -> cont (Lexing.from_string command) 67 | | None -> Eval.eval state command 68 | end 69 | 70 | | None -> 71 | loop term history state 72 | 73 | and step term history command = function 74 | 75 | | Eval.Done (state, out) -> 76 | let%lwt () = LTerm.fprintls term (make_output state out) in 77 | LTerm_history.add history command; 78 | loop term history state 79 | 80 | | Eval.More (state, cont) -> 81 | LTerm_history.add history command; 82 | loop term history ~cont state 83 | ;; 84 | 85 | (* Entry point *) 86 | let main () = 87 | let%lwt () = LTerm_inputrc.load () in 88 | try%lwt 89 | let%lwt () = LTerm.printls (eval [S "NumLin REPL"]) in 90 | let%lwt term = Lazy.force LTerm.stdout in 91 | loop term (LTerm_history.create []) 0 92 | with 93 | | LTerm_read_line.Interrupt -> Lwt.return () 94 | | exn -> Lwt.fail exn 95 | ;; 96 | 97 | let () = 98 | Lwt_main.run (main ()) 99 | ;; 100 | 101 | -------------------------------------------------------------------------------- /bin/transpile.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | let speclist set_in set_out = 5 | let open Caml.Arg in 6 | [ ("-i", Set_string set_in, "input file") 7 | ; ("-o", Set_string set_out, "output file") 8 | ] 9 | ;; 10 | 11 | let () = 12 | let set_in, set_out = ref "", ref "" in 13 | Caml.Arg.parse (speclist set_in set_out) (Fn.const ()) "transpile -i -o "; 14 | match Numlin.Transpile.files ~in_file:!set_in ~out_file:!set_out with 15 | | Ok () -> () 16 | | Error str -> Stdio.Out_channel.(output_string stderr) str; Caml.exit(1); 17 | ;; 18 | -------------------------------------------------------------------------------- /bin/utils.ml: -------------------------------------------------------------------------------- 1 | module type Intf = 2 | sig 3 | type wrap 4 | val files: base:int -> cols:int -> Collect.mat_info list 5 | val runtest_exn: 6 | Collect.mat_info list -> 7 | macro_runs:int -> 8 | micro_quota:int option -> 9 | base:int -> 10 | cols:int -> 11 | exp:int -> 12 | wrap list -> 13 | int * string Data.t list 14 | end 15 | 16 | module type With_algs = 17 | sig 18 | include Intf 19 | val algs: wrap list 20 | end 21 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.0) 2 | (using menhir 2.0) 3 | -------------------------------------------------------------------------------- /examples/bindings.ml: -------------------------------------------------------------------------------- 1 | module Make(F : Cstubs.FOREIGN) = 2 | struct 3 | let foreign = F.foreign 4 | 5 | module C = struct 6 | include Ctypes 7 | let (@->) = F.(@->) 8 | let returning = F.returning 9 | end 10 | 11 | let measure = foreign "measure_kalman" 12 | C.(int @-> (* n *) 13 | int @-> (* k *) 14 | ptr double @-> (* sigma *) 15 | ptr double @-> (* h *) 16 | ptr double @-> (* mu *) 17 | ptr double @-> (* r *) 18 | ptr double @-> (* data *) 19 | returning double) 20 | 21 | let test = foreign "test" C.(int @-> returning double) 22 | 23 | let result = foreign "result" 24 | C.(int @-> (* n *) 25 | int @-> (* k *) 26 | ptr double @-> (* sigma *) 27 | ptr double @-> (* h *) 28 | ptr double @-> (* mu *) 29 | ptr double @-> (* r *) 30 | ptr double @-> (* data *) 31 | returning (ptr double)) 32 | 33 | end 34 | -------------------------------------------------------------------------------- /examples/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name examples) 3 | (synopsis "All examples") 4 | (flags :standard -short-paths) 5 | (modules kalman gen python_compile l1_norm_min lin_reg) 6 | (libraries kalman_c_ffi numlin pyml owl)) 7 | 8 | (executable 9 | (name generate) 10 | (flags :standard -short-paths) 11 | (modules generate) 12 | (libraries numlin)) 13 | 14 | (rule 15 | (targets gen.ml) 16 | (deps 17 | (:< generate.exe) 18 | (glob_files *.lt)) 19 | (action 20 | (run %{<}))) 21 | 22 | (library 23 | (name bindings) 24 | (modules bindings) 25 | (libraries ctypes.stubs ctypes)) 26 | ; HACK to generate .merlin file with PPX rewriters 27 | ; (preprocess 28 | ;(pps ppx_jane lwt_ppx ppxlib.runner))) 29 | -------------------------------------------------------------------------------- /examples/examples.ml: -------------------------------------------------------------------------------- 1 | module Kalman = Kalman 2 | module L1_norm_min = L1_norm_min 3 | module Lin_reg = Lin_reg 4 | -------------------------------------------------------------------------------- /examples/factorial.lt: -------------------------------------------------------------------------------- 1 | let rec factorial ( !x : !int ) : !int = 2 | if x < 0 || x = 0 then 3 | 1 4 | else 5 | x * factorial (x - 1) in 6 | factorial ;; 7 | -------------------------------------------------------------------------------- /examples/generate.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | let transpile chan file = 5 | match String.chop_suffix file ~suffix:".lt" with 6 | | None -> () 7 | | Some file -> 8 | let from_name = file ^ ".lt" in 9 | Stdio.In_channel.with_file from_name ~f:(fun from -> 10 | Stdio.Out_channel.output_string chan 11 | @@ Printf.sprintf "module %s =\nstruct\n" 12 | @@ String.capitalize file; 13 | begin match Numlin.Transpile.chans ~in_file:from_name from chan with 14 | | Ok () -> 15 | Stdio.Out_channel.output_string chan @@ "end\n\n"; 16 | | Error str -> 17 | Stdio.prerr_endline str; 18 | Caml.exit(1) 19 | end) 20 | ;; 21 | 22 | let () = 23 | Stdio.Out_channel.with_file "gen.ml" ~f:(fun chan -> 24 | Array.iter ~f:(transpile chan) @@ Caml.Sys.(readdir @@ getcwd ())) 25 | ;; 26 | 27 | -------------------------------------------------------------------------------- /examples/kalman.h: -------------------------------------------------------------------------------- 1 | #ifndef LT4LA_KALMAN 2 | #define LT4LA_KALMAN 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #define N 5 13 | #define K 3 14 | 15 | double *new_sigma; 16 | 17 | double const sigma[N][N] = { 18 | { 1.682490, 0.621964, 0.959947, 1.228820, 1.029410, } , 19 | { 0.621964, 0.631446, 0.551902, 0.723342, 0.756674, } , 20 | { 0.959947, 0.551902, 1.100060, 0.908402, 1.032840, } , 21 | { 1.228820, 0.723342, 0.908402, 1.212400, 1.011350, } , 22 | { 1.029410, 0.756674, 1.032840, 1.011350, 1.302410, } , 23 | }; 24 | 25 | double const h[K][N] = { 26 | { 0.4621110, 0.833041, 0.0395867, 0.529315, 0.241678, }, 27 | { 0.0507828, 0.340120, 0.8726660, 0.836114, 0.571528, }, 28 | { 0.7779080, 0.541655, 0.8691540, 0.286846, 0.265820, }, 29 | }; 30 | 31 | double mu[N][1] = { 32 | { 0.8015420 }, 33 | { 0.8585870 }, 34 | { 0.0950306 }, 35 | { 0.8101720 }, 36 | { 0.3491810 }, 37 | }; 38 | 39 | double r[K][K] = { 40 | { 0.880164, 0.676823, 0.802738, }, 41 | { 0.676823, 0.650806, 0.958725, }, 42 | { 0.802738, 0.958725, 1.745970, }, 43 | }; 44 | 45 | double data[K][1] = { 46 | { 0.551922 }, 47 | { 0.673854 }, 48 | { 0.259412 }, 49 | }; 50 | 51 | static void kalman( 52 | const int n, 53 | const int k, 54 | const double *sigma, /* n,n */ 55 | const double *h, /* k,n */ 56 | double *mu, /* n,1 */ 57 | double *r, /* k,k */ 58 | double *data, /* k,1 */ 59 | double **ret_sigma /* n,n */ 60 | ) { 61 | double* n_by_k = (double *) malloc(n * k * sizeof(double)); 62 | cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasTrans, n, k, n, 1., sigma, n, h, n, 0., n_by_k, k); 63 | cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, k, k, n, 1., h, n, n_by_k, k, 1., r, k); 64 | LAPACKE_dposv(LAPACK_COL_MAJOR, 'U', k, n, r, k, n_by_k, k); 65 | cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, k, 1, n, 1., h, n, mu, 1, -1., data, 1); 66 | cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, n, 1, k, 1., n_by_k, k, data, 1, 1., mu, 1); 67 | double* n_by_n = (double *) malloc(n * n * sizeof(double)); 68 | cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, n, n, k, 1., n_by_k, k, h, n, 0., n_by_n, n); 69 | free(n_by_k); 70 | double* n_by_n2 = (double *) malloc(n * n * sizeof(double)); 71 | cblas_dcopy(n*n, sigma, 1, n_by_n2, 1); 72 | cblas_dsymm(CblasRowMajor, CblasRight, CblasUpper, n, n, -1., sigma, n, n_by_n, n, 1., n_by_n2, n); 73 | free(n_by_n); 74 | *ret_sigma = n_by_n2; 75 | } 76 | 77 | static double measure_kalman_no_free( 78 | const int n, 79 | const int k, 80 | const double *sigma, /* n,n */ 81 | const double *h, /* k,n */ 82 | double *mu, /* n,1 */ 83 | double *r, /* k,k */ 84 | double *data /* k,1 */ 85 | ) { 86 | struct rusage usage; 87 | 88 | getrusage(RUSAGE_SELF, &usage); 89 | struct timeval start = usage.ru_utime; 90 | 91 | kalman(n, k, sigma, h, mu, r, data, &new_sigma); 92 | 93 | getrusage(RUSAGE_SELF, &usage); 94 | struct timeval end = usage.ru_utime; 95 | 96 | // Execution time would have to reach about 300 years before (* 1000000) will cause problems 97 | return (double) ((end.tv_sec - start.tv_sec) * 1000000 + (end.tv_usec - start.tv_usec)); 98 | } 99 | 100 | double measure_kalman( 101 | const int n, 102 | const int k, 103 | const double *sigma, /* n,n */ 104 | const double *h, /* k,n */ 105 | double *mu, /* n,1 */ 106 | double *r, /* k,k */ 107 | double *data /* k,1 */ 108 | ) { 109 | const double result = measure_kalman_no_free(n, k, sigma, h, mu, r, data); 110 | free(new_sigma); 111 | return result; 112 | } 113 | 114 | double *result( 115 | const int n, 116 | const int k, 117 | const double *sigma, /* n,n */ 118 | const double *h, /* k,n */ 119 | double *mu, /* n,1 */ 120 | double *r, /* k,k */ 121 | double *data /* k,1 */ 122 | ) { 123 | measure_kalman_no_free(n, k, sigma, h, mu, r, data); 124 | return new_sigma; 125 | } 126 | 127 | double test(int arg) { 128 | 129 | const double result = 130 | measure_kalman_no_free(N, K, &sigma[0][0], &h[0][0], &mu[0][0], &r[0][0], &data[0][0]); 131 | printf("Arg: %d, Result: %f\n\n", arg, result); 132 | 133 | // Print Matrices 134 | for (int i = 0; i < N; i++) { 135 | for (int j = 0; j < N; j++) { 136 | printf("\t%f", new_sigma[i*N + j]); 137 | } 138 | printf("\n"); 139 | } 140 | printf("\n"); 141 | free(new_sigma); 142 | 143 | for (int i = 0; i < N; i++) { 144 | printf("\t%f\n", mu[i][0]); 145 | } 146 | printf("\n"); 147 | 148 | return result; 149 | 150 | } 151 | 152 | #endif // LT4LA_KALMAN 153 | -------------------------------------------------------------------------------- /examples/kalman.lt: -------------------------------------------------------------------------------- 1 | let !kalman 2 | ('s) (sigma : 's mat) (* n,n *) 3 | ('h) (h : 'h mat) (* k,n *) 4 | (mu : z mat) (* n,1 *) 5 | (r_1 : z mat) (* k,k *) 6 | (data_1 : z mat) (* k,1 *) = 7 | let (h, (!k, !n)) = sizeM _ h in 8 | (* could use [| sym(sigma) * hT |] but would 9 | need a (n,k) temporary hT = tranpose _ h *) 10 | let sigma_hT <- new (n, k) [| sigma * h^T |] in 11 | let r_2 <- [| r_1 + h * sigma_hT |] in 12 | let (k_by_k, x) = posvFlip r_2 sigma_hT in 13 | let data_2 <- [| h * mu - data_1 |] in 14 | let new_mu <- [| mu + x * data_2 |] in 15 | let x_h <- new (n,n) [| x * h |] in 16 | let () = freeM (* n,k *) x in 17 | let sigma2 <- new [| sigma |] in 18 | let new_sigma <- [| sigma2 - x_h * sym(sigma) |] in 19 | let () = freeM (* n,n *) x_h in 20 | ((sigma, h), (new_sigma, (new_mu, (k_by_k, data_2)))) in 21 | kalman ;; 22 | -------------------------------------------------------------------------------- /examples/kalman.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | let owl ~sigma ~h ~mu ~r ~data = 5 | let open Owl.Mat in 6 | let ( * ) = dot in 7 | let h' = transpose h in 8 | let sigma_h' = sigma * h' in 9 | let x = sigma_h' * (inv @@ r + h * sigma_h') in 10 | let new_mu = mu + x * (h * mu - data) in 11 | let new_sigma = sigma - x * h * sigma in 12 | new_sigma, new_mu 13 | ;; 14 | 15 | let numpy, numpy_measure = 16 | let kalman_bytecode = 17 | Python_compile.f `Exec ~optimize:`Normal ~filename:"kalman.py" ~source:" 18 | import gc 19 | import resource 20 | import numpy as np 21 | from numpy.linalg import inv 22 | 23 | def kalman(sigma, h, mu, r, data): 24 | sigma_hT = np.dot(sigma, h.T) 25 | x = np.dot(sigma_hT, inv(r + np.dot(h, sigma_hT))) 26 | new_mu = mu + np.dot(x, np.dot(h, mu) - data) 27 | new_sigma = sigma - np.dot(np.dot(x,h), sigma) 28 | return (new_sigma, new_mu) 29 | 30 | def measure(sigma, h, mu, r, data): 31 | gc.collect() 32 | start = resource.getrusage(resource.RUSAGE_SELF).ru_utime 33 | (new_sigma, new_mu) = kalman(sigma, h, mu, r, data) 34 | end = resource.getrusage(resource.RUSAGE_SELF).ru_utime 35 | return ((end - start) * 1000000.0) 36 | " in 37 | let kalman_module = Py.Import.exec_code_module "kalman" kalman_bytecode in 38 | let measure = Py.Module.get_function kalman_module "measure" in 39 | let kalman = Py.Module.get_function kalman_module "kalman" in 40 | kalman, measure 41 | ;; 42 | 43 | let numpy ~sigma ~h ~mu ~r ~data = 44 | let [| new_sigma; new_mu |] = 45 | [| sigma; h; mu; r; data |] 46 | |> Array.map ~f:Numpy.of_bigarray 47 | |> numpy 48 | |> Py.Tuple.to_array 49 | |> Array.map ~f:(Numpy.to_bigarray Bigarray.float64 Bigarray.c_layout) 50 | [@@ocaml.warning "-8" (* inexhaustive pattern match *) ] in 51 | (new_sigma, new_mu) 52 | ;; 53 | 54 | let numpy_measure ~sigma ~h ~mu ~r ~data = 55 | [| sigma; h; mu; r; data |] 56 | |> Array.map ~f:Numpy.of_bigarray 57 | |> numpy_measure 58 | |> Py.Float.to_float 59 | ;; 60 | 61 | let numlin ~sigma ~h ~mu ~r ~data = 62 | Gen.Kalman.it (M sigma) (M h) (M mu) (M r) (M data) 63 | ;; 64 | 65 | let cblas ~n ~k ~sigma ~h ~mu ~r ~data = 66 | let open Kalman_c_ffi.Bind.C in 67 | let module Bind = Kalman_c_ffi.Bind in 68 | let gen, f64 = Ctypes_static.Genarray, Bigarray.float64 in 69 | let f x = bigarray_start gen x [@@ocaml.inline] in 70 | let new_sigma = Bind.result n k (f sigma) (f h) (f mu) (f r) (f data) in 71 | let new_sigma = bigarray_of_ptr gen [| n; n |] f64 new_sigma in 72 | new_sigma 73 | ;; 74 | 75 | let cblas_measure ~n ~k ~sigma ~h ~mu ~r ~data = 76 | let open Kalman_c_ffi in 77 | let f x = Bind.C.(bigarray_start Ctypes_static.Genarray x) [@@ocaml.inline] in 78 | Bind.measure n k (f sigma) (f h) (f mu) (f r) (f data) 79 | ;; 80 | 81 | let lazy_ = 82 | let module Lazy_Nd = Owl.Lazy.Make (Owl.Dense.Ndarray.D) in 83 | let open Lazy_Nd in 84 | let sigma = var_arr "sigma" 85 | and h = var_arr "h" 86 | and h' = var_arr "h'" 87 | and mu = var_arr "mu" 88 | and r = var_arr "r" 89 | and data = var_arr "data" 90 | in 91 | fun ~sigma:sigma_ ~h:h_ ~mu:mu_ ~r:r_ ~data:data_ -> 92 | let ( := ) = assign_arr in 93 | sigma := sigma_; 94 | h := h_ ; 95 | h' := Owl.Mat.transpose h_; 96 | mu := mu_; 97 | r := r_; 98 | data := data_; 99 | let ( * ) = dot and ( + ) = add and ( - ) = sub in 100 | let sigma_h' = sigma * h' in 101 | let x = sigma_h' * (inv @@ r + h * sigma_h') in 102 | let new_mu = mu + x * (h * mu - data) in 103 | let new_sigma = sigma - x * h * sigma in 104 | let graph = 105 | let input = Array.map ~f:arr_to_node [| sigma; h; h'; mu; r; data |] in 106 | let output = Array.map ~f:arr_to_node [| new_mu; new_sigma |] in 107 | make_graph ~input ~output "lazy_kalman" in 108 | Owl_io.write_file "lazy_kalman.dot" @@ graph_to_dot graph; 109 | eval_graph graph; 110 | (unpack_arr new_sigma, unpack_arr new_mu) 111 | ;; 112 | 113 | (* Uniform interface *) 114 | type o_mat = 115 | Owl.Mat.mat 116 | ;; 117 | 118 | type 'a l_mat = 119 | 'a Numlin.Template.mat 120 | ;; 121 | 122 | type l_z = 123 | Numlin.Template.z 124 | ;; 125 | 126 | type 'a from_input = 127 | sigma:o_mat -> h:o_mat -> mu:o_mat -> r:o_mat -> data:o_mat -> 'a 128 | ;; 129 | 130 | type numlin = 131 | { f : 'a 'b. 132 | (('a l_mat * 'b l_mat) * 133 | (l_z l_mat * (l_z l_mat * (l_z l_mat * l_z l_mat)))) from_input } 134 | ;; 135 | 136 | type _ t = 137 | | NumPy : (float from_input * (o_mat * o_mat) from_input) t 138 | | Owl : ((o_mat * o_mat) from_input) t 139 | | CBLAS : ((n:int -> k:int -> float from_input) * (n:int -> k:int -> o_mat from_input)) t 140 | | NumLin : numlin t 141 | ;; 142 | 143 | type wrap = 144 | | W : _ t -> wrap 145 | [@@ocaml.unboxed] 146 | ;; 147 | 148 | let get : type a . a t -> a = function 149 | | NumPy -> (numpy_measure, numpy) 150 | | Owl -> owl 151 | | NumLin -> { f = numlin } 152 | | CBLAS -> (cblas_measure, cblas) 153 | ;; 154 | 155 | let name : wrap -> string = function 156 | | W NumPy -> "NumPy" 157 | | W Owl -> "Owl" 158 | | W NumLin -> "Numlin" 159 | | W CBLAS -> "CBLAS" 160 | ;; 161 | 162 | let all = 163 | [W CBLAS; W NumLin; W Owl; W NumPy] 164 | ;; 165 | 166 | -------------------------------------------------------------------------------- /examples/l1_norm_min.lt: -------------------------------------------------------------------------------- 1 | let !l1_norm_min (q : z mat) (u : z mat) = 2 | let (u, (!_n, !k)) = sizeM _ u in 3 | let (u, u_T) = transpose _ u in 4 | let (tmp_n_n , q_inv_u ) = gesv q u in 5 | let i = eye k in 6 | let to_inv <- [| i + u_T * q_inv_u |] in 7 | let (tmp_k_k, inv_u_T ) = gesv to_inv u_T in 8 | let () = freeM tmp_k_k in 9 | let answer <- [| 0. * tmp_n_n + q_inv_u * inv_u_T |] in 10 | let () = freeM q_inv_u in 11 | let () = freeM inv_u_T in 12 | answer in 13 | l1_norm_min ;; 14 | -------------------------------------------------------------------------------- /examples/l1_norm_min.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | let numpy, numpy_measure = 5 | let l1_norm_min_bytecode = 6 | Python_compile.f `Exec ~optimize:`Normal ~filename:"l1_norm_min.py" ~source:" 7 | import gc 8 | import resource 9 | import numpy as np 10 | from numpy.linalg import inv 11 | 12 | def l1_norm_min(q, u): 13 | q_inv_u = np.dot(inv(q), u) 14 | i = np.identity(u.shape[1]) 15 | return np.dot(np.dot(q_inv_u, inv(i + np.dot(u.T, q_inv_u))), u.T) 16 | 17 | def measure(q, u): 18 | gc.collect() 19 | start = resource.getrusage(resource.RUSAGE_SELF).ru_utime 20 | result = l1_norm_min(q, u) 21 | end = resource.getrusage(resource.RUSAGE_SELF).ru_utime 22 | return ((end - start) * 1000000.0) 23 | " in 24 | let l1_norm_min_module = Py.Import.exec_code_module "l1_norm_min" l1_norm_min_bytecode in 25 | let measure = Py.Module.get_function l1_norm_min_module "measure" in 26 | let l1_norm_min = Py.Module.get_function l1_norm_min_module "l1_norm_min" in 27 | l1_norm_min, measure 28 | ;; 29 | 30 | let numpy ~q ~u = 31 | [| q; u |] 32 | |> Array.map ~f:Numpy.of_bigarray 33 | |> numpy 34 | |> Numpy.to_bigarray Bigarray.float64 Bigarray.c_layout 35 | ;; 36 | 37 | let numpy_measure ~q ~u = 38 | [| q; u |] 39 | |> Array.map ~f:Numpy.of_bigarray 40 | |> numpy_measure 41 | |> Py.Float.to_float 42 | ;; 43 | 44 | let owl ~q ~u = 45 | let open Owl.Mat in 46 | let ( * ) = dot in 47 | let u' = transpose u in 48 | let q_inv_u = inv q * u in 49 | let i = Owl.Mat.(eye @@ snd @@ shape u) in 50 | q_inv_u * inv ( i + u' * q_inv_u ) * u' 51 | ;; 52 | 53 | let numlin ~q ~u = 54 | let Numlin.Template.M x = Gen.L1_norm_min.it (M q) (M u) in 55 | x 56 | ;; 57 | 58 | (* Uniform interface *) 59 | type o_mat = 60 | Owl.Mat.mat 61 | ;; 62 | 63 | type _ t = 64 | | Owl : (q:o_mat -> u:o_mat -> o_mat) t 65 | | NumLin : (q:o_mat -> u:o_mat -> o_mat) t 66 | | NumPy : ((q:o_mat -> u:o_mat -> float) * (q:o_mat -> u:o_mat -> o_mat)) t 67 | ;; 68 | 69 | type wrap = 70 | | W : _ t -> wrap 71 | [@@ocaml.unboxed] 72 | ;; 73 | 74 | let get : type a . a t -> a = function 75 | | Owl -> owl 76 | | NumLin -> numlin 77 | | NumPy -> (numpy_measure, numpy) 78 | ;; 79 | 80 | let name : wrap -> string = function 81 | | W Owl -> "Owl" 82 | | W NumLin -> "NumLin" 83 | | W NumPy -> "NumPy" 84 | ;; 85 | 86 | let all = 87 | [W NumPy; W Owl; W NumLin] 88 | ;; 89 | -------------------------------------------------------------------------------- /examples/lib/bind.ml: -------------------------------------------------------------------------------- 1 | include Bindings.Make(Stubs) 2 | -------------------------------------------------------------------------------- /examples/lib/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets stubs.ml) 3 | (deps 4 | (:< ../stubgen/ffi_stubgen.exe)) 5 | (action 6 | (with-stdout-to 7 | %{targets} 8 | (run %{<} -ml)))) 9 | 10 | (rule 11 | (targets kalman_c_stubs.c) 12 | (deps 13 | (:< ../stubgen/ffi_stubgen.exe) 14 | ../kalman.h) 15 | (action 16 | (with-stdout-to 17 | %{targets} 18 | (run %{<} -c)))) 19 | 20 | (library 21 | (name kalman_c_ffi) 22 | (modules stubs bind) 23 | (c_names kalman_c_stubs) 24 | ; -llopenblas -llapacke are not needed? 25 | (c_flags :standard -I.. -O3 -g -Wall -Wextra) 26 | (libraries bindings ctypes.stubs ctypes)) 27 | -------------------------------------------------------------------------------- /examples/lin_reg.lt: -------------------------------------------------------------------------------- 1 | let !lin_reg ('x) (x : 'x mat) 2 | ('y) (y : 'y mat) = 3 | let (x, (!_n, !m)) = sizeM _ x in 4 | let xy <- new (m, 1) [| x^T * y |] in 5 | let x_T_x <- new (m, m) [| x^T * x |] in 6 | let (to_del, answer) = posv x_T_x xy in 7 | let () = freeM to_del in 8 | ((x, y), answer) in 9 | lin_reg ;; 10 | -------------------------------------------------------------------------------- /examples/lin_reg.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | let numpy, numpy_measure = 5 | let lin_reg_bytecode = 6 | Python_compile.f `Exec ~optimize:`Normal ~filename:"lin_reg.py" ~source:" 7 | import gc 8 | import resource 9 | import numpy as np 10 | from numpy.linalg import inv, lstsq 11 | 12 | def lin_reg(x, y): 13 | return np.dot(np.dot(inv(np.dot(x.T, x)), x.T), y) 14 | 15 | def measure(x, y): 16 | gc.collect() 17 | start = resource.getrusage(resource.RUSAGE_SELF).ru_utime 18 | result = lin_reg(x, y) 19 | end = resource.getrusage(resource.RUSAGE_SELF).ru_utime 20 | return ((end - start) * 1000000.0) 21 | " in 22 | let lin_reg_module = Py.Import.exec_code_module "lin_reg" lin_reg_bytecode in 23 | let measure = Py.Module.get_function lin_reg_module "measure" in 24 | let lin_reg = Py.Module.get_function lin_reg_module "lin_reg" in 25 | lin_reg, measure 26 | ;; 27 | 28 | let numpy ~x ~y = 29 | [| x; y |] 30 | |> Array.map ~f:Numpy.of_bigarray 31 | |> numpy 32 | |> Numpy.to_bigarray Bigarray.float64 Bigarray.c_layout 33 | ;; 34 | 35 | let numpy_measure ~x ~y = 36 | [| x; y |] 37 | |> Array.map ~f:Numpy.of_bigarray 38 | |> numpy_measure 39 | |> Py.Float.to_float 40 | ;; 41 | 42 | let owl ~x ~y = 43 | let open Owl.Mat in 44 | let ( * ) = dot in 45 | let x' = transpose x in 46 | inv (x' * x) * x' * y 47 | ;; 48 | 49 | let numlin ~x ~y = 50 | Gen.Lin_reg.it (M x) (M y) 51 | ;; 52 | 53 | (* Uniform interface *) 54 | type o_mat = 55 | Owl.Mat.mat 56 | ;; 57 | 58 | type 'a l_mat = 59 | 'a Numlin.Template.mat 60 | ;; 61 | 62 | type l_z = 63 | Numlin.Template.z 64 | ;; 65 | 66 | type 'a from_input = 67 | x:o_mat -> y:o_mat -> 'a 68 | ;; 69 | 70 | type numlin = 71 | { f : 'a 'b. (('a l_mat * 'b l_mat) * l_z l_mat) from_input } 72 | ;; 73 | 74 | type _ t = 75 | | Owl : o_mat from_input t 76 | | NumLin : numlin t 77 | | NumPy : (float from_input * o_mat from_input) t 78 | ;; 79 | 80 | type wrap = 81 | | W : _ t -> wrap 82 | [@@ocaml.unboxed] 83 | ;; 84 | 85 | let get : type a . a t -> a = function 86 | | Owl -> owl 87 | | NumLin -> { f = numlin } 88 | | NumPy -> (numpy_measure, numpy) 89 | ;; 90 | 91 | let name : wrap -> string = function 92 | | W Owl -> "Owl" 93 | | W NumLin -> "NumLin" 94 | | W NumPy -> "NumPy" 95 | ;; 96 | 97 | let all = 98 | [ W NumPy; W Owl; W NumLin] 99 | ;; 100 | -------------------------------------------------------------------------------- /examples/python_compile.ml: -------------------------------------------------------------------------------- 1 | Py.initialize ~version:3 () 2 | ;; 3 | 4 | let f ~source ~filename ?(dont_inherit = false) 5 | ?(optimize = `Default) mode = 6 | let compile = 7 | Py.Module.get_function_with_keywords (Py.Module.builtins ()) "compile" in 8 | let source = Py.String.of_string source in 9 | let filename = Py.String.of_string filename in 10 | let mode = 11 | Py.String.of_string @@ match mode with 12 | | `Exec -> "exec" 13 | | `Eval -> "eval" 14 | | `Single -> "single" in 15 | let optimize = 16 | Py.Int.of_int @@ match optimize with 17 | | `Default -> -1 18 | | `Debug -> 0 19 | | `Normal -> 1 20 | | `RemoveDocstrings -> 2 in 21 | let dont_inherit = Py.Bool.of_bool dont_inherit in 22 | compile [| source; filename; mode |] 23 | ["dont_inherit", dont_inherit; "optimize", optimize] 24 | ;; 25 | -------------------------------------------------------------------------------- /examples/square.lt: -------------------------------------------------------------------------------- 1 | let !square ('x) (x : 'x mat) = 2 | let (x, (!m, !n)) = sizeM _ x in 3 | let (x1, x2) = shareM _ x in 4 | let answer <- new (m, n) [| x1 * x2 |] in 5 | let x = unshareM _ x1 x2 in 6 | (x, answer) in 7 | square ;; 8 | -------------------------------------------------------------------------------- /examples/stubgen/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name ffi_stubgen) 3 | (modules ffi_stubgen) 4 | (libraries bindings ctypes.stubs ctypes)) 5 | -------------------------------------------------------------------------------- /examples/stubgen/ffi_stubgen.ml: -------------------------------------------------------------------------------- 1 | let prefix = "kalman_c_stub" 2 | 3 | let prologue = "#include \"kalman.h\"" 4 | 5 | let () = 6 | let generate_ml, generate_c = ref false, ref false in 7 | let () = 8 | Arg.(parse [ ("-ml", Set generate_ml, "Generate ML"); 9 | ("-c", Set generate_c, "Generate C") ]) 10 | (fun _ -> failwith "unexpected anonymous argument") 11 | "stubgen [-ml|-c]" 12 | in 13 | match !generate_ml, !generate_c with 14 | | false, false 15 | | true, true -> 16 | failwith "Exactly one of -ml and -c must be specified" 17 | | true, false -> 18 | Cstubs.write_ml Format.std_formatter ~prefix (module Bindings.Make) 19 | | false, true -> 20 | print_endline prologue; 21 | Cstubs.write_c Format.std_formatter ~prefix (module Bindings.Make) 22 | -------------------------------------------------------------------------------- /examples/sugar.lt: -------------------------------------------------------------------------------- 1 | let !f ('x) ( in_arr : 'x arr) ( ( !x, Many !y ) : !int * !!int ) = 2 | (in_arr, x + y) in 3 | ( f , fun (Many !zero : !!int) -> fun 'y -> fun ('x) ( !i : !int ) -> i + 2 * zero ) 4 | ;; 5 | -------------------------------------------------------------------------------- /examples/sum_array.lt: -------------------------------------------------------------------------------- 1 | let rec sum_array (!i : !int) (!n : !int) (!x0 : !elt) 2 | ('x) (row : 'x arr) : 'x arr * !elt = 3 | if i = n then 4 | (row, x0) 5 | else 6 | let (row, !x1) = row[i] in 7 | sum_array (i + 1) n (x0 +. x1) 'x row in 8 | sum_array ;; 9 | -------------------------------------------------------------------------------- /examples/weighted_avg.lt: -------------------------------------------------------------------------------- 1 | let rec f (i : !int) : !int --o !elt --o z arr --o 'x. 'x arr --o 'x arr * z arr = 2 | let Many i = i in let Many i = Many (Many i) in 3 | fun n : !int -> let Many n = n in let Many n = Many (Many n) in 4 | fun x0 : !elt -> let Many x0 = x0 in let Many x0 = Many (Many x0) in 5 | fun write : z arr -> fun 'x -> fun weights : 'x arr -> 6 | if n = i then (weights, write) else 7 | let (weights, w0) = weights[0] in 8 | let Many w0 = w0 in let Many w0 = Many (Many w0) in 9 | let (weights, w1) = weights[1] in 10 | let Many w1 = w1 in let Many w1 = Many (Many w1) in 11 | let (weights, w2) = weights[2] in 12 | let Many w2 = w2 in let Many w2 = Many (Many w2) in 13 | let (write, x1) = write[i] in 14 | let Many x1 = x1 in let Many x1 = Many (Many x1) in 15 | let (write, x2) = write[i + 1] in 16 | let Many x2 = x2 in let Many x2 = Many (Many x2) in 17 | let newx : !elt = w0 *. x0 +. (w1 *. x1 +. w2 *. x2) in 18 | let Many newx = newx in let Many newx = Many (Many newx) in 19 | let write : z arr = write[i] := newx in 20 | f (i + 1) n x1 write 'x weights in 21 | f 22 | ;; 23 | -------------------------------------------------------------------------------- /examples/weighted_avg_infer.lt: -------------------------------------------------------------------------------- 1 | let rec simp_oned_conv 2 | (!i : !int) (!n : !int) (!x0 : !elt) 3 | (write : z arr) ('x) (weights : 'x arr) 4 | : 'x arr * z arr = 5 | if n = i then (weights, write) else 6 | let !w0 <- weights[0] in 7 | let !w1 <- weights[1] in 8 | let !w2 <- weights[2] in 9 | let !x1 <- write[i] in 10 | let !x2 <- write[i + 1] in 11 | let written = write[i] := w0 *. x0 +. (w1 *. x1 +. w2 *. x2) in 12 | simp_oned_conv (i + 1) n x1 written _ weights in 13 | simp_oned_conv ;; 14 | -------------------------------------------------------------------------------- /jbuild-workspace: -------------------------------------------------------------------------------- 1 | (context default) 2 | -------------------------------------------------------------------------------- /old/src/ast.mli: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* LT4LA Abstract Syntax Tree *) 3 | (* -------------------------- *) 4 | 5 | (** Make a pretty-printer output a string. *) 6 | val string_of_pp : ?size:int -> (Base.Formatter.t -> 'a -> unit) -> 'a -> string 7 | 8 | (** Variables have a [name] for pretty-printing and an [id] for uniqueness. *) 9 | type variable = { id : int; name : string; } 10 | val sexp_of_variable : variable -> Base.Sexp.t 11 | val compare_variable : variable -> variable -> int 12 | val string_of_variable : variable -> string 13 | 14 | (** We (will) have two kinds in this type system, fractional capabilities of an array 15 | and sizes of an array. Fractional capabilities keep track of the linearity 16 | of the array, whether or not it is aliased. They can be interpreted as 17 | 2^(-[frac_cap]). Hence, a whole (unshared) array has a capability 1 18 | capability (2^-[Zero]). Either 1 or 1/2 or 1/4, etc... or a variable. *) 19 | type frac_cap = Zero | Succ of frac_cap | Var of variable 20 | val sexp_of_frac_cap : frac_cap -> Base.Sexp.t 21 | val compare_frac_cap : frac_cap -> frac_cap -> int 22 | val string_of_frac_cap : frac_cap -> string 23 | 24 | (** [bind_fc_fc var fc] replaces any [Var var'] in [fc] with [Var var] if [var.name = var'.name]. *) 25 | val bind_fc_fc : variable -> frac_cap -> frac_cap 26 | 27 | (** Standard Linear type system, using fractional capabilities 28 | and extensions for Linear Algebra. *) 29 | type linear_t = 30 | | Unit 31 | | Int 32 | | Float64 33 | | Pair of linear_t * linear_t 34 | | Fun of linear_t * linear_t 35 | | ForAll_frac_cap of variable * linear_t 36 | | Array_t of frac_cap 37 | val sexp_of_linear_t : linear_t -> Base.Sexp.t 38 | val compare_linear_t : linear_t -> linear_t -> int 39 | val pp_linear_t : Base.Formatter.t -> linear_t -> unit 40 | val substitute_in : linear_t -> var:variable -> replacement:frac_cap -> linear_t Base.Or_error.t 41 | val same_linear_t : linear_t -> linear_t -> unit Base.Or_error.t 42 | 43 | (** [bind_fc_lt var lt] replaces any [Var var'] in [lt] with [Var var] if [var.name = var'.name]. *) 44 | val bind_fc_lt : variable -> linear_t -> linear_t 45 | 46 | (** Primitives/extensions 47 | Intel Level 1: software.intel.com/en-us/mkl-developer-reference-c-blas-level-1-routines-and-functions 48 | BLAS Reference: www.netlib.org/blas/blasqr.pdf 49 | Not included: xxDOT (derivable), xDOTU, xDOTC (Complex Float32/64) *) 50 | type primitive = 51 | (* Operators *) 52 | | Split_Permission 53 | | Merge_Permission 54 | | Free 55 | | Copy (* xCOPY *) 56 | | Swap (* xSWAP *) 57 | 58 | (* Routines/Functions *) 59 | | Sum_Mag (* xASUM *) 60 | | Scalar_Mult_Then_Add (* xAXPY *) 61 | | DotProd (* xDOT *) 62 | | Norm2 (* xNRM2 *) 63 | | Plane_Rotation (* xROT *) 64 | | Givens_Rotation (* xROTG *) 65 | | GivensMod_Rotation (* xROTM *) 66 | | Gen_GivensMod_Rotation (* xROTMG *) 67 | | Scalar_Mult (* xSCAL *) 68 | | Index_of_Max_Abs (* IxAMAX *) 69 | 70 | val sexp_of_primitive : primitive -> Base.Sexp.t 71 | 72 | val string_of_primitive : primitive -> string 73 | 74 | (** Expressions of the language. Right now, I've made my life much easier by 75 | having type-directed abstract-syntax. Can hopefully elaborate to this later. 76 | Elimination rules for [Int]s and [Float64]s will come later, after an 77 | arithmetic expression language is fixed. *) 78 | type expression = 79 | | Var of variable 80 | | Int_Intro of int 81 | | Float64_Intro of float 82 | | Unit_Intro 83 | | Unit_Elim of expression * expression 84 | | Pair_Intro of expression * expression 85 | | Pair_Elim of variable * variable * expression * expression 86 | | Lambda of variable * linear_t * expression 87 | | App of expression * expression 88 | | ForAll_frac_cap of variable * expression 89 | | Specialise_frac_cap of expression * frac_cap 90 | | Array_Intro of expression 91 | | Array_Elim of variable * expression * expression 92 | (*| ForAll_Size of variable * expression *) 93 | | Primitive of primitive 94 | 95 | val sexp_of_expression : expression -> Base.Sexp.t 96 | 97 | val pp_expression : Base.Formatter.t -> expression -> unit 98 | 99 | (** [bind_fc_exp var exp] replaces any [Var var' : frac_cap] in [exp] with [Var 100 | var] if [var.name = var'.name]. *) 101 | val bind_fc_exp : variable -> expression -> expression 102 | 103 | (** [bind_exp var exp] replaces any [Var var' : expression] in [exp] with [Var 104 | var] if [var.name = var'.name]. *) 105 | val bind_exp : variable -> expression -> expression 106 | -------------------------------------------------------------------------------- /old/src/check_monad.mli: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* LT4LA Check Monad *) 3 | (* ----------------- *) 4 | (* This is a wrapper arround the monad defined in state_or_error.mli. 5 | This is so that (1) I don't have arbitrary access to the state during 6 | typechecking and (2) I can enforce invariants such as only marking those 7 | linear variables which have been found and not used as used in [use_var] 8 | or enforcing that all types are well-formed (3) I can change how the monad 9 | and how the state are implemented independently. Right now, (almost) 10 | everything is pure functional. *) 11 | 12 | (** Proof that types is well-formed. 13 | Private so you can pattern match and extract but not fake proof. *) 14 | type well_formed = private WF of Ast.linear_t 15 | 16 | val sexp_of_well_formed : well_formed -> Base.Sexp.t 17 | 18 | val wf_Array_t_Zero : well_formed 19 | val wf_Unit : well_formed 20 | val wf_Int : well_formed 21 | val wf_Float64 : well_formed 22 | val wf_Pair : well_formed -> well_formed -> well_formed 23 | val wf_Fun : well_formed -> well_formed -> well_formed 24 | val wf_ForAll : Ast.variable -> well_formed -> well_formed 25 | 26 | (** Proof that a type is not used *) 27 | type not_used 28 | 29 | val sexp_of_not_used : not_used -> Base.Sexp.t 30 | 31 | (** Track usage of linear types *) 32 | type tagged_linear_t = Not_used of not_used | Used of well_formed 33 | 34 | val sexp_of_tagged_linear_t : tagged_linear_t -> Base.Sexp.t 35 | 36 | (** The theory has two (eventually three) sorts: variables can map to either 37 | - Linear Types, with an 'a (e.g. usage) 38 | - Fractional capabilities 39 | - Sizes/dimensions or arrays and matrices *) 40 | type state 41 | 42 | val sexp_of_state : state -> Base.Sexp.t 43 | 44 | (** Sequence computations based on a given state. *) 45 | type 'a t 46 | 47 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 48 | 49 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 50 | 51 | module Monad_infix : sig 52 | 53 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 54 | 55 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 56 | 57 | end 58 | 59 | val bind : 'a t -> f:('a -> 'b t) -> 'b t 60 | 61 | val return : 'a -> 'a t 62 | 63 | val map : 'a t -> f:('a -> 'b) -> 'b t 64 | 65 | val join : 'a t t -> 'a t 66 | 67 | val ignore_m : 'a t -> unit t 68 | 69 | val all : 'a t list -> 'a list t 70 | 71 | val all_unit : unit t list -> unit t 72 | 73 | module Let_syntax : sig 74 | 75 | val return : 'a -> 'a t 76 | 77 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 78 | 79 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 80 | 81 | module Let_syntax : sig 82 | 83 | val return : 'a -> 'a t 84 | 85 | val bind : 'a t -> f:('a -> 'b t) -> 'b t 86 | 87 | val map : 'a t -> f:('a -> 'b) -> 'b t 88 | 89 | val both : 'a t -> 'b t -> ('a * 'b) t 90 | 91 | module Open_on_rhs : sig end 92 | 93 | end 94 | 95 | end 96 | 97 | (** Ignore the state and return error message with erroneous value. *) 98 | val fail : ?strict:unit -> string -> 'a -> ('a -> Base.Sexp.t) -> 'a t 99 | 100 | (** Ignore the state and return error message *) 101 | val fail_string : string -> 'a t 102 | 103 | (** Ignore the state and return a formatted message *) 104 | val failf : ('a, unit, string, 'b t) format4 -> 'a 105 | 106 | (* Create a fresh variable and update the state *) 107 | val create_fresh : ?name:string -> unit -> Ast.variable t 108 | 109 | (** Look for given variable in linear_vars *) 110 | val lookup : Ast.variable -> tagged_linear_t option t 111 | 112 | (** Proof that a fractional-capability is well-formed. *) 113 | type wf_frac_cap 114 | 115 | (** Check if a fractional capability is well-formed w.r.t. the environment. *) 116 | val if_well_formed : 117 | Ast.frac_cap -> then_:(wf_frac_cap -> 'a t) -> else_:(Ast.frac_cap -> 'a t) -> 'a t 118 | 119 | (** Proof that (fractional-capability) variable is well-formed. *) 120 | type wf_variable 121 | 122 | (** Perform a well-formed substitution on a ForAll_frac_cap type *) 123 | val wf_substitute_in : well_formed -> wf_variable -> wf_frac_cap -> well_formed t 124 | 125 | (** Perform a split on a well-formed typed assuming it is a ForAll_frac_cap. *) 126 | val split_wf_ForAll : 127 | well_formed t -> 128 | if_forall:(wf_variable -> well_formed -> 'a t) -> 129 | not_forall:(Ast.linear_t -> 'a t) -> 'a t 130 | 131 | (** Perform a split on a well-formed typed assuming it is a pair. *) 132 | val split_wf_Pair : 133 | well_formed t -> 134 | if_pair:(well_formed -> well_formed -> 'a t) -> 135 | not_pair:(Ast.linear_t -> 'a t) -> 'a t 136 | 137 | (** Perform a split on a well-formed typed assuming it is a fun. *) 138 | val split_wf_Fun : 139 | well_formed t -> 140 | if_fun:(well_formed -> well_formed -> 'a t) -> 141 | not_fun:(Ast.linear_t -> 'a t) -> 'a t 142 | 143 | (** Linear-type is well-formed if all fractional capabilities are well-formed. *) 144 | val well_formed_lt : 145 | fmt:('a -> Ast.linear_t t, unit, string, 'b t) format4 -> 146 | arg:'a -> Ast.linear_t -> well_formed t 147 | 148 | (** Marks the [not_used] variable and linear_t as used and returns latter. *) 149 | val use_var : not_used -> well_formed t 150 | 151 | (** Evaluates the given monadic value in the context extended with the given 152 | mappings and then removes those mappings from the environment, checking that 153 | each variable has been used once. 154 | - Mappings must be globally unique. *) 155 | val with_linear_t : 156 | (Ast.variable * well_formed) list -> well_formed t -> well_formed t 157 | 158 | (** Evaluates the given monadic value in the context extended with the given 159 | mappings and then removes those mappings from the environment. 160 | - Mappings must be globally unique. *) 161 | val with_frac_cap : 162 | Ast.variable list -> well_formed t -> well_formed t 163 | 164 | (** Evaluates the monadic value. Must ensure [counter] = #variables in expression + 1. *) 165 | val run : well_formed t -> counter:int -> Ast.linear_t Base.Or_error.t 166 | -------------------------------------------------------------------------------- /old/src/combinators.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* LT4LA Combinators *) 3 | (* ----------------- *) 4 | (* Allow a user to build up a term that is fairly well-typed. *) 5 | 6 | type z = Z 7 | 8 | type 'a s = S of 'a 9 | 10 | let new_var = 11 | let i = ref 0 in 12 | fun () -> let x = !i in (i := x + 1; Ast.{name="gen";id=(x)}) 13 | 14 | type _ fc = Ast.frac_cap 15 | let z : z fc = Zero 16 | let s (x : ('a) fc) : ('a s) fc = Succ x 17 | 18 | type _ arr = (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t 19 | 20 | module Type = 21 | struct 22 | 23 | open Ast 24 | 25 | type _ t = linear_t 26 | let extract (x : _ t) : linear_t = x 27 | 28 | let unit : unit t = Unit 29 | let int : int t = Int 30 | let f64 : float t = Float64 31 | let arr (x : 'fc fc) : 'fc arr t = Array_t x 32 | let pair (fst : 'a t) (snd : 'b t) : ('a * 'b) t = Pair (fst, snd) 33 | let func (arg : 'a t) (res : 'b t) : ('a -> 'b) t = Fun (arg, res) 34 | 35 | (* impure *) 36 | let all (f : 'fc fc -> 'a t) : ('fc fc -> 'a) t = 37 | let a = new_var () in ForAll_frac_cap (a, f (Var a)) 38 | 39 | module Ops = 40 | struct 41 | let ( * ) = pair 42 | let ( @-> ) = func 43 | let ( !! ) = all 44 | end 45 | 46 | end 47 | 48 | module Code = 49 | struct 50 | 51 | open Ast 52 | 53 | type _ t = expression 54 | let extract (x : _ t) : expression = x 55 | 56 | let unit : unit t = Unit_Intro 57 | let letU (exp : unit t) (res : 'res t) : 'res t = Unit_Elim (exp, res) 58 | let int (i : int) : int t = Int_Intro i 59 | let f64 (f : float) : float t = Float64_Intro f 60 | let pair (fst : 'a t) (snd : 'b t) : ('a * 'b) t = Pair_Intro (fst, snd) 61 | let app (f : ('a -> 'b) t) (arg : 'a t) : 'b t = App (f, arg) 62 | let arr (exp : int t) : z arr t = Array_Intro exp 63 | let spc (exp : ('fc fc -> 'a) t) (fc : 'fc fc) : 'a t = 64 | Specialise_frac_cap (exp, fc) 65 | 66 | (* impure *) 67 | let letP (p : ('a * 'b) t) (elim : 'a t -> 'b t -> 'res t) : 'res t = 68 | let a, b = new_var (), new_var () in Pair_Elim (a, b, p, elim (Var a) (Var b)) 69 | 70 | (* impure *) 71 | let lambda (t : 'a Type.t) (f : 'a t -> 'b t) : ('a -> 'b) t = 72 | let a = new_var () in Lambda (a, t, f (Var a)) 73 | 74 | (* impure *) 75 | let letA (exp : 'a arr t) (elim : 'a arr t -> 'res t) : 'res t = 76 | let a = new_var () in Array_Elim (a, exp, elim (Var a)) 77 | 78 | (* impure *) 79 | let all (f : 'fc fc -> 'a t) : ('fc fc -> 'a) t = 80 | let a = new_var () in ForAll_frac_cap (a, f (Var a)) 81 | 82 | module Ops = 83 | struct 84 | let ( %% ) = app 85 | let ( & ) = pair 86 | let ( // ) = spc 87 | let ( !! ) = all [@@ ocaml.warning "-32" (* unused value *) ] 88 | end 89 | 90 | let split_perm : ('x fc -> 'x arr -> 'x s arr * 'x s arr) t = Primitive Split_Permission 91 | let merge_perm : ('x fc -> 'x s arr * 'x s arr -> 'x arr) t = Primitive Merge_Permission 92 | let free : (z arr -> unit) t = Primitive Free 93 | let copy : ('x fc -> 'x arr -> 'x arr * z arr) t = Primitive Copy 94 | let swap : (z arr * z arr -> z arr * z arr) t = Primitive Swap 95 | let asum : ('x arr -> 'x arr * float) t = Primitive Sum_Mag 96 | let axpy : (float -> 'vec fc -> 'vec arr -> z arr -> 'vec arr * z arr) t = Primitive Scalar_Mult_Then_Add 97 | let dot : ('x fc -> 'x arr -> 'y fc -> 'y arr -> ('x arr * 'y arr) * float) t = Primitive DotProd 98 | let nrm2 : ('x fc -> 'x arr -> 'x arr * float) t = Primitive Norm2 99 | let rot : (float -> float -> (float * float) * (float * float)) t = Primitive Plane_Rotation 100 | let rotm : (z arr -> z arr -> 'p fc -> 'p arr -> (z arr * z arr) * 'p arr) t = Primitive GivensMod_Rotation 101 | let rotmg : (float * float -> float * float -> (float * float) * (float * z arr)) t = Primitive Gen_GivensMod_Rotation 102 | let scal : (float -> z arr -> z arr) t = Primitive Scalar_Mult 103 | let amax : ('x fc -> 'x arr -> int * 'x arr) t = Primitive Index_of_Max_Abs 104 | 105 | end 106 | -------------------------------------------------------------------------------- /old/src/combinators.mli: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* LT4LA Combinator Interface *) 3 | (* -------------------------- *) 4 | 5 | (** Type-level zero for fractional-capabilities. *) 6 | type z = Z 7 | 8 | (** Type-level successor for fractional-capbalities. *) 9 | type 'a s = S of 'a 10 | 11 | (** Fractional capabilities keep track of the linearity of the array, 12 | whether or not it is aliased. They can be interpreted as 13 | 2^(-[frac_cap]). Hence, a whole (unshared) array has a capability 1 14 | capability (2^-[Zero]). Either 1 or 1/2 or 1/4, etc... or a variable. *) 15 | type _ fc 16 | val z : z fc 17 | val s : 'a fc -> 'a s fc 18 | 19 | (** Array-types are parameterised over fractional-capabilities. *) 20 | type _ arr 21 | 22 | (** Module containing combinators to build linear-types. *) 23 | module Type : 24 | sig 25 | (** Standard Linear type system, using fractional capabilities 26 | and extensions for Linear Algebra. *) 27 | type _ t 28 | val extract : 'a t -> Ast.linear_t 29 | val unit : unit t 30 | val int : int t 31 | val f64 : float t 32 | val arr : 'fc fc -> 'fc arr t 33 | val pair : 'a t -> 'b t -> ('a * 'b) t 34 | val func : 'a t -> 'b t -> ('a -> 'b) t 35 | val all : ('fc fc -> 'a t) -> ('fc fc -> 'a) t 36 | module Ops : 37 | sig 38 | val ( * ) : 'a t -> 'b t -> ('a * 'b) t 39 | val ( @-> ) : 'a t -> 'b t -> ('a -> 'b) t 40 | val ( !! ) : ('fc fc -> 'a t) -> ('fc fc -> 'a) t 41 | end 42 | end 43 | 44 | (** Expressions of the language. *) 45 | module Code : 46 | sig 47 | type _ t 48 | val extract : 'a t -> Ast.expression 49 | val unit : unit t 50 | val letU : unit t -> 'res t -> 'res t 51 | val int : int -> int t 52 | val f64 : float -> float t 53 | val pair : 'a t -> 'b t -> ('a * 'b) t 54 | val app : ('a -> 'b) t -> 'a t -> 'b t 55 | val arr : int t -> z arr t 56 | val spc : ('fc fc -> 'a) t -> 'fc fc -> 'a t 57 | val letP : ('a * 'b) t -> ('a t -> 'b t -> 'res t) -> 'res t 58 | val lambda : 'a Type.t -> ('a t -> 'b t) -> ('a -> 'b) t 59 | val letA : 'a arr t -> ('a arr t -> 'res t) -> 'res t 60 | val all : ('fc fc -> 'a t) -> ('fc fc -> 'a) t 61 | module Ops : 62 | sig 63 | val ( %% ) : ('a -> 'b) t -> 'a t -> 'b t 64 | val ( & ) : 'a t -> 'b t -> ('a * 'b) t 65 | val ( // ) : ('a fc -> 'b) t -> 'a fc -> 'b t 66 | end 67 | 68 | val split_perm : ('x fc -> 'x arr -> 'x s arr * 'x s arr) t 69 | val merge_perm : ('x fc -> 'x s arr * 'x s arr -> 'x arr) t 70 | val free : (z arr -> unit) t 71 | val copy : ('x fc -> 'x arr -> 'x arr * z arr) t 72 | val swap : (z arr * z arr -> z arr * z arr) t 73 | val asum : ('x arr -> 'x arr * float) t 74 | val axpy : (float -> 'vec fc -> 'vec arr -> z arr -> 'vec arr * z arr) t 75 | val dot : ('x fc -> 'x arr -> 'y fc -> 'y arr -> ('x arr * 'y arr) * float) t 76 | val nrm2 : ('x fc -> 'x arr -> 'x arr * float) t 77 | val rot : (float -> float -> (float * float) * (float * float)) t 78 | val rotm : (z arr -> z arr -> 'p fc -> 'p arr -> (z arr * z arr) * 'p arr) t 79 | val rotmg : (float * float -> float * float -> (float * float) * (float * z arr)) t 80 | val scal : (float -> z arr -> z arr) t 81 | val amax : ('x fc -> 'x arr -> int * 'x arr) t 82 | 83 | end 84 | -------------------------------------------------------------------------------- /old/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name old) 3 | (synopsis "Linear Types for Linear Algebra") 4 | (flags :standard -short-paths) 5 | (libraries owl menhirLib base ppxlib.traverse_builtins sexplib0 stdio) 6 | (inline_tests) 7 | (preprocess 8 | (pps ppx_jane ppx_traverse ppxlib.runner))) 9 | 10 | (menhir 11 | (modules parser) 12 | (flags --table --strict --comment --explain)) 13 | 14 | (ocamllex lexer) 15 | -------------------------------------------------------------------------------- /old/src/lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | (* Dhruv Makwana *) 3 | (* LT4LA Lexer *) 4 | (* ----------- *) 5 | (* TODO: Remove exception 6 | * Unicode *) 7 | 8 | open Lexing 9 | ;; 10 | 11 | open Parser 12 | ;; 13 | 14 | exception SyntaxError of string 15 | ;; 16 | 17 | let next_line lexbuf = 18 | let pos = lexbuf.lex_curr_p in 19 | lexbuf.lex_curr_p <- 20 | { pos with 21 | pos_bol = lexbuf.lex_curr_pos; 22 | pos_lnum = pos.pos_lnum + 1; 23 | } 24 | ;; 25 | 26 | let keywords = 27 | let open Base in 28 | let keywords = 29 | (* simple linear types *) 30 | [ ("I", UNIT) 31 | ; ("int", INT_LT) 32 | ; ("f64", F64_LT) 33 | ; ("Arr", ARR_LT) 34 | (* linear types *) 35 | ; ("all", ALL) 36 | (* primitives *) 37 | ; ("split_perm", SPLIT_PERM) 38 | ; ("merge_perm", MERGE_PERM) 39 | ; ("free", FREE) 40 | ; ("copy", COPY) 41 | ; ("swap", SWAP) 42 | ; ("asum", ASUM) 43 | ; ("axpy", AXPY) 44 | ; ("dot", DOT_PROD) 45 | ; ("nrm2", NRM2) 46 | ; ("rot", ROT) 47 | ; ("rotg", ROTG) 48 | ; ("rotm", ROTM) 49 | ; ("rotmg", ROTMG) 50 | ; ("scal", SCAL) 51 | ; ("amax", AMAX) 52 | (* expressions *) 53 | ; ("let", LET ) 54 | ; ("Array", ARRAY ) 55 | ] in 56 | let table = Hashtbl.of_alist_exn (module String) keywords in 57 | fun str -> match Hashtbl.find table str with 58 | | Some token -> token 59 | | None -> ID str 60 | ;; 61 | 62 | } 63 | 64 | let digit = ['0'-'9'] 65 | 66 | let nat = digit digit* 67 | let int = '-'? nat 68 | 69 | let frac = '.' digit* 70 | let exp = ['e' 'E'] ['-' '+']? digit+ 71 | let float = digit* frac? exp? 72 | 73 | let white = [' ' '\t']+ 74 | let newline = '\r' | '\n' | "\r\n" 75 | let id = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_']* 76 | 77 | rule read = 78 | parse 79 | | white { read lexbuf } 80 | | newline { next_line lexbuf; read lexbuf } 81 | | eof { EOF } 82 | (* fractional capabilities *) 83 | | nat { NAT (int_of_string (Lexing.lexeme lexbuf)) } 84 | | '+' { PLUS } 85 | | id { keywords (Lexing.lexeme lexbuf) } 86 | (* simple linear types *) 87 | | '[' { LEFT_BRACKET } 88 | | ']' { RIGHT_BRACKET } 89 | | '(' { LEFT_PAREN } 90 | | ')' { RIGHT_PAREN } 91 | (* linear types *) 92 | | '*' { STAR } 93 | | "--o" { LOLLIPOP } 94 | | '.' { DOT } 95 | (* simple expressions *) 96 | | int { INT (int_of_string (Lexing.lexeme lexbuf)) } 97 | | float { FLOAT (float_of_string (Lexing.lexeme lexbuf)) } 98 | | ',' { COMMA } 99 | | ':' { COLON } 100 | | '\\' { BACKSLASH } 101 | (* expressions *) 102 | | '=' { EQUAL } 103 | | ';' { SEMICOLON } 104 | (* TODO: make more informative/friendly *) 105 | | _ { raise (SyntaxError ("unexpected char: " ^ Lexing.lexeme lexbuf)) } 106 | -------------------------------------------------------------------------------- /old/src/parser_utils.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* Parser Utilities *) 3 | (* ---------------- *) 4 | 5 | type ('i, 'o) driver = 6 | { handler : Lexing.lexbuf -> 'o 7 | ; accept : 'i -> 'o 8 | } 9 | ;; 10 | 11 | let rec drive driver lexbuf = 12 | let module Inc = Parser.MenhirInterpreter in 13 | function 14 | | Inc.InputNeeded _ as checkpoint -> 15 | let token = Lexer.read lexbuf in 16 | let startp, endp = lexbuf.lex_start_p, lexbuf.lex_curr_p in 17 | let checkpoint = Inc.offer checkpoint (token, startp, endp) in 18 | drive driver lexbuf checkpoint 19 | 20 | | Inc.Shifting (_, _, _) 21 | | Inc.AboutToReduce (_, _) as checkpoint -> 22 | let checkpoint = Inc.resume checkpoint in 23 | drive driver lexbuf checkpoint 24 | 25 | | Inc.HandlingError _ -> 26 | driver.handler lexbuf 27 | 28 | | Inc.Accepted v -> 29 | driver.accept v 30 | 31 | | Inc.Rejected -> 32 | assert false 33 | ;; 34 | 35 | -------------------------------------------------------------------------------- /old/src/state_or_error.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* LT4LA State_or_error *) 3 | (* -------------------- *) 4 | 5 | open Base 6 | 7 | module Make (State : sig type t end) = 8 | struct 9 | 10 | type 'a t = 11 | State.t -> ('a * State.t) Or_error.t 12 | 13 | let get : 'a t = 14 | fun state -> Or_error.return (state, state) 15 | 16 | let put state : unit t = 17 | fun _ -> Or_error.return ((), state) 18 | 19 | let fail ?strict str value conv : 'a t = 20 | fun _ -> Or_error.error ?strict str value conv 21 | 22 | let fail_string str : 'a t = 23 | fun _ -> Or_error.error_string str 24 | 25 | let failf fmt : 'a = 26 | Printf.ksprintf fail_string fmt 27 | 28 | let run value state = 29 | value state 30 | 31 | include Monad.Make 32 | (struct 33 | 34 | type 'a tmp = 35 | 'a t 36 | 37 | type 'a t = 38 | 'a tmp 39 | 40 | let bind t ~f state = 41 | let open Or_error.Let_syntax in 42 | let%bind (result, state) = t state in 43 | run (f result) state 44 | 45 | let map = 46 | `Define_using_bind 47 | 48 | let return t state = 49 | Or_error.return (t, state) 50 | 51 | end) 52 | 53 | end 54 | 55 | -------------------------------------------------------------------------------- /old/src/state_or_error.mli: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* LT4LA State_or_error *) 3 | (* -------------------- *) 4 | 5 | (** Basic monad for expressing stateful computation with terminating errors. *) 6 | module Make : 7 | functor (State : sig type t end) -> 8 | sig 9 | type 'a t 10 | val get : State.t t 11 | val put : State.t -> unit t 12 | val fail : ?strict:unit -> string -> 'b -> ('b -> Base.Sexp.t) -> 'a t 13 | val fail_string : string -> 'a t 14 | val failf : ('a, unit, string, 'b t) format4 -> 'a 15 | val run : 'a t -> State.t -> ('a * State.t) Base.Or_error.t 16 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 17 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 18 | module Monad_infix : 19 | sig 20 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 21 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 22 | end 23 | val bind : 'a t -> f:('a -> 'b t) -> 'b t 24 | val return : 'a -> 'a t 25 | val map : 'a t -> f:('a -> 'b) -> 'b t 26 | val join : 'a t t -> 'a t 27 | val ignore_m : 'a t -> unit t 28 | val all : 'a t list -> 'a list t 29 | val all_unit : unit t list -> unit t 30 | module Let_syntax : 31 | sig 32 | val return : 'a -> 'a t 33 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 34 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 35 | module Let_syntax : 36 | sig 37 | val return : 'a -> 'a t 38 | val bind : 'a t -> f:('a -> 'b t) -> 'b t 39 | val map : 'a t -> f:('a -> 'b) -> 'b t 40 | val both : 'a t -> 'b t -> ('a * 'b) t 41 | module Open_on_rhs : sig end 42 | end 43 | end 44 | end 45 | -------------------------------------------------------------------------------- /old/src/template.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* LT4LA Compiler Output Header *) 3 | (* ---------------------------- *) 4 | (* This file is a header/wrapper around Owl's CBLAS bindings. *) 5 | 6 | (* begin template *) 7 | module Cblas = 8 | Owl_cblas_basic 9 | ;; 10 | 11 | module Arr = 12 | Bigarray.Array1 13 | ;; 14 | 15 | type zero = 16 | Zero 17 | ;; 18 | 19 | type 'a succ = 20 | Succ 21 | ;; 22 | 23 | type 'a arr = 24 | (float, Bigarray.float64_elt, Bigarray.c_layout) Arr.t 25 | ;; 26 | 27 | type arr0 = 28 | zero arr 29 | ;; 30 | 31 | let (=) (x: int) (y: int) = 32 | x = y 33 | ;; 34 | 35 | module Prim = 36 | struct 37 | 38 | let array_intro n : arr0 = 39 | Arr.(create Float64 C_layout n) 40 | ;; 41 | 42 | let split_perm : 'a . 'a arr -> ('a succ) arr * ('a succ) arr = 43 | fun arr -> 44 | (arr, arr) 45 | ;; 46 | 47 | let merg_perm : 'a. ('a succ) arr * ('a succ) arr -> 'a arr = 48 | fun (arr1, arr2) -> 49 | (* Is this correct? *) 50 | let () = assert (arr1 == arr2) in 51 | arr1 52 | ;; 53 | 54 | (* Can we "actually" free it? *) 55 | let free : arr0 -> unit = 56 | fun _ -> 57 | () 58 | ;; 59 | 60 | let copy : 'a. 'a arr -> 'a arr * arr0 = 61 | fun read -> 62 | let n = Arr.dim read in 63 | let copied = array_intro n in 64 | let () = Cblas.copy n read 1 copied 1 in 65 | (read, copied) 66 | ;; 67 | 68 | let same_dim_exn : 'a 'b. 'a arr -> 'b arr -> int = 69 | fun read_a read_b -> 70 | let n_a, n_b = Arr.(dim read_a, dim read_b) in 71 | let () = assert (n_a = n_b) in 72 | n_a 73 | ;; 74 | 75 | let swap : arr0 * arr0 -> arr0 * arr0 = 76 | fun (write_x, write_y) -> 77 | let n = same_dim_exn write_x write_y in 78 | let () = Cblas.swap n write_x 1 write_y 1 in 79 | (write_x, write_y) 80 | ;; 81 | 82 | let asum : 'a. 'a arr -> 'a arr * float = 83 | fun read -> 84 | let result = Cblas.asum (Arr.dim read) read 1 in 85 | (read , result) 86 | ;; 87 | 88 | let axpy : 'a. float -> 'a arr -> arr0 -> 'a arr * arr0 = 89 | fun scalar read write -> 90 | let n = same_dim_exn read write in 91 | let () = Cblas.axpy n scalar read 1 write 1 in 92 | (read, write) 93 | ;; 94 | 95 | let dot : 'a 'b. 'a arr -> 'b arr -> (('a arr * 'b arr) * float) = 96 | fun fst snd -> 97 | let n = same_dim_exn fst snd in 98 | let result = Cblas.dot n fst 1 snd 1 in 99 | ((fst, snd), result) 100 | ;; 101 | 102 | let nrm2 : 'a. 'a arr -> 'a arr * float = 103 | fun read -> 104 | let result = Cblas.nrm2 (Arr.dim read) read 1 in 105 | (read, result) 106 | ;; 107 | 108 | (* This one makes me questions the order of c/s before x/y. *) 109 | let rot : float -> float -> arr0 -> arr0 -> (arr0 * arr0) = 110 | fun c s write_x write_y -> 111 | let n = same_dim_exn write_x write_y in 112 | let () = Cblas.rot n write_x 1 write_y 1 c s in 113 | (write_x, write_y) 114 | ;; 115 | 116 | let rotg : float -> float -> (float * float) * (float * float) = 117 | fun a b -> 118 | let (a,b,c,s) = Cblas.rotg a b in 119 | ((a,b),(c,s)) 120 | ;; 121 | 122 | let rotm : 'param. arr0 -> arr0 -> 'param arr -> (arr0 * arr0) * 'param arr = 123 | fun write_a write_b param -> 124 | let n = same_dim_exn write_a write_b in 125 | let () = Cblas.rotm n write_a 1 write_b 1 param in 126 | ((write_a, write_b), param) 127 | ;; 128 | 129 | let rotmg : float * float -> float * float -> (float * float) * (float * arr0) = 130 | fun (d1, d2) (b1, b2) -> 131 | let (d1, d2, b1, p) = Cblas.rotmg Bigarray.Float64 d1 d2 b1 b2 in 132 | ((d1, d2), (b1, p)) 133 | ;; 134 | 135 | let scal : float -> arr0 -> arr0 = 136 | fun scal write -> 137 | let () = Cblas.scal (Arr.dim write) scal write 1 in 138 | write 139 | ;; 140 | 141 | let amax : 'a. 'a arr -> int * 'a arr = 142 | fun read -> 143 | let result = Cblas.amax (Arr.dim read) read 1 in 144 | (result, read) 145 | ;; 146 | 147 | end 148 | ;; 149 | 150 | (* end template *) 151 | -------------------------------------------------------------------------------- /old/test/checker_test.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* Old.Checker External Tests *) 3 | (* These will be easier to write with a parser. *) 4 | 5 | open Base 6 | ;; 7 | 8 | open Vars 9 | ;; 10 | 11 | module Ast = 12 | Old.Ast 13 | ;; 14 | 15 | let check_expr = 16 | Old.Checker.check_expr ~counter:1719 17 | ;; 18 | 19 | let pretty x = 20 | Stdio.printf 21 | !"%{sexp: string Or_error.t}\n" 22 | (Or_error.map x ~f:(Ast.(string_of_pp pp_linear_t))) 23 | ;; 24 | 25 | let arr : Ast.expression = 26 | Array_Intro (Int_Intro 5) 27 | ;; 28 | 29 | let%expect_test "checker_unit_intro" = 30 | check_expr Unit_Intro 31 | |> pretty; 32 | [%expect {| (Ok I) |}] 33 | ;; 34 | 35 | let%expect_test "checker_var_unbound" = 36 | check_expr (Var one) 37 | |> pretty; 38 | [%expect {| (Error "Unbound variable one_1 (not found in environment)") |}] 39 | ;; 40 | 41 | let unit_elim : Ast.expression = 42 | Unit_Elim (Unit_Intro, arr) 43 | ;; 44 | 45 | let%expect_test "checker_unit_elim" = 46 | check_expr unit_elim 47 | |> pretty; 48 | [%expect {| (Ok Arr[0]) |}] 49 | ;; 50 | 51 | let pair : Ast.expression = 52 | Pair_Intro (arr, Unit_Intro) 53 | ;; 54 | 55 | let%expect_test "checker_pair_intro" = 56 | check_expr pair 57 | |> pretty; 58 | [%expect {| (Ok "Arr[0] * I") |}] 59 | ;; 60 | 61 | let pair_elim : Ast.expression = 62 | Pair_Elim (one, two, pair, Pair_Intro (Var two, Var one)) 63 | ;; 64 | 65 | let%expect_test "checker_pair_elim" = 66 | check_expr pair_elim 67 | |> pretty; 68 | [%expect {| (Ok "I * Arr[0]") |}] 69 | ;; 70 | 71 | let%expect_test "checker_pair_elim" = 72 | check_expr (Pair_Elim (one, two, pair, Var one)) 73 | |> pretty; 74 | [%expect {| (Error "Variable two_2 not used.") |}] 75 | ;; 76 | 77 | let unit_lambda : Ast.expression = 78 | Lambda (one, Unit, Var one) 79 | ;; 80 | 81 | let%expect_test "checker_lambda" = 82 | check_expr unit_lambda 83 | |> pretty; 84 | [%expect {| (Ok "I --o I") |}] 85 | ;; 86 | 87 | let app : Ast.expression = 88 | App (unit_lambda, Unit_Intro) 89 | ;; 90 | 91 | let%expect_test "checker_app" = 92 | check_expr app 93 | |> pretty; 94 | [%expect {| (Ok I) |}] 95 | ;; 96 | 97 | let forall : Ast.expression = 98 | ForAll_frac_cap (one, Lambda (two, Array_t (Var one), Var two)) 99 | ;; 100 | 101 | let%expect_test "checker_forall" = 102 | check_expr forall 103 | |> pretty; 104 | [%expect {| (Ok "\226\136\128 one_1. Arr[one_1] --o Arr[one_1]") |}] 105 | ;; 106 | 107 | let specialise : Ast.expression = 108 | Specialise_frac_cap(forall, Succ Zero) 109 | ;; 110 | 111 | let%expect_test "checker_specialise" = 112 | check_expr specialise 113 | |> pretty; 114 | [%expect {| (Ok "Arr[1] --o Arr[1]") |}] 115 | ;; 116 | 117 | let%expect_test "checker_specialise" = 118 | check_expr (Specialise_frac_cap(forall, Succ (Var three))) 119 | |> pretty; 120 | [%expect {| 121 | (Error 122 | "Specialise_frac_cap: (Succ (Var ((id 3) (name three)))) not found in environment.") |}] 123 | ;; 124 | 125 | let%expect_test "checker_array_elim" = 126 | check_expr (Array_Elim (one, arr, Var one)) 127 | |> pretty; 128 | [%expect {| (Ok Arr[0]) |}] 129 | ;; 130 | 131 | let prims : Ast.primitive list = 132 | (* Operators *) 133 | [ Split_Permission 134 | ; Merge_Permission 135 | ; Free 136 | ; Copy (* xCOPY *) 137 | ; Swap (* xSWAP *) 138 | 139 | (* Routines/Functions *) 140 | ; Sum_Mag (* xASUM *) 141 | ; Scalar_Mult_Then_Add (* xAXPY *) 142 | ; DotProd (* xDOT *) 143 | ; Norm2 (* xNRM2 *) 144 | ; Plane_Rotation (* xROT *) 145 | ; Givens_Rotation (* xROTG *) 146 | ; GivensMod_Rotation (* xROTM *) 147 | ; Gen_GivensMod_Rotation (* xROTMG *) 148 | ; Scalar_Mult (* xSCAL *) 149 | ; Index_of_Max_Abs (* IxAMAX *) 150 | ] 151 | ;; 152 | 153 | let%expect_test "check_array_elim" = 154 | List.map ~f:(fun x -> check_expr (Primitive x)) prims 155 | |> List.iter ~f:pretty; 156 | [%expect {| 157 | (Ok 158 | "\226\136\128 split_perm_1719.\ 159 | \n Arr[split_perm_1719] --o Arr[split_perm_1719+1] * Arr[split_perm_1719+1]") 160 | (Ok 161 | "\226\136\128 merge_perm_1719.\ 162 | \n Arr[merge_perm_1719+1] * Arr[merge_perm_1719+1] --o Arr[merge_perm_1719]") 163 | (Ok "Arr[0] --o I") 164 | (Ok "\226\136\128 copy_1719. Arr[copy_1719] --o Arr[copy_1719] * Arr[0]") 165 | (Ok "Arr[0] * Arr[0] --o Arr[0] * Arr[0]") 166 | (Ok 167 | "\226\136\128 sum_mag_1719. Arr[sum_mag_1719] --o Arr[sum_mag_1719] * f64") 168 | (Ok 169 | "\226\136\128 sum_mag_vec_1719.\ 170 | \n f64 --o Arr[sum_mag_vec_1719] --o Arr[0] --o Arr[sum_mag_vec_1719] * Arr[0]") 171 | (Ok 172 | "\226\136\128 dot_prod_x_1719.\ 173 | \n Arr[dot_prod_x_1719] --o \226\136\128 dot_prod_y_1720.\ 174 | \n Arr[dot_prod_y_1720] --o\ 175 | \n ( Arr[dot_prod_x_1719] * Arr[dot_prod_y_1720] ) * f64") 176 | (Ok "\226\136\128 norm2_1719. Arr[norm2_1719] --o Arr[norm2_1719] * f64") 177 | (Ok "f64 --o f64 --o Arr[0] --o Arr[0] --o Arr[0] * Arr[0]") 178 | (Ok "f64 --o f64 --o ( f64 * f64 ) * ( f64 * f64 )") 179 | (Ok 180 | "Arr[0] --o Arr[0] --o \226\136\128 rotm_1719.\ 181 | \n Arr[rotm_1719] --o ( Arr[0] * Arr[0] ) * Arr[rotm_1719]") 182 | (Ok "f64 * f64 --o f64 * f64 --o ( f64 * f64 ) * ( f64 * Arr[0] )") 183 | (Ok "f64 --o Arr[0] --o Arr[0]") 184 | (Ok 185 | "\226\136\128 index_max_abs_1719.\ 186 | \n Arr[index_max_abs_1719] --o int * Arr[index_max_abs_1719]") |}] 187 | ;; 188 | -------------------------------------------------------------------------------- /old/test/combinators_test.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* Old.Combinators External Tests *) 3 | 4 | open Base 5 | ;; 6 | 7 | module Ast = 8 | Old.Ast 9 | ;; 10 | 11 | open Old.Combinators 12 | ;; 13 | 14 | let pretty f x = 15 | Stdio.printf "%s\n" (Ast.string_of_pp f x) 16 | ;; 17 | 18 | let%expect_test "all" = 19 | let open Type in 20 | let x = all (fun x -> arr x) in 21 | extract x 22 | |> pretty Ast.pp_linear_t; 23 | [%expect {| ∀ gen_0. Arr[gen_0] |}] 24 | ;; 25 | 26 | (* Advantage of GADTs: Proto_comb.Try3.dotProd_t is syntactically a value. *) 27 | let x () = 28 | Type.(Ops.(all @@ fun a -> arr a @-> all @@ fun b -> (arr a * arr b) * f64)) 29 | ;; 30 | 31 | (* xDOT: ∀x. Arr[x] --o ∀y. Arr[y] --o (Arr[x] * Arr[y]) * f64 *) 32 | let%expect_test "swap" = 33 | x () 34 | |> Type.extract 35 | |> pretty Ast.pp_linear_t; 36 | [%expect {| ∀ gen_1. Arr[gen_1] --o ∀ gen_2. ( Arr[gen_1] * Arr[gen_2] ) * f64 |}] 37 | ;; 38 | 39 | let apply_dot () = 40 | Code.(Ops.(dot // z %% (arr (int 5)) // z %% (arr (int 5)))) 41 | ;; 42 | 43 | let%expect_test "dot" = 44 | apply_dot () 45 | |> Code.extract 46 | |> pretty Ast.pp_expression; 47 | [%expect {| Prim.dot (* [0] *) (array_intro 5) (* [0] *) (array_intro 5) |}] 48 | ;; 49 | -------------------------------------------------------------------------------- /old/test/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name oldtest) 3 | (flags :standard -short-paths) 4 | (libraries old) 5 | (inline_tests) 6 | (preprocess 7 | (pps ppx_jane))) 8 | -------------------------------------------------------------------------------- /old/test/parser_test.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* Old.Parser External Tests *) 3 | 4 | (* TODO *) 5 | -------------------------------------------------------------------------------- /old/test/test.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* All Old External Tests *) 3 | 4 | let%test_module "Ast_test" = 5 | (module Ast_test) 6 | ;; 7 | 8 | let%test_module "Check_monad" = 9 | (module Check_monad_test) 10 | ;; 11 | 12 | let%test_module "Checker" = 13 | (module Checker_test) 14 | ;; 15 | 16 | let%test_module "Parser" = 17 | (module Parser_test) 18 | ;; 19 | 20 | let%test_module "Combinators" = 21 | (module Combinators_test) 22 | ;; 23 | 24 | let main () = 25 | Ppx_inline_test_lib.Runtime.exit () 26 | ;; 27 | -------------------------------------------------------------------------------- /old/test/vars.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* A stock of variables *) 3 | 4 | let one, two, three, four, five, six, seven, eight, nine, ten, eleven, sentinel = 5 | let open Old.Ast in 6 | ( {id=1; name="one"} , {id=2; name="two"} , {id=3; name="three"} 7 | , {id=4; name="four"} , {id=5; name="five"} , {id=6; name="six"} 8 | , {id=7; name="seven"} , {id=8; name="eight"} , {id=9; name="nine"} 9 | , {id=10; name="ten"} , {id=11; name="eleven"} , {id=(-1); name="sentinel"} ) 10 | ;; 11 | -------------------------------------------------------------------------------- /src/ast.mli: -------------------------------------------------------------------------------- 1 | (** Utilities *) 2 | val string_of_pp : 3 | ?size:int -> (Base.Formatter.t -> 'a -> unit) -> 'a -> string 4 | 5 | (** Variables *) 6 | type var = string 7 | [@@deriving sexp_of, compare] 8 | type comparator_witness 9 | val comparator : (var, comparator_witness) Base.Comparator.t 10 | 11 | (** Fractional Capabilities *) 12 | type fc = Z | S of fc | V of var | U of var 13 | [@@deriving sexp_of] 14 | 15 | (** Linear types *) 16 | type lin = 17 | | Unit 18 | | Bool 19 | | Int 20 | | Elt 21 | | Arr of fc 22 | | Mat of fc 23 | | Pair of lin * lin 24 | | Bang of lin 25 | | Fun of lin * lin 26 | | All of var * lin 27 | [@@deriving sexp_of] 28 | val pp_lin : Base.Formatter.t -> lin -> unit 29 | val substitute_in : lin -> var:var -> replace:fc -> lin 30 | val substitute_unify : lin -> var:var -> replace:fc -> lin 31 | (** [same_lin] [ (x,x) | x is a free-variable] t1 t2 determines whether two 32 | types are the same up to alpha-equivalence. *) 33 | val same_lin : (var * var) list -> lin -> lin -> (var * fc) list Base.Or_error.t 34 | 35 | (** Arithmetic expressions *) 36 | type arith = Add | Sub | Mul | Div | Eq | Lt 37 | [@@deriving sexp_of] 38 | 39 | (** Primitives *) 40 | type prim = 41 | (** Boolean *) 42 | | Not_ 43 | (** Arithmetic *) 44 | | IntOp of arith 45 | | EltOp of arith 46 | (** Arrays *) 47 | | Set 48 | | Get 49 | | Share 50 | | Unshare 51 | | Free 52 | (** Owl *) 53 | | Array 54 | | Copy 55 | | Sin 56 | | Hypot 57 | (** Level 1 BLAS *) 58 | | Asum 59 | | Axpy 60 | | Dot 61 | | Rotmg 62 | | Scal 63 | | Amax 64 | (** Matrix *) 65 | | Get_mat 66 | | Set_mat 67 | | Share_mat 68 | | Unshare_mat 69 | | Free_mat 70 | | Matrix 71 | | Eye 72 | | Copy_mat 73 | | Copy_mat_to 74 | | Size_mat 75 | | Transpose 76 | (** Level 3 BLAS/LAPACK *) 77 | | Symm 78 | | Gemm 79 | | Gesv 80 | | Posv 81 | | Posv_flip 82 | | Potrs 83 | | Syrk 84 | [@@deriving sexp_of] 85 | val string_of_prim : prim -> string 86 | val prims : prim list 87 | 88 | (** Locations *) 89 | type loc = 90 | Lexing.position = { 91 | pos_fname : string; 92 | pos_lnum : int; 93 | pos_bol : int; 94 | pos_cnum : int; 95 | } 96 | val sexp_of_loc : loc -> Base.Sexp.t 97 | val dummy : loc 98 | val line_col : loc -> string 99 | 100 | (** Expressions *) 101 | type exp = 102 | | Prim of loc * prim 103 | | Var of loc * var 104 | | Unit_I of loc 105 | | True of loc 106 | | False of loc 107 | | Int_I of loc * int 108 | | Elt_I of loc * float 109 | | Pair_I of loc * exp * exp 110 | | Bang_I of loc * exp 111 | | Spc of loc * exp * fc 112 | | App of loc * exp * exp 113 | | Unit_E of loc * exp * exp 114 | | Bang_E of loc * var * exp * exp 115 | | Pair_E of loc * var * var * exp * exp 116 | | Fix of loc * var * var * lin * lin * exp 117 | | If of loc * exp * exp * exp 118 | | Gen of loc * var * exp 119 | | Lambda of loc * var * lin * exp 120 | | Let of loc * var * exp * exp 121 | 122 | val loc : exp -> loc 123 | val is_value : exp -> bool 124 | val sexp_of_exp : exp -> Base.Sexp.t 125 | val prec : exp -> int 126 | val pp_exp : ?comments:bool -> Base.Formatter.t -> exp -> unit 127 | -------------------------------------------------------------------------------- /src/check_monad.mli: -------------------------------------------------------------------------------- 1 | (** Proof a type is well-formed w.r.t environment. *) 2 | type wf_fc = private WFC of Ast.fc [@@ocaml.unboxed] 3 | type wf_var = private WFV of Ast.var [@@ocaml.unboxed] 4 | type wf_lin = private WFL of Ast.lin [@@ocaml.unboxed] 5 | [@@deriving sexp_of] 6 | 7 | (** Well-formed constructors *) 8 | val wf_Unit : wf_lin 9 | val wf_Bool : wf_lin 10 | val wf_Int : wf_lin 11 | val wf_Elt : wf_lin 12 | val wf_Pair : wf_lin -> wf_lin -> wf_lin 13 | val wf_Bang : wf_lin -> wf_lin 14 | val wf_Arr_Z : wf_lin 15 | val wf_Mat_Z : wf_lin 16 | val wf_Fun : wf_lin -> wf_lin -> wf_lin 17 | val wf_All : Ast.var -> wf_lin -> wf_lin 18 | 19 | (** Proof that a type is not used. *) 20 | type not_used 21 | [@@deriving sexp_of] 22 | 23 | (** A type is either used, not used, or intuitionistic. *) 24 | type tagged = private Not_used of not_used | Used of Ast.loc | Intuition of wf_lin 25 | [@@deriving sexp_of] 26 | 27 | (** Type checker state *) 28 | type state 29 | [@@deriving sexp_of] 30 | 31 | (** State-or-error monad values. *) 32 | type 'a t 33 | val get : state t 34 | val put : state -> unit t 35 | val fail : ?strict:unit -> string -> 'b -> ('b -> Base.Sexp.t) -> 'a t 36 | val fail_string : string -> 'a t 37 | val failf : ('a, unit, string, 'b t) format4 -> 'a 38 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 39 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 40 | module Monad_infix : 41 | sig 42 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 43 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 44 | end 45 | val bind : 'a t -> f:('a -> 'b t) -> 'b t 46 | val return : 'a -> 'a t 47 | val map : 'a t -> f:('a -> 'b) -> 'b t 48 | val join : 'a t t -> 'a t 49 | val ignore_m : 'a t -> unit t 50 | val all : 'a t list -> 'a list t 51 | val all_unit : unit t list -> unit t 52 | module Let_syntax : 53 | sig 54 | val return : 'a -> 'a t 55 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 56 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 57 | module Let_syntax : 58 | sig 59 | val return : 'a -> 'a t 60 | val bind : 'a t -> f:('a -> 'b t) -> 'b t 61 | val map : 'a t -> f:('a -> 'b) -> 'b t 62 | val both : 'a t -> 'b t -> ('a * 'b) t 63 | module Open_on_rhs : sig end 64 | end 65 | end 66 | 67 | (** Checker utilities *) 68 | val create_fresh : ?name:string -> unit -> Ast.var t 69 | val lookup : Ast.var -> tagged option t 70 | val use_var : Ast.loc -> not_used -> wf_lin t 71 | val same_lin : wf_lin -> wf_lin -> (Ast.var * Ast.fc) list Base.Or_error.t t 72 | val apply : (string * Ast.fc) list -> wf_lin -> wf_lin 73 | val with_lin : Ast.var -> wf_lin -> 'a t -> 'a t 74 | val with_int : Ast.var -> wf_lin -> 'a t -> 'a t 75 | val with_fc : Ast.var -> 'a t -> 'a t 76 | val run : wf_lin t -> counter:int -> Ast.lin Base.Or_error.t 77 | val in_empty : 'a t -> 'a t 78 | val same_resources : ('a t * Ast.loc) -> ('b t * Ast.loc) -> ('a * 'b) t 79 | 80 | (** Well-formed destructors *) 81 | val if_wf : Ast.fc -> then_:(wf_fc -> 'a t) -> else_:(Ast.fc -> 'a t) -> 'a t 82 | val wf_substitute_in : wf_lin -> wf_var -> wf_fc -> wf_lin 83 | val split_wf_Pair : 84 | wf_lin t -> 85 | if_pair:(wf_lin -> wf_lin -> 'a t) -> 86 | not_pair:(Ast.lin -> 'a t) -> 'a t 87 | val split_wf_Bang : 88 | wf_lin t -> 89 | if_bang:(wf_lin -> 'a t) -> not_bang:(Ast.lin -> 'a t) -> 'a t 90 | val split_wf_All : 91 | wf_lin t -> 92 | if_all:(wf_var -> wf_lin -> 'a t) -> 93 | not_all:(Ast.lin -> 'a t) -> 'a t 94 | val split_wf_Fun : 95 | wf_lin t -> 96 | if_fun:(wf_lin -> wf_lin -> 'a t) -> 97 | not_fun:(Ast.lin -> 'a t) -> 'a t 98 | val wf_lin : 99 | fmt:('a -> Ast.loc -> Ast.lin t, unit, string, 'b t) format4 -> 100 | arg:'a -> loc:Ast.loc -> Ast.lin -> wf_lin t 101 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name numlin) 3 | (synopsis "NumLin: Linear Types for Linear Algebra") 4 | (flags :standard -short-paths) 5 | (libraries base ctypes owl menhirLib sexplib0 stdio) 6 | (inline_tests) 7 | (preprocess 8 | (pps ppx_jane))) 9 | 10 | (menhir 11 | (modules parser) 12 | (flags --table --strict --comment --explain)) 13 | 14 | (ocamllex lexer) 15 | -------------------------------------------------------------------------------- /src/error_msg.ml: -------------------------------------------------------------------------------- 1 | 2 | (* This file was auto-generated based on "src/parser.messages". *) 3 | 4 | (* Please note that the function [message] can raise [Not_found]. *) 5 | 6 | let message = 7 | fun s -> 8 | match s with 9 | | 102 -> 10 | "\n" 11 | | 97 -> 12 | "\n" 13 | | 122 -> 14 | "\n" 15 | | 32 -> 16 | "\n" 17 | | 37 -> 18 | "\n" 19 | | 34 -> 20 | "\n" 21 | | 35 -> 22 | "\n" 23 | | 0 -> 24 | "\n" 25 | | 15 -> 26 | "\n" 27 | | 114 -> 28 | "\n" 29 | | 117 -> 30 | "\n" 31 | | 116 -> 32 | "\n" 33 | | 16 -> 34 | "\n" 35 | | 20 -> 36 | "\n" 37 | | 21 -> 38 | "\n" 39 | | 22 -> 40 | "\n" 41 | | 23 -> 42 | "\n" 43 | | 24 -> 44 | "\n" 45 | | 25 -> 46 | "\n" 47 | | 53 -> 48 | "\n" 49 | | 54 -> 50 | "\n" 51 | | 55 -> 52 | "\n" 53 | | 52 -> 54 | "\n" 55 | | 56 -> 56 | "\n" 57 | | 66 -> 58 | "\n" 59 | | 111 -> 60 | "\n" 61 | | 112 -> 62 | "\n" 63 | | 67 -> 64 | "\n" 65 | | 58 -> 66 | "\n" 67 | | 59 -> 68 | "\n" 69 | | 60 -> 70 | "\n" 71 | | 61 -> 72 | "\n" 73 | | 63 -> 74 | "\n" 75 | | 64 -> 76 | "\n" 77 | | 44 -> 78 | "\n" 79 | | 45 -> 80 | "\n" 81 | | 65 -> 82 | "\n" 83 | | 48 -> 84 | "\n" 85 | | 49 -> 86 | "\n" 87 | | 27 -> 88 | "\n" 89 | | 50 -> 90 | "\n" 91 | | 30 -> 92 | "\n" 93 | | 31 -> 94 | "\n" 95 | | 41 -> 96 | "\n" 97 | | 42 -> 98 | "\n" 99 | | 43 -> 100 | "\n" 101 | | 47 -> 102 | "\n" 103 | | 108 -> 104 | "I saw 'if then ' and was expecting 'else ' after it\n" 105 | | 109 -> 106 | "I saw 'if then else' and was expecting '' after it\n" 107 | | 107 -> 108 | "I saw 'if then' and was expecting ' else ' after it\n" 109 | | 106 -> 110 | "I saw 'if ' and was expecting 'then else ' after it\n" 111 | | 69 -> 112 | "I saw 'if' and was expecting an expression after it\n" 113 | | 73 -> 114 | "I saw 'fun' and was expecting ' : -> ' after it\n" 115 | | 74 -> 116 | "I saw 'fun ' and was expecting a type annotation and then '->'\nExample: 'fun x : unit -> '\n" 117 | | 75 -> 118 | "I saw 'fun : ' and was expecting a next\n" 119 | | 76 -> 120 | "I saw 'fun : ' so far and was expecting a '->'\n" 121 | | 77 -> 122 | "I saw 'fun : ->' and was expecting an expression after it.\nExamples:\n f x\n let = in \n if then else \n" 123 | | 92 -> 124 | "I saw 'all' and was expecting an identifier after it.\nExample: all x . \n" 125 | | 93 -> 126 | "I saw 'all ' and was expecting a '.' after it.\n" 127 | | 94 -> 128 | "I saw 'all .' and was expecting an expression after it.\nExamples:\n f x\n let = in \n if then else \n" 129 | | _ -> 130 | raise Not_found 131 | -------------------------------------------------------------------------------- /src/lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | (* Dhruv Makwana *) 3 | (* LT4LA Lexer *) 4 | (* ----------- *) 5 | (* TODO: Remove exception 6 | * Unicode *) 7 | 8 | open Lexing 9 | ;; 10 | 11 | open Parser 12 | ;; 13 | 14 | exception SyntaxError of position * string 15 | ;; 16 | 17 | let next_line lexbuf = 18 | let pos = lexbuf.lex_curr_p in 19 | lexbuf.lex_curr_p <- 20 | { pos with 21 | pos_bol = pos.pos_cnum; 22 | pos_lnum = pos.pos_lnum + 1; 23 | } 24 | ;; 25 | 26 | let keywords = 27 | let open Base in 28 | let keywords = 29 | (* fractional capabilities *) 30 | [ ("z", ZED) 31 | ; ("s", ES) 32 | (* simple linear types *) 33 | ; ("unit", UNIT) 34 | ; ("int", INT_LT) 35 | ; ("elt", ELT_LT) 36 | ; ("arr", ARR_LT) 37 | ; ("mat", MAT_LT) 38 | (* primitives *) 39 | ; ("not", NOT) 40 | ; ("share", SHARE) 41 | ; ("unshare", UNSHARE) 42 | ; ("free", FREE) 43 | ; ("array", ARRAY) 44 | ; ("copy", COPY) 45 | ; ("sin", SIN) 46 | ; ("hypot", HYPOT) 47 | ; ("asum", ASUM) 48 | ; ("axpy", AXPY) 49 | ; ("dot", DOTP) 50 | ; ("rotmg", ROTMG) 51 | ; ("scal", SCAL) 52 | ; ("amax", AMAX) 53 | (* matrix primitives *) 54 | ; ("shareM", SHARE_M) 55 | ; ("unshareM", UNSHARE_M) 56 | ; ("freeM", FREE_M) 57 | ; ("matrix", MATRIX) 58 | ; ("eye", EYE) 59 | ; ("copyM", COPY_M) 60 | ; ("copyM_to", COPY_M_TO) 61 | ; ("sizeM", SIZE_M) 62 | ; ("transpose", TRANSPOSE) 63 | (* Level 2/3 BLAS *) 64 | ; ("symm", SYMM) 65 | ; ("gemm", GEMM) 66 | ; ("gesv", GESV) 67 | ; ("posv", POSV) 68 | ; ("posvFlip", POSV_FLIP) 69 | ; ("potrs", POTRS) 70 | ; ("syrk", SYRK) 71 | (* expressions *) 72 | ; ("true", TRUE) 73 | ; ("false", FALSE) 74 | ; ("if", IF) 75 | ; ("then", THEN) 76 | ; ("else", ELSE) 77 | ; ("let", LET) 78 | ; ("rec", REC) 79 | ; ("in", IN) 80 | ; ("fun", FUN) 81 | ; ("Many", MANY) 82 | (* inference *) 83 | ; ("_", UNDERSCORE) 84 | (* matrix expressions *) 85 | ; ("new", NEW) 86 | ] in 87 | let table = Hashtbl.of_alist_exn (module String) keywords in 88 | fun str -> match Hashtbl.find table str with 89 | | Some token -> token 90 | | None -> ID str 91 | ;; 92 | 93 | } 94 | 95 | let digit = ['0'-'9'] 96 | let int = digit+ 97 | 98 | let frac = '.' digit* 99 | let exp = ['e' 'E'] ['-' '+']? digit+ 100 | let float = digit* frac? exp? 101 | 102 | let white = [' ' '\t']+ 103 | let newline = '\r' | '\n' | "\r\n" 104 | let id = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_']* 105 | let fc_var = ''' id 106 | 107 | rule read = 108 | parse 109 | | white { read lexbuf } 110 | | newline { next_line lexbuf; read lexbuf } 111 | | eof { EOF } 112 | | ";;" { EOP } 113 | (* fractional capabilities *) 114 | | fc_var { FC_VAR (Lexing.lexeme lexbuf) } 115 | | id { keywords (Lexing.lexeme lexbuf) } 116 | (* simple linear types *) 117 | | '(' { L_PAREN } 118 | | ')' { R_PAREN } 119 | (* linear types *) 120 | | '!' { BANG } 121 | | '*' { STAR } 122 | | "--o" { LOLLIPOP } 123 | | '.' { DOT } 124 | (* simple expressions *) 125 | | int { INT (Base.Int.of_string (Lexing.lexeme lexbuf)) } 126 | | float { FLOAT (Base.Float.of_string (Lexing.lexeme lexbuf)) } 127 | | ',' { COMMA } 128 | | ':' { COLON } 129 | (* expressions *) 130 | | '=' { EQUAL } 131 | | "->" { R_ARROW } 132 | (* sugar, arrays *) 133 | | '[' { L_BRACKET } 134 | | ']' { R_BRACKET } 135 | | ":=" { COLON_EQ } 136 | | "||" { DOUBLE_BAR } 137 | | "&&" { DOUBLE_AND } 138 | (* integer arithmetic *) 139 | | '<' { LESS_THAN } 140 | | '+' { PLUS } 141 | | '-' { MINUS } 142 | | '/' { FWD_SLASH } 143 | (* element arithmetic *) 144 | | "=." { EQUAL_DOT } 145 | | "<." { LESS_THAN_DOT } 146 | | "+." { PLUS_DOT } 147 | | "-." { MINUS_DOT } 148 | | "*." { STAR_DOT } 149 | | "/." { FWD_SLASH_DOT } 150 | (* comments *) 151 | | "(*" { comment 1 lexbuf } 152 | (* matrix expressions *) 153 | | "<-" { L_ARROW } 154 | | "[|" { L_SEMBRACK } 155 | | "|]" { R_SEMBRACK } 156 | | '^' { CARET } 157 | (* TODO: make more informative/friendly *) 158 | | _ { raise (SyntaxError (lexbuf.lex_curr_p, "unexpected char: " ^ Lexing.lexeme lexbuf)) } 159 | 160 | (* [n] handles nested comments *) 161 | and comment n = parse 162 | | "(*" { comment (n+1) lexbuf} 163 | | "*)" { if n=1 then read lexbuf else comment (n-1) lexbuf } 164 | | newline { next_line lexbuf; comment n lexbuf } 165 | | _ { comment n lexbuf } 166 | -------------------------------------------------------------------------------- /src/parse.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* Parser Utilities *) 3 | (* ---------------- *) 4 | 5 | type ('i, 'o) driver = 6 | { handler : Lexing.lexbuf -> msg:string -> 'o 7 | ; accept : 'i -> 'o 8 | ; resume : ((Lexing.lexbuf -> 'o) -> 'o) option 9 | } 10 | ;; 11 | 12 | module Inc = 13 | Parser.Incremental 14 | ;; 15 | 16 | (* TODO Catch Lexer.SyntaxError *) 17 | let drive_no_resume accept handler lexbuf = 18 | let module Intp = Parser.MenhirInterpreter in 19 | let rec loop = function 20 | | Intp.InputNeeded _ as checkpoint -> 21 | let token = Lexer.read lexbuf in 22 | let startp, endp = lexbuf.lex_start_p, lexbuf.lex_curr_p in 23 | let checkpoint = Intp.offer checkpoint (token, startp, endp) in 24 | loop checkpoint 25 | 26 | | Intp.Shifting (_, _, _) 27 | | Intp.AboutToReduce (_, _) as checkpoint -> 28 | let checkpoint = Intp.resume checkpoint in 29 | loop checkpoint 30 | 31 | | Intp.HandlingError env -> 32 | let state = Intp.current_state_number env in 33 | handler lexbuf ~msg:( 34 | try Error_msg.message state 35 | with Not_found -> 36 | Printf.sprintf "Error raised in state %d\n" state) 37 | 38 | | Intp.Accepted v -> 39 | begin match Sugar.ds_exp v with 40 | | Ok v -> accept v 41 | | Error msg -> handler lexbuf ~msg 42 | end 43 | 44 | | Intp.Rejected -> 45 | assert false 46 | 47 | in loop @@ Inc.prog lexbuf.lex_curr_p 48 | ;; 49 | 50 | (* TODO Catch Lexer.SyntaxError *) 51 | let drive accept handler resume lexbuf = 52 | let module Intp = Parser.MenhirInterpreter in 53 | let rec loop lexbuf = function 54 | | Intp.InputNeeded _ as checkpoint -> 55 | let token = Lexer.read lexbuf in 56 | if token = EOF then 57 | resume @@ fun lexbuf -> loop lexbuf checkpoint 58 | else 59 | let startp, endp = lexbuf.lex_start_p, lexbuf.lex_curr_p in 60 | let checkpoint = Intp.offer checkpoint (token, startp, endp) in 61 | loop lexbuf checkpoint 62 | 63 | | Intp.Shifting (_, _, _) 64 | | Intp.AboutToReduce (_, _) as checkpoint -> 65 | let checkpoint = Intp.resume checkpoint in 66 | loop lexbuf checkpoint 67 | 68 | | Intp.HandlingError env -> 69 | let state = Intp.current_state_number env in 70 | handler lexbuf ~msg:( 71 | try Error_msg.message state 72 | with Not_found -> 73 | Printf.sprintf "Error raised in state %d\n" state) 74 | 75 | | Intp.Accepted v -> 76 | begin match Sugar.ds_exp v with 77 | | Ok v -> accept v 78 | | Error msg -> handler lexbuf ~msg 79 | end 80 | 81 | | Intp.Rejected -> 82 | assert false 83 | 84 | in loop lexbuf @@ Inc.prog lexbuf.lex_curr_p 85 | 86 | ;; 87 | 88 | let drive lexbuf driver = 89 | let {handler; accept; resume} = driver in 90 | match resume with 91 | | None -> drive_no_resume accept handler lexbuf 92 | | Some resume -> drive accept handler resume lexbuf 93 | ;; 94 | -------------------------------------------------------------------------------- /src/parse.mli: -------------------------------------------------------------------------------- 1 | type ('i, 'o) driver = 2 | { handler : Lexing.lexbuf -> msg:string -> 'o 3 | ; accept : 'i -> 'o 4 | ; resume : ((Lexing.lexbuf -> 'o) -> 'o) option 5 | } 6 | 7 | val drive : Lexing.lexbuf -> (Ast.exp, 'a) driver -> 'a 8 | -------------------------------------------------------------------------------- /src/state_or_error.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* LT4LA State_or_error *) 3 | (* -------------------- *) 4 | 5 | open Base 6 | 7 | module Make (State : sig type t end) = 8 | struct 9 | 10 | type 'a t = 11 | State.t -> ('a * State.t) Or_error.t 12 | 13 | let get : 'a t = 14 | fun state -> Or_error.return (state, state) 15 | 16 | let put state : unit t = 17 | fun _ -> Or_error.return ((), state) 18 | 19 | let fail ?strict str value conv : 'a t = 20 | fun _ -> Or_error.error ?strict str value conv 21 | 22 | let fail_string str : 'a t = 23 | fun _ -> Or_error.error_string str 24 | 25 | let failf fmt : 'a = 26 | Printf.ksprintf fail_string fmt 27 | 28 | let run value state = 29 | value state 30 | 31 | include Monad.Make 32 | (struct 33 | 34 | type nonrec 'a t = 35 | 'a t 36 | 37 | let bind t ~f state = 38 | let open Or_error.Let_syntax in 39 | let%bind (result, state) = t state in 40 | run (f result) state 41 | 42 | let map = 43 | `Define_using_bind 44 | 45 | let return t state = 46 | Or_error.return (t, state) 47 | 48 | end) 49 | 50 | end 51 | 52 | -------------------------------------------------------------------------------- /src/state_or_error.mli: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* LT4LA State_or_error *) 3 | (* -------------------- *) 4 | 5 | (** Basic monad for expressing stateful computation with terminating errors. *) 6 | module Make : 7 | functor (State : sig type t end) -> 8 | sig 9 | type 'a t 10 | val get : State.t t 11 | val put : State.t -> unit t 12 | val fail : ?strict:unit -> string -> 'b -> ('b -> Base.Sexp.t) -> 'a t 13 | val fail_string : string -> 'a t 14 | val failf : ('a, unit, string, 'b t) format4 -> 'a 15 | val run : 'a t -> State.t -> ('a * State.t) Base.Or_error.t 16 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 17 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 18 | module Monad_infix : 19 | sig 20 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 21 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 22 | end 23 | val bind : 'a t -> f:('a -> 'b t) -> 'b t 24 | val return : 'a -> 'a t 25 | val map : 'a t -> f:('a -> 'b) -> 'b t 26 | val join : 'a t t -> 'a t 27 | val ignore_m : 'a t -> unit t 28 | val all : 'a t list -> 'a list t 29 | val all_unit : unit t list -> unit t 30 | module Let_syntax : 31 | sig 32 | val return : 'a -> 'a t 33 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 34 | val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t 35 | module Let_syntax : 36 | sig 37 | val return : 'a -> 'a t 38 | val bind : 'a t -> f:('a -> 'b t) -> 'b t 39 | val map : 'a t -> f:('a -> 'b) -> 'b t 40 | val both : 'a t -> 'b t -> ('a * 'b) t 41 | module Open_on_rhs : sig end 42 | end 43 | end 44 | end 45 | -------------------------------------------------------------------------------- /src/sugar.mli: -------------------------------------------------------------------------------- 1 | type var = string 2 | val sexp_of_var : var -> Base.Sexp.t 3 | 4 | type fc = Z | S of fc | V of var | U of var 5 | [@@deriving sexp_of] 6 | val ds_fc : fc -> Ast.fc 7 | 8 | type lin = 9 | Unit 10 | | Bool 11 | | Int 12 | | Elt 13 | | Arr of fc 14 | | Mat of fc 15 | | Pair of lin * lin 16 | | Bang of lin 17 | | Fun of lin * lin 18 | | All of var * lin 19 | [@@deriving sexp_of] 20 | val ds_lin : lin -> Ast.lin 21 | 22 | type prim = 23 | Not_ 24 | | Share 25 | | Unshare 26 | | Free 27 | | Array 28 | | Copy 29 | | Sin 30 | | Hypot 31 | | Asum 32 | | Axpy 33 | | Dot 34 | | Rotmg 35 | | Scal 36 | | Amax 37 | | Share_mat 38 | | Unshare_mat 39 | | Free_mat 40 | | Matrix 41 | | Eye 42 | | Copy_mat 43 | | Copy_mat_to 44 | | Size_mat 45 | | Transpose 46 | | Symm 47 | | Gemm 48 | | Gesv 49 | | Posv 50 | | Posv_flip 51 | | Potrs 52 | | Syrk 53 | [@@deriving sexp_of] 54 | 55 | type bang_var = NotB of var | Bang of var 56 | [@@deriving sexp_of] 57 | 58 | type loc = Lexing.position 59 | [@@deriving sexp_of] 60 | 61 | type pat = Unit of loc | Base of loc * bang_var | Many of loc * pat | Pair of loc * pat * pat 62 | [@@deriving sexp_of] 63 | val ds_pat : pat -> Ast.exp -> loc * Ast.var * Ast.exp 64 | 65 | type op = 66 | Or 67 | | And 68 | | Plus 69 | | Minus 70 | | Times 71 | | Div 72 | | Eq 73 | | Lt 74 | | PlusDot 75 | | MinusDot 76 | | TimesDot 77 | | DivDot 78 | | EqDot 79 | | LtDot 80 | [@@deriving sexp_of] 81 | 82 | type mat_var = 83 | | Just of loc * var 84 | | Symm of loc * var 85 | | Trsp of loc * var 86 | [@@deriving sexp_of] 87 | 88 | type 'a non_empty = { first : 'a; rest : 'a list; } 89 | [@@deriving sexp_of] 90 | 91 | type annot_arg = { pat : pat; lin : lin; } 92 | [@@deriving sexp_of] 93 | 94 | type arg_like = Underscore of loc | Fc of loc * fc | Exp of exp 95 | and mat_exp = 96 | | Copy_mat of loc * var 97 | | Copy_mat_to of loc * var 98 | | New_AB of exp * exp * loc * float * mat_var * mat_var 99 | | AB_C of loc * float * mat_var * mat_var * loc * float * loc * var 100 | | ArrIndex of var * loc * (exp * exp option) 101 | and exp = 102 | | Prim of loc * prim 103 | | Var of loc * var 104 | | Unit_I of loc 105 | | True of loc 106 | | False of loc 107 | | Int_I of loc * int 108 | | Elt_I of loc * float 109 | | Pair_I of loc * exp * exp 110 | | Bang_I of loc * exp 111 | | AppLike of exp * arg_like non_empty 112 | | If of loc * exp * exp * exp 113 | | Lambda of (annot_arg, loc * var) Base.Either.t non_empty * exp 114 | | Index of loc * var * loc * exp * exp option 115 | | Assign of loc * var * loc * exp * exp option * exp 116 | | Infix of loc * exp * op * exp 117 | | LetAnnot of loc * bang_var * lin * exp * exp 118 | | LetPat of loc * pat * exp * exp 119 | | LetFun of loc * bang_var * (annot_arg, loc * var) Base.Either.t non_empty * exp * exp 120 | | LetRecFun of loc * bang_var * annot_arg * (annot_arg, loc * var) Base.Either.t list * lin * exp * exp 121 | | LetMat of loc * bang_var * loc * mat_exp * exp 122 | [@@deriving sexp_of] 123 | val ds_exp : exp -> (Ast.exp, string) result 124 | -------------------------------------------------------------------------------- /src/template.mli: -------------------------------------------------------------------------------- 1 | module Arr = Owl.Dense.Ndarray.D 2 | type z = Z 3 | type 'a s = Succ 4 | type 'a arr = A of Arr.arr [@@unboxed] 5 | type 'a mat = M of Arr.arr [@@unboxed] 6 | type 'a bang = Many of 'a [@@unboxed] 7 | module Ops : 8 | sig 9 | val (||) : bool bang -> bool bang lazy_t -> bool bang 10 | val (&&) : bool bang -> bool bang lazy_t -> bool bang 11 | end 12 | module Prim : 13 | sig 14 | val extract : 'a bang -> 'a 15 | (** Boolean *) 16 | val not_ : bool bang -> bool bang 17 | (** Arithmetic *) 18 | val addI : int bang -> int bang -> int bang 19 | val subI : int bang -> int bang -> int bang 20 | val mulI : int bang -> int bang -> int bang 21 | val divI : int bang -> int bang -> int bang 22 | val ltI : int bang -> int bang -> bool bang 23 | val eqI : int bang -> int bang -> bool bang 24 | val addE : float bang -> float bang -> float bang 25 | val subE : float bang -> float bang -> float bang 26 | val mulE : float bang -> float bang -> float bang 27 | val divE : float bang -> float bang -> float bang 28 | val eqE : float bang -> float bang -> bool bang 29 | val ltE : float bang -> float bang -> bool bang 30 | (** Arrays *) 31 | val set : z arr -> int bang -> float bang -> z arr 32 | val get : 'a arr -> int bang -> 'a arr * float bang 33 | val share : 'a arr -> 'a s arr * 'a s arr 34 | val unshare : 'a s arr -> 'a s arr -> 'a arr 35 | val free : z arr -> unit 36 | (** Owl *) 37 | val array : int bang -> z arr 38 | val copy : 'a arr -> 'a arr * z arr 39 | val sin : z arr -> z arr 40 | val hypot : z arr -> 'a arr -> 'a arr * z arr 41 | (** Level 1 BLAS *) 42 | val asum : 'a arr -> 'a arr * float bang 43 | val axpy : float bang -> 'a arr -> z arr -> 'a arr * z arr 44 | val dot : 'a arr -> 'b arr -> ('a arr * 'b arr) * float bang 45 | val rotmg : float bang * float bang -> float bang * float bang -> (float bang * float bang) * (float bang * z arr) 46 | val scal : float bang -> z arr -> z arr 47 | val amax : 'a arr -> 'a arr * int bang 48 | (* Matrix *) 49 | val get_mat : 'a mat -> int bang -> int bang -> 'a mat * float bang 50 | val set_mat : z mat -> int bang -> int bang -> float bang -> z mat 51 | val share_mat : 'a mat -> 'a s mat * 'a s mat 52 | val unshare_mat : 'a s mat -> 'a s mat -> 'a mat 53 | val free_mat : z mat -> unit 54 | val matrix : int bang -> int bang -> z mat 55 | val eye : int bang -> z mat 56 | val copy_mat : 'a mat -> 'a mat * z mat 57 | val copy_mat_to : 'a mat -> z mat -> 'a mat * z mat 58 | val size_mat : 'a mat -> 'a mat * (int bang * int bang) 59 | val transpose : 'a mat -> 'a mat * z mat 60 | (* Level 3 BLAS/LAPACK *) 61 | val gemm : float bang -> ('a mat * bool bang) -> ('b mat * bool bang) -> 62 | float bang -> z mat -> ('a mat * 'b mat) * z mat 63 | val symm : bool bang -> float bang -> 'a mat -> 'b mat -> float bang -> 64 | z mat -> ('a mat * 'b mat) * z mat 65 | val gesv : z mat -> z mat -> z mat * z mat 66 | val posv : z mat -> z mat -> z mat * z mat 67 | val posv_flip : z mat -> z mat -> z mat * z mat 68 | val potrs : 'a mat -> z mat -> 'a mat * z mat 69 | val syrk : bool bang -> float bang -> 'a mat -> float bang -> z mat -> 70 | 'a mat * z mat 71 | end 72 | -------------------------------------------------------------------------------- /src/transpile.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | module Out = 5 | Stdio.Out_channel 6 | ;; 7 | 8 | let handler lexbuf ~msg = 9 | let open Lexing in 10 | let pos = lexbuf.lex_curr_p in 11 | Printf.sprintf "%s:%d:%d\n%s" 12 | pos.pos_fname pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1) msg 13 | |> Result.fail 14 | ;; 15 | 16 | let accept chan value = 17 | match Checker.check_expr value ~counter:0 with 18 | 19 | | Ok (_ : Ast.lin) -> 20 | Out.output_lines chan [ 21 | "open Numlin.Template"; ";;"; ""; 22 | "open Ops"; "[@@ocaml.warning \"-33\"]"; ";;"; "" 23 | ]; 24 | Caml.Format.(fprintf @@ formatter_of_out_channel chan) 25 | 26 | (* 27 | | Automagically printing out correct OCaml type is a bit nuanced 28 | | ( 'x. 'x arr --o !int * !!int --o 'x arr * !int ) 29 | | * ( !!int --o 'y. 'x. !int --o !int ) 30 | *) 31 | 32 | "@[<2>let it =@;@[%a@]@]" (Ast.pp_exp ~comments:false) value; 33 | Out.output_lines chan [""; ";;"; ""]; 34 | Result.return () 35 | 36 | | Error err -> 37 | let string_of_exp = Ast.(string_of_pp pp_exp) in 38 | Printf.sprintf !"Pretty-print:\n%{string_of_exp}\n\ 39 | Error:\n%{Error.to_string_hum}" value err 40 | |> Result.fail 41 | ;; 42 | 43 | let chans ~in_file from to_ = 44 | let lexbuf = Lexing.from_channel from in 45 | lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = in_file }; 46 | Parse.(drive lexbuf { handler; accept = accept to_; resume = None; }); 47 | ;; 48 | 49 | let files ~in_file ~out_file = 50 | Stdio.(In_channel.with_file in_file ~f:(fun from -> 51 | Out_channel.with_file out_file ~f:(fun to_ -> 52 | chans ~in_file from to_))) 53 | ;; 54 | 55 | -------------------------------------------------------------------------------- /src/transpile.mli: -------------------------------------------------------------------------------- 1 | (** Transpile across channels *) 2 | val chans : in_file:string -> in_channel -> out_channel -> (unit, string) result 3 | 4 | (** Transpile files (convenience function) *) 5 | val files : in_file:string -> out_file:string -> (unit, string) result 6 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name test) 3 | (flags :standard -short-paths) 4 | (libraries examples numlin) 5 | (preprocess 6 | (pps ppx_jane)) 7 | (inline_tests)) 8 | -------------------------------------------------------------------------------- /test/examples_test.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | open Numlin.Template 5 | ;; 6 | 7 | let%expect_test "factorial" = 8 | let fact = Examples.Gen.Factorial.it in 9 | for i = -2 to 10 do 10 | Stdio.printf "%d\n" @@ Prim.extract @@ fact (Many i); 11 | done; 12 | [%expect {| 13 | 1 14 | 1 15 | 1 16 | 1 17 | 2 18 | 6 19 | 24 20 | 120 21 | 720 22 | 5040 23 | 40320 24 | 362880 25 | 3628800 |}] 26 | ;; 27 | 28 | let%expect_test "sum_array" = 29 | let sum_array = Examples.Gen.Sum_array.it in 30 | let n = 20 in 31 | let row : z arr = A Owl.Arr.(mapi (fun x _ -> Int.to_float x) (empty [| n |])) in 32 | let (_, Many sum) = sum_array (Many 0) (Many n) (Many 0.) row in 33 | Stdio.printf "%f\n" sum; 34 | [%expect {| 190.000000 |}] 35 | ;; 36 | 37 | let make_arr () = 38 | let n = 7 in 39 | A (Owl.Arr.of_array [| 10.; 50.; 60.; 10.; 20.; 30.; 40. |] [| n |]) 40 | ;; 41 | 42 | (* It's not quite but close enough... *) 43 | let%expect_test "one_d_conv" = 44 | let one_d_conv = Examples.Gen.Weighted_avg.it in 45 | let (A row) : z arr = make_arr () in 46 | let n = Owl.Arr.numel row in 47 | let weights : z arr = A (Owl.Arr.(init [| n |] (fun _ -> 1. /. 3.))) in 48 | let (_, A row) = one_d_conv (Many 1) (Many (n-1)) (Many 10.) (A row) weights in 49 | Stdio.printf !"%{sexp: float array}" (Owl.Arr.to_array row); 50 | [%expect {| (10 40 40 30 19.999999999999996 30 40) |}] 51 | ;; 52 | 53 | (* With inferred fractional capabilities *) 54 | let%expect_test "one_d_conv" = 55 | let one_d_conv = Examples.Gen.Weighted_avg_infer.it in 56 | let (A row) : z arr = make_arr () in 57 | let n = Owl.Arr.numel row in 58 | let weights : z arr = A (Owl.Arr.(init [| n |] (fun _ -> 1. /. 3.))) in 59 | let (_ ,A row) = one_d_conv (Many 1) (Many (n-1)) (Many 10.) (A row) weights in 60 | Stdio.printf !"%{sexp: float array}" (Owl.Arr.to_array row); 61 | [%expect {| (10 40 40 30 19.999999999999996 30 40) |}] 62 | ;; 63 | 64 | let%expect_test "sugar" = 65 | let (f, g) = Examples.Gen.Sugar.it in 66 | let row : _ arr = A Owl.Arr.(ones [| 3 |]) in 67 | let (A row, Many x) = f row (Many 1, Many (Many 2)) in 68 | let Many y = g (Many (Many 4)) (Many 1) in 69 | Stdio.printf !"%{sexp: float array} and %d and %d" (Owl.Arr.to_array row) x y; 70 | [%expect {| (1 1 1) and 3 and 9 |}] 71 | ;; 72 | 73 | let%test "square" = 74 | let square = Examples.Gen.Square.it in 75 | let rand = Owl.Mat.uniform 5 5 in 76 | let (_, M answer) = square (M rand) in 77 | let answer2 = Owl.Mat.dot rand rand in 78 | Owl.Mat.(answer = answer2) 79 | ;; 80 | 81 | let%test_module "Kalman" = 82 | (module Kalman_test) 83 | ;; 84 | 85 | let%test_module "L1_norm_min" = 86 | (module L1_norm_min_test) 87 | ;; 88 | 89 | let%test_module "Lin_reg" = 90 | (module Lin_reg_test) 91 | ;; 92 | 93 | -------------------------------------------------------------------------------- /test/kalman_test.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | open Numlin.Template 5 | ;; 6 | 7 | module Ex = 8 | Examples.Kalman 9 | ;; 10 | 11 | (* Test set-up *) 12 | let n, k = 13 | 5, 3 14 | ;; 15 | 16 | let duplicate ~row ~col arr = 17 | let arr = Owl.Mat.of_array arr row col in 18 | arr, Owl.Mat.copy arr 19 | ;; 20 | 21 | let sigma, sigma_copy = 22 | let sigma, sigma_copy = duplicate ~row:n ~col:n [| 23 | 1.682490; 0.621964; 0.959947; 1.228820; 1.029410; 24 | 0.621964; 0.631446; 0.551902; 0.723342; 0.756674; 25 | 0.959947; 0.551902; 1.100060; 0.908402; 1.032840; 26 | 1.228820; 0.723342; 0.908402; 1.212400; 1.011350; 27 | 1.029410; 0.756674; 1.032840; 1.011350; 1.302410; 28 | |] in 29 | let () = assert Owl.Linalg.D.(is_posdef sigma && is_symmetric sigma) in 30 | sigma, sigma_copy 31 | ;; 32 | 33 | let h, h_copy = 34 | let h, h_copy = duplicate ~row:k ~col:n [| 35 | 0.4621110; 0.833041; 0.0395867; 0.529315; 0.241678; 36 | 0.0507828; 0.340120; 0.8726660; 0.836114; 0.571528; 37 | 0.7779080; 0.541655; 0.8691540; 0.286846; 0.265820; 38 | |] in 39 | h, h_copy 40 | ;; 41 | 42 | let mu, mu_copy = 43 | let mu, mu_copy = duplicate ~row:n ~col:1 [| 44 | 0.8015420; 45 | 0.8585870; 46 | 0.0950306; 47 | 0.8101720; 48 | 0.3491810; 49 | |] in 50 | mu, mu_copy 51 | ;; 52 | 53 | let data, data_copy = 54 | let data, data_copy = duplicate ~row:k ~col:1 [| 55 | 0.551922; 56 | 0.673854; 57 | 0.259412 58 | |] in 59 | data, data_copy 60 | ;; 61 | 62 | let r, r_copy = 63 | let r, r_copy = duplicate ~row:k ~col:k [| 64 | 0.880164; 0.676823; 0.802738; 65 | 0.676823; 0.650806; 0.958725; 66 | 0.802738; 0.958725; 1.745970; 67 | |] in 68 | let () = assert Owl.Linalg.D.(is_posdef r && is_symmetric r) in 69 | r, r_copy 70 | ;; 71 | 72 | (* Matrices. Must reset before every test. *) 73 | let reset () = 74 | List.iter ~f:(fun (orig, copy) -> Owl.Mat.copy_ copy ~out:orig) [ 75 | (sigma, sigma_copy); 76 | (h, h_copy); 77 | (mu, mu_copy); 78 | (r, r_copy); 79 | (data, data_copy); 80 | ] 81 | ;; 82 | 83 | let%expect_test "Kalman" = 84 | 85 | let same x = if x then "same" else " NOT" in 86 | 87 | (* NumLin *) 88 | let numlin_sigma, numlin_mu = 89 | reset (); 90 | let (_, (M numlin_sigma, (M numlin_mu, _))) = 91 | Ex.numlin ~sigma ~h ~mu ~r ~data in 92 | numlin_sigma, Owl.Mat.copy numlin_mu in 93 | let () = Owl.Mat.(Stdio.printf !"NumLin - sigma? %{same} | h? %{same}\n" (sigma = sigma_copy) (h = h_copy)) in 94 | 95 | (* Owl *) 96 | let owl_sigma, owl_mu = 97 | reset (); 98 | Ex.owl ~sigma ~h ~mu ~r ~data in 99 | 100 | (* NumPy *) 101 | let numpy_sigma, numpy_mu = 102 | reset (); 103 | Ex.numpy ~sigma ~h ~mu ~r ~data in 104 | let () = Owl.Mat.(Stdio.printf !"NumPy - sigma? %{same} | h? %{same}\n" (sigma = sigma_copy) (h = h_copy)) in 105 | 106 | (* CBLAS *) 107 | let cblas_sigma, cblas_mu = 108 | reset (); 109 | let cblas_sigma = Ex.cblas ~n ~k ~sigma ~h ~mu ~r ~data in 110 | cblas_sigma, Owl.Mat.copy mu in 111 | let () = Owl.Mat.(Stdio.printf !"CBLAS - sigma? %{same} | h? %{same}\n" (sigma = sigma_copy) (h = h_copy)) in 112 | 113 | (* Lazy *) 114 | let lazy_sigma, lazy_mu = 115 | reset (); 116 | Ex.lazy_ ~sigma ~h ~mu ~r ~data in 117 | 118 | let results = [ 119 | ("NumPy", numpy_mu, numpy_sigma); 120 | ("Owl", owl_mu, owl_sigma); 121 | ("NumLin", numlin_mu, numlin_sigma); 122 | ("CBLAS", cblas_mu, cblas_sigma); 123 | ("Lazy", lazy_mu, lazy_sigma); 124 | ] in 125 | 126 | let pair_up x rest = List.map rest ~f:(fun y -> (x,y)) in 127 | let all_pairs xs = fst @@ List.fold xs ~init:([], []) ~f:(fun (pairs, rest) x -> 128 | pair_up x rest @ pairs, x :: rest) in 129 | 130 | let pairs = all_pairs results in 131 | let () = List.iter pairs ~f:(fun ((a, mu_a, sigma_a), (b, mu_b, sigma_b)) -> 132 | let mu_res = Owl.Mat.(mu_a =~ mu_b) and sigma_res = Owl.Mat.(sigma_a =~ sigma_b) in 133 | Stdio.printf !"%5s and %5s: Mu (%{same}) Sigma (%{same})\n" a b mu_res sigma_res) in 134 | 135 | Owl.Mat.print ~header:false cblas_sigma; 136 | Owl.Mat.print ~header:false cblas_mu; 137 | 138 | [%expect {| 139 | NumLin - sigma? same | h? same 140 | NumPy - sigma? same | h? same 141 | CBLAS - sigma? same | h? same 142 | Lazy and CBLAS: Mu (same) Sigma (same) 143 | Lazy and NumLin: Mu (same) Sigma (same) 144 | Lazy and Owl: Mu (same) Sigma (same) 145 | Lazy and NumPy: Mu (same) Sigma (same) 146 | CBLAS and NumLin: Mu (same) Sigma (same) 147 | CBLAS and Owl: Mu (same) Sigma (same) 148 | CBLAS and NumPy: Mu (same) Sigma (same) 149 | NumLin and Owl: Mu (same) Sigma (same) 150 | NumLin and NumPy: Mu (same) Sigma (same) 151 | Owl and NumPy: Mu (same) Sigma (same) 152 | 153 | 0.541272 -0.00852694 0.133997 0.234808 0.0897324 154 | -0.00852694 0.17944 -0.0357339 0.0665866 0.078525 155 | 0.133997 -0.0357339 0.100837 0.0120868 -0.00196882 156 | 0.234808 0.0665866 0.0120868 0.227933 0.00138223 157 | 0.0897324 0.078525 -0.00196882 0.00138223 0.18484 158 | 159 | 160 | 1.40304 161 | 0.983331 162 | -0.0586492 163 | 1.06233 164 | 0.313462 |}] 165 | ;; 166 | -------------------------------------------------------------------------------- /test/l1_norm_min_test.ml: -------------------------------------------------------------------------------- 1 | let n, k = 2 | 5, 3 3 | ;; 4 | 5 | let duplicate ~row ~col arr = 6 | let arr = Owl.Mat.of_array arr row col in 7 | arr, Owl.Mat.copy arr 8 | ;; 9 | 10 | let q, q_copy = 11 | duplicate ~row:n ~col:n [| 12 | 1.682490; 0.621964; 0.959947; 1.228820; 1.029410; 13 | 0.621964; 0.631446; 0.551902; 0.723342; 0.756674; 14 | 0.959947; 0.551902; 1.100060; 0.908402; 1.032840; 15 | 1.228820; 0.723342; 0.908402; 1.212400; 1.011350; 16 | 1.029410; 0.756674; 1.032840; 1.011350; 1.302410; 17 | |] 18 | ;; 19 | 20 | let u, u_copy = 21 | duplicate ~row:n ~col:k [| 22 | 0.4621110; 0.0507828; 0.7779080; 23 | 0.833041 ; 0.340120 ; 0.541655 ; 24 | 0.0395867; 0.8726660; 0.8691540; 25 | 0.529315 ; 0.836114 ; 0.286846 ; 26 | 0.241678 ; 0.571528 ; 0.265820 ; 27 | |] 28 | ;; 29 | 30 | let i = 31 | Owl.Mat.eye k 32 | ;; 33 | 34 | let%expect_test "l1_norm_min" = 35 | 36 | let numpy = Examples.L1_norm_min.numpy ~q ~u in 37 | let owl = Examples.L1_norm_min.owl ~q ~u in 38 | (* run last *) 39 | let numlin = Examples.L1_norm_min.numlin ~q ~u in 40 | 41 | if not Owl.Mat.(owl =~ numlin) then Stdio.printf "Owl/NumLin: NOT SAME!\n"; 42 | if not Owl.Mat.(owl =~ numpy) then Stdio.printf "Owl/NumPy: NOT SAME!\n"; 43 | if not Owl.Mat.(numlin =~ numpy) then Stdio.printf "NumLin/NumPy: NOT SAME!\n"; 44 | Owl.Mat.print ~header:false numpy; 45 | Owl.Mat.print ~header:false numlin; 46 | 47 | [%expect {| 48 | 0.163738 -0.0580065 -0.236211 -0.378285 -0.237876 49 | 0.803372 0.920085 0.357245 0.437528 0.240099 50 | 0.463474 0.278753 0.97436 0.367974 0.341635 51 | -0.421418 0.00261993 0.0966232 0.51514 0.291141 52 | -0.584246 -0.609541 -0.733115 -0.505515 -0.35633 53 | 54 | 55 | 0.163738 -0.0580065 -0.236211 -0.378285 -0.237876 56 | 0.803372 0.920085 0.357245 0.437528 0.240099 57 | 0.463474 0.278753 0.97436 0.367974 0.341635 58 | -0.421418 0.00261993 0.0966232 0.51514 0.291141 59 | -0.584246 -0.609541 -0.733115 -0.505515 -0.35633 |}] 60 | ;; 61 | -------------------------------------------------------------------------------- /test/lin_reg_test.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | ;; 3 | 4 | open Numlin.Template 5 | ;; 6 | 7 | let n, k = 8 | 5, 3 9 | ;; 10 | 11 | let duplicate ~row ~col arr = 12 | let arr = Owl.Mat.of_array arr row col in 13 | arr, Owl.Mat.copy arr 14 | ;; 15 | 16 | let x, x_copy = 17 | duplicate ~row:n ~col:k [| 18 | 0.4621110; 0.0507828; 0.7779080; 19 | 0.833041 ; 0.340120 ; 0.541655 ; 20 | 0.0395867; 0.8726660; 0.8691540; 21 | 0.529315 ; 0.836114 ; 0.286846 ; 22 | 0.241678 ; 0.571528 ; 0.265820 ; 23 | |] 24 | ;; 25 | 26 | let params = 27 | Owl.Mat.of_array [| 28 | 0.2; 29 | 0.3; 30 | 0.5; 31 | |] k 1 32 | ;; 33 | 34 | let y, y_copy = 35 | let y = Owl.Mat.(x *@ params ) in 36 | y, Owl.Mat.copy y 37 | ;; 38 | 39 | let%expect_test "lin_reg" = 40 | 41 | let owl_res = Examples.Lin_reg.owl ~x ~y in 42 | let results = Examples.Lin_reg.[ 43 | ("Owl", owl_res); 44 | ("NumLin", let _, M res = numlin ~x ~y in res); 45 | ("NumPy", numpy ~x ~y); 46 | ] in 47 | let () = assert Owl.Mat.(x = x_copy && y = y_copy) in 48 | 49 | let pair_up x rest = List.map rest ~f:(fun y -> (x,y)) in 50 | let all_pairs xs = fst @@ List.fold xs ~init:([], []) ~f:(fun (pairs, rest) x -> 51 | pair_up x rest @ pairs, x :: rest) in 52 | 53 | let pairs = all_pairs results in 54 | let same x = if x then "same" else " NOT" in 55 | let () = List.iter pairs ~f:(fun ((a, res_a), (b, res_b)) -> 56 | Stdio.printf !"%5s and %5s: (%{same})\n" a b Owl.Mat.(res_a =~ res_b)) in 57 | 58 | Owl.Mat.print ~header:false owl_res; 59 | 60 | [%expect {| 61 | NumPy and NumLin: (same) 62 | NumPy and Owl: (same) 63 | NumLin and Owl: (same) 64 | 65 | 66 | 0.2 67 | 0.3 68 | 0.5 |}] 69 | ;; 70 | (* 71 | *) 72 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* All NumLin External Tests *) 3 | 4 | let%test_module "Ast_test" = 5 | (module Ast_test) 6 | ;; 7 | 8 | let%test_module "Check_monad" = 9 | (module Check_monad_test) 10 | ;; 11 | 12 | let%test_module "Checker" = 13 | (module Checker_test) 14 | ;; 15 | 16 | (* TODO *) 17 | (* let%test_module "Combinators" = *) 18 | (* (module Combinators_test) *) 19 | (* ;; *) 20 | 21 | let%test_module "Examples" = 22 | (module Examples_test) 23 | ;; 24 | -------------------------------------------------------------------------------- /test/vars.ml: -------------------------------------------------------------------------------- 1 | (* Dhruv Makwana *) 2 | (* A stock of variables *) 3 | 4 | let one, two, three, four, five, six, seven, eight, nine, ten, eleven, sentinel = 5 | ( "one" , "two" , "three" 6 | , "four" , "five" , "six" 7 | , "seven" , "eight" , "nine" 8 | , "ten" , "eleven" , "sentinel" ) 9 | ;; 10 | -------------------------------------------------------------------------------- /write-up/Makefile: -------------------------------------------------------------------------------- 1 | .SUFFIXES: .pdf .tex .bib $(SUFFIXES) 2 | 3 | FLAGS := -quiet 4 | 5 | BUILD := build 6 | 7 | # Proposal 8 | 9 | PROP := proposal.bib 10 | PROP_DIR := proposal 11 | PROP := $(addprefix $(PROP_DIR)/,$(PROP)) 12 | 13 | # Dissertation 14 | 15 | DIS := myclass.cls \ 16 | semantics_def.tex \ 17 | titlepage.tex \ 18 | declaration.tex \ 19 | abstract.tex \ 20 | introduction.tex \ 21 | background.tex \ 22 | implementation.tex \ 23 | evaluation.tex \ 24 | related_work.tex \ 25 | conclusion.tex \ 26 | ott_spec.tex \ 27 | timings.tex \ 28 | primitives.tex \ 29 | proposal.bib \ 30 | eval_data.tex \ 31 | timings_all.tex \ 32 | timings.txt \ 33 | trace.txt 34 | 35 | DIS_DIR := dissertation 36 | DIS := $(addprefix $(DIS_DIR)/,$(DIS)) 37 | 38 | # Semantics 39 | 40 | SEM := semantics_def.tex \ 41 | interpretation.tex \ 42 | lemmas.tex \ 43 | soundness.tex 44 | 45 | SEM_DIR := semantics 46 | SEM := $(addprefix $(SEM_DIR)/,$(SEM)) 47 | 48 | # Paper 49 | 50 | EXAMPLES := factorial.lt \ 51 | sum_array.lt \ 52 | weighted_avg_infer.lt \ 53 | square.lt \ 54 | lin_reg.lt \ 55 | l1_norm_min.lt \ 56 | kalman.lt 57 | EXAMPLES := $(addprefix ../examples/,$(EXAMPLES)) 58 | 59 | PAPER := intro.tex \ 60 | lang_and_examples.tex \ 61 | formal_system.tex \ 62 | implementation.tex \ 63 | discussion.tex \ 64 | appendix.tex \ 65 | lin_reg_timings.tex \ 66 | l1_norm_min_timings.tex \ 67 | kalman_timings.tex \ 68 | ourbib.bib \ 69 | lipics-v2019.cls \ 70 | fig1.eps \ 71 | plainurl.bst 72 | 73 | PAPER_DIR := paper 74 | PAPER := $(addprefix $(PAPER_DIR)/,$(PAPER)) 75 | 76 | # Isolated paper for submission 77 | 78 | ISOLATED := lipics-v2019.cls \ 79 | ottlayout.sty \ 80 | pf2.sty \ 81 | orcid.pdf \ 82 | cc-by.pdf \ 83 | lipics-logo-bw.pdf \ 84 | impl_build.png \ 85 | ourbib.bib \ 86 | plainurl.bst 87 | 88 | ISOLATED_DIR := isolated 89 | 90 | ISOLATED := $(addprefix $(PAPER_DIR)/,$(ISOLATED)) $(EXAMPLES) 91 | 92 | BUILD_DIS := $(BUILD)/$(DIS_DIR) 93 | 94 | PDFS := $(SEM_DIR).pdf \ 95 | $(PROP_DIR).pdf \ 96 | $(DIS_DIR).pdf \ 97 | $(PAPER_DIR).pdf 98 | 99 | .PHONY: all clean 100 | all: $(PDFS) $(ISOLATED_DIR).tar.gz 101 | 102 | .SECONDEXPANSION: 103 | $(PDFS):%.pdf: $$*/$$*.tex | $(BUILD) 104 | cd $(dir $<) && latexmk -pdf -dvi- -ps- $(notdir $<) -shell-escape -output-directory=../$(BUILD) $(FLAGS) 105 | mv $(BUILD)/$@ $@ 106 | 107 | $(PAPER_DIR)/$(PAPER_DIR).tex: $(PAPER) $(SEM) $(EXAMPLES) 108 | touch $@ 109 | 110 | $(DIS_DIR)/$(DIS_DIR).tex: $(DIS) | $(BUILD_DIS) 111 | touch $@ 112 | 113 | $(DIS_DIR)/semantics_def.tex: $(DIS_DIR)/semantics.ott 114 | ott -i $< -tex_show_meta false -tex_wrap false -o $@ 115 | 116 | $(SEM_DIR)/$(SEM_DIR).tex: $(SEM) 117 | touch $@ 118 | 119 | $(PROP_DIR)/$(PROP_DIR).tex: $(PROP) 120 | touch $@ 121 | 122 | $(SEM_DIR)/semantics_def.tex: $(SEM_DIR)/semantics.ott 123 | ott -i $< -tex_show_meta false -tex_wrap false -o $@ 124 | 125 | .SECONDEXPANSION: 126 | $(ISOLATED_DIR).tar.gz:%.tar.gz: $$*/$$*.tex $(ISOLATED) | $(ISOLATED_DIR) 127 | cp $(ISOLATED) $(dir $<) 128 | tar czf $@ $(dir $<) 129 | 130 | $(ISOLATED_DIR)/$(ISOLATED_DIR).tex: $(PAPER_DIR)/$(PAPER_DIR).tex $(ISOLATED) | $(ISOLATED_DIR) 131 | cd $(dir $<) && cat $(notdir $<) | sed 's~^\\clearpage\\appendix\\input{appendix}$$~%&~' | latexpand - > ../$@ 132 | sed -i 's~\[outputdir=\.\./$(BUILD)\]~~' $@ 133 | sed -i 's~\.\./\.\./examples/~~' $@ 134 | sed -i 's/Figure~\\ref{fig:\(cblas\|ocaml\)_kalman}\|Appendix~\\ref{\w\+\:\(\w\|_\)\+}/the Appendix/g' $@ 135 | sed -i 's/^permissions (\\ref{fracPermSub})/permissions; all of these (and more) are stated formally and proved in the Appendix/g' $@ 136 | sed -i 's/ (\\ref{\(frame\|subsetKJ\|restriction\|fracPermSub\)})//g' $@ 137 | sed -i 's/\\ref{fracPermSub}/one of the lemmas/g' $@ 138 | 139 | $(BUILD_DIS): $(BUILD) 140 | $(BUILD) $(BUILD_DIS) $(ISOLATED_DIR): %: 141 | mkdir -p $@ 142 | 143 | clean: 144 | rm -rf $(BUILD) $(ISOLATED_DIR) 145 | -------------------------------------------------------------------------------- /write-up/default.nix: -------------------------------------------------------------------------------- 1 | { pkgs ? import {} }: 2 | 3 | with pkgs; 4 | 5 | stdenv.mkDerivation { 6 | 7 | name = "numlin"; 8 | 9 | buildInputs = [ 10 | (texlive.combine { 11 | inherit (texlive) 12 | amsmath 13 | academicons 14 | booktabs 15 | bussproofs 16 | caption 17 | charter 18 | cleveref 19 | cm-super 20 | comment 21 | ec 22 | epstopdf 23 | etoolbox # minted 24 | fancyvrb # minted 25 | float # minted 26 | framed 27 | graphics 28 | hyperref 29 | ifplatform # minted 30 | latexmk 31 | latexpand 32 | lastpage 33 | lineno # minted 34 | listings 35 | mdwtools # syntax 36 | microtype 37 | minitoc 38 | minted 39 | ms # pgfplots 40 | multirow 41 | parskip 42 | pgf 43 | pgfplots 44 | scheme-basic 45 | sectsty 46 | setspace 47 | supertabular 48 | soul 49 | texcount 50 | titlesec 51 | threeparttable 52 | tocbibind 53 | tocloft 54 | ucs 55 | xcolor 56 | xstring # minted 57 | ; 58 | }) 59 | ghostscript 60 | ocamlPackages.ott 61 | pythonPackages.pygments 62 | which 63 | ]; 64 | 65 | src = ./.; 66 | 67 | installPhase = '' 68 | mkdir -p $out 69 | cp *.pdf $out 70 | ''; 71 | } 72 | 73 | # vim: set sw=4 sts=4 ft=conf: 74 | -------------------------------------------------------------------------------- /write-up/dissertation.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dc-mak/NumLin/9f19783f52f9258aefccec4c466ccb1ffad5c8e5/write-up/dissertation.pdf -------------------------------------------------------------------------------- /write-up/dissertation/abstract.tex: -------------------------------------------------------------------------------- 1 | \vspace*{\fill} 2 | \begin{abstract} 3 | 4 | In this thesis, I argue that linear types are an appropriate, \emph{type-based 5 | formalism} for expressing aliasing, read/write permissions, memory allocation, 6 | re-use and deallocation, first, in the context of the APIs of linear algebra 7 | libraries and then in the context of matrix expression compilation. 8 | 9 | I show that framing the problem using linear types can \emph{reduce bugs} 10 | by making precise and explicit, the informal, ad-hoc practices typically 11 | employed by experts and matrix expression compilers \emph{and} automate 12 | checking them. 13 | 14 | As evidence for this argument, I show non-trivial, yet readable, linear algebra 15 | programs, that are safe and explicit (with respect to aliasing, read/write 16 | permissions, memory allocation, re-use and deallocation) which (1) are more 17 | memory-efficient than equivalent programs written using high-level 18 | linear algebra libraries and (2) perform just as predictably as equivalent 19 | programs written using low-level linear algebra libraries. I also argue 20 | \emph{the experience} of writing such programs with linear types is 21 | qualitatively better in key respects. In addition to all of this, I show that 22 | it is possible to provide such features \emph{as a library} on top of existing 23 | programming languages and linear algebra libraries. 24 | 25 | \end{abstract} 26 | 27 | \vspace*{\fill} 28 | \cleardoublepage% 29 | \vspace*{\fill} 30 | \renewcommand{\abstractname}{Acknowledgements} 31 | 32 | \begin{abstract} 33 | 34 | I would like to thank my family and closest friends for supporting me through 35 | my time at Cambridge: you were my strength when I had none. I would also like 36 | to thank my supervisors, Dr\@.~Neelakantan Krishnaswami and Dr\@.~Stephen 37 | Dolan, for teaching me so much this year. I owe a debt of gratitude to both the 38 | 2017 Part III Appeals Committee and those who wrote letters in support of my 39 | appeal, for believing I deserved the chance to stay on: never have I valued the 40 | privilege of learning what I enjoy and enjoying what I learn more. Lastly, I 41 | would like to thank the many staff and research members of the Computer Lab who 42 | have been approachable, patient and attentive during my time here. 43 | 44 | \end{abstract} 45 | 46 | \vspace*{\fill} 47 | \cleardoublepage% 48 | -------------------------------------------------------------------------------- /write-up/dissertation/declaration.tex: -------------------------------------------------------------------------------- 1 | \newpage 2 | {\normalfont\Huge\sffamily\bfseries Declaration} 3 | 4 | \vspace{24pt} 5 | 6 | I \authorname of \authorcollege, being a candidate for Computer Science Tripos, 7 | Part III, hereby declare that this report and the work described in it are my 8 | own work, unaided except as may be specified below, and that the report does 9 | not contain material that has already been used to any substantial extent for a 10 | comparable purpose. 11 | 12 | \vspace{24pt} 13 | Total word count: \wordcount 14 | 15 | \vspace{60pt} 16 | \textbf{Signed}: 17 | 18 | \vspace{12pt} 19 | \textbf{Date}: 20 | 21 | \vfill 22 | 23 | This dissertation is copyright \copyright 2018 \authorname. 24 | \\ 25 | All trademarks used in this dissertation are hereby acknowledged. 26 | 27 | \cleardoublepage% 28 | -------------------------------------------------------------------------------- /write-up/dissertation/dissertation.tex: -------------------------------------------------------------------------------- 1 | \documentclass{./myclass} 2 | 3 | % From dissertation template 4 | \usepackage{graphicx,parskip,setspace,tabularx,xspace} 5 | \usepackage{epstopdf} 6 | \epstopdfsetup{outdir=../build/} 7 | \usepackage{lscape} 8 | 9 | % Titles 10 | \def\authorname{Dhruv C.~Makwana\xspace} 11 | \def\authorcollege{Trinity College\xspace} 12 | \def\authoremail{dcm41@cam.ac.uk} 13 | \def\dissertationtitle{Applications of Linear Types} 14 | \def\wordcount{10,154} 15 | 16 | % From Ott 17 | \usepackage{amstext} 18 | \usepackage{supertabular} 19 | \usepackage{ifthen} 20 | \usepackage{alltt}%hack 21 | \input{semantics_def} 22 | 23 | % PL Stuff 24 | \usepackage[nounderscore]{syntax} 25 | \renewcommand{\syntleft}{\normalfont\itshape} 26 | \renewcommand{\syntright}{} 27 | \renewcommand{\ulitleft}{\normalfont\bf}%\syn@ttspace\frenchspacing} 28 | \renewcommand{\ulitright}{} 29 | \renewcommand{\litleft}{\bgroup\ulitleft} 30 | \renewcommand{\litright}{\ulitright\egroup} 31 | \usepackage{bussproofs} 32 | 33 | % Minted convenience 34 | \newmintinline[highl]{ocaml}{fontsize=\small} 35 | 36 | %% START OF DOCUMENT 37 | \begin{document} 38 | 39 | %% FRONTMATTER (TITLE PAGE, DECLARATION, ABSTRACT, ETC) 40 | \pagestyle{empty} 41 | \singlespacing% 42 | \input{titlepage} 43 | \onehalfspacing% 44 | \input{declaration} 45 | \singlespacing% 46 | \input{abstract} 47 | 48 | % Minitoc 49 | \dominitoc% 50 | % No resetting page numbers: ISO 7144 51 | % \pagenumbering{roman} 52 | % \setcounter{page}{0} 53 | \pagestyle{plain} 54 | \setcounter{tocdepth}{1} 55 | \tableofcontents% 56 | % \listoffigures% 57 | % \listoftables% 58 | 59 | % For Bold minitoc Section Headings, minitoc & tocloft conflict 60 | \renewcommand{\cftsecfont}{\normalfont\sffamily\bfseries}% Bold Sans minitoc Section font 61 | \renewcommand{\cftsecleader}{\normalfont\sffamily\bfseries\cftdotfill{\cftdotsep}}% Bold Sans dots for Sections 62 | \renewcommand{\cftsecpagefont}{\bfseries}% Bold (not sans for ToC & page consistency) page numbers 63 | \cleardoublepage{} 64 | 65 | \onehalfspacing% 66 | 67 | %% START OF MAIN TEXT 68 | 69 | \include{introduction} 70 | 71 | \include{background} 72 | 73 | \include{implementation} 74 | 75 | \include{evaluation} 76 | 77 | \include{related_work} 78 | 79 | \include{conclusion} 80 | 81 | \appendix% 82 | \include{ott_spec} 83 | \RecustomVerbatimEnvironment{Verbatim}{Verbatim}{}% 84 | \include{primitives} 85 | \include{eval_data} 86 | \singlespacing% 87 | 88 | \bibliographystyle{unsrt} 89 | \bibliography{proposal} 90 | 91 | \end{document} 92 | -------------------------------------------------------------------------------- /write-up/dissertation/eval_data.tex: -------------------------------------------------------------------------------- 1 | \chapter{Evaluation Raw Data}\label{chap:eval_data} 2 | 3 | Below is formatted output from a trace I obtained by recompiling Owl with print 4 | statements inserted on the relevant primitives. I made two modifications: I 5 | shortened `\_matrix\_transpose' to `\_mtrsp' for formatting and I split `posv' 6 | into `potrf/potrs' for a fairer comparison. 7 | 8 | \inputminted[fontsize=\small]{text}{trace.txt} 9 | 10 | Below is the raw output from the benchmarking script I wrote. 11 | \inputminted[fontsize=\small]{text}{timings.txt} 12 | 13 | -------------------------------------------------------------------------------- /write-up/dissertation/impl_build.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dc-mak/NumLin/9f19783f52f9258aefccec4c466ccb1ffad5c8e5/write-up/dissertation/impl_build.png -------------------------------------------------------------------------------- /write-up/dissertation/introduction.tex: -------------------------------------------------------------------------------- 1 | \chapter{Introduction} 2 | 3 | % No resetting page numbers: ISO 7144 4 | % \pagenumbering{arabic} 5 | % \setcounter{page}{0} 6 | 7 | % \begin{guidance} 8 | % This is the introduction where you should introduce your work. In 9 | % general the thing to aim for here is to describe a little bit of the 10 | % context for your work --- why did you do it (motivation), what was the 11 | % hoped-for outcome (aims) --- as well as trying to give a brief 12 | % overview of what you actually did. 13 | % 14 | % It's often useful to bring forward some ``highlights'' into 15 | % this chapter (e.g.\ some particularly compelling results, or 16 | % a particularly interesting finding). 17 | % 18 | % It's also traditional to give an outline of the rest of the 19 | % document, although without care this can appear formulaic 20 | % and tedious. Your call. 21 | % \end{guidance} 22 | 23 | Linear types allow the compiler and programmer to statically keep track of the 24 | resources that a program uses, thus offering a promising solution to the 25 | problems associated with complex resource management. However, they have not 26 | made their way into many mainstream programming languages, in the same way 27 | parametrically polymorphic types have. To illustrate their simplicity and 28 | power, I implemented an OCaml library that allows users to learn about and 29 | become familiar with linear types, specifically in the context of linear 30 | algebra programs. 31 | 32 | The main contributions of this thesis are: 33 | 34 | \begin{itemize} 35 | 36 | \item An \textbf{original, usable implementation} of a type system that can express 37 | aliasing, read/write permissions, memory allocation, re-use and deallocation. 38 | 39 | \item An \textbf{original} demonstration of how that type system can be 40 | \textbf{applied to the APIs} of linear algebra libraries and the 41 | \textbf{benefits} of doing so. 42 | 43 | \item Many \textbf{new} examples of how that type system can \textbf{automatically 44 | check} for common aliasing, read/write permission, memory allocation, 45 | re-use and deallocation \textbf{errors} in the context of 46 | linear algebra programs. 47 | 48 | \item An \textbf{original} demonstration of how that type system can be 49 | \textbf{used} for \textbf{matrix expression compilation}. 50 | 51 | \item \textbf{New and readable implementations} of \textbf{non-trivial} 52 | linear algebra programs that \textbf{take advantage} of said type 53 | system. 54 | 55 | \item A \textbf{new solution} to the \textbf{dichotomy} of 56 | \textbf{readability}, \textbf{ease of reasoning and safety} of 57 | high-level linear algebra libraries versus the 58 | \textbf{memory-efficiency} of low-level linear algebra libraries. 59 | 60 | \item A \textbf{new library design} to provide said solution in a way that 61 | \textbf{integrates well} with existing OCaml code and linear algebra 62 | libraries. 63 | 64 | \end{itemize} 65 | -------------------------------------------------------------------------------- /write-up/dissertation/kalman.f90: -------------------------------------------------------------------------------- 1 | subroutine kalman(mu, Sigma, H, INFO, R, Sigma_2, data, mu_2, k, n) 2 | implicit none 3 | 4 | integer, intent(in) :: k, n 5 | real*8, intent(in) :: Sigma(n,n), H(k,n), mu(n) 6 | real*8, intent(inout) :: data(k) ! data, H*mu - data , (H*Sigma*H^T + R)^-1*(H*mu - data) 7 | real*8, intent(inout) :: R(k, k) ! R, H*Sigma*H^T + R 8 | integer, intent(out) :: INFO ! INFO 9 | real*8, intent(out) :: Sigma_2(n,n) ! H^T*(H*Sigma*H^T + R)^-1*H, Sigma, Sigma*(I - H^T*(H*Sigma*H^T + R)^-1*H*Sigma) 10 | real*8, intent(out) :: mu_2(n) ! mu, Sigma*H^T*(H*Sigma*H^T + R)^-1*(H*mu - data) + mu 11 | real*8 :: H_2(k,n) ! H * Sigma , H , (H*Sigma*H^T + R)^-1*H 12 | real*8 :: chol_R(k,k) ! R, U where (H*Sigma*H^T + R)=U^T*U 13 | real*8 :: H_data(n) ! H^T*(H*Sigma*H^T + R)^-1*(H*mu - data) 14 | real*8 :: N_N_tmp(n,n) ! H^T*(H*Sigma*H^T + R)^-1*H*Sigma 15 | 16 | call dsymm('R', 'U', k, n, 1, Sigma, n, H, n, 0, H_2, n) ! H_2 := 1. * H * Sigma + 0. * H_2 17 | call dgemm('N', 'T', k, k, n, 1, H_2, n, H, n, 1, R, k) ! R := 1. * H_2 * H + 1. * R 18 | call dgemm('N', 'N', k, 1, n, 1, H, n, mu, 1, -1, data, 1) ! data := 1. * H * mu + -1. * data 19 | call dcopy(k*n, H, 1, H_2, 1) ! H_2 := H 20 | call dcopy(k*k, R, 1, chol_R, 1) ! chol_R := R 21 | call dposv('U', k, n, chol_R, k, H_2, n, INFO) ! chol_R := U where R = U^T * U 22 | ! H_2 := R^-1 * H_2 23 | call dpotrs('U', k, 1, chol_R, k, data, 1, INFO) ! data := R^-1 * data 24 | call dgemm('T', 'N', n, n, k, 1, H, n, H_2, n, 0, Sigma_2, n) ! N_N_tmp := 1. * H^T * H_2 + 0. * N_N_tmp 25 | call dgemm('T', 'N', n, 1, k, 1, H, n, data, 1, 0, H_data, 1) ! H_data := 1. * H^T * data + 0. * H_data 26 | call dcopy(n, mu, 1, mu_2, 1) ! mu_2 := mu 27 | call dsymm('L', 'U', n, 1, 1, Sigma, n, H_data, 1, 1, mu_2, 1) ! mu_2 := 1. * Sigma * H_data + 1. * mu_2 28 | call dsymm('R', 'U', n, n, 1, Sigma, n, Sigma_2, n, 0, N_N_tmp, n) ! N_N_tmp := 1. * N_N_tmp * Sigma + 0. * N_N_tmp 29 | call dcopy(n**2, Sigma, 1, Sigma_2, 1) ! Sigma_2 := Sigma 30 | call dsymm('L', 'U', n, n, -1, Sigma, n, N_N_tmp, n, 1, Sigma_2, n) ! Sigma_2 := -1 * Sigma * N_N_tmp + 1. * Sigma_2 31 | 32 | RETURN 33 | END 34 | -------------------------------------------------------------------------------- /write-up/dissertation/myclass.cls: -------------------------------------------------------------------------------- 1 | % Boilerplate 2 | \NeedsTeXFormat{LaTeX2e} 3 | \ProvidesClass{myclass}[05/02/2018 Dhruv Makwana Part III Project Class] 4 | \LoadClass[12pt,a4paper,twoside,openright,notitlepage]{report} 5 | 6 | % Standard 7 | \RequirePackage[utf8x]{inputenc} 8 | \RequirePackage[T1]{fontenc} 9 | \RequirePackage[dvipsnames]{xcolor} 10 | 11 | % Hyperlinks 12 | % --- 13 | \RequirePackage[ 14 | pdftitle={Applications of Linear Types}, 15 | pdfauthor={Dhruv C.~Makwana}, 16 | pdfkeywords={numerical, linear, algebra, types, OCaml} 17 | ]{hyperref} 18 | 19 | % Remove ugly boxes around hyperlinks 20 | \hypersetup{% 21 | colorlinks=true, 22 | linkcolor={black}, 23 | citecolor={green!50!black}, 24 | urlcolor={blue!80!black} 25 | } 26 | 27 | % Refer to Chapters and Sections by their Title 28 | \RequirePackage{nameref} 29 | 30 | % Referrable enumerated lists 31 | % \RequirePackage{enumitem} 32 | 33 | % Formatting 34 | % --- 35 | 36 | % Allow flexible pages 37 | \raggedbottom{} 38 | \sloppy% 39 | % penalise orphan lines/paragraphs 40 | \clubpenalty1000% 41 | \widowpenalty1000% 42 | 43 | % Paragraph formatting 44 | \parindent0pt% 45 | \parskip6pt% 46 | 47 | % Full width footnote rule 48 | \renewcommand{\footnoterule}{}% 49 | % \kern -3pt 50 | % \hrule width \textwidth height 1pt 51 | % \kern 2pt 52 | % } 53 | 54 | % Nice tables 55 | \RequirePackage{booktabs} 56 | 57 | % Nice captions 58 | \RequirePackage[ 59 | format=hang, 60 | font=small, 61 | labelfont=sf, 62 | labelsep=endash 63 | ]{caption} 64 | 65 | % Fancy headers 66 | \RequirePackage{fancyhdr} 67 | 68 | % Margins 69 | \RequirePackage[ 70 | headheight=15pt, % 15pt for fancyhdr 71 | top=1.1in, 72 | bottom=1.25in, 73 | left=1.25in, 74 | right=1.25in 75 | ]{geometry} 76 | 77 | % More readable; preserves hyphenation 78 | % \RequirePackage[document]{ragged2e} 79 | 80 | % Sans-serif section headers 81 | \RequirePackage{sectsty} 82 | \allsectionsfont{\normalfont\sffamily\bfseries}% sans Sub*sections font 83 | \setcounter{secnumdepth}{3}% Number subsubsections 84 | \renewcommand{\thesubsubsection}{\Roman{subsubsection}}% with captial roman 85 | 86 | % Control (format) table of contents, figures 87 | \RequirePackage{tocloft} 88 | \setlength{\cftparskip}{6pt}% Spacing in ToC 89 | \renewcommand{\cfttoctitlefont}{\normalfont\Huge\sffamily\bfseries}% sans ToC Title 90 | \renewcommand{\cftchapfont}{\normalfont\sffamily\bfseries}% sans ToC chapter font 91 | \renewcommand{\cftsecfont}{\normalfont\sffamily}% sans ToC section font 92 | \renewcommand{\cftsubsecfont}{\normalfont\sffamily}% sans ToC subsection font 93 | \renewcommand{\cftloftitlefont}{\normalfont\Huge\sffamily\bfseries}% sans LoFig Title 94 | \renewcommand{\cftlottitlefont}{\normalfont\Huge\sffamily\bfseries}% sans LoTab Title 95 | 96 | % Customise Chapter Titles 97 | \RequirePackage{titlesec} 98 | % Fancy (and smaller) Chapter Heading Style 99 | \titleformat{\chapter}[hang]{\sffamily\Huge\bfseries}{% 100 | \thechapter\hspace{20pt}\textcolor{lightgray}{|}\hspace{20pt}}{0pt}{\sffamily\Huge\bfseries} 101 | 102 | % Special features 103 | % --- 104 | 105 | % Maths symbols (explaining triangle for defs, square for proofs in Eval) 106 | \RequirePackage{amsmath} 107 | \RequirePackage{amssymb} 108 | 109 | % Including stand-alone LaTeX documents as is 110 | % \RequirePackage{docmute} 111 | 112 | % Source code highlighting 113 | \RequirePackage[outputdir=../build]{minted} 114 | % Magic incantation to stop minted from putting red boxes around shit 115 | \RequirePackage{etoolbox} 116 | \makeatletter 117 | \AtBeginEnvironment{minted}{\dontdofcolorbox} 118 | \def\dontdofcolorbox{\renewcommand\fcolorbox[4][]{##4}} 119 | \makeatother 120 | \RecustomVerbatimEnvironment{Verbatim}{BVerbatim}{} 121 | 122 | % Graphs 123 | \RequirePackage{pgfplots} 124 | \RequirePackage{rotating} 125 | 126 | % % Evaluation table 127 | % \RequirePackage{adjustbox} 128 | \RequirePackage{array} 129 | % 130 | % % Rotated table headers 131 | % % http://tex.stackexchange.com/questions/32683/rotated-column-titles-in-tabular#32690 132 | % \newcolumntype{R}[2]{% 133 | % >{\adjustbox{angle=#1,lap=\width- (#2)}\bgroup}% 134 | % l% 135 | % <{\egroup}% 136 | % }% 137 | % \newcommand*\rot{\multicolumn{1}{R{90}{0.8em}}} 138 | % 139 | % % Fancy coloured boxes 140 | % \newcommand{\Y}{\tikz\fill [ForestGreen] (-0.3ex,0) rectangle (1.3ex,0.7em); } 141 | % \newcommand{\M}{\tikz\fill [YellowOrange] (-0.3ex,0) rectangle (1.3ex,0.7em); } 142 | % \newcommand{\N}{\tikz\fill [Red] (-0.3ex,0) rectangle (1.3ex,0.7em); } 143 | 144 | % Per Chapter Mini Table of Contents (load after titlesec) 145 | \RequirePackage{minitoc} 146 | 147 | % Conveniences 148 | % --- 149 | 150 | % Guidance from template 151 | \newif\ifguidance% 152 | \guidancetrue% 153 | \newenvironment{guidance} 154 | {\sffamily\color{red}} 155 | {\normalfont\color{black}} 156 | 157 | % At the start of each chapter 158 | \renewcommand{\mtctitle}{} 159 | \newcommand*{\prechapter}[1]{% 160 | \minitoc% 161 | \bigskip% 162 | \begin{center}% 163 | \begin{minipage}[h][][c]{0.8\linewidth}% 164 | #1 165 | \end{minipage}% 166 | \end{center} 167 | 168 | \newpage% 169 | } 170 | 171 | % End 172 | \endinput 173 | -------------------------------------------------------------------------------- /write-up/dissertation/ott_spec.tex: -------------------------------------------------------------------------------- 1 | \chapter{Ott Specification}\label{chap:ott_spec} 2 | 3 | The following pages present a specification of the grammar and type system used 4 | in LT4LA, produced using the Ott~\cite{sewell_ott} tool. It is important to 5 | note that the type system is not implemented how it is described in the coming 6 | pages. For explaining (and using Ott) it was easier to set it out as below. 7 | However, for implementing, I found it much more and user- and 8 | debugging-friendly to: 9 | 10 | \begin{itemize} 11 | 12 | \item Have the type environment \emph{change} as a result 13 | of type-checking an expression, similar to the rules shown in 14 | Figure~\ref{fig:example_rules}; with this, the below rules describe 15 | the \emph{difference} between the environment after and before checking 16 | an expression. For example, in the pair-introduction rule, $\Gamma = 17 | \Gamma_2 - \Gamma_1$ and $\Gamma' = \Gamma_3 - \Gamma_2$, for an 18 | appropriate definition of $(-)$. 19 | 20 | \item \emph{Mark} variables as used instead of \emph{removing} them from the 21 | environment for better error messages. 22 | 23 | \item Have \emph{one} environment where variables were \emph{tagged} as 24 | linear and unused, linear and used, and intuitionistic. This was 25 | definitely an implementation convenience so that variable binding could 26 | be handled uniformly for linear and intuitionistic variables and 27 | scoping/variable look-up could be handled implicitly with the 28 | associative-list structure of the environment. So, it would be more 29 | (but still not completely) accurate to define the variable rule as: 30 | \begin{prooftree} 31 | \AxiomC{} 32 | \RightLabel{\textsc{Ty\_Var}} 33 | \UnaryInfC{$\Theta; \Gamma, x \overset{n}{:} t \vdash x : t ; \Gamma, x \overset{n-1}{:} t$} 34 | \end{prooftree} 35 | for $n \in \{0\,\textrm{(used)}, 1\,\textrm{(unused)}, 36 | \omega\,\textrm{(intuitionistic)}\}$, $\omega - 1 = \omega$ and $1 - 1 = 0$. 37 | 38 | \end{itemize} 39 | 40 | \clearpage% 41 | \singlespacing% 42 | \ottall% 43 | \onehalfspacing% 44 | -------------------------------------------------------------------------------- /write-up/dissertation/primitives.tex: -------------------------------------------------------------------------------- 1 | \chapter{Primitives}\label{chap:primitives} 2 | 3 | The following signature gives an indication of how I embedded LT4LA's type 4 | system into OCaml's and typed its primitives accordingly. This helped catch 5 | bugs and increase confidence in the correctness of the code produced. 6 | 7 | \begin{minted}[fontsize=\small]{ocaml} 8 | module Arr = Owl.Dense.Ndarray.D 9 | type z = Z 10 | type 'a s = Succ 11 | type 'a arr = A of Arr.arr [@@unboxed] 12 | type 'a mat = M of Arr.arr [@@unboxed] 13 | type 'a bang = Many of 'a [@@unboxed] 14 | module Prim : 15 | sig 16 | val extract : 'a bang -> 'a 17 | (** Boolean *) 18 | val not_ : bool bang -> bool bang 19 | (** Arithmetic, many omitted for brevity *) 20 | val addI : int bang -> int bang -> int bang 21 | val ltE : float bang -> float bang -> bool bang 22 | (** Arrays *) 23 | val set : z arr -> int bang -> float bang -> z arr 24 | val get : 'a arr -> int bang -> 'a arr * float bang 25 | val share : 'a arr -> 'a s arr * 'a s arr 26 | val unshare : 'a s arr -> 'a s arr -> 'a arr 27 | val free : z arr -> unit 28 | (** Owl *) 29 | val array : int bang -> z arr 30 | val copy : 'a arr -> 'a arr * z arr 31 | val sin : z arr -> z arr 32 | val hypot : z arr -> 'a arr -> 'a arr * z arr 33 | (** Level 1 BLAS *) 34 | val asum : 'a arr -> 'a arr * float bang 35 | val axpy : float bang -> 'a arr -> z arr -> 'a arr * z arr 36 | val dot : 'a arr -> 'b arr -> ('a arr * 'b arr) * float bang 37 | val rotmg : float bang * float bang -> float bang * float bang -> 38 | (float bang * float bang) * (float bang * z arr) 39 | val scal : float bang -> z arr -> z arr 40 | val amax : 'a arr -> 'a arr * int bang 41 | (* Matrix, some omitted for brevity *) 42 | val matrix : int bang -> int bang -> z mat 43 | val copy_mat : 'a mat -> 'a mat * z mat 44 | val copy_mat_to : 'a mat -> z mat -> 'a mat * z mat 45 | val size_mat : 'a mat -> 'a mat * (int bang * int bang) 46 | val transpose : 'a mat -> 'a mat * z mat 47 | (* Level 3 BLAS/LAPACK *) 48 | val gemm : float bang -> ('a mat * bool bang) -> ('b mat * bool bang) -> 49 | float bang -> z mat -> ('a mat * 'b mat) * z mat 50 | val symm : bool bang -> float bang -> 'a mat -> 'b mat -> 51 | float bang -> z mat -> ('a mat * 'b mat) * z mat 52 | val posv : z mat -> z mat -> z mat * z mat 53 | val potrs : 'a mat -> z mat -> 'a mat * z mat 54 | end 55 | \end{minted} 56 | -------------------------------------------------------------------------------- /write-up/dissertation/timings.tex: -------------------------------------------------------------------------------- 1 | \begin{tikzpicture}[trim axis left] 2 | \begin{axis}[ 3 | % width of chart 4 | width=\textwidth, 5 | height=0.4\textheight, 6 | % no box, below chart, horizontal 7 | legend style={% 8 | draw=none, 9 | at={(0.5,-0.15)}, 10 | anchor=north, 11 | legend columns=4, 12 | column sep = 1em, 13 | cells={align=center}, 14 | }, 15 | % log ticks with fixed point, 16 | % yticklabel={\pgfmathparse{pow(10,\tick-3)}\pgfmathprintnumber[fixed]{\pgfmathresult}}\,ms, % N ms along y-axis 17 | % xticklabel={\pgfmathparse{pow(5,\tick)}\pgfmathprintnumber[fixed]{\pgfmathresult}}, 18 | xlabel near ticks, 19 | xlabel={Matrix size $n$ (for a Kalman filter, with $k=3n/5$)}, 20 | ylabel near ticks, 21 | ylabel={Execution time of one call to Kalman filter ($\mu$s)}, 22 | xmode = log, 23 | log basis x = {5}, 24 | axis line style={opacity=0}, % hide y axis 25 | major tick style={draw=none}, % no ticks 26 | ymode=log, % log scale for y 27 | log basis y = {10}, % log base 10 28 | ymajorgrids, % rows of lines 29 | major grid style={gray, line width=1pt}, 30 | ] 31 | 32 | % CBLAS 33 | \addplot+ [ 34 | violet, 35 | mark options={fill=violet}, 36 | error bars/.cd, y dir=both, y explicit, 37 | ] table [ 38 | y error plus=ey+, 39 | y error minus=ey-, 40 | ] { 41 | x y ey+ ey- 42 | 5 24 0 0 43 | 25 104 1 1 44 | 125 1803 64 57 45 | 625 187667 36281 36281 46 | 3125 15651064 530675 530675 47 | }; 48 | 49 | % LT4LA 50 | \addplot+ [ 51 | ForestGreen, 52 | mark options={fill=ForestGreen}, 53 | error bars/.cd, y dir=both, y explicit, 54 | ] table [ 55 | y error plus=ey+, 56 | y error minus=ey-, 57 | ] { 58 | x y ey+ ey- 59 | 5 41 1 1 60 | 25 133 2 2 61 | 125 1678 36 33 62 | 625 180575 38386 38386 63 | 3125 16061291 193746 193746 64 | }; 65 | 66 | \legend{CBLAS,LT4LA} 67 | 68 | \end{axis} 69 | \end{tikzpicture} 70 | -------------------------------------------------------------------------------- /write-up/dissertation/timings.txt: -------------------------------------------------------------------------------- 1 | ############################################# 2 | 3 | Alg = CBLAS 4 | 5 | Size N Mean (us) Sample Err+ Err- R^2 6 | ------ --------- ------ ------- -------- ---- 7 | 5 24 526 0 -0 1.00 8 | 25 104 370 1 -1 0.98 9 | 125 1803 104 64 -57 0.91 10 | 625 187667 1000 36281 -36281 N/A 11 | 3125 15651064 15 530675 -530675 N/A 12 | 13 | ############################################## 14 | 15 | Alg = LT4LA 16 | 17 | Size N Mean (us) Sample Err+ Err- R^2 18 | ------ --------- ------ ------- -------- ---- 19 | 5 41 466 1 -1 0.98 20 | 25 133 343 2 -2 0.97 21 | 125 1678 109 36 -33 0.97 22 | 625 180575 1000 38386 -38386 N/A 23 | 3125 16061291 15 193746 -193746 N/A 24 | 25 | ############################################## 26 | 27 | Alg = Chol 28 | 29 | Size N Mean (us) Sample Err+ Err- R^2 30 | ------ --------- ------ ------- -------- ---- 31 | 5 52 448 1 -1 0.98 32 | 25 128 347 1 -1 0.98 33 | 125 1583 112 95 -75 0.74 34 | 625 125526 1000 25502 -25502 N/A 35 | 3125 11210982 15 852463 -852463 N/A 36 | 37 | ############################################## 38 | 39 | Alg = Owl 40 | 41 | Size N Mean (us) Sample Err+ Err- R^2 42 | ------ --------- ------ ------- -------- ---- 43 | 5 53 444 1 -1 0.97 44 | 25 95 379 0 -0 1.00 45 | 125 1488 116 27 -24 0.97 46 | 625 146150 1000 32346 -32346 N/A 47 | 3125 12108640 15 466381 -466381 N/A 48 | 49 | ############################################## 50 | -------------------------------------------------------------------------------- /write-up/dissertation/timings2.txt: -------------------------------------------------------------------------------- 1 | ############################################# 2 | 3 | N = 5 4 | 5 | Alg Mean (us) Sample Err+ Err- R^2 6 | ------ --------- ------ ------- -------- ---- 7 | CBLAS 24 526 0 -0 1.00 8 | LT4LA 41 466 1 -1 0.98 9 | Chol 52 448 1 -1 0.98 10 | Owl 53 444 1 -1 0.97 11 | 12 | ############################################# 13 | 14 | N = 25 15 | 16 | Alg Mean (us) Sample Err+ Err- R^2 17 | ------ --------- ------ ------- -------- ---- 18 | CBLAS 104 370 1 -1 0.98 19 | LT4LA 133 343 2 -2 0.97 20 | Chol 128 347 1 -1 0.98 21 | Owl 95 379 0 -0 1.00 22 | 23 | ############################################# 24 | 25 | N = 125 26 | 27 | Alg Mean (us) Sample Err+ Err- R^2 28 | ------ --------- ------ ------- -------- ---- 29 | CBLAS 1803 104 64 -57 0.91 30 | LT4LA 1678 109 36 -33 0.97 31 | Chol 1583 112 95 -75 0.74 32 | Owl 1488 116 27 -24 0.97 33 | 34 | ############################################# 35 | 36 | N = 625 37 | 38 | Alg Mean (us) Sample Err+ Err- R^2 39 | ------ --------- ------ ------- -------- ---- 40 | CBLAS 187667 1000 36281 -36281 N/A 41 | LT4LA 180575 1000 38386 -38386 N/A 42 | Chol 125526 1000 25502 -25502 N/A 43 | Owl 146150 1000 32346 -32346 N/A 44 | 45 | ############################################## 46 | 47 | N = 3125 48 | 49 | Alg Mean (us) Sample Err+ Err- R^2 50 | ------ --------- ------ ------- -------- ---- 51 | CBLAS 15651064 15 530675 -530675 N/A 52 | LT4LA 16061291 15 193746 -193746 N/A 53 | Chol 11210982 15 852463 -852463 N/A 54 | Owl 12108640 15 466381 -466381 N/A 55 | -------------------------------------------------------------------------------- /write-up/dissertation/timings_all.tex: -------------------------------------------------------------------------------- 1 | \begin{tikzpicture}[trim axis left] 2 | \begin{axis}[ 3 | % width of chart 4 | width=\textwidth, 5 | height=0.8\textheight, 6 | % no box, below chart, horizontal 7 | legend style={% 8 | draw=none, 9 | at={(0.5,-0.15)}, 10 | anchor=north, 11 | legend columns=4, 12 | column sep = 1em, 13 | cells={align=center}, 14 | }, 15 | % log ticks with fixed point, 16 | % yticklabel={\pgfmathparse{pow(10,\tick-3)}\pgfmathprintnumber[fixed]{\pgfmathresult}}\,ms, % N ms along y-axis 17 | % xticklabel={\pgfmathparse{pow(5,\tick)}\pgfmathprintnumber[fixed]{\pgfmathresult}}, 18 | xlabel near ticks, 19 | xlabel={Matrix size $n$ (for a Kalman filter, with $k=3n/5$)}, 20 | ylabel near ticks, 21 | ylabel={Execution time of one call to Kalman filter ($\mu$s)}, 22 | xmode = log, 23 | log basis x = {5}, 24 | axis line style={opacity=0}, % hide y axis 25 | major tick style={draw=none}, % no ticks 26 | ymode=log, % log scale for y 27 | log basis y = {10}, % log base 10 28 | ymajorgrids, % rows of lines 29 | major grid style={gray, line width=1pt}, 30 | ] 31 | 32 | % CBLAS 33 | \addplot+ [ 34 | violet, 35 | mark options={fill=violet}, 36 | error bars/.cd, y dir=both, y explicit, 37 | ] table [ 38 | y error plus=ey+, 39 | y error minus=ey-, 40 | ] { 41 | x y ey+ ey- 42 | 5 24 0 0 43 | 25 104 1 1 44 | 125 1803 64 57 45 | 625 187667 36281 36281 46 | 3125 15651064 530675 530675 47 | }; 48 | 49 | % LT4LA 50 | \addplot+ [ 51 | ForestGreen, 52 | mark options={fill=ForestGreen}, 53 | error bars/.cd, y dir=both, y explicit, 54 | ] table [ 55 | y error plus=ey+, 56 | y error minus=ey-, 57 | ] { 58 | x y ey+ ey- 59 | 5 41 1 1 60 | 25 133 2 2 61 | 125 1678 36 33 62 | 625 180575 38386 38386 63 | 3125 16061291 193746 193746 64 | }; 65 | 66 | % Chol 67 | \addplot+ [ 68 | red, 69 | mark options={fill=red}, 70 | error bars/.cd, y dir=both, y explicit, 71 | ] table [ 72 | y error plus=ey+, 73 | y error minus=ey-, 74 | ] { 75 | x y ey+ ey- 76 | 5 52 1 1 77 | 25 128 1 1 78 | 125 1583 95 75 79 | 625 125526 25502 25502 80 | 3125 11210982 852463 852463 81 | }; 82 | 83 | % Owl 84 | \addplot+ [ 85 | Blue, 86 | mark options={fill=Blue}, 87 | error bars/.cd, y dir=both, y explicit, 88 | ] table [ 89 | y error plus=ey+, 90 | y error minus=ey-, 91 | ] { 92 | x y ey+ ey- 93 | 5 53 1 1 94 | 25 95 0 0 95 | 125 1488 27 24 96 | 625 146150 32346 32346 97 | 3125 12108640 466381 466381 98 | }; 99 | 100 | 101 | 102 | \legend{CBLAS,LT4LA,Chol,Owl} 103 | 104 | \end{axis} 105 | \end{tikzpicture} 106 | -------------------------------------------------------------------------------- /write-up/dissertation/titlepage.tex: -------------------------------------------------------------------------------- 1 | % title page information 2 | \begin{titlepage} 3 | 4 | \begin{center} 5 | \noindent 6 | \huge 7 | \dissertationtitle \\ 8 | \vspace*{\stretch{1}} 9 | \end{center} 10 | 11 | \begin{center} 12 | \noindent 13 | \huge 14 | \authorname \\ 15 | \Large 16 | \authorcollege \\[24pt] 17 | \includegraphics{CUni3.eps} 18 | \end{center} 19 | 20 | \vspace{24pt} 21 | 22 | \begin{center} 23 | \noindent 24 | \large 25 | {\it A dissertation submitted to the University of Cambridge \\ 26 | in partial fulfilment of the requirements for the\\ 27 | Computer Science Tripos, Part III} 28 | \vspace*{\stretch{1}} 29 | \end{center} 30 | 31 | \begin{center} 32 | \noindent 33 | University of Cambridge \\ 34 | Department of Computer Science and Technology \\ 35 | William Gates Building \\ 36 | 15 JJ Thomson Avenue \\ 37 | Cambridge CB3 0FD \\ 38 | {\sc United Kingdom} \\ 39 | \end{center} 40 | 41 | \begin{center} 42 | \noindent 43 | Email: \authoremail \\ 44 | \end{center} 45 | 46 | \begin{center} 47 | \noindent 48 | May 29, 2018 49 | \end{center} 50 | 51 | \end{titlepage} 52 | 53 | \cleardoublepage% 54 | -------------------------------------------------------------------------------- /write-up/dissertation/trace.txt: -------------------------------------------------------------------------------- 1 | Chol Owl LT4LA TRANSP 2 | --- --- --- --- 3 | empty empty empty empty 4 | _mtrsp _mtrsp symm _mtrsp 5 | empty empty gemm empty 6 | gemm gemm gemm symm 7 | empty empty _owl_copy gemm 8 | gemm gemm empty gemm 9 | empty empty _owl_copy _owl_copy 10 | _owl_copy _owl_copy potrf empty 11 | _owl_add _owl_add potrs empty 12 | empty empty potrs _owl_copy 13 | _owl_copy _owl_copy empty potrf 14 | potrf getrf gemm potrs 15 | empty getri empty potrs 16 | _owl_copy empty gemm empty 17 | _owl_copy gemm empty gemm 18 | _owl_copy empty _owl_copy empty 19 | empty gemm symm gemm 20 | gemm empty empty empty 21 | empty _owl_copy symm _owl_copy 22 | _owl_copy _owl_sub _owl_copy symm 23 | potrs empty symm empty 24 | empty gemm symm 25 | gemm empty _owl_copy 26 | empty _owl_copy symm 27 | _owl_copy _owl_add 28 | _owl_sub empty 29 | empty gemm 30 | gemm empty 31 | empty gemm 32 | _owl_copy empty 33 | _owl_sub _owl_copy 34 | empty _owl_sub 35 | _owl_copy 36 | potrs 37 | empty 38 | gemm 39 | empty 40 | _owl_copy 41 | _owl_add 42 | 43 | 44 | -------------------------------------------------------------------------------- /write-up/paper.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dc-mak/NumLin/9f19783f52f9258aefccec4c466ccb1ffad5c8e5/write-up/paper.pdf -------------------------------------------------------------------------------- /write-up/paper/appendix.tex: -------------------------------------------------------------------------------- 1 | \section{\lang\ Specification} 2 | 3 | \ottstyledefaults{premiselayout=justify}% 4 | \subsection{Static Semantics}\label{subsec:static_sem} 5 | \ottdefnsTypes% 6 | 7 | \subsection{Dynamic Semantics}\label{subsec:dyn_sem} 8 | \ottdefnsOpXXSem% 9 | 10 | \clearpage 11 | \input{../semantics/interpretation} 12 | 13 | \input{../semantics/lemmas} 14 | 15 | \input{../semantics/soundness} 16 | 17 | \subsection{Well-formed types} 18 | \ottdefnsWellXXFormed% 19 | 20 | \section{\lang\ Grammar}\label{sec:grammar_def} 21 | \ottgrammar% 22 | 23 | \clearpage 24 | \section{Primitives}\label{subsec:primitives} 25 | 26 | \vspace*{\fill} 27 | \begin{center} 28 | \begin{minted}[fontsize=\small]{ocaml} 29 | module Arr = Owl.Dense.Ndarray.D 30 | type z = Z 31 | type 'a s = Succ 32 | type 'a arr = A of Arr.arr [@@unboxed] 33 | type 'a mat = M of Arr.arr [@@unboxed] 34 | type 'a bang = Many of 'a [@@unboxed] 35 | module Prim : 36 | sig 37 | val extract : 'a bang -> 'a 38 | (** Boolean *) 39 | val not_ : bool bang -> bool bang 40 | (** Arithmetic, many omitted for brevity *) 41 | val addI : int bang -> int bang -> int bang 42 | val eqI : int bang -> int bang -> bool bang 43 | (** Arrays *) 44 | val set : z arr -> int bang -> float bang -> z arr 45 | val get : 'a arr -> int bang -> 'a arr * float bang 46 | val share : 'a arr -> 'a s arr * 'a s arr 47 | val unshare : 'a s arr -> 'a s arr -> 'a arr 48 | val free : z arr -> unit 49 | (** Owl *) 50 | val array : int bang -> z arr 51 | val copy : 'a arr -> 'a arr * z arr 52 | val sin : z arr -> z arr 53 | val hypot : z arr -> 'a arr -> 'a arr * z arr 54 | (** Level 1 BLAS *) 55 | val asum : 'a arr -> 'a arr * float bang 56 | val axpy : float bang -> 'a arr -> z arr -> 'a arr * z arr 57 | val dot : 'a arr -> 'b arr -> ('a arr * 'b arr) * float bang 58 | val scal : float bang -> z arr -> z arr 59 | val amax : 'a arr -> 'a arr * int bang 60 | (* Matrix, some omitted for brevity *) 61 | val matrix : int bang -> int bang -> z mat 62 | val eye : int bang -> z mat 63 | val copy_mat : 'a mat -> 'a mat * z mat 64 | val copy_mat_to : 'a mat -> z mat -> 'a mat * z mat 65 | val size_mat : 'a mat -> 'a mat * (int bang * int bang) 66 | val transpose : 'a mat -> 'a mat * z mat 67 | (* Level 3 BLAS/LAPACK *) 68 | val gemm : float bang -> ('a mat * bool bang) -> ('b mat * bool bang) -> 69 | float bang -> z mat -> ('a mat * 'b mat) * z mat 70 | val symm : bool bang -> float bang -> 'a mat -> 'b mat -> float bang -> 71 | z mat -> ('a mat * 'b mat) * z mat 72 | val gesv : z mat -> z mat -> z mat * z mat 73 | val posv : z mat -> z mat -> z mat * z mat 74 | val potrs : 'a mat -> z mat -> 'a mat * z mat 75 | val syrk : bool bang -> float bang -> 'a mat -> float bang -> z mat -> 76 | 'a mat * z mat 77 | end 78 | \end{minted} 79 | \end{center} 80 | \vfill 81 | 82 | \clearpage 83 | \section{Kalman Filters from \lang\ and C} 84 | 85 | \begin{figure}[h] 86 | \begin{center} 87 | \begin{minted}[fontsize=\footnotesize]{ocaml} 88 | let kalman sigma h mu r_1 data_1 = 89 | let h, _p_k_n_p_ = Prim.size_mat h in 90 | let k, n = _p_k_n_p_ in 91 | let sigma_hT = Prim.matrix n k in 92 | let (sigma, h), sigma_hT = 93 | Prim.gemm (Many 1.) (sigma, Many false) (h, Many true) (Many 0.) sigma_hT in 94 | let (h, sigma_hT), r_2 = 95 | Prim.gemm (Many 1.) (h, Many false) (sigma_hT, Many false) (Many 1.) r_1 in 96 | let k_by_k, x = Prim.posv_flip r_2 sigma_hT in 97 | let (h, mu), data_2 = 98 | Prim.gemm (Many 1.) (h, Many false) (mu, Many false) (Many (-1.)) data_1 in 99 | let (x, data_2), new_mu = 100 | Prim.gemm (Many 1.) (x, Many false) (data_2, Many false) (Many 1.) mu in 101 | let x_h = Prim.matrix n n in 102 | let (x, h), x_h = 103 | Prim.gemm (Many 1.) (x, Many false) (h, Many false) (Many 0.) x_h in 104 | let () = Prim.free_mat x in 105 | let sigma, sigma2 = Prim.copy_mat sigma in 106 | let (sigma, x_h), new_sigma = 107 | Prim.symm (Many true) (Many (-1.)) sigma x_h (Many 1.) sigma2 in 108 | let () = Prim.free_mat x_h in 109 | ((sigma, h), (new_sigma, (new_mu, (k_by_k, data_2)))) 110 | \end{minted} 111 | \caption{OCaml code for a Kalman filter, generated (at \emph{compile time}) 112 | from the code in Figure~\ref{fig:lang_kalman}, passed through 113 | \texttt{ocamlformat} for presentation.}\label{fig:ocaml_kalman} 114 | 115 | \vspace{\baselineskip} 116 | 117 | \begin{minted}[fontsize=\footnotesize]{c} 118 | static void kalman( const int n, const int k, 119 | const double *sigma, /* n,n */ const double *h, /* k,n */ 120 | const double *mu, /* n,1 */ double *r, /* k,k */ 121 | double *data, /* k,1 */ double **ret_sigma /* n,n */ ) { 122 | double* n_by_k = (double *) malloc(n * k * sizeof(double)); 123 | cblas_dgemm(RowMajor, NoTrans, Trans, n, k, n, 1., sigma, n, h, n, 0., n_by_k, k); 124 | cblas_dgemm(RowMajor, NoTrans, NoTrans, k, k, n, 1., h, n, n_by_k, k, 1., r, k); 125 | LAPACKE_dposv(LAPACK_COL_MAJOR, 'U', k, n, r, k, n_by_k, k); 126 | cblas_dgemm(RowMajor, NoTrans, NoTrans, k, 1, n, 1., h, n, mu, 1, -1., data, 1); 127 | cblas_dgemm(RowMajor, NoTrans, NoTrans, n, 1, k, 1., n_by_k, k, data, 1, 1., mu, 1); 128 | double* n_by_n = (double *) malloc(n * n * sizeof(double)); 129 | cblas_dgemm(RowMajor, NoTrans, NoTrans, n, n, k, 1., n_by_k, k, h, n, 0., n_by_n, n); 130 | free(n_by_k); 131 | double* n_by_n2 = (double *) malloc(n * n * sizeof(double)); 132 | cblas_dcopy(n*n, sigma, 1, n_by_n2, 1); 133 | cblas_dsymm(RowMajor, Right, Upper, n, n, -1., sigma, n, n_by_n, n, 1., n_by_n2, n); 134 | free(n_by_n); 135 | *ret_sigma = n_by_n2; } 136 | \end{minted} 137 | \caption{\textsc{Cblas/Lapacke} implementation of a Kalman filter. I used C instead 138 | of Fortran because it is what Owl uses under the hood and OCaml FFI 139 | support for C is better and easier to use than that for Fortran. A distinct 140 | `measure\_kalman' function that sandwiches a call to this function with 141 | \texttt{getrusage} is omitted for brevity.}\label{fig:cblas_kalman} 142 | 143 | \end{center} 144 | \end{figure} 145 | 146 | -------------------------------------------------------------------------------- /write-up/paper/cc-by.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dc-mak/NumLin/9f19783f52f9258aefccec4c466ccb1ffad5c8e5/write-up/paper/cc-by.pdf -------------------------------------------------------------------------------- /write-up/paper/fig1-eps-converted-to.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dc-mak/NumLin/9f19783f52f9258aefccec4c466ccb1ffad5c8e5/write-up/paper/fig1-eps-converted-to.pdf -------------------------------------------------------------------------------- /write-up/paper/fig1.eps: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dc-mak/NumLin/9f19783f52f9258aefccec4c466ccb1ffad5c8e5/write-up/paper/fig1.eps -------------------------------------------------------------------------------- /write-up/paper/impl_build.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dc-mak/NumLin/9f19783f52f9258aefccec4c466ccb1ffad5c8e5/write-up/paper/impl_build.png -------------------------------------------------------------------------------- /write-up/paper/intro.tex: -------------------------------------------------------------------------------- 1 | \section{Introduction} 2 | 3 | Programmers writing numerical software often find themselves caught on 4 | the horns of a dilemma. The foundational, low-level linear algebra 5 | libraries such as BLAS and LAPACK offer programmers very precise 6 | control over the memory lifetime and usage of vector and matrix 7 | values. However, this power comes paired with the responsibility to 8 | manually manage the memory, lifetimes, aliasing and sharing of each array 9 | object: concerns similar to those that plague low-level systems 10 | programming. It also moves the APIs away from the linear-algebraic, 11 | mathematical style of thinking that numerical programmers want to use. 12 | 13 | As a result, programmers often turn to higher-level languages such as 14 | Matlab, R and NumPy, which offer very high-level array abstractions 15 | that can be viewed as ordinary mathematical values. This makes 16 | programming safer, as well as making prototyping and verification much 17 | easier, since it lets programmers write programs which bear a closer 18 | resemblance to the formulas that the mathematicians and statisticians 19 | designing these algorithms prefer to work with, and ensures that 20 | program bugs will reflect incorrectly-computed values rather than heap 21 | corruption. 22 | 23 | The intention is that these languages can use libraries BLAS and 24 | LAPACK, without having to expose programmers to explicit memory 25 | management. However, this benefit comes at a price: because user 26 | programs do not worry about aliasing, the language implementations 27 | cannot in general exploit the underlying features of the low-level 28 | libraries that let them explicitly manage and reuse memory. As a 29 | result, programs written in high-level statistical languages can 30 | be much less memory-efficient than programs that make full use 31 | of the powers the low-level APIs offer. 32 | 33 | So in practice, programmers face a trade-off: they can eschew safety 34 | and exploit the full power of the underlying linear algebra libraries, 35 | or they can obtain safety at the price of unneeded copies and worse 36 | memory efficiency. In this work, we show that this trade-off is not a 37 | fundamental one. 38 | 39 | \lang\ is a functional programming language whose type system is 40 | designed to enforce the safe usage of the APIs of low-level linear algebra 41 | libraries (such as BLAS/LAPACK). It does so by combining linear types, 42 | fractional permissions, runtime errors and recursion into a small, easily 43 | understandable, yet expressive set of core constructs. 44 | 45 | \lang\ allows a novice to understand and work with complicated linear 46 | algebra library APIs, as well as point out subtle aliasing bugs and 47 | reduce memory usage in existing programs. In fact, we were able to use 48 | \lang\ to find linearity and aliasing bugs in a linear algebra 49 | algorithm that was \emph{generated} by another program 50 | \emph{specifically designed to translate matrix expressions into an 51 | efficient sequence of calls to linear algebra routines}. We were 52 | also able to reduce the number of temporaries used by the same 53 | algorithm, using \lang's type system to guide us. 54 | 55 | \lang's implementation supports several syntactic conveniences as well as a 56 | \emph{usable} integration with real OCaml libraries. 57 | 58 | \subsection{Contributions} 59 | 60 | Our contribution is the idea applying of linear types with fractional 61 | permissions to enforce the correct \emph{usage} (as opposed to 62 | \emph{implementation}) of linear algebra libraries. We explain the idea in 63 | detail and provide evidence for its efficacy. Prior type systems for fractional 64 | permissions \cite{boyland2003, bierhoff, bierhoff2008plural} are quite complex. 65 | This is because these type systems typically encode a sophisticated analysis to 66 | automatically infer how fractional permissions should be split and rejoined. 67 | 68 | In contrast, in \lang, we made sharing and merging explicit. As a result, we 69 | were able to drastically simplify the type system. Thefore, our formal system 70 | is very close to standard presentations of linear logic, and the implementation 71 | complexity is no worse than that for parametric polymorphism. 72 | 73 | In this paper 74 | \begin{itemize} 75 | \item we describe \lang, a linearly typed language for linear algebra programs 76 | \item we illustrate that \lang's design and features are well-suited to its 77 | intended domain with progressively sophisticated examples 78 | \item we prove \lang's soundness, using a step-indexed logical relation 79 | \item we describe a very simple, unification based type-inference algorithm 80 | for polymorphic fractional permissions (similar to ones used for 81 | parametric polymorphism), demonstrating an alternative approach to 82 | dataflow analysis \cite{bierhoff} 83 | \item we describe an implementation that is compatible with and usable 84 | from existing code 85 | \item we show an example of how using \lang\ helped highlight linearity 86 | and aliasing bugs, and reduce the memory usage of a \emph{generated} 87 | linear algebra program 88 | \item we show that using \lang, we can achieve parity with C for linear 89 | algebra routines, whilst having much better static guarantees about the 90 | linearity and aliasing behaviour of our programs. 91 | \end{itemize} 92 | 93 | -------------------------------------------------------------------------------- /write-up/paper/kalman_timings.tex: -------------------------------------------------------------------------------- 1 | \begin{tikzpicture}[trim axis left] 2 | \begin{axis}[ 3 | % width of chart 4 | width=\textwidth, 5 | height=0.4\textheight, 6 | % no box, below chart, horizontal 7 | legend style={% 8 | draw=none, 9 | at={(0.5,-0.15)}, 10 | anchor=north, 11 | legend columns=4, 12 | column sep = 1em, 13 | cells={align=center}, 14 | }, 15 | % log ticks with fixed point, 16 | % yticklabel={\pgfmathparse{pow(10,\tick-3)}\pgfmathprintnumber[fixed]{\pgfmathresult}}\,ms, % N ms along y-axis 17 | % xticklabel={\pgfmathparse{pow(5,\tick)}\pgfmathprintnumber[fixed]{\pgfmathresult}}, 18 | xlabel near ticks, 19 | xlabel={Matrix size $n$ (for a Kalman filter, with $k=3n/5$)}, 20 | ylabel near ticks, 21 | ylabel={Execution time of one call to Kalman filter ($\mu$s)}, 22 | xmode = log, 23 | log basis x = {5}, 24 | axis line style={opacity=0}, % hide y axis 25 | major tick style={draw=none}, % no ticks 26 | ymode=log, % log scale for y 27 | log basis y = {10}, % log base 10 28 | ymajorgrids, % rows of lines 29 | major grid style={gray, line width=1pt}, 30 | ] 31 | 32 | % CBLAS 33 | \addplot+ [ 34 | violet, 35 | mark options={fill=violet}, 36 | error bars/.cd, y dir=both, y explicit, 37 | ] table [ 38 | y error plus=ey+, 39 | y error minus=ey-, 40 | ] { 41 | x y ey+ ey- 42 | 5 20 0 -0 43 | 25 70 1 -1 44 | 125 1118 33 -32 45 | 625 112024 35726 -35726 46 | 3125 10794507 671827 -671827 47 | }; 48 | 49 | % LT4LA 50 | \addplot+ [ 51 | ForestGreen, 52 | mark options={fill=ForestGreen}, 53 | error bars/.cd, y dir=both, y explicit, 54 | ] table [ 55 | y error plus=ey+, 56 | y error minus=ey-, 57 | ] { 58 | x y ey+ ey- 59 | 5 53 0 -0 60 | 25 127 16 -11 61 | 125 1169 20 -18 62 | 625 105381 24608 -24608 63 | 3125 11976659 1269467 -1269467 64 | }; 65 | 66 | % Owl 67 | \addplot+ [ 68 | Blue, 69 | mark options={fill=Blue}, 70 | error bars/.cd, y dir=both, y explicit, 71 | ] table [ 72 | y error plus=ey+, 73 | y error minus=ey-, 74 | ] { 75 | x y ey+ ey- 76 | 5 109 1 -1 77 | 25 157 1 -1 78 | 125 1637 30 -23 79 | 625 124221 38149 -38149 80 | 3125 13326557 214388 -214388 81 | }; 82 | 83 | % NumPy 84 | \addplot+ [ 85 | red, 86 | mark options={fill=red}, 87 | error bars/.cd, y dir=both, y explicit, 88 | ] table [ 89 | y error plus=ey+, 90 | y error minus=ey-, 91 | ] { 92 | x y ey+ ey- 93 | 5 293 17 -14 94 | 25 355 11 -10 95 | 125 1627 23 -20 96 | 625 112469 11677 -11677 97 | 3125 12702242 638344 -638344 98 | }; 99 | 100 | \legend{\textsc{Cblas},\lang,\textsc{Owl},\textsc{NumPy}} 101 | 102 | \end{axis} 103 | \end{tikzpicture} 104 | -------------------------------------------------------------------------------- /write-up/paper/l1_norm_min_timings.tex: -------------------------------------------------------------------------------- 1 | \begin{tikzpicture}[trim axis left] 2 | \begin{axis}[ 3 | % width of chart 4 | width=\textwidth, 5 | height=0.4\textheight, 6 | % no box, below chart, horizontal 7 | legend style={% 8 | draw=none, 9 | at={(0.5,-0.15)}, 10 | anchor=north, 11 | legend columns=4, 12 | column sep = 1em, 13 | cells={align=center}, 14 | }, 15 | % log ticks with fixed point, 16 | % yticklabel={\pgfmathparse{pow(10,\tick-3)}\pgfmathprintnumber[fixed]{\pgfmathresult}}\,ms, % N ms along y-axis 17 | % xticklabel={\pgfmathparse{pow(5,\tick)}\pgfmathprintnumber[fixed]{\pgfmathresult}}, 18 | xlabel near ticks, 19 | xlabel={Matrix size $n$}, 20 | ylabel near ticks, 21 | ylabel={Execution time of one call to L1-norm minimisation ($\mu$s)}, 22 | xmode = log, 23 | log basis x = {5}, 24 | axis line style={opacity=0}, % hide y axis 25 | major tick style={draw=none}, % no ticks 26 | ymode=log, % log scale for y 27 | log basis y = {10}, % log base 10 28 | ymajorgrids, % rows of lines 29 | major grid style={gray, line width=1pt}, 30 | ] 31 | 32 | % LT4LA 33 | \addplot+ [ 34 | ForestGreen, 35 | mark options={fill=ForestGreen}, 36 | error bars/.cd, y dir=both, y explicit, 37 | ] table [ 38 | y error plus=ey+, 39 | y error minus=ey-, 40 | ] { 41 | x y ey+ ey- 42 | 5 44 1 -1 43 | 25 146 2 -2 44 | 125 2357 31 -26 45 | 625 129910 36616 -36616 46 | 3125 11206923 272380 -272380 47 | }; 48 | 49 | % Owl 50 | \addplot+ [ 51 | Blue, 52 | mark options={fill=Blue}, 53 | error bars/.cd, y dir=both, y explicit, 54 | ] table [ 55 | y error plus=ey+, 56 | y error minus=ey-, 57 | ] { 58 | x y ey+ ey- 59 | 5 70 0 -0 60 | 25 221 3 -3 61 | 125 3114 58 -52 62 | 625 163943 16789 -16789 63 | 3125 16397765 3452667 -3452667 64 | }; 65 | 66 | % NumPy 67 | \addplot+ [ 68 | red, 69 | mark options={fill=red}, 70 | error bars/.cd, y dir=both, y explicit, 71 | ] table [ 72 | y error plus=ey+, 73 | y error minus=ey-, 74 | ] { 75 | x y ey+ ey- 76 | 5 204 5 -4 77 | 25 306 6 -6 78 | 125 3156 127 -146 79 | 625 146608 29089 -29089 80 | 3125 12525704 906730 -906730 81 | }; 82 | 83 | \legend{\lang,\textsc{Owl},\textsc{NumPy}} 84 | 85 | \end{axis} 86 | \end{tikzpicture} 87 | -------------------------------------------------------------------------------- /write-up/paper/lin_reg_timings.tex: -------------------------------------------------------------------------------- 1 | \begin{tikzpicture}[] 2 | \begin{axis}[ 3 | % width of chart 4 | width=\textwidth, 5 | height=0.4\textheight, 6 | % no box, below chart, horizontal 7 | legend style={% 8 | draw=none, 9 | at={(0.5,-0.15)}, 10 | anchor=north, 11 | legend columns=4, 12 | column sep = 1em, 13 | cells={align=center}, 14 | }, 15 | % log ticks with fixed point, 16 | % yticklabel={\pgfmathparse{pow(10,\tick-3)}\pgfmathprintnumber[fixed]{\pgfmathresult}}\,ms, % N ms along y-axis 17 | % xticklabel={\pgfmathparse{pow(5,\tick)}\pgfmathprintnumber[fixed]{\pgfmathresult}}, 18 | xlabel near ticks, 19 | xlabel={Matrix size $n$}, 20 | ylabel near ticks, 21 | yticklabel pos=right, 22 | ylabel={Execution time of one call to $\mathbf{(X^T X)^{-1} X^T y}$ ($\mu$s)}, 23 | xmode = log, 24 | log basis x = {5}, 25 | axis line style={opacity=0}, % hide y axis 26 | major tick style={draw=none}, % no ticks 27 | ymode=log, % log scale for y 28 | log basis y = {10}, % log base 10 29 | ymajorgrids, % rows of lines 30 | major grid style={gray, line width=1pt}, 31 | ] 32 | 33 | % LT4LA 34 | \addplot+ [ 35 | ForestGreen, 36 | mark options={fill=ForestGreen}, 37 | error bars/.cd, y dir=both, y explicit, 38 | ] table [ 39 | y error plus=ey+, 40 | y error minus=ey-, 41 | ] { 42 | x y ey+ ey- 43 | 5 18 0 -0 44 | 25 30 0 -0 45 | 125 300 8 -7 46 | 625 12566 4786 -4786 47 | 3125 934711 43029 -43029 48 | }; 49 | 50 | % Owl 51 | \addplot+ [ 52 | Blue, 53 | mark options={fill=Blue}, 54 | error bars/.cd, y dir=both, y explicit, 55 | ] table [ 56 | y error plus=ey+, 57 | y error minus=ey-, 58 | ] { 59 | x y ey+ ey- 60 | 5 37 0 -0 61 | 25 69 0 -0 62 | 125 856 9 -8 63 | 625 45861 11078 -11078 64 | 3125 3976019 108600 -108600 65 | }; 66 | 67 | % NumPy 68 | \addplot+ [ 69 | red, 70 | mark options={fill=red}, 71 | error bars/.cd, y dir=both, y explicit, 72 | ] table [ 73 | y error plus=ey+, 74 | y error minus=ey-, 75 | ] { 76 | x y ey+ ey- 77 | 5 95 2 -2 78 | 25 124 3 -2 79 | 125 658 26 -18 80 | 625 34295 4956 -4956 81 | 3125 3134875 213123 -213123 82 | }; 83 | 84 | \legend{\lang,\textsc{Owl},\textsc{NumPy}} 85 | 86 | \end{axis} 87 | \end{tikzpicture} 88 | -------------------------------------------------------------------------------- /write-up/paper/lipics-logo-bw.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dc-mak/NumLin/9f19783f52f9258aefccec4c466ccb1ffad5c8e5/write-up/paper/lipics-logo-bw.pdf -------------------------------------------------------------------------------- /write-up/paper/orcid.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dc-mak/NumLin/9f19783f52f9258aefccec4c466ccb1ffad5c8e5/write-up/paper/orcid.pdf -------------------------------------------------------------------------------- /write-up/paper/other.bib: -------------------------------------------------------------------------------- 1 | @misc{retrofitting, 2 | title={Retrofitting Linear Types}, 3 | author={Bernardy, Jean-Philippe and Boespflug, Mathieu and Newton, Ryan R 4 | and Jones, Simon Peyton and Spiwack, Arnaud}, 5 | year={2017} 6 | } 7 | 8 | @misc{owl, 9 | title={Owl - An OCaml Numerical Library}, 10 | author={Liang Wang}, 11 | howpublished={\url{https://github.com/ryanrhymes/owl}}, 12 | note={Accessed: 20/11/2017} 13 | } 14 | 15 | @misc{ublas, 16 | title={Boost uBLAS}, 17 | howpublished={\url{http://www.boost.org/doc/libs/1_65_1/libs/numeric/ublas/doc/operations_overview.html}}, 18 | note={Accessed: 20/11/2017} 19 | } 20 | 21 | @misc{blas, 22 | title={BLAS (Basic Linear Algebra Subprograms)}, 23 | howpublished={\url{http://www.netlib.org/blas/}}, 24 | note={Accessed: 20/11/2017} 25 | } 26 | 27 | @misc{sewell_ott, 28 | title={Ott}, 29 | howpublished={\url{http://www.cl.cam.ac.uk/~pes20/ott/}}, 30 | note={Accessed: 29/04/2018} 31 | } 32 | 33 | @book{pierce2005advanced, 34 | title={Advanced topics in types and programming languages}, 35 | author={Pierce, Benjamin C}, 36 | year={2005}, 37 | publisher={MIT press} 38 | } 39 | 40 | @misc{rocklin_gist, 41 | title={Kalman Filter in BLAS/LAPACK Fortran}, 42 | howpublished={\url{https://gist.github.com/mrocklin/5144149\#file-kalman-f90.raw}}, 43 | author={Matthew Rocklin}, 44 | year={2018} 45 | } 46 | 47 | @article{girard, 48 | title={Linear logic}, 49 | author={Girard, Jean-Yves}, 50 | journal={Theoretical computer science}, 51 | volume={50}, 52 | number={1}, 53 | pages={1--101}, 54 | year={1987}, 55 | publisher={Elsevier} 56 | } 57 | 58 | @inproceedings{petricek, 59 | title={Coeffects: Unified static analysis of context-dependence}, 60 | author={Petricek, Tomas and Orchard, Dominic and Mycroft, Alan}, 61 | booktitle={International Colloquium on Automata, Languages, and Programming}, 62 | pages={385--397}, 63 | year={2013}, 64 | organization={Springer} 65 | } 66 | 67 | @article{atkey, 68 | title={The Syntax and Semantics of Quantitative Type Theory.(2017)}, 69 | author={Atkey, Robert}, 70 | journal={Under submission}, 71 | year={2017} 72 | } 73 | 74 | @inproceedings{hoffmann, 75 | title={Resource aware ML}, 76 | author={Hoffmann, Jan and Aehlig, Klaus and Hofmann, Martin}, 77 | booktitle={International Conference on Computer Aided Verification}, 78 | pages={781--786}, 79 | year={2012}, 80 | organization={Springer} 81 | } 82 | 83 | @article{fabregat_thesis, 84 | title={Knowledge-Based Automatic Generation of Linear Algebra Algorithms and Code}, 85 | author={Fabregat-Traver, Diego}, 86 | journal={arXiv preprint arXiv:1404.3406}, 87 | year={2014} 88 | } 89 | 90 | @article{gunnels_flame, 91 | title={FLAME: Formal linear algebra methods environment}, 92 | author={Gunnels, John A and Gustavson, Fred G and Henry, Greg M and Van De Geijn, Robert A}, 93 | journal={ACM Transactions on Mathematical Software (TOMS)}, 94 | volume={27}, 95 | number={4}, 96 | pages={422--455}, 97 | year={2001}, 98 | publisher={ACM} 99 | } 100 | 101 | @inproceedings{linnea, 102 | author = "Henrik Barthels and Paolo Bientinesi", 103 | title = "Linnea: Compiling Linear Algebra Expressions to High-Performance Code", 104 | booktitle = "Proceedings of the 8th International Workshop on Parallel Symbolic Computation", 105 | year = 2017, 106 | address = "Kaiserslautern, Germany", 107 | month = jul, 108 | url = "http://hpac.rwth-aachen.de/~barthels/publications/PASCO_2017.pdf" 109 | } 110 | 111 | @article{gmc, 112 | title={The generalized matrix chain algorithm}, 113 | author={Barthels, Henrik and Copik, Marcin and Bientinesi, Paolo}, 114 | journal={arXiv preprint arXiv:1804.04021}, 115 | year={2018} 116 | } 117 | 118 | @article{taco, 119 | title={The tensor algebra compiler}, 120 | author={Kjolstad, Fredrik and Kamil, Shoaib and Chou, Stephen and Lugato, David and Amarasinghe, Saman}, 121 | journal={Proceedings of the ACM on Programming Languages}, 122 | volume={1}, 123 | number={OOPSLA}, 124 | pages={77}, 125 | year={2017}, 126 | publisher={ACM} 127 | } 128 | 129 | @article{scala_lms, 130 | title={Lightweight modular staging and embedded compilers: Abstraction without regret for high-level high-performance programming}, 131 | author={Rompf, Tiark}, 132 | journal={{\'E}COLE POLYTECHNIQUE F{\'E}D{\'E}RALE DE LAUSANNE}, 133 | year={2012}, 134 | publisher={Citeseer} 135 | } 136 | 137 | @inproceedings{metaocaml, 138 | title={The design and implementation of BER MetaOCaml}, 139 | author={Kiselyov, Oleg}, 140 | booktitle={International Symposium on Functional and Logic Programming}, 141 | pages={86--102}, 142 | year={2014}, 143 | organization={Springer} 144 | } 145 | 146 | @article{futhark, 147 | title={Design and Implementation of the Futhark Programming Language (Revised)}, 148 | author={Henriksen, Troels}, 149 | year={2017} 150 | } 151 | 152 | @misc{rust, 153 | title={Rust}, 154 | author={Rust Community}, 155 | howpublished={\url{https://www.rust-lang.org/en-US}}, 156 | note={Accessed: 08/05/2018} 157 | } 158 | 159 | @misc{idris_linear, 160 | title={Idris 1.2.0 Release Notes}, 161 | author={Idris Community}, 162 | howpublished={\url{https://www.idris-lang.org/idris-1-2-0-released/}}, 163 | note={Accessed: 08/05/2018} 164 | } 165 | 166 | @inproceedings{wadler, 167 | title={Linear types can change the world}, 168 | author={Wadler, Philip}, 169 | booktitle={IFIP TC}, 170 | volume={2}, 171 | pages={347--359}, 172 | year={1990} 173 | } 174 | 175 | @article{yallop, 176 | title={Partially static data as free extension of algebras}, 177 | author={Yallop, Jeremy and von Glehn, Tamara and Kammar, Ohad} 178 | } 179 | 180 | @inproceedings{boyland, 181 | title={Checking interference with fractional permissions}, 182 | author={Boyland, John}, 183 | booktitle={International Static Analysis Symposium}, 184 | pages={55--72}, 185 | year={2003}, 186 | organization={Springer} 187 | } 188 | -------------------------------------------------------------------------------- /write-up/proposal.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dc-mak/NumLin/9f19783f52f9258aefccec4c466ccb1ffad5c8e5/write-up/proposal.pdf -------------------------------------------------------------------------------- /write-up/semantics.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dc-mak/NumLin/9f19783f52f9258aefccec4c466ccb1ffad5c8e5/write-up/semantics.pdf -------------------------------------------------------------------------------- /write-up/semantics/interpretation.tex: -------------------------------------------------------------------------------- 1 | \section{Interpretation} 2 | 3 | \subsection{Definitions} 4 | 5 | % Changed to multiset because normal disjoint unions and subsets of cartesian 6 | % products for the heap wouldn't capture _multiplicity_:different variables 7 | % in the environment could have identical permissions/types. 8 | 9 | Operationally, $\emph{Heap} \sqsubseteq \emph{Loc} \times \emph{Permission} 10 | \times \emph{Matrix} $ (a multiset), denoted with a $\sigma$.\\ 11 | Define its \emph{interpretation} to be $\emph{Loc} \rightharpoonup 12 | \emph{Permission} \times \emph{Matrix}$ with $\star: 13 | \emph{Heap} \times \emph{Heap} \rightharpoonup \emph{Heap}$ as follows: 14 | \[ 15 | (\varsigma_1 \star \varsigma_2)(l) \equiv 16 | \begin{cases} 17 | \varsigma_1(l) & \textrm{if } l \in \dom(\varsigma_1) \wedge l \notin \dom(\varsigma_2) \\ 18 | \varsigma_2(l) & \textrm{if } l \in \dom(\varsigma_2) \wedge l \notin \dom(\varsigma_1) \\ 19 | (f_1 + f_2, m) & \textrm{if } (f_1, m) = \varsigma_1(l) \wedge (f_2, m) = \varsigma_2(l) \wedge f_1 + f_2 \leq 1 \\ 20 | \textrm{undefined} & \textrm{otherwise} 21 | \end{cases} 22 | \] 23 | Commutativity and associativity of $\star$ follows from that of $+$.\\ 24 | $\varsigma_1 \star \varsigma_2$ is \emph{defined} if it is for all $l \in 25 | \dom(\varsigma_1) \cup \dom(\varsigma_2)$.\\ 26 | Define $\den{H}{}{\sigma} = \bigstar_{(l,f,m) \in \sigma} [l \mapsto_f m]$ 27 | and \textbf{implicitly denote} $\varsigma \equiv \den{H}{}{\theta(\sigma)}$.\\ 28 | \\ 29 | The $n-$fold iteration for the $\rightarrow$ (functional) relation, is also a (functional) relation: 30 | \begin{align*} 31 | \forall n.\ \ottkw{err} &\rightarrow^n \ottkw{err} & 32 | \langle \sigma , v \rangle &\rightarrow^n \langle \sigma , v \rangle & 33 | \langle \sigma , e \rangle &\rightarrow^0 \langle \sigma , e \rangle & 34 | \langle \sigma , e \rangle &\rightarrow^{n+1} ((\langle \sigma , e \rangle \rightarrow) \rightarrow^n) 35 | \end{align*} 36 | Hence, all bounded iterations end in either an $\ottkw{err}$, a heap-and-expression or a 37 | heap-and-value. 38 | 39 | \subsection{Interpretation} 40 | 41 | % TODO How to handle primitives? 42 | 43 | \begin{align*} 44 | \V{k}{ \Unit } &= \{ (\empH, \ast) \} \\ 45 | \\ 46 | \V{k}{ \Bool } &= \{ (\empH, true), (\empH, false) \} \\ 47 | \\ 48 | \V{k}{ \Int } &= \{ (\empH, n) \mid 2^{-63} \leq n \leq 2^{63} -1 \} \\ 49 | \\ 50 | \V{k}{ \Elt } &= \{ (\empH, f) \mid f \textrm{ a IEEE Float64 } \} \\ 51 | \\ 52 | \V{k}{ f \, \Mat } &= \{ (\{ l \mapsto_{2^{-f}} \_ \} , l) \} \\ 53 | \\ 54 | \V{k}{ \Bang t } &= \{ (\empH, \Many\, v) \mid (\empH, v) \in \V{k}{t} \} \\ 55 | \\ 56 | % Using substitution here directly helps avoid routing (fun fc -> v) [f] in C_k[[..]] 57 | \V{k}{ '\!f\!c.\ t } &= \{ (\varsigma, \ottkw{fun}\: '\!f\!c \rightarrow \, v) \mid \forall f.\ (\varsigma [f / f\!c], v [f / f\!c]) \in \V{k-1}{ t [f / f\!c] } \} \\ 58 | \\ 59 | \V{k}{ t_1 \otimes t_2 } &= \{ (\varsigma_1 \star \varsigma_2, ( v_1, v_2 )) \mid (\varsigma_1, v_1) \in \V{k}{t_1} \wedge (\varsigma_2, v_2) \in \V{k}{t_2} \} \\ 60 | \\ 61 | % j <= k because beta-reduction is guaranteed to take one step AND our types aren't recursive. 62 | \V{k}{ t' \multimap t } &= \{ (\varsigma_v, v ) \mid ( v \equiv \ottkw{fun}\, x : t' \rightarrow e \vee v \equiv \ottkw{fix} (g, x : t' , e : t) ) \, \wedge\\ 63 | & \qquad \qquad \forall j \leq k, (\varsigma_{v'}, v') \in \V{j}{ t' }.\ \varsigma_v \star \varsigma_v' \textrm{ defined } \Rightarrow (\varsigma_v \star \varsigma_v', v\, v') \in \C{j}{t} \} \\ 64 | \\ 65 | % j < k to match L3 Fluet/Ahmed paper 66 | \C{k}{ t } &= \{ (\varsigma_s, e_s) \mid \forall \, j < k, \sigma_r.\ \varsigma_s \star \varsigma_r \textrm{ defined } \Rightarrow \langle \sigma_s + \sigma_r, e_s \rangle \rightarrow^j \ottkw{err}\ \vee \exists \sigma_f, e_f.\\ 67 | & \qquad \qquad \langle \sigma_s + \sigma_r, e_s \rangle \rightarrow^j \langle \sigma_f + \sigma_r, e_f \rangle \wedge ( e_f \textrm { is a value } \Rightarrow ( \varsigma_f \star \varsigma_r, e_f ) \in \V{k-j}{t} ) \} \\ 68 | \\ 69 | \den{I}{k}{ \cdot } \theta &= \{ [] \} \\ 70 | \\ 71 | \den{I}{k}{ \Delta, x : t } \theta &= \{ \delta[x \mapsto v_x] \mid \delta \in \den{I}{k}{\Delta}\theta \wedge (\empH, v_x) \in \V{k}{\theta(t)} \} \\ 72 | \\ 73 | \den{L}{k}{ \cdot } \theta &= \{ (\empH, []) \} \\ 74 | \\ 75 | \den{L}{k}{ \Gamma, x : t } \theta &= \{ (\varsigma \star \varsigma_x, \gamma[x \mapsto v_x]) \mid (\varsigma, \gamma) \in \den{L}{k}{\Gamma}\theta \wedge (\varsigma_x, v_x) \in \V{k}{\theta(t)} \} \\ 76 | \\ 77 | \den{H}{}{\sigma} &= \bigstar_{(l,f,m) \in \sigma} [l \mapsto_f m] 78 | \\ 79 | \varsigma &\equiv \den{H}{}{\theta(\sigma)} \\ 80 | \\ 81 | \den{}{k}{ \Theta; \Delta ; \Gamma \vdash e : t } &= \forall \theta, \delta, \gamma, \sigma.\ \Theta = \dom(\theta) \wedge (\varsigma, \gamma) \in \den{L}{k}{ \Gamma }\theta \wedge \delta \in \den{I}{k}{ \Delta }\theta \Rightarrow \\ 82 | & \qquad \qquad (\varsigma, \theta(\delta(\gamma(e)))) \in \C{k}{ \theta(t) } 83 | \end{align*} 84 | -------------------------------------------------------------------------------- /write-up/semantics/semantics.tex: -------------------------------------------------------------------------------- 1 | \documentclass[11pt]{article}% 2 | \usepackage{amsmath,amssymb}% 3 | \usepackage{supertabular}% 4 | \usepackage{geometry}% 5 | \usepackage{ifthen}% 6 | \usepackage{alltt}%hack% 7 | \geometry{a4paper,dvips,twoside,left=22.5mm,right=22.5mm,top=20mm,bottom=30mm}% 8 | 9 | \usepackage{hyperref}% 10 | \input{semantics_def}% 11 | \usepackage{ottlayout}% 12 | \renewcommand{\ottpremise}[1]{\premiseSTY{#1}}% 13 | \renewcommand{\ottusedrule}[1]{\usedruleSTY{#1}}% 14 | \renewcommand{\ottdrule}[4][]{\druleSTY[#1]{#2}{#3}{#4}}% 15 | \renewenvironment{ottdefnblock}[3][]{\defnblockSTY[#1]{#2}{#3}}{\enddefnblockSTY}% 16 | 17 | \newcommand{\den}[3]{ \mathcal{#1}_{#2} [\![ #3 ]\!] }% 18 | \newcommand{\V}[2]{ \den{V}{#1}{#2} }% 19 | \newcommand{\C}[2]{ \den{C}{#1}{#2} }% 20 | 21 | \newcommand{\Unit}{\ottkw{unit}}% 22 | \newcommand{\Bang}{\ottkw{!}} 23 | \newcommand{\Bool}{\ottkw{bool}}% 24 | \newcommand{\Int}{\ottkw{int}}% 25 | \newcommand{\Elt}{\ottkw{elt}}% 26 | \newcommand{\Mat}{\ottkw{mat}}% 27 | \newcommand{\Zf}{\ottkw{Z}}% 28 | \newcommand{\Sf}{\ottkw{S}}% 29 | \newcommand{\Many}{\ottkw{Many}}% 30 | \newcommand{\dom}{\mathrm{dom}}% 31 | 32 | \newcommand{\empH}{\emptyset}% 33 | 34 | \usepackage{pf2} 35 | \beforePfSpace{15pt, 10pt, 10pt, 10pt, 5pt, 2pt} 36 | \afterPfSpace{15pt, 10pt, 10pt, 10pt, 5pt, 2pt} 37 | \interStepSpace{15pt, 10pt, 10pt, 10pt, 5pt, 2pt} 38 | \pflongindent% 39 | %\pfhidelevel{4} 40 | 41 | % \newtheorem{mydef}{Definition}[numberby] 42 | % \newtheorem{mythm}{Theorem}[numberby] 43 | 44 | \begin{document}% 45 | \ottstyledefaults{premiselayout=justify}% 46 | 47 | \section{Static Semantics} 48 | \ottdefnsTypes% 49 | 50 | \section{Dynamic Semantics} 51 | \ottdefnsOpXXSem% 52 | 53 | \input{interpretation} 54 | \clearpage% 55 | 56 | \input{lemmas} 57 | \clearpage% 58 | 59 | \input{soundness} 60 | \clearpage% 61 | 62 | \section{Additional Details} 63 | 64 | \subsection{Well-formed types} 65 | \ottdefnsWellXXFormed% 66 | 67 | \subsection{Grammar Definition} 68 | \ottgrammar% 69 | 70 | \clearpage% 71 | 72 | \end{document} 73 | -------------------------------------------------------------------------------- /write-up/shepherding.md: -------------------------------------------------------------------------------- 1 | # Shepherding instructions 2 | --- 3 | 4 | We hope that you will take on board all the reviewer suggestions that you agree 5 | with, but in terms of shepherding, final acceptance of your paper is 6 | conditional on addressing the following points: 7 | 8 | ## Done 9 | 10 | * Improve the introduction of NumLin to a) emphasise that the main 11 | contribution of this paper is the definition of the NumLin language and its 12 | application as a safe language for invoking BLAS routines, and b) to 13 | clarify the relationship to previous work on linear types and fractional 14 | permissions (as explained in the response). 15 | 16 | * Provide an accessible description of your soundness result. 17 | 18 | * Improve the discussion of the desugaring of let !x = e1 in e2 as explained 19 | in the response. 20 | 21 | * Introduce the syntax, syntactic sugar and supported operations more 22 | explicitly (i.e. not only with examples), in order to make the paper 23 | more accessible. 24 | 25 | * Explain the types of some of the primitives in the main body of the 26 | paper, and your process for deriving the NumLin types from the BLAS API 27 | types and documentation. 28 | 29 | --------------------------------------------------------------------------------