├── .gitignore ├── .ocamlformat ├── LICENSE ├── Makefile ├── README.md ├── bidirectional ├── Bidirectional.ml ├── Bidirectional.mli ├── Statics.ml ├── Statics.mli └── dune ├── constructive-real ├── Constructive_real.ml ├── Constructive_real.mli ├── LICENSE └── dune ├── crowbar ├── dune └── main.ml ├── del ├── Binding_aware_pattern_model.ml ├── Binding_aware_pattern_model.mli ├── Core.ml ├── Core.mli ├── Empty.ml ├── Empty.mli ├── List_model.ml ├── List_model.mli ├── Option_model.ml ├── Option_model.mli ├── Pattern_model.ml ├── Pattern_model.mli ├── Sort_model.ml ├── Sort_model.mli └── dune ├── dune-project ├── experimental ├── DeBruijn_2d.ml ├── DeBruijn_2d.mli ├── Matching.ml ├── Matching.mli ├── languages │ └── LanguageDiagram.ml ├── pages │ ├── 0x-core-eval │ │ ├── index.html │ │ └── main.ml │ ├── 0x-diagram-render │ │ ├── index.html │ │ └── main.ml │ ├── 0x-document-render │ │ ├── index.html │ │ └── main.ml │ ├── 0x-huttons-razor │ │ ├── index.html │ │ └── main.ml │ └── style │ │ ├── codemirror.css │ │ └── index.css └── web │ ├── exe │ ├── index.html │ ├── main.ml │ └── test.md │ └── store.ml ├── input └── input ├── languages ├── Calculator.ml ├── Document.ml ├── Edits.ml ├── Eff.ml ├── Huttons_razor.ml ├── Jyp_pretty.ml ├── Lambda_calculus.ml ├── Lvca_models.ml ├── Namespaced_de_bruijn.ml ├── Nat.ml ├── Parse_pretty.ml ├── Parser.ml ├── Pfpl_dpcf.ml ├── Pfpl_pcf.ml ├── Tex_math.ml └── dune ├── lvca.opam ├── pages ├── Ast_operations.ml ├── Bidirectional_debugger.ml ├── Calculator.ml ├── Check_term.ml ├── Common.ml ├── Common.mli ├── Components.ml ├── Digits_entry.ml ├── Edits.ml ├── Eval_with_provenance.ml ├── Ide.ml ├── Katex.ml ├── List_nat.ml ├── Md_viewer.ml ├── Multiline_input.ml ├── Multiline_input.mli ├── Parser.ml ├── Pcf.ml ├── Prelude.ml ├── Range_formatter.ml ├── Repl.ml ├── Scope_viewer.ml ├── Single_line_input.ml ├── Single_line_input.mli ├── Stateless_view.ml ├── Store.ml ├── Store_view.ml ├── Term_and_concrete.ml ├── Term_and_document.ml ├── Term_to_tex.ml ├── Tree_view.ml ├── Tree_view.mli ├── Web_util.ml ├── devel_main.ml ├── dune ├── favicon512.png ├── fonts │ ├── KaTeX_AMS-Regular.ttf │ ├── KaTeX_AMS-Regular.woff │ ├── KaTeX_AMS-Regular.woff2 │ ├── KaTeX_Caligraphic-Bold.ttf │ ├── KaTeX_Caligraphic-Bold.woff │ ├── KaTeX_Caligraphic-Bold.woff2 │ ├── KaTeX_Caligraphic-Regular.ttf │ ├── KaTeX_Caligraphic-Regular.woff │ ├── KaTeX_Caligraphic-Regular.woff2 │ ├── KaTeX_Fraktur-Bold.ttf │ ├── KaTeX_Fraktur-Bold.woff │ ├── KaTeX_Fraktur-Bold.woff2 │ ├── KaTeX_Fraktur-Regular.ttf │ ├── KaTeX_Fraktur-Regular.woff │ ├── KaTeX_Fraktur-Regular.woff2 │ ├── KaTeX_Main-Bold.ttf │ ├── KaTeX_Main-Bold.woff │ ├── KaTeX_Main-Bold.woff2 │ ├── KaTeX_Main-BoldItalic.ttf │ ├── KaTeX_Main-BoldItalic.woff │ ├── KaTeX_Main-BoldItalic.woff2 │ ├── KaTeX_Main-Italic.ttf │ ├── KaTeX_Main-Italic.woff │ ├── KaTeX_Main-Italic.woff2 │ ├── KaTeX_Main-Regular.ttf │ ├── KaTeX_Main-Regular.woff │ ├── KaTeX_Main-Regular.woff2 │ ├── KaTeX_Math-BoldItalic.ttf │ ├── KaTeX_Math-BoldItalic.woff │ ├── KaTeX_Math-BoldItalic.woff2 │ ├── KaTeX_Math-Italic.ttf │ ├── KaTeX_Math-Italic.woff │ ├── KaTeX_Math-Italic.woff2 │ ├── KaTeX_SansSerif-Bold.ttf │ ├── KaTeX_SansSerif-Bold.woff │ ├── KaTeX_SansSerif-Bold.woff2 │ ├── KaTeX_SansSerif-Italic.ttf │ ├── KaTeX_SansSerif-Italic.woff │ ├── KaTeX_SansSerif-Italic.woff2 │ ├── KaTeX_SansSerif-Regular.ttf │ ├── KaTeX_SansSerif-Regular.woff │ ├── KaTeX_SansSerif-Regular.woff2 │ ├── KaTeX_Script-Regular.ttf │ ├── KaTeX_Script-Regular.woff │ ├── KaTeX_Script-Regular.woff2 │ ├── KaTeX_Size1-Regular.ttf │ ├── KaTeX_Size1-Regular.woff │ ├── KaTeX_Size1-Regular.woff2 │ ├── KaTeX_Size2-Regular.ttf │ ├── KaTeX_Size2-Regular.woff │ ├── KaTeX_Size2-Regular.woff2 │ ├── KaTeX_Size3-Regular.ttf │ ├── KaTeX_Size3-Regular.woff │ ├── KaTeX_Size3-Regular.woff2 │ ├── KaTeX_Size4-Regular.ttf │ ├── KaTeX_Size4-Regular.woff │ ├── KaTeX_Size4-Regular.woff2 │ ├── KaTeX_Typewriter-Regular.ttf │ ├── KaTeX_Typewriter-Regular.woff │ ├── KaTeX_Typewriter-Regular.woff2 │ └── dune ├── index.html ├── katex.css ├── katex.js ├── md │ ├── abstract-syntax.md │ ├── are-constructors-functions.md │ ├── bidirectional-typechecking.md │ ├── binding-aware-patterns.md │ ├── binding-viewer.md │ ├── checking-terms-and-patterns.md │ ├── church-and-curry.md │ ├── comments-are-metadata.md │ ├── constructive-real-calculator.md │ ├── finding-terms.md │ ├── garage-door.md │ ├── huttons-razor.md │ ├── introduction.md │ ├── lambda-concrete-and-abstract.md │ ├── make-code-review-easier.md │ ├── making-concrete-and-abstract.md │ ├── never-waste-a-refactor.md │ ├── parsing-language.md │ ├── progress-august-8-2020.md │ ├── progress-december-23-2020.md │ ├── progress-december-28-2020.md │ ├── progress-july-24-2020.md │ ├── progress-july-25-2021.md │ ├── progress-june-9-2021.md │ ├── progress-may-24-2021.md │ ├── progress-november-7-2020.md │ ├── progress-october-8-2020.md │ ├── progress-september-23-2020.md │ ├── semantic-diffs-and-broken-tests.md │ ├── semantic-diffs.md │ ├── software-evolution.md │ ├── sorts-and-kind-checking.md │ ├── the-interop-story.md │ ├── universes.md │ ├── what-is-a-pl.md │ ├── what-lvca-doesnt-do.md │ └── why-is-lvca-interesting.md ├── static │ ├── hl-demo1.mp4 │ ├── hl-demo1.webm │ ├── hl-demo2.mp4 │ ├── hl-demo2.webm │ ├── images │ │ ├── scopeview1.png │ │ ├── scopeview2.png │ │ ├── scopeview3.png │ │ ├── scopeview4.png │ │ └── scopeview5.png │ ├── treeview.mp4 │ └── treeview.webm ├── style.css └── tailwind-style.css ├── parsing ├── Lvca_parsing.ml ├── Lvca_parsing.mli └── dune ├── ppx_lvca ├── Module_builder.ml ├── dune ├── ppx_lvca.ml └── test │ ├── .ocamlformat-ignore │ ├── dune │ ├── pp.ml │ ├── test.expected.ml │ └── test.ml ├── ppx_lvca_del ├── Core_syntax_quoter.ml ├── dune └── ppx_lvca_core.ml ├── provenance ├── Opt_range.ml ├── Opt_range.mli ├── Range.ml ├── Range.mli ├── Ranges.ml ├── Ranges.mli ├── Source_range.ml ├── Source_range.mli ├── Source_ranges.ml ├── Source_ranges.mli └── dune ├── server.py ├── syntax ├── Abstract_syntax.ml ├── Abstract_syntax.mli ├── Arity.ml ├── Arity.mli ├── Binding_aware_pattern.ml ├── Binding_aware_pattern.mli ├── Check_failure.ml ├── Check_failure.mli ├── Concrete.ml ├── Concrete.mli ├── DeBruijn.ml ├── DeBruijn.mli ├── Directed_graph.ml ├── Directed_graph.mli ├── Kind.ml ├── Kind.mli ├── Language_object_intf.ml ├── Nominal.ml ├── Nominal.mli ├── Nonbinding.ml ├── Nonbinding.mli ├── Operator_def.ml ├── Operator_def.mli ├── Path.ml ├── Path.mli ├── Pattern.ml ├── Pattern.mli ├── Pattern_sort.ml ├── Pattern_sort.mli ├── Primitive.ml ├── Primitive.mli ├── Primitive_impl.ml ├── Properties_intf.ml ├── Provenance.ml ├── Provenance.mli ├── Regex.ml ├── Regex.mli ├── Single_var.ml ├── Sort.ml ├── Sort.mli ├── Sort_def.ml ├── Sort_def.mli ├── Sort_slot.ml ├── Sort_slot.mli ├── Valence.ml ├── Valence.mli └── dune ├── syntax_quoter ├── Syntax_quoter.ml ├── Syntax_quoter.mli └── dune └── util ├── Lvca_util.ml └── dune /.gitignore: -------------------------------------------------------------------------------- 1 | *.exe 2 | *.obj 3 | *.out 4 | *.compile 5 | *.native 6 | *.byte 7 | *.cmo 8 | *.annot 9 | *.cmi 10 | *.cmx 11 | *.cmt 12 | *.cmti 13 | *.cma 14 | *.a 15 | *.cmxa 16 | *.obj 17 | *~ 18 | *.annot 19 | *.cmj 20 | *.bak 21 | *.mlast 22 | *.mliast 23 | .vscode 24 | .merlin 25 | _build 26 | output 27 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | profile = janestreet 2 | break-cases = fit 3 | parse-docstrings = true 4 | wrap-comments = false 5 | version=0.20.1 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2020-2021 Joel Burget 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 8 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | format: 2 | @fd --extension ml --extension mli | xargs ocamlformat --enable-outside-detected-project --inplace 3 | 4 | doc: 5 | @dune build @doc 6 | 7 | # Note: zarith requires gmp, digestif requires pkg-config 8 | install-deps: 9 | @opam install angstrom base brr cbor crowbar digestif fmt note omd ppx_jane ppxlib zarith zarith_stubs_js ppx_blob 10 | 11 | lint: 12 | @opam-dune-lint 13 | @dune build @fmt 14 | @dune build @check @runtest 15 | 16 | server: 17 | @echo "http://localhost:8000" 18 | @python3 server.py 19 | 20 | .PHONY: format doc install-deps lint server 21 | -------------------------------------------------------------------------------- /bidirectional/Bidirectional.mli: -------------------------------------------------------------------------------- 1 | (** An implementation of bidirectional typechecking. *) 2 | 3 | open Lvca_syntax 4 | open Statics 5 | 6 | module Env : sig 7 | type t = 8 | { rules : Rule.t list (** The (checking / inference) rules we can apply *) 9 | ; var_types : Nominal.Term.t Lvca_util.String.Map.t 10 | (** The types of all known free variables *) 11 | } 12 | 13 | val ( = ) : t -> t -> bool 14 | end 15 | 16 | module Capture : sig 17 | type t = Binding_aware_pattern.Capture.t 18 | 19 | val ( = ) : t -> t -> bool 20 | end 21 | 22 | module Check_error : sig 23 | type t = 24 | | Check_error of string 25 | | Bad_merge of Capture.t * Capture.t 26 | 27 | val ( = ) : t -> t -> bool 28 | end 29 | 30 | module Trace_entry : sig 31 | type t = 32 | | Check_trace of Env.t * Typing.t 33 | | Check_success 34 | | Check_failure of Check_error.t 35 | | Infer_trace of Env.t * Nominal.Term.t 36 | | Inferred of Nominal.Term.t 37 | 38 | val ( = ) : t -> t -> bool 39 | end 40 | 41 | module Trace_step : sig 42 | type t = Trace_entry.t list 43 | 44 | val ( = ) : t -> t -> bool 45 | end 46 | 47 | (* 48 | val check_trace : ( Trace_step.t -> unit) -> Env.t -> Typing.t -> Check_error.t option 49 | 50 | val infer_trace 51 | : ( Trace_step.t -> unit) 52 | -> Env.t 53 | -> Nominal.term 54 | -> ( Nominal.term, 'a Check_error.t) Result.t 55 | 56 | val check : Env.t -> Typing.t -> Check_error.t option 57 | val infer : Env.t -> Nominal.term -> ( Nominal.term, Check_error.t) Result.t 58 | *) 59 | 60 | val check_trace : (Trace_step.t -> unit) -> Env.t -> Typing.t -> Check_error.t option 61 | 62 | val infer_trace 63 | : (Trace_step.t -> unit) 64 | -> Env.t 65 | -> Nominal.Term.t 66 | -> (Nominal.Term.t, Check_error.t) Result.t 67 | 68 | val check : Env.t -> Typing.t -> Check_error.t option 69 | val infer : Env.t -> Nominal.Term.t -> (Nominal.Term.t, Check_error.t) Result.t 70 | -------------------------------------------------------------------------------- /bidirectional/Statics.mli: -------------------------------------------------------------------------------- 1 | (** Statics describe the rules for stating whether an expression is well-formed. This 2 | implementation is for expressing bidirectional typing rules. *) 3 | 4 | open Lvca_syntax 5 | open Lvca_util 6 | 7 | (** Both typing and inference rules share this shape. 8 | 9 | There is an important distinction in terms of the typechecking algorithm, though. 10 | Inference rules assert that some type can be synthesized from the given term. Checking 11 | rules assert that given both a term and a type we can check if the term is of that 12 | type. *) 13 | module Typing_rule : sig 14 | type t = 15 | { tm : Binding_aware_pattern.t 16 | ; ty : Binding_aware_pattern.t 17 | } 18 | 19 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 20 | val ( = ) : t -> t -> bool 21 | end 22 | 23 | module Typing_clause : sig 24 | type inference_rule = Typing_rule.t 25 | type checking_rule = Typing_rule.t 26 | 27 | type t = 28 | | Inference_rule of inference_rule 29 | | Checking_rule of checking_rule 30 | 31 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 32 | val ( = ) : t -> t -> bool 33 | val parse : t Lvca_parsing.t 34 | end 35 | 36 | (** A hypothesis contains a set of variables (and their types) that must appear in the 37 | context, as well as an inference or checking clause. *) 38 | module Hypothesis : sig 39 | type t = Binding_aware_pattern.t String.Map.t * Typing_clause.t 40 | 41 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 42 | val ( = ) : t -> t -> bool 43 | 44 | module Parse : sig 45 | val typed_term : (string * Binding_aware_pattern.t) Lvca_parsing.t 46 | val context : Binding_aware_pattern.t String.Map.t Lvca_parsing.t 47 | val t : t Lvca_parsing.t 48 | end 49 | end 50 | 51 | (** A rule contains a set of hypotheses, an optional name, and a conclusion *) 52 | module Rule : sig 53 | type t = 54 | { hypotheses : Hypothesis.t list 55 | ; name : string option 56 | ; conclusion : Hypothesis.t 57 | } 58 | 59 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 60 | val ( = ) : t -> t -> bool 61 | 62 | module Parse : sig 63 | val line : string option Lvca_parsing.t 64 | val t : t Lvca_parsing.t 65 | end 66 | end 67 | 68 | module Typing : sig 69 | type t = Typing of Nominal.Term.t * Nominal.Term.t 70 | 71 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 72 | val ( = ) : t -> t -> bool 73 | end 74 | 75 | type t = Rule.t list 76 | 77 | val parse : t Lvca_parsing.t 78 | -------------------------------------------------------------------------------- /bidirectional/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lvca_bidirectional) 3 | (public_name lvca.bidirectional) 4 | (inline_tests) 5 | (libraries lvca_parsing lvca_provenance lvca_syntax) 6 | (preprocess 7 | (pps ppx_jane))) 8 | -------------------------------------------------------------------------------- /constructive-real/Constructive_real.mli: -------------------------------------------------------------------------------- 1 | (** Constructive / computable real numbers. *) 2 | type t 3 | 4 | val pp : t Fmt.t 5 | val debug_to_string : t -> string 6 | val ( + ) : t -> t -> t 7 | val ( - ) : t -> t -> t 8 | val ( * ) : t -> t -> t 9 | val ( / ) : t -> t -> t 10 | 11 | (** Shift to the left. Equivalent to multiplication by a power of 2. The second argument 12 | can be negative. *) 13 | val shift_left : t -> int32 -> t 14 | 15 | (** Shift to the right. Equivalent to division by a power of 2. The second argument can be 16 | negative. *) 17 | val shift_right : t -> int32 -> t 18 | 19 | val negate : t -> t 20 | val sqrt : t -> t 21 | val select : t -> t -> t -> t 22 | val max : t -> t -> t 23 | val min : t -> t -> t 24 | val abs : t -> t 25 | val exp : t -> t 26 | val ln : t -> t 27 | val sin : t -> t 28 | val cos : t -> t 29 | val tan : t -> t 30 | val asin : t -> t 31 | val acos : t -> t 32 | val atan : t -> t 33 | val of_bigint : Z.t -> t 34 | val of_int : int -> t 35 | val of_int32 : int32 -> t 36 | val of_float : float -> t 37 | val signum : t -> int32 38 | val bigint_value : t -> Z.t 39 | val int_value : t -> int 40 | val float_value : t -> float 41 | val eval_to_string : ?digits:int32 -> ?radix:int32 -> t -> string 42 | val compare_absolute : t -> t -> absolute_tolerance:int32 -> int 43 | val compare : t -> t -> relative_tolerance:int32 -> absolute_tolerance:int32 -> int 44 | val compare_known_unequal : t -> t -> int 45 | val one : t 46 | val minus_one : t 47 | val two : t 48 | val three : t 49 | val pi : t 50 | val half_pi : t 51 | val e : t 52 | 53 | (** A number that may not have been completely evaluated but is assumed to be an integer, 54 | * so is never evaluated beyond the decimal point. *) 55 | val assume_int : t -> t 56 | -------------------------------------------------------------------------------- /constructive-real/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name constructive_real) 3 | (public_name lvca.constructive_real) 4 | (inline_tests) 5 | (libraries base fmt zarith zarith_stubs_js) 6 | (preprocess 7 | (pps ppx_jane)) 8 | (wrapped false)) 9 | -------------------------------------------------------------------------------- /crowbar/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names main) 3 | (preprocess 4 | (pps ppx_jane)) 5 | (libraries lvca_syntax lvca_languages crowbar)) 6 | -------------------------------------------------------------------------------- /del/Binding_aware_pattern_model.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lvca_syntax 3 | 4 | include 5 | [%lvca.abstract_syntax_module 6 | {| 7 | string : * 8 | primitive : * 9 | list : * -> * 10 | 11 | pattern := 12 | | Operator(string; list scope) 13 | | Primitive(primitive) 14 | | Var(string) 15 | ; 16 | 17 | scope := Scope(list string; pattern); 18 | |} 19 | , { string = "Primitive.String"; primitive = "Primitive.All"; list = "List_model" }] 20 | 21 | let rec into tm = 22 | let info = Provenance.calculated_here [%here] [ Binding_aware_pattern.info tm ] in 23 | match tm with 24 | | Binding_aware_pattern.Operator (_, str, scopes) -> 25 | let scopes = scopes |> List.map ~f:scope |> List_model.of_list in 26 | Pattern.Operator (info, (info, str), scopes) 27 | | Primitive (_, prim) -> Primitive (info, (info, prim)) 28 | | Var (_, str) -> Var (info, (info, str)) 29 | 30 | and scope (Binding_aware_pattern.Scope (names, pat)) = 31 | Scope.Scope (Provenance.of_here [%here], List_model.of_list names, into pat) 32 | ;; 33 | 34 | let rec out tm = 35 | let info = Provenance.calculated_here [%here] [ Pattern.info tm ] in 36 | match tm with 37 | | Pattern.Operator (_, (_, str), scopes) -> 38 | let scopes = scopes |> List_model.to_list |> List.map ~f:scope in 39 | Binding_aware_pattern.Operator (info, str, scopes) 40 | | Primitive (_, (_, prim)) -> Primitive (info, prim) 41 | | Var (_, (_, str)) -> Var (info, str) 42 | 43 | and scope (Scope.Scope (_, names, pat)) = 44 | Binding_aware_pattern.Scope (List_model.to_list names, out pat) 45 | ;; 46 | -------------------------------------------------------------------------------- /del/Binding_aware_pattern_model.mli: -------------------------------------------------------------------------------- 1 | open Lvca_syntax 2 | 3 | include 4 | [%lvca.abstract_syntax_module_sig 5 | {| 6 | string : * 7 | primitive : * 8 | list : * -> * 9 | 10 | pattern := 11 | | Operator(string; list scope) 12 | | Primitive(primitive) 13 | | Var(string) 14 | ; 15 | 16 | scope := Scope(list string; pattern); 17 | |} 18 | , { string = "Primitive.String"; primitive = "Primitive.All"; list = "List_model" }] 19 | 20 | val into : Lvca_syntax.Binding_aware_pattern.t -> Pattern.t 21 | val out : Pattern.t -> Lvca_syntax.Binding_aware_pattern.t 22 | -------------------------------------------------------------------------------- /del/Empty.ml: -------------------------------------------------------------------------------- 1 | include [%lvca.abstract_syntax_module "empty := ;"] 2 | 3 | type t = Empty.t 4 | 5 | let pp _ppf = function (_ : t) -> . 6 | let parse = Lvca_parsing.fail "(empty type)" 7 | -------------------------------------------------------------------------------- /del/Empty.mli: -------------------------------------------------------------------------------- 1 | include [%lvca.abstract_syntax_module_sig "empty := ;"] 2 | 3 | type t = Empty.t 4 | 5 | val pp : t Fmt.t 6 | val parse : t Lvca_parsing.t 7 | -------------------------------------------------------------------------------- /del/List_model.ml: -------------------------------------------------------------------------------- 1 | open Lvca_syntax 2 | module Kernel = [%lvca.abstract_syntax_module "list a := Nil() | Cons(a; list a);"] 3 | include Kernel.List 4 | 5 | type 'a t = 'a Kernel.List.t = 6 | | Nil of Provenance.t 7 | | Cons of Provenance.t * 'a * 'a t 8 | 9 | let rec of_list xs = 10 | let info = Provenance.of_here [%here] in 11 | match xs with [] -> mk_Nil ~info | x :: xs -> Cons (info, x, of_list xs) 12 | ;; 13 | 14 | let rec to_list xs = match xs with Nil _ -> [] | Cons (_, x, xs) -> x :: to_list xs 15 | let rec map ~f = function Nil i -> Nil i | Cons (i, x, xs) -> Cons (i, f x, map ~f xs) 16 | 17 | let rec extract_vars_from_empty_pattern = function 18 | | Pattern.Operator (_, "Nil", []) -> [] 19 | | Operator (_, "Cons", [ Var (_, name); pats ]) -> 20 | name :: extract_vars_from_empty_pattern pats 21 | | _ -> Lvca_util.invariant_violation [%here] "Invalid empty list pattern" 22 | ;; 23 | 24 | let rec make_empty_pattern vars = 25 | match vars with 26 | | [] -> Pattern.Operator (Provenance.of_here [%here], "Nil", []) 27 | | (v, pos) :: vars -> 28 | Operator 29 | (Provenance.of_here [%here], "Cons", [ Var (v, pos); make_empty_pattern vars ]) 30 | ;; 31 | -------------------------------------------------------------------------------- /del/List_model.mli: -------------------------------------------------------------------------------- 1 | open Lvca_syntax 2 | module Kernel : [%lvca.abstract_syntax_module_sig "list a := Nil() | Cons(a; list a);"] 3 | 4 | type 'a t = 'a Kernel.List.t = 5 | | Nil of Provenance.t 6 | | Cons of Provenance.t * 'a * 'a t 7 | 8 | val equivalent 9 | : (?info_eq:(Lvca_syntax.Provenance.t -> Lvca_syntax.Provenance.t -> bool) 10 | -> 'a 11 | -> 'b 12 | -> bool) 13 | -> ?info_eq:(Lvca_syntax.Provenance.t -> Lvca_syntax.Provenance.t -> bool) 14 | -> 'a t 15 | -> 'b t 16 | -> bool 17 | 18 | val to_nominal : ('a -> Nominal.Term.t) -> 'a t -> Nominal.Term.t 19 | 20 | val of_nominal 21 | : (Nominal.Term.t -> ('a, Nominal.Conversion_error.t) Result.t) 22 | -> Nominal.Term.t 23 | -> ('a t, Nominal.Conversion_error.t) Result.t 24 | 25 | val of_list : 'a list -> 'a t 26 | val to_list : 'a t -> 'a list 27 | val map : f:('a -> 'b) -> 'a t -> 'b t 28 | val extract_vars_from_empty_pattern : Pattern.t -> string list 29 | val make_empty_pattern : (Provenance.t * string) list -> Pattern.t 30 | -------------------------------------------------------------------------------- /del/Option_model.ml: -------------------------------------------------------------------------------- 1 | open Lvca_syntax 2 | include [%lvca.abstract_syntax_module "option a := None() | Some(a);"] 3 | 4 | let of_option x = 5 | let info = Provenance.of_here [%here] in 6 | match x with None -> Option.None info | Some a -> Some (info, a) 7 | ;; 8 | 9 | let to_option = function Option.None _ -> None | Some (_, a) -> Some a 10 | let map ~f = function Option.None i -> Option.None i | Some (i, a) -> Some (i, f a) 11 | -------------------------------------------------------------------------------- /del/Option_model.mli: -------------------------------------------------------------------------------- 1 | include [%lvca.abstract_syntax_module_sig "option a := None() | Some(a);"] 2 | 3 | val of_option : 'a option -> 'a Option.t 4 | val to_option : 'a Option.t -> 'a option 5 | val map : f:('a -> 'b) -> 'a Option.t -> 'b Option.t 6 | -------------------------------------------------------------------------------- /del/Pattern_model.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lvca_syntax 3 | 4 | include 5 | [%lvca.abstract_syntax_module 6 | {| 7 | string : * 8 | primitive : * 9 | list : * -> * 10 | 11 | pattern := 12 | | Operator(string; list pattern) 13 | | Primitive(primitive) 14 | | Var(string) 15 | ; 16 | |} 17 | , { string = "Primitive.String"; primitive = "Primitive.All"; list = "List_model" }] 18 | 19 | let rec into tm = 20 | let info = Provenance.calculated_here [%here] [ Lvca_syntax.Pattern.info tm ] in 21 | match tm with 22 | | Lvca_syntax.Pattern.Operator (_, str, tms) -> 23 | let tms = tms |> List.map ~f:into |> List_model.of_list in 24 | Pattern.Operator (info, (info, str), tms) 25 | | Primitive (_, prim) -> Primitive (info, (info, prim)) 26 | | Var (_, str) -> Var (info, (info, str)) 27 | ;; 28 | 29 | let rec out tm = 30 | let info = Provenance.calculated_here [%here] [ Pattern.info tm ] in 31 | match tm with 32 | | Pattern.Operator (_, (_, str), tms) -> 33 | let tms = tms |> List_model.to_list |> List.map ~f:out in 34 | Lvca_syntax.Pattern.Operator (info, str, tms) 35 | | Primitive (_, (_, prim)) -> Primitive (info, prim) 36 | | Var (_, (_, str)) -> Var (info, str) 37 | ;; 38 | -------------------------------------------------------------------------------- /del/Pattern_model.mli: -------------------------------------------------------------------------------- 1 | open Lvca_syntax 2 | 3 | include 4 | [%lvca.abstract_syntax_module_sig 5 | {| 6 | string : * 7 | primitive : * 8 | list : * -> * 9 | 10 | pattern := 11 | | Operator(string; list pattern) 12 | | Primitive(primitive) 13 | | Var(string) 14 | ; 15 | |} 16 | , { string = "Primitive.String"; primitive = "Primitive.All"; list = "List_model" }] 17 | 18 | val into : Lvca_syntax.Pattern.t -> Pattern.t 19 | val out : Pattern.t -> Lvca_syntax.Pattern.t 20 | -------------------------------------------------------------------------------- /del/Sort_model.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lvca_syntax 3 | 4 | module Kernel = 5 | [%lvca.abstract_syntax_module 6 | {| 7 | string : * 8 | list : * -> * 9 | 10 | sort := 11 | | Ap(string; list sort) 12 | | Name(string) 13 | ; 14 | |} 15 | , { string = "Primitive.String"; list = "List_model" }] 16 | 17 | let rec into tm = 18 | let info = Provenance.calculated_here [%here] [ Lvca_syntax.Sort.info tm ] in 19 | match tm with 20 | | Lvca_syntax.Sort.Ap (_, name, lst) -> 21 | let lst = lst |> List.map ~f:into |> List_model.of_list in 22 | Kernel.Sort.Ap (info, (info, name), lst) 23 | | Name (_, name) -> Name (info, (info, name)) 24 | ;; 25 | 26 | let rec out tm = 27 | let info = Provenance.calculated_here [%here] [ Kernel.Sort.info tm ] in 28 | match tm with 29 | | Kernel.Sort.Ap (_, (_, name), lst) -> 30 | let lst = lst |> List_model.to_list |> List.map ~f:out in 31 | Lvca_syntax.Sort.Ap (info, name, lst) 32 | | Name (_, (_, name)) -> Name (info, name) 33 | ;; 34 | 35 | include Kernel.Sort 36 | include Nominal.Convertible.Extend (Kernel.Sort) 37 | -------------------------------------------------------------------------------- /del/Sort_model.mli: -------------------------------------------------------------------------------- 1 | open Lvca_syntax 2 | 3 | module Kernel : [%lvca.abstract_syntax_module_sig 4 | {| 5 | string : * 6 | list : * -> * 7 | 8 | sort := 9 | | Ap(string; list sort) 10 | | Name(string) 11 | ; 12 | |} 13 | , { string = "Primitive.String"; list = "List_model" }] 14 | 15 | include Nominal.Convertible.Extended_s with type t = Kernel.Sort.t 16 | 17 | val mk_Ap 18 | : info:Lvca_syntax.Provenance.t 19 | -> Lvca_syntax.Primitive.String.t 20 | -> t List_model.t 21 | -> t 22 | 23 | val mk_Name : info:Lvca_syntax.Provenance.t -> Lvca_syntax.Primitive.String.t -> t 24 | val into : Lvca_syntax.Sort.t -> t 25 | val out : t -> Lvca_syntax.Sort.t 26 | -------------------------------------------------------------------------------- /del/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lvca_del) 3 | (public_name lvca.del) 4 | (inline_tests) 5 | (libraries lvca_parsing lvca_syntax) 6 | (preprocess 7 | (pps ppx_jane ppx_lvca))) 8 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.2) 2 | -------------------------------------------------------------------------------- /experimental/DeBruijn_2d.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lvca_util 3 | open Option.Let_syntax 4 | 5 | type 'info term = 6 | | Operator of 'info * string * 'info scope list 7 | | BoundVar of 'info * int * int 8 | | FreeVar of 'info * string 9 | | Primitive of 'info Primitive.All.t 10 | 11 | and 'info scope = Scope of 'info Pattern.t list * 'info term 12 | 13 | let rec to_nominal' ctx = function 14 | | BoundVar (info, ix1, ix2) -> 15 | List.nth ctx ix1 16 | |> Option.bind ~f:(Fn.flip List.nth ix2) 17 | |> Option.map ~f:(fun name -> Nominal.Term.Var (info, name)) 18 | | Operator (info, tag, subtms) -> 19 | subtms 20 | |> List.map ~f:(scope_to_nominal ctx) 21 | |> Option.all 22 | |> Option.map ~f:(fun subtms' -> Nominal.Term.Operator (info, tag, subtms')) 23 | | FreeVar (info, name) -> Some (Var (info, name)) 24 | | Primitive prim -> Some (Nominal.Term.Primitive prim) 25 | 26 | and scope_to_nominal ctx (Scope (binders, body)) = 27 | let ctx = 28 | binders 29 | |> List.map ~f:(fun pat -> pat |> Pattern.list_vars_of_pattern |> List.map ~f:snd) 30 | |> List.append ctx 31 | in 32 | let%map body = to_nominal' ctx body in 33 | Nominal.Scope.Scope (binders, body) 34 | ;; 35 | 36 | let to_nominal tm = to_nominal' [] tm 37 | 38 | let rec of_nominal_with_bindings env = function 39 | | Nominal.Term.Operator (info, tag, subtms) -> 40 | let open Result.Let_syntax in 41 | let%map subtms' = subtms |> List.map ~f:(scope_of_nominal env) |> Result.all in 42 | Operator (info, tag, subtms') 43 | | Var (info, name) -> 44 | Ok 45 | (match Map.find env name with 46 | | None -> FreeVar (info, name) 47 | | Some (i, j) -> BoundVar (info, i, j)) 48 | | Primitive prim -> Ok (Primitive prim) 49 | 50 | and scope_of_nominal env (Nominal.Scope.Scope (pats, body) as scope) = 51 | let open Result.Let_syntax in 52 | let n = List.length pats in 53 | let var_nums : (string * (int * int)) list = 54 | pats 55 | |> List.mapi ~f:(fun i pat -> 56 | pat 57 | |> Pattern.list_vars_of_pattern 58 | |> List.mapi ~f:(fun j (_, var) -> var, (i, j))) 59 | |> List.join 60 | in 61 | match String.Map.of_alist var_nums with 62 | | `Ok var_map -> 63 | let env' : (int * int) String.Map.t = 64 | env |> Map.map ~f:(fun (i, j) -> i + n, j) |> Map.union_right_biased var_map 65 | in 66 | let%map body' = of_nominal_with_bindings env' body in 67 | Scope (pats, body') 68 | | `Duplicate_key _key -> Error scope 69 | ;; 70 | 71 | let of_nominal tm = of_nominal_with_bindings String.Map.empty tm 72 | 73 | let rec alpha_equivalent t1 t2 = 74 | match t1, t2 with 75 | | Operator (_, h1, subtms1), Operator (_, h2, subtms2) -> 76 | String.(h1 = h2) 77 | && 78 | (match List.zip subtms1 subtms2 with 79 | | Ok zipped -> 80 | List.for_all zipped ~f:(fun (Scope (_, body1), Scope (_, body2)) -> 81 | alpha_equivalent body1 body2) 82 | | Unequal_lengths -> false) 83 | | BoundVar (_, i1, j1), BoundVar (_, i2, j2) -> Int.(i1 = i2 && j1 = j2) 84 | | FreeVar (_, name1), FreeVar (_, name2) -> String.(name1 = name2) 85 | | Primitive p1, Primitive p2 -> 86 | Primitive.All.equal 87 | ~info_eq:Unit.( = ) 88 | (Primitive.All.erase p1) 89 | (Primitive.All.erase p2) 90 | | _, _ -> false 91 | ;; 92 | 93 | let rec select_path ~path tm = 94 | match path with 95 | | [] -> Ok tm 96 | | i :: path -> 97 | (match tm with 98 | | BoundVar _ | FreeVar _ | Primitive _ -> Error "TODO: message" 99 | | Operator (_, _, scopes) -> 100 | (match List.nth scopes i with 101 | | None -> Error "TODO: message" 102 | | Some (Scope (_pats, tm)) -> select_path ~path tm)) 103 | ;; 104 | -------------------------------------------------------------------------------- /experimental/DeBruijn_2d.mli: -------------------------------------------------------------------------------- 1 | (** Representation of terms that uses 2d de Bruijn indices to represent scope. 2 | 3 | A [BoundVar (_, i, j)] represents a variable bound [i] scopes out, at index [j] in the 4 | pattern. *) 5 | type 'info term = 6 | | Operator of 'info * string * 'info scope list 7 | | BoundVar of 'info * int * int 8 | | FreeVar of 'info * string 9 | | Primitive of 'info Primitive.All.t 10 | 11 | and 'info scope = Scope of 'info Pattern.t list * 'info term 12 | 13 | val to_nominal : 'info term -> 'info Nominal.Term.t option 14 | val of_nominal : 'info Nominal.Term.t -> ('info term, 'info Nominal.Scope.t) Result.t 15 | 16 | val of_nominal_with_bindings 17 | : (int * int) Lvca_util.String.Map.t 18 | -> 'info Nominal.Term.t 19 | -> ('info term, 'info Nominal.Scope.t) Result.t 20 | 21 | (** Are the two terms equivalent up to variable renaming? *) 22 | val alpha_equivalent : 'a term -> 'b term -> bool 23 | 24 | val select_path : path:int list -> 'info term -> ('info term, string) Result.t 25 | 26 | (** Open a scope, substituting a term for each variable bound by this scope. *) 27 | 28 | (* val open_scope : scope -> term list -> (term, string) Result.t *) 29 | -------------------------------------------------------------------------------- /experimental/languages/LanguageDiagram.ml: -------------------------------------------------------------------------------- 1 | (* Inspiration: haskell's diagrams package, Tikz 2 | * 3 | * Questions: What should be primitive? How do we define a standard library? 4 | *) 5 | 6 | let abstract_syntax = 7 | {| 8 | // rational? 9 | // global: float 10 | 11 | diagram := 12 | | atop(diagram; diagram) 13 | | beside(vector; diagram; diagram) 14 | | adjustment(list attribute; diagram) 15 | 16 | vector := vector(float; float) 17 | 18 | adjustment := 19 | | scale 20 | | 21 | 22 | shape := 23 | | circle 24 | | line 25 | |} 26 | ;; 27 | 28 | let standard_library = 29 | {| 30 | unitX : vector 31 | = 1, 0 32 | 33 | unitY : vector 34 | = 0, 1 35 | 36 | (===) : diagram -> diagram -> diagram 37 | = beside (-unitY) 38 | 39 | (|||) : diagram -> diagram -> diagram 40 | = beside unitX 41 | |} 42 | ;; 43 | -------------------------------------------------------------------------------- /experimental/pages/0x-core-eval/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | LVCA 01: term <-> concrete 6 | 7 | 8 | 9 | 10 |
11 | 12 | 13 | -------------------------------------------------------------------------------- /experimental/pages/0x-diagram-render/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | LVCA 0x: diagram render 6 | 7 | 8 | 9 | 10 |
11 | 12 | 13 | -------------------------------------------------------------------------------- /experimental/pages/0x-document-render/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | LVCA 0x: document render 6 | 7 | 8 | 9 | 10 |
11 | 12 | 13 | -------------------------------------------------------------------------------- /experimental/pages/0x-document-render/main.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Js_of_ocaml 3 | open Lvca 4 | 5 | module Model = struct 6 | type t = 7 | { input : string 8 | ; result : (Binding.Nominal.term, ParseError.t) Core_kernel.Result.t option 9 | } 10 | 11 | let initial_model : t = 12 | let input = 13 | {|document( 14 | header(h2(); "some document"), 15 | paragraph(inline(inlineAtom("attrs"; "body text"))) 16 | )|} 17 | in 18 | { input; result = None } 19 | ;; 20 | end 21 | 22 | module Action = struct 23 | type t = 24 | | UpdateInput of string 25 | | Evaluate of string 26 | end 27 | 28 | type signal = Model.t React.signal 29 | type update_fun = ?step:React.step -> Model.t -> unit 30 | type react_pair = signal * update_fun 31 | 32 | module Controller = struct 33 | let update (action : Action.t) ((r, f) : react_pair) = 34 | let open Model in 35 | let { input; result } = React.S.value r in 36 | let new_model = 37 | match action with 38 | | Action.UpdateInput str -> { input = str; result } 39 | | Action.Evaluate str -> { input = str; result = Some (Parsing.Term.parse input) } 40 | in 41 | f new_model 42 | ;; 43 | end 44 | 45 | module View = struct 46 | open Js_of_ocaml_tyxml.Tyxml_js 47 | module Ev = Js_of_ocaml_lwt.Lwt_js_events 48 | 49 | let bind_event ev elem handler = 50 | let handler evt _ = handler evt in 51 | Ev.(async @@ fun () -> ev elem handler) 52 | ;; 53 | 54 | let mk_input ((r, _f) as react_pair : react_pair) = 55 | let input = 56 | r 57 | |> React.S.map (fun m -> m.Model.input) 58 | |> fun (value : string React.signal) -> 59 | R.Html5.( 60 | textarea 61 | ~a:[ a_rows (React.S.const 25); a_cols (React.S.const 90) ] 62 | (React.S.const (txt value))) 63 | in 64 | let input_dom = To_dom.of_textarea input in 65 | bind_event Ev.keydowns input_dom (fun evt -> 66 | let key = evt##.key |> Js.Optdef.to_option |> Option.map ~f:Js.to_string in 67 | Lwt.return 68 | (match key with 69 | (* TODO: require special key *) 70 | | Some "Enter" -> 71 | Controller.update (Evaluate (Js.to_string input_dom##.value)) react_pair 72 | | _ -> ())); 73 | input 74 | ;; 75 | 76 | let info ((r, _f) : react_pair) = 77 | r 78 | |> React.S.map (fun m -> 79 | match m.Model.result with 80 | | None -> "(press (ctrl/shift/meta)-enter to evaluate)" 81 | | Some tm_result -> 82 | (match tm_result with 83 | | Ok _tm -> "TODO (render document)" 84 | | Error err -> ParseError.to_string err)) 85 | |> fun msg -> Html5.(div [ R.Html5.txt msg ]) 86 | ;; 87 | 88 | let view (react_pair : react_pair) = 89 | Html5.(div [ mk_input react_pair; info react_pair ]) 90 | ;; 91 | end 92 | 93 | let main _ = 94 | let doc = Dom_html.document in 95 | let parent = 96 | Js.Opt.get (doc##getElementById (Js.string "app")) (fun () -> assert false) 97 | in 98 | let m = Model.initial_model in 99 | let react_pair = React.S.create m in 100 | Dom.appendChild parent (Js_of_ocaml_tyxml.Tyxml_js.To_dom.of_div (View.view react_pair)); 101 | Lwt.return () 102 | ;; 103 | 104 | let (_ : unit Lwt.t) = 105 | let open Lwt.Infix in 106 | Js_of_ocaml_lwt.Lwt_js_events.onload () >>= main 107 | ;; 108 | -------------------------------------------------------------------------------- /experimental/pages/0x-huttons-razor/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | LVCA 0x: Hutton's Razor parser 6 | 7 | 8 | 9 | 10 |

concrete syntax -> abstract

11 |
12 |

abstract syntax -> concrete

13 |
14 |

typechecking

15 |
16 | 17 | 18 | -------------------------------------------------------------------------------- /experimental/pages/style/index.css: -------------------------------------------------------------------------------- 1 | input:focus, textarea { 2 | outline: none !important; 3 | } 4 | body, textarea, input, table { 5 | font-family: monospace; 6 | color: #1e1e5d; 7 | } 8 | body, table { 9 | font-size: 16px; 10 | } 11 | h1 { 12 | font-weight: 400; 13 | margin: 0; 14 | } 15 | h2, h3 { 16 | font-weight: 200; 17 | margin: 0; 18 | } 19 | button { 20 | border: 2px solid #1e1e5d; 21 | background: white; 22 | color: #1e1e5d; 23 | font-family: system-ui, sans-serif; 24 | font-size: 1rem; 25 | line-height: 1.2; 26 | white-space: nowrap; 27 | text-decoration: none; 28 | padding: 0.25rem 0.5rem; 29 | margin: 0.25rem; 30 | cursor: pointer; 31 | } 32 | a { 33 | text-decoration: none; 34 | color: #1e1e5d; 35 | } 36 | .error { 37 | color: #c12828; 38 | } 39 | div.lvca-viewer { 40 | display: table; 41 | border-collapse: collapse; 42 | width: 800px; 43 | } 44 | h1.header { 45 | margin-left: 20px; 46 | margin-top: 30px; 47 | } 48 | h2.header2 { 49 | padding: 15px 0 10px 20px; 50 | } 51 | h2.header2 checkbox { 52 | font-size: 20px; 53 | } 54 | div.concrete-pane, 55 | div.concrete-info-pane, 56 | div.abstract-syntax-pane, 57 | div.statics-pane, 58 | div.dynamics-pane, 59 | div.repl-pane { 60 | padding: 20px; 61 | } 62 | div.term-input { 63 | padding: 10px; 64 | border: 2px dashed #1e1e2d; 65 | } 66 | div.history-item { 67 | margin: 30px 0; 68 | } 69 | div.history-input { 70 | padding: 14px 10px; 71 | margin: 5px 0; 72 | border: 2px solid #1e1e2d; 73 | cursor: pointer; 74 | } 75 | div.term-view { 76 | margin-top: 5px; 77 | padding-top: 10px; 78 | } 79 | div.repl-pane .CodeMirror pre { 80 | padding: 0; 81 | } 82 | .result-bad { 83 | color: #c12828; 84 | } 85 | .result-good { 86 | color: #06925a; 87 | } 88 | .CodeMirror { 89 | height: auto; 90 | border: 2px solid #1e1e5d; 91 | } 92 | div.eval-result-row { 93 | display: flex; 94 | justify-content: space-between; 95 | } 96 | 97 | table { 98 | border-collapse: collapse; 99 | } 100 | 101 | table, 102 | td, th { 103 | border: 1px solid #1e1e5d; 104 | padding: 5px; 105 | } 106 | 107 | thead, 108 | tfoot { 109 | /* background-color: #1e1e5d; 110 | color: #fff; 111 | */ 112 | } 113 | 114 | .syntax-debugger { 115 | margin: 20px 20px 20px 0; 116 | } 117 | 118 | /* TODO: fix padding of first token */ 119 | .token { 120 | cursor: pointer; 121 | display: inline-block; 122 | padding: 0 4px; 123 | } 124 | 125 | .token:first-child { 126 | padding: 0 4px 0 0; 127 | } 128 | 129 | .debugger-tokens { 130 | padding: 8px 0; 131 | } 132 | .section-box { 133 | border: 2px solid #1e1e5d; 134 | padding: 20px; 135 | display: table-row; 136 | } 137 | .section-box.disabled { 138 | color: gray; 139 | cursor: not-allowed; 140 | } 141 | .section-box h3 { 142 | padding: 10px; 143 | cursor: pointer; 144 | } 145 | .section-box.disabled h3, .section-box.disabled a, button.disabled { 146 | color: gray; 147 | cursor: not-allowed; 148 | } 149 | -------------------------------------------------------------------------------- /experimental/web/exe/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | LVCA web 6 | 7 | 8 | 9 | 10 |
11 | 12 | 13 | -------------------------------------------------------------------------------- /experimental/web/exe/main.ml: -------------------------------------------------------------------------------- 1 | open Bonsai_web 2 | open Core_kernel 3 | open Lvca_web2 4 | 5 | let test_md = [%blob "test.md"] 6 | 7 | let (_ : _ Start.Handle.t) = 8 | (* Points from sha256 to term *) 9 | let term_store = String.Table.create () in 10 | let component = 11 | test_md 12 | |> LanguageDocument.evaluate_and_produce_vdom 13 | { term_store; name_store = Store.initial_name_store } 14 | |> Bonsai.const 15 | in 16 | Start.start_standalone 17 | ~initial_input:() 18 | ~initial_model:() 19 | ~bind_to_element_with_id:"app" 20 | component 21 | ;; 22 | -------------------------------------------------------------------------------- /experimental/web/exe/test.md: -------------------------------------------------------------------------------- 1 | # Hutton's Razor 2 | 3 | Hutton's Razor is a minimal language with exactly two types of expressions: 4 | integer literals and addition. 5 | 6 | ``` 7 | {define arith : abstract_syntax} 8 | // global: integer 9 | 10 | tm := 11 | | add(tm(); tm()) 12 | | lit(integer()) 13 | ``` 14 | 15 | ``` 16 | {define arith_concrete : concrete_syntax} 17 | PLUS := "+" 18 | NUM := /[0-9]+/ 19 | 20 | tm := 21 | | a = tm PLUS b = tm { add(a; b) } 22 | | n = NUM { lit(integer(n)) } 23 | ``` 24 | 25 | ``` 26 | {define arith_statics : statics} 27 | --- (infer int) 28 | ctx >> tm => int() 29 | ``` 30 | 31 | ``` 32 | {define arith_dynamics : dynamics} 33 | meaning = \(tm : int()) -> match tm with { 34 | | add(x; y) -> #add(meaning x; meaning y) 35 | | lit(i) -> i 36 | } 37 | ``` 38 | 39 | ``` 40 | {define test : arith} 41 | 1 + 1 42 | ``` 43 | -------------------------------------------------------------------------------- /experimental/web/store.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/experimental/web/store.ml -------------------------------------------------------------------------------- /input/input: -------------------------------------------------------------------------------- 1 | 03.14 2 | -------------------------------------------------------------------------------- /languages/Lvca_models.ml: -------------------------------------------------------------------------------- 1 | open Lvca_syntax 2 | module Option_model = Lvca_del.Option_model 3 | module List_model = Lvca_del.List_model 4 | module Either_model = [%lvca.abstract_syntax_module "either a b := Left(a) | Right(b);"] 5 | 6 | module Primitive_model = 7 | [%lvca.abstract_syntax_module 8 | {| 9 | integer : * 10 | int32 : * 11 | string : * 12 | float : * 13 | char : * 14 | 15 | primitive := 16 | | Integer(integer) 17 | | Int32(int32) 18 | | String(string) 19 | | Float(float) 20 | | Char(char) 21 | ; 22 | |} 23 | , { integer = "Primitive.Integer" 24 | ; int32 = "Primitive.Int32" 25 | ; string = "Primitive.String" 26 | ; float = "Primitive.Float" 27 | ; char = "Primitive.Char" 28 | }] 29 | 30 | module Nonbinding_model = 31 | [%lvca.abstract_syntax_module 32 | {| 33 | string : * 34 | primitive : * 35 | list : * -> * 36 | 37 | term := 38 | | Operator(string; list term) 39 | | Primitive(primitive) 40 | ; 41 | |} 42 | , { string = "Primitive.String"; primitive = "Primitive.All"; list = "List_model" }] 43 | 44 | module Pattern_model = 45 | [%lvca.abstract_syntax_module 46 | {| 47 | string : * 48 | primitive : * 49 | list : * -> * 50 | 51 | pattern := 52 | | Operator(string; list pattern) 53 | | Primitive(primitive) 54 | | Var(string) 55 | | Ignored(string) 56 | ; 57 | |} 58 | , { string = "Primitive.String"; primitive = "Primitive.All"; list = "List_model" }] 59 | 60 | module Nominal_model = 61 | [%lvca.abstract_syntax_module 62 | {| 63 | list : * -> * 64 | pattern : * 65 | primitive : * 66 | string : * 67 | 68 | term := 69 | | Operator(string; list scope) 70 | | Var(string) 71 | | Primitive(primitive) 72 | ; 73 | 74 | scope := Scope(list pattern; term); 75 | |} 76 | , { list = "List_model" 77 | ; pattern = "Pattern_model.Pattern" 78 | ; primitive = "Primitive.All" 79 | ; string = "Primitive.String" 80 | }] 81 | 82 | (* TODO: this should fail if we remove the declaration of either. *) 83 | module DeBruijn_model = 84 | [%lvca.abstract_syntax_module 85 | {| 86 | either : * -> * -> * 87 | int32 : * 88 | list : * -> * 89 | primitive : * 90 | string : * 91 | 92 | term := 93 | | BoundVar(int32) 94 | | FreeVar(string) 95 | | Primitive(primitive) 96 | | Operator(string; list (either scope term)) 97 | ; 98 | 99 | scope := Scope(string; term); 100 | |} 101 | , { either = "Either_model.Either" 102 | ; int32 = "Primitive.Int32" 103 | ; list = "List_model" 104 | ; primitive = "Primitive.All" 105 | ; string = "Primitive.String" 106 | }] 107 | 108 | module DeBruijn_2d_model = 109 | [%lvca.abstract_syntax_module 110 | {| 111 | int32 : * 112 | list : * -> * 113 | pattern : * 114 | primitive : * 115 | string : * 116 | 117 | term := 118 | | Operator(string; list scope) 119 | | BoundVar(int32) 120 | | FreeVar(string) 121 | | Primitive(primitive) 122 | ; 123 | 124 | scope := Scope(list pattern; term); 125 | |} 126 | , { int32 = "Primitive.Int32" 127 | ; list = "List_model" 128 | ; pattern = "Pattern_model.Pattern" 129 | ; primitive = "Primitive.All" 130 | ; string = "Primitive.String" 131 | }] 132 | 133 | module Properties (Lang : Nominal.Convertible.S) = struct 134 | (* TODO: check all generated functions equivalent *) 135 | end 136 | -------------------------------------------------------------------------------- /languages/Nat.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lvca_syntax 3 | open Lvca_util 4 | 5 | module Lang = 6 | [%lvca.abstract_syntax_module 7 | {| 8 | string : * 9 | 10 | nat := Z() | S(nat); 11 | 12 | list := Nil() | Cons(string; list); 13 | |} 14 | , { string = "Primitive.String" }] 15 | 16 | (* very loosely *) 17 | let correspondence = 18 | {| 19 | let rec f = function 20 | | Z{info} <-> Nil{info} 21 | | S{info}(n) <-> Cons(info; f n) 22 | |} 23 | ;; 24 | 25 | module List = Nominal.Convertible.Extend (Lang.List) 26 | module Nat = Nominal.Convertible.Extend (Lang.Nat) 27 | 28 | module Foo : sig 29 | val list_to_nat : List.t -> Nat.t option 30 | val nat_to_list : Nat.t -> List.t option 31 | 32 | module Properties : sig 33 | val round_trip_1 : List.t -> Property_result.t 34 | val round_trip_2 : Nat.t -> Property_result.t 35 | end 36 | end = struct 37 | open Option.Let_syntax 38 | 39 | let rec list_to_nat = function 40 | | Lang.Types.Nil info -> Some (Lang.Types.Z info) 41 | | Cons (info, _a, lst) -> 42 | let%map lst = list_to_nat lst in 43 | Lang.Types.S (info, lst) 44 | ;; 45 | 46 | let rec nat_to_list = function 47 | | Lang.Types.Z info -> Some (Lang.Types.Nil info) 48 | | S (info, n) -> 49 | let%map lst = nat_to_list n in 50 | Lang.Types.Cons (info, failwith "TODO", lst) 51 | ;; 52 | 53 | module Properties = struct 54 | let round_trip_1 lst = 55 | match list_to_nat lst with 56 | | None -> Property_result.Uninteresting 57 | | Some nat -> 58 | (match nat_to_list nat with 59 | | None -> Failed "Failed to convert nat back to list" 60 | | Some lst' -> Property_result.check (List.equivalent lst lst') "Lists not equal") 61 | ;; 62 | 63 | let round_trip_2 nat = 64 | match nat_to_list nat with 65 | | None -> Property_result.Uninteresting 66 | | Some lst -> 67 | (match list_to_nat lst with 68 | | None -> Failed "Failed to convert list back to nat" 69 | | Some nat' -> Property_result.check (Nat.equivalent nat nat') "Nats not equal") 70 | ;; 71 | end 72 | end 73 | 74 | (* TODO: 75 | - un-hardcode string 76 | - check: 77 | * list_to_nat, nat_to_list round-trip 78 | * correspondence parser, matches list_to_nat, nat_to_list 79 | * give example: implement addition, get concatenation 80 | *) 81 | -------------------------------------------------------------------------------- /languages/Parse_pretty.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lvca_syntax 3 | open Lvca_models 4 | 5 | module Lang = 6 | [%lvca.abstract_syntax_module 7 | {| 8 | list : * -> * 9 | string : * 10 | term : * 11 | binding_aware_pattern : * 12 | 13 | lang := Rows(list row); 14 | 15 | row := Row(binding_aware_pattern; directive); 16 | 17 | directive := 18 | | Literal(string) 19 | | Many(list directive) 20 | | Many1(list directive) 21 | | Sep_by(directive; list directive) 22 | | Sep_by1(directive; list directive) 23 | | Term(term) 24 | ; 25 | |} 26 | , { list = "List_model" 27 | ; string = "Primitive.String" 28 | ; term = "Nominal.Term" 29 | ; binding_aware_pattern = "Binding_aware_pattern" 30 | }] 31 | 32 | let hutton_example = 33 | {| 34 | expr: 35 | | lit(i) <-> i 36 | | add(a; b) <-> a "+" b XXX precedence needed 37 | 38 | type: 39 | | int() <-> "int" 40 | 41 | precedence: 42 | a "+" b "+" c -> 43 | (a "+" b) "+" c 44 | add(add(a; b); c) 45 | 46 | a + b + c -> (a + b) + c 47 | 48 | + + -> (+) + 49 | |} 50 | ;; 51 | 52 | let eff_example = 53 | {| 54 | value: 55 | | True() <-> "true" 56 | | False() <-> "false" 57 | | Fun(x. c) <-> "fun" x "->" c 58 | | Handler_val(h) <-> h 59 | 60 | handler_clause: 61 | | Return_clause(x. c) <-> "return" x "->" c 62 | | Op_clause(name; x. k. c) <-> name "(" x "." k ")" "->" c 63 | 64 | handler: 65 | | Handler(clauses) <-> "handler" "{" clauses "}" 66 | 67 | computation: 68 | | Return(v) <-> "return" v 69 | | Op(name; v; y. c) <-> name "(" v ";" y "." c ")" 70 | | Do(c1; x. c2) <-> "do" x "<-" c1 "in" c2 71 | | If(v; c1; c2) <-> "if" v "then" c1 "else" c2 72 | | App(v1; v2) <-> v1 v2 73 | | With_handle(v; c) <-> "with" v "handle" c 74 | 75 | v_type: 76 | | Bool() <-> "bool" 77 | | Fun_ty(v; c) <-> v "->" c 78 | | Handler_ty(c1; c2) <-> c1 "=>" c2 79 | 80 | c_type: 81 | | Computation(v; ops) <-> v "!" "{" ops "}" 82 | |} 83 | ;; 84 | 85 | module Todo = struct 86 | (* Translate from this language to the parser langugage *) 87 | let parser_mapping = 88 | {| 89 | 90 | TODO 91 | 92 | let translate_row = \(row : row) -> match row with { 93 | | row(pat. directive) -> ... 94 | } 95 | 96 | \(lang : lang) -> match lang with { rows(rows) -> list.map translate_row rows } 97 | |} 98 | ;; 99 | 100 | (* Translate from this language to the JYP printer langugage *) 101 | let printer_mapping = 102 | {| 103 | let translate_directive = \(directive : directive) -> match directive with { 104 | | literal(str) -> text(str) 105 | | many(directives) -> 106 | | many1(directives) -> 107 | let directives = list.map translate_directive directives in 108 | let broken_directives = list.intersperse directives line() in 109 | alt(directives; broken_directives) 110 | | Sep_by(sep; directives) -> 111 | | sepby1(sep; directives) -> 112 | let directives = list.map translate_directive directives in 113 | let sep_directives = list.intersperse directives sep in 114 | let broken_sep_directives = list.intersperse directives cat(sep; line()) in 115 | alt(sep_directives; broken_sep_directives) 116 | | term(tm) -> term.print tm 117 | } 118 | 119 | let translate_row = \(row : row) -> match row with { 120 | // XXX how does this bind? Also, need term here. 121 | row(pat. directive) -> binding_aware_pattern.match(pat; term; translate_directive directive) 122 | } 123 | 124 | \(lang : lang) -> match lang with { rows(rows) -> list.map translate_row rows } 125 | |} 126 | ;; 127 | end 128 | -------------------------------------------------------------------------------- /languages/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lvca_languages) 3 | (public_name lvca.languages) 4 | (inline_tests) 5 | (libraries constructive_real fmt lvca_bidirectional lvca_del lvca_parsing 6 | lvca_syntax lvca_util omd) 7 | (preprocess 8 | (pps ppx_jane ppx_lvca ppx_lvca_del))) 9 | -------------------------------------------------------------------------------- /lvca.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | version: "1.0" 3 | synopsis: "Tools for creating programming languages" 4 | maintainer: "joelburget@gmail.com" 5 | authors: "Joel Burget" 6 | license: "MIT" 7 | homepage: "https://github.com/joelburget/lvca" 8 | bug-reports: "https://github.com/joelburget/lvca/issues" 9 | depends: [ 10 | "angstrom" 11 | "base" 12 | "brr" 13 | "cbor" 14 | "crowbar" 15 | "digestif" 16 | "dune" {>= "2.0.0"} 17 | "fmt" 18 | "note" 19 | "ocaml" {>= "4.08.0"} 20 | "omd" 21 | "ppx_blob" 22 | "ppx_inline_test" 23 | "ppx_jane" 24 | "ppx_optcomp" {>= "v0.14.1"} 25 | "ppxlib" {>= "0.22.0"} 26 | "uchar" {>= "0.0.2"} 27 | "zarith" 28 | "zarith_stubs_js" 29 | "re" {>= "1.10.3"} 30 | ] 31 | build: ["dune" "build" "-p" name "-j" jobs] 32 | dev-repo: "git+https://github.com/joelburget/lvca.git" 33 | -------------------------------------------------------------------------------- /pages/Ast_operations.ml: -------------------------------------------------------------------------------- 1 | module Model = struct 2 | let initial_model = () 3 | end 4 | 5 | module View = struct 6 | open Brr.El 7 | 8 | let view _model = 9 | div 10 | [ txt' "substitution" 11 | ; txt' "opening" 12 | ; txt' "closing" 13 | ; txt' "structural induction" 14 | ; txt' "folding" 15 | ; txt' "is open? (free vars)" 16 | ; txt' "renaming" 17 | ; txt' "(alpha) equivalence checking" 18 | ] 19 | ;; 20 | end 21 | 22 | let stateless_view () = View.view Model.initial_model 23 | -------------------------------------------------------------------------------- /pages/Common.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Brr 3 | open Brr_note 4 | open Lvca_provenance 5 | open Lvca_syntax 6 | open Prelude 7 | 8 | type term = Nominal.Term.t 9 | 10 | let reserved = Lvca_util.String.Set.empty 11 | 12 | let parse_term = 13 | let open Lvca_parsing in 14 | parse_string (whitespace *> Nominal.Term.parse' reserved) 15 | ;; 16 | 17 | type lang = 18 | | Lambda 19 | | Term 20 | 21 | let parser_of = function 22 | | Lambda -> Lvca_languages.Lambda_calculus.Parse.t 23 | | Term -> Nominal.Term.parse' reserved 24 | ;; 25 | 26 | (* let term_pretty = Nominal.Term.pp *) 27 | (* let lambda_pretty = Lvca_languages.Lambda_calculus.pp *) 28 | (* let lambda_ranges_pretty = Lvca_languages.Lambda_calculus.pp *) 29 | let html_eq = Stdlib.( = ) 30 | let htmls_eq = List.equal Stdlib.( = ) 31 | 32 | module Action = struct 33 | type t = 34 | | Evaluate of string 35 | | Input_select of Opt_range.t 36 | | Output_select of Opt_range.t 37 | | Switch_input_lang 38 | end 39 | 40 | let demo_template input_desc input_elem output_desc output_elem = 41 | let button, div, h2, h3 = El.(button, div, h2, h3) in 42 | let txt str = El.txt (Jstr.v str) in 43 | let button = 44 | button 45 | ~at:(classes "p-2 border-2 border-indigo-900 rounded") 46 | [ txt "switch input languages" ] 47 | in 48 | let evt = Evr.on_el Ev.click Fn.id button in 49 | let elem = 50 | div 51 | [ h2 [ txt "Demo" ] 52 | ; div 53 | ~at:[ class' "container" ] 54 | [ div ~at:[ class' "py-4" ] [ h3 [ input_desc ]; input_elem ] 55 | ; div ~at:[ class' "switch-languages" ] [ button ] 56 | ; div ~at:[ class' "py-4" ] [ h3 [ output_desc ]; output_elem ] 57 | ] 58 | ] 59 | in 60 | elem, evt 61 | ;; 62 | 63 | type input_event = 64 | | Evaluate_input of string 65 | | Input_update of string 66 | | Input_select of Range.t 67 | | Input_unselect 68 | 69 | let mk_output elt_s = mk_reactive' El.div ~at:[ class' "bg-gray-100" ] elt_s 70 | -------------------------------------------------------------------------------- /pages/Common.mli: -------------------------------------------------------------------------------- 1 | (** Grab-bag of frontend stuff. *) 2 | 3 | open Lvca_provenance 4 | open Lvca_syntax 5 | 6 | type term = Nominal.Term.t 7 | 8 | val parse_term : string -> (term, string) Result.t 9 | 10 | type lang = 11 | | Lambda 12 | | Term 13 | 14 | val parser_of : lang -> term Lvca_parsing.t 15 | 16 | (* val term_pretty : Nominal.Term.t Fmt.t *) 17 | (* val lambda_pretty : Nominal.Term.t Fmt.t *) 18 | (* val lambda_ranges_pretty : Nominal.Term.t Fmt.t *) 19 | val html_eq : Brr.El.t -> Brr.El.t -> bool 20 | val htmls_eq : Brr.El.t list -> Brr.El.t list -> bool 21 | 22 | module Action : sig 23 | type t = 24 | | Evaluate of string 25 | | Input_select of Opt_range.t 26 | | Output_select of Opt_range.t 27 | | Switch_input_lang 28 | end 29 | 30 | val demo_template 31 | : Brr.El.t 32 | -> Brr.El.t 33 | -> Brr.El.t 34 | -> Brr.El.t 35 | -> Brr.El.t * Brr.Ev.Mouse.t Brr.Ev.t Note.event 36 | 37 | type input_event = 38 | | Evaluate_input of string 39 | | Input_update of string 40 | | Input_select of Range.t 41 | | Input_unselect 42 | 43 | val mk_output : Brr.El.t Note.signal -> Brr.El.t 44 | -------------------------------------------------------------------------------- /pages/Components.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Brr 3 | open Brr_note 4 | open Note 5 | open Prelude 6 | 7 | let error_msg x = El.div ~at:[ class' "error" ] x 8 | let success_msg x = El.div ~at:[ class' "success" ] x 9 | 10 | (* TODO: remove *) 11 | let mk_at ~border ~classes = 12 | let classes = if border then "border-2" :: classes else classes in 13 | List.map classes ~f:Prelude.class' 14 | ;; 15 | 16 | let rows ?(border = false) ?(classes = [ "ml-2" ]) elems = 17 | El.div ~at:(mk_at ~border ~classes:("flex" :: "flex-col" :: classes)) elems 18 | ;; 19 | 20 | let cols ?(border = false) ?(classes = []) elems = 21 | El.div ~at:(mk_at ~border ~classes:("flex" :: "flex-row" :: classes)) elems 22 | ;; 23 | 24 | let button_classes = 25 | [ "px-2" 26 | ; "border-2" 27 | ; "border-blue-800" 28 | ; "dark:border-blue-200" 29 | ; "rounded" 30 | ; "bg-transparent" 31 | ; "hover:bg-blue-700" 32 | ; "dark:hover:bg-blue-900" 33 | ; "text-blue-800" 34 | ; "dark:text-blue-50" 35 | ; "hover:text-white" (* (no dark) *) 36 | ; "cursor-pointer" 37 | ] 38 | ;; 39 | 40 | let button str = 41 | let button = El.button ~at:(button_classes |> List.map ~f:class') [ El.txt' str ] in 42 | let evt : unit event = Evr.on_el Ev.click (fun _ -> ()) button in 43 | evt, button 44 | ;; 45 | 46 | let table ?(classes = []) thead tbody = 47 | let tbody = tbody |> S.map ~eq:Common.htmls_eq (fun tbody -> thead :: tbody) in 48 | mk_reactive El.table ~at:(classes |> List.map ~f:class') tbody 49 | ;; 50 | 51 | let inline_block x = El.div ~at:[ class' "inline-block" ] [ x ] 52 | let r_inline_block child_s = mk_reactive' El.div ~at:[ class' "inline-block" ] child_s 53 | 54 | let button_toggle ~visible_text ~hidden_text visible_s = 55 | let text_s = 56 | visible_s |> S.map (function true -> visible_text | false -> hidden_text) 57 | in 58 | let button = 59 | mk_reactive' El.button ~at:(List.map button_classes ~f:class') (S.map El.txt' text_s) 60 | in 61 | let evt = Evr.on_el Ev.click Fn.id button in 62 | evt, button 63 | ;; 64 | 65 | let chevron_toggle visible_s = 66 | let class_s = 67 | visible_s 68 | |> S.map (function true -> "gg-chevron-down" | false -> "gg-chevron-right") 69 | |> S.map (fun cls -> Some (Jstr.v cls)) 70 | in 71 | let i = El.i [] in 72 | let () = Elr.def_at At.Name.class' class_s i in 73 | let elem = 74 | El.a 75 | ~at:[ class' "cursor-pointer"; class' "p-1" ] 76 | [ El.span ~at:[ class' "chevron-icon-wrap" ] [ i ] ] 77 | in 78 | let e = Evr.on_el Ev.click (fun _evt -> not (S.value visible_s)) elem in 79 | e, elem 80 | ;; 81 | -------------------------------------------------------------------------------- /pages/Digits_entry.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Brr 3 | open Brr_note 4 | open Note 5 | open Prelude 6 | 7 | type digits_update = 8 | | SetDigits of int 9 | | IncrDigits 10 | | DecrDigits 11 | 12 | let mk digits_s = 13 | (* TODO: inputmode="decimal" 14 | * https://css-tricks.com/better-form-inputs-for-better-mobile-user-experiences/ 15 | * https://github.com/ocsigen/tyxml/issues/278 16 | *) 17 | let at = 18 | At.[ type' (Jstr.v "text"); inputmode "numeric" ] 19 | @ classes "font-mono border-2 border-indigo-900 rounded p-1 focus:ring w-16" 20 | in 21 | let input = El.input ~at () in 22 | let digits_s = digits_s |> S.map (fun str -> Some (Jstr.v (Int.to_string str))) in 23 | let () = Elr.def_at (Jstr.v "value") digits_s input in 24 | let digits_event = 25 | Evr.on_el 26 | Ev.keydown 27 | (fun evt -> 28 | let key_evt = Ev.as_type evt in 29 | let key_name = key_evt |> Ev.Keyboard.key |> Jstr.to_string in 30 | match key_name with 31 | | "Enter" -> 32 | Ev.prevent_default evt; 33 | (try 34 | Some 35 | (SetDigits 36 | (input 37 | |> El.at At.Name.value 38 | |> Option.value_exn 39 | |> Jstr.to_string 40 | |> Int.of_string)) 41 | with 42 | | _ -> None) 43 | | "ArrowUp" | "ArrowRight" -> 44 | Ev.prevent_default evt; 45 | Some IncrDigits 46 | | "ArrowDown" | "ArrowLeft" -> 47 | Ev.prevent_default evt; 48 | Some DecrDigits 49 | | _ -> None) 50 | input 51 | |> E.Option.on_some 52 | in 53 | input, digits_event 54 | ;; 55 | -------------------------------------------------------------------------------- /pages/Edits.ml: -------------------------------------------------------------------------------- 1 | module Model = struct 2 | let initial_model = () 3 | end 4 | 5 | module View = struct 6 | open Brr.El 7 | 8 | let view _model = div [ txt' "TODO" ] 9 | end 10 | 11 | let stateless_view () = View.view Model.initial_model 12 | -------------------------------------------------------------------------------- /pages/Ide.ml: -------------------------------------------------------------------------------- 1 | open Brr 2 | open Note 3 | 4 | module Model = struct 5 | type t = unit 6 | 7 | let initial_model = () 8 | let ( = ) _ _ = true 9 | end 10 | 11 | module Action = struct 12 | type t = Nop 13 | end 14 | 15 | module Controller = struct 16 | let update (action : Action.t) model = match action with Nop -> model 17 | end 18 | 19 | module View = struct 20 | open El 21 | 22 | let view _model_s = E.select [], div [ txt' "TODO: IDE" ] 23 | end 24 | 25 | module Stateless_view = Stateless_view.Mk (Action) (Model) (View) (Controller) 26 | -------------------------------------------------------------------------------- /pages/Katex.ml: -------------------------------------------------------------------------------- 1 | open Brr 2 | 3 | let render : El.t -> string -> unit = 4 | fun elem str -> 5 | let katex = Jv.get (Window.to_jv G.window) "katex" in 6 | let (_ : Jv.t) = 7 | Jv.call 8 | katex 9 | "render" 10 | [| Jv.of_string str; El.to_jv elem; Jv.obj [| "throwOnError", Jv.false' |] |] 11 | in 12 | () 13 | ;; 14 | -------------------------------------------------------------------------------- /pages/List_nat.ml: -------------------------------------------------------------------------------- 1 | module Language = struct 2 | let nat = [%lvca.abstract_syntax "nat := Z() | S(nat);"] 3 | let list = [%lvca.abstract_syntax "list a := Nil() | Cons(a; list a);"] 4 | 5 | (* 6 | let rec nat_to_list = function 7 | | Nonbinding.Operator (_, "Z", []) -> Nonbinding.Operator ((), "Nil", []) 8 | | Operator (i, "S", [ nat ]) -> Operator ((), "Cons", [ i; nat_to_list nat ]) 9 | | Operator _ | Primitive _ -> failwith "invariant violation" 10 | ;; 11 | 12 | let rec list_to_nat = function 13 | | Nonbinding.Operator (_, "Nil", []) -> Nonbinding.Operator (None, "Z", []) 14 | | Operator ((), "Cons", [ i; list ]) -> Operator (Some i, "S", [ list_to_nat list ]) 15 | | Operator _ | Primitive _ -> failwith "invariant violation" 16 | ;; 17 | *) 18 | 19 | (* From this defn, should be able to derive list concatenation *) 20 | let core_sum = 21 | {|let rec sum = \(x : nat) (y : nat) -> match x with { 22 | | Z() -> y 23 | | S(x') -> S(sum x' y) 24 | }|} 25 | ;; 26 | 27 | (* From this defn, should be able to derive predecessor *) 28 | let core_tail = 29 | {|let tail = \(x : a list) -> match x with { 30 | | Cons(a; as) -> as 31 | | Nil() -> Nil 32 | } 33 | |} 34 | ;; 35 | end 36 | 37 | module Model = struct 38 | let initial_model = () 39 | end 40 | 41 | module View = struct 42 | open Brr.El 43 | 44 | let view _model = div [ txt' "TODO" ] 45 | end 46 | 47 | let stateless_view () = View.view Model.initial_model 48 | -------------------------------------------------------------------------------- /pages/Multiline_input.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Brr 3 | open Brr_note 4 | open Note 5 | open Prelude 6 | 7 | let txt' = El.txt' 8 | 9 | let mk ?(autofocus = true) ?(border = true) ?(rows = None) ?(cols = 60) ?(at = []) input_s 10 | = 11 | let input_dirty_s, update_input_dirty = S.create false in 12 | let needed_rows = 13 | match rows with 14 | | Some n -> n 15 | | None -> String.count (S.value input_s) ~f:(fun c -> Char.(c = '\n')) + 1 16 | in 17 | let input_dirty_elem = 18 | input_dirty_s 19 | |> S.map (function 20 | | true -> 21 | (match Web_util.platform_special_combo () with 22 | | Some info_elems -> 23 | List.concat 24 | [ [ txt' "updated, press " ]; info_elems; [ txt' " to re-evaluate)" ] ] 25 | | None -> [ txt' "updated (press Enter to re-evaluate)" ]) 26 | | false -> [ txt' "" ]) 27 | in 28 | let classes = 29 | [ Some "mt-4" 30 | ; Some "p-8" 31 | ; Some "font-mono" 32 | ; Some "dark:bg-transparent" 33 | ; (if border then Some "border-2" else None) 34 | ; (if border then Some "border-indigo-900" else None) 35 | ; (if border then Some "dark:border-indigo-200" else None) 36 | ] 37 | |> List.filter_map ~f:Fn.id 38 | |> List.map ~f:class' 39 | in 40 | let input = 41 | El.textarea 42 | ~at: 43 | ([ At.rows needed_rows; At.cols cols ] 44 | @ classes 45 | @ if autofocus then [ At.autofocus ] else []) 46 | [ input_s |> S.value |> txt' ] 47 | in 48 | let () = Elr.set_prop El.Prop.value input ~on:(input_s |> S.changes |> E.map Jstr.v) in 49 | let _sink : Logr.t option = 50 | let evt = Evr.on_el Ev.input Fn.id input in 51 | E.log evt (fun _evt -> update_input_dirty true) 52 | in 53 | let keydown_evt = 54 | let handler evt = 55 | let keyboard_evt = Ev.as_type evt in 56 | if Web_util.is_special_enter keyboard_evt 57 | then ( 58 | Ev.prevent_default evt; 59 | update_input_dirty false; 60 | Some (Common.Evaluate_input (El.prop El.Prop.value input |> Jstr.to_string))) 61 | else None 62 | in 63 | Evr.on_el Ev.keydown handler input |> E.filter_map Fn.id 64 | in 65 | let select_evt = 66 | let handler _evt = 67 | let start = El.prop selection_start input in 68 | let finish = El.prop selection_end input in 69 | Common.Input_select Lvca_provenance.Range.{ start; finish } 70 | in 71 | Evr.on_el Ev.select handler input 72 | in 73 | let unselect_evt : Common.input_event event = 74 | Evr.on_el Ev.click (fun _evt -> Common.Input_unselect) input 75 | in 76 | let input_event = E.select [ keydown_evt; select_evt; unselect_evt ] in 77 | let result = 78 | El.div 79 | ~at:([ class' "flex"; class' "flex-col" ] @ at) 80 | [ input; mk_reactive El.span ~at:[ class' "my-2" ] input_dirty_elem ] 81 | in 82 | result, input_event 83 | ;; 84 | -------------------------------------------------------------------------------- /pages/Multiline_input.mli: -------------------------------------------------------------------------------- 1 | val mk 2 | : ?autofocus:bool 3 | -> ?border:bool 4 | -> ?rows:int option 5 | -> ?cols:int 6 | -> ?at:Brr.At.t list 7 | -> string Note.signal 8 | -> Brr.El.t * Common.input_event Note.event 9 | -------------------------------------------------------------------------------- /pages/Prelude.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Brr 3 | open Brr_note 4 | 5 | let main ?d ?at = El.v ?d ?at (Jstr.v "main") 6 | let class' str = At.class' (Jstr.v str) 7 | let data' name v = At.v (Jstr.v ("data-" ^ name)) (Jstr.v v) 8 | let type' str = At.type' (Jstr.v str) 9 | 10 | let classes str = 11 | str |> String.split ~on:' ' |> List.map ~f:(fun cls -> At.class' (Jstr.v cls)) 12 | ;; 13 | 14 | let inputmode str = At.v (Jstr.v "inputmode") (Jstr.v str) 15 | 16 | module Navigator = struct 17 | include Brr.Navigator 18 | 19 | let user_agent = Jv.Jstr.get (Navigator.to_jv G.navigator) "userAgent" 20 | let platform = Jv.Jstr.get (Navigator.to_jv G.navigator) "platform" 21 | end 22 | 23 | module Window = struct 24 | include Brr.Window 25 | 26 | let get_selection w = Jv.call w "getSelection" [||] 27 | end 28 | 29 | module Selection : sig 30 | type t 31 | 32 | val to_jstr : t -> Jstr.t 33 | end = struct 34 | type t = Jv.t 35 | 36 | let to_jstr s = Jv.to_jstr (Jv.call s "toString" [||]) 37 | end 38 | 39 | let selection_start = El.Prop.int (Jstr.v "selectionStart") 40 | let selection_end = El.Prop.int (Jstr.v "selectionEnd") 41 | 42 | let mk_reactive cons ?d ?at s = 43 | let result = cons ?d ?at [] in 44 | let () = Elr.def_children result s in 45 | result 46 | ;; 47 | 48 | let mk_reactive' cons ?eq ?d ?at s = 49 | mk_reactive cons ?d ?at (s |> Note.S.map ?eq (fun elem -> [ elem ])) 50 | ;; 51 | -------------------------------------------------------------------------------- /pages/Single_line_input.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Brr 3 | open Brr_note 4 | open Lvca_provenance 5 | open Note 6 | open Prelude 7 | 8 | let mk ?(autofocus = false) ?highlights_s:(external_highlights_s = S.const []) input_s = 9 | let dirty_input_s, update_dirty = S.create false in 10 | let highlights_s = 11 | external_highlights_s |> Note.S.changes |> Note.S.hold ~eq:Ranges.( = ) [] 12 | in 13 | let at = 14 | let classes = 15 | [ "font-mono" 16 | (* ; "border-2" *) 17 | (* ; "border-indigo-900" *) 18 | (* ; "rounded" *) 19 | ; "p-1" (* ; "focus:ring" *) 20 | ; "bg-none" 21 | ; "border-none" 22 | ; "display-block" 23 | ; "w-full" 24 | ] 25 | |> List.map ~f:class' 26 | in 27 | let at' = 28 | List.filter_map 29 | ~f:Fn.id 30 | [ Some (At.type' (Jstr.v "text")) 31 | ; Some (input_s |> S.value |> Jstr.v |> At.value) 32 | ; (if autofocus then Some At.autofocus else None) 33 | ] 34 | in 35 | at' @ classes 36 | in 37 | let input = El.input ~at () in 38 | let () = Elr.set_prop El.Prop.value input ~on:(input_s |> S.changes |> E.map Jstr.v) in 39 | let highlighted_input_s = 40 | S.l2 41 | (fun input_str highlight_ranges -> 42 | Ranges.mark_string highlight_ranges input_str 43 | |> List.map ~f:(fun string_status -> 44 | let Range.{ start; finish } = 45 | match string_status with Ranges.Covered rng | Uncovered rng -> rng 46 | in 47 | let str = String.sub input_str ~pos:start ~len:(finish - start) in 48 | match string_status with 49 | | Ranges.Covered _ -> 50 | El.span ~at:(classes "bg-pink-200 rounded") [ El.txt' str ] 51 | | Uncovered _ -> El.txt' str)) 52 | input_s 53 | highlights_s 54 | in 55 | (* TODO: sync scroll position *) 56 | let input_shadow = 57 | let at = 58 | At.true' (Jstr.v "aria-hidden") 59 | :: classes "absolute -z-1 left-1 top-1 text-transparent font-mono whitespace-pre" 60 | in 61 | El.div ~at [] 62 | in 63 | let () = Elr.def_children input_shadow highlighted_input_s in 64 | let updated_elem = El.span ~at:[ class' "ml-1" ] [] in 65 | let () = 66 | Elr.def_children 67 | updated_elem 68 | (dirty_input_s 69 | |> S.map (function true -> "updated (press Enter to re-evaluate)" | false -> "") 70 | |> S.map (fun str -> [ El.txt' str ])) 71 | in 72 | let result = 73 | El.div 74 | [ El.div 75 | ~at: 76 | (classes 77 | "relative overflow-hidden border border-blue-800 dark:border-blue-200 \ 78 | rounded") 79 | [ input; input_shadow ] 80 | ; updated_elem 81 | ] 82 | in 83 | let _sink : Logr.t option = 84 | let evt = Evr.on_el Ev.input (fun _evt -> update_dirty true) input in 85 | E.log evt Fn.id 86 | in 87 | let keydown_evt = 88 | let handler evt = 89 | let keyboard_evt = Ev.as_type evt in 90 | let str = El.prop El.Prop.value input |> Jstr.to_string in 91 | if Web_util.is_enter keyboard_evt 92 | then ( 93 | Ev.prevent_default evt; 94 | update_dirty false; 95 | Common.Evaluate_input str) 96 | else Input_update str 97 | in 98 | Evr.on_el Ev.keydown handler input 99 | in 100 | let select_evt = 101 | let handler _evt = 102 | let start = El.prop selection_start input in 103 | let finish = El.prop selection_end input in 104 | Common.Input_select Range.{ start; finish } 105 | in 106 | Evr.on_el Ev.select handler input 107 | in 108 | let unselect_evt : Common.input_event event = 109 | Evr.on_el Ev.click (fun _evt -> Common.Input_unselect) input 110 | in 111 | let input_event = E.select [ keydown_evt; select_evt; unselect_evt ] in 112 | result, input_event 113 | ;; 114 | -------------------------------------------------------------------------------- /pages/Single_line_input.mli: -------------------------------------------------------------------------------- 1 | val mk 2 | : ?autofocus:bool 3 | -> ?highlights_s:Lvca_provenance.Ranges.t Note.signal 4 | -> string Note.signal 5 | -> Brr.El.t * Common.input_event Note.event 6 | -------------------------------------------------------------------------------- /pages/Stateless_view.ml: -------------------------------------------------------------------------------- 1 | open Brr 2 | open Note 3 | 4 | module type Action_sig = sig 5 | type t 6 | end 7 | 8 | module type Model_sig = sig 9 | type t 10 | 11 | val ( = ) : t -> t -> bool 12 | val initial_model : t 13 | end 14 | 15 | module type View_sig = sig 16 | type model_t 17 | type action_t 18 | 19 | val view : model_t signal -> action_t event * El.t 20 | end 21 | 22 | module type Controller_sig = sig 23 | type model_t 24 | type action_t 25 | 26 | val update : action_t -> model_t -> model_t 27 | end 28 | 29 | module Mk 30 | (Action : Action_sig) 31 | (Model : Model_sig) 32 | (View : View_sig with type model_t := Model.t and type action_t := Action.t) 33 | (Controller : Controller_sig 34 | with type model_t := Model.t 35 | and type action_t := Action.t) = 36 | struct 37 | let view () = 38 | let wrapper model_s = 39 | let evts, elem = View.view model_s in 40 | let do_action = E.map Controller.update evts in 41 | let model_s' = S.accum ~eq:Model.( = ) (S.value model_s) do_action in 42 | model_s', (model_s', elem) 43 | in 44 | let model_s, elem = S.fix ~eq:Model.( = ) Model.initial_model wrapper in 45 | Logr.hold (S.log model_s (fun _ -> ())); 46 | elem 47 | ;; 48 | end 49 | -------------------------------------------------------------------------------- /pages/Store.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lvca_syntax 3 | open Lvca_util 4 | 5 | module Content_store = struct 6 | (** Mapping from hash to content *) 7 | type t = (string, Nominal.Term.t) Hashtbl.t 8 | 9 | let singleton : t = Hashtbl.create (module String) 10 | let find = Hashtbl.find singleton 11 | end 12 | 13 | module Tag_store = struct 14 | (** Mapping from tag to hash *) 15 | type t = (string, string) Hashtbl.t 16 | 17 | let singleton : t = Hashtbl.create (module String) 18 | let find = Hashtbl.find singleton 19 | end 20 | 21 | let add_document ~slug ~blob = 22 | let doc = 23 | blob |> Lvca_languages.Document.parse |> Lvca_languages.Document.Lang.Doc.to_nominal 24 | in 25 | let hash = Nominal.Term.hash doc in 26 | Hashtbl.set Content_store.singleton ~key:hash ~data:doc; 27 | Hashtbl.set Tag_store.singleton ~key:slug ~data:hash 28 | ;; 29 | 30 | let () = 31 | add_document 32 | ~slug:"make-code-review-easier" 33 | ~blob:[%blob "md/make-code-review-easier.md"]; 34 | add_document ~slug:"finding-terms" ~blob:[%blob "md/finding-terms.md"] 35 | ;; 36 | 37 | let find tag = 38 | let open Option.Let_syntax in 39 | let%bind addr = Hashtbl.find Tag_store.singleton tag in 40 | Hashtbl.find Content_store.singleton addr 41 | ;; 42 | -------------------------------------------------------------------------------- /pages/Term_and_document.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Brr 3 | open Note 4 | open Lvca_syntax 5 | module Document = Lvca_languages.Document 6 | open Document.Lang 7 | module List_model = Lvca_del.List_model 8 | module Option_model = Lvca_del.Option_model 9 | 10 | type term = Doc.t 11 | 12 | let parse = Lvca_languages.Document.parse 13 | 14 | module Model = struct 15 | type t = 16 | { input : string 17 | ; result : term 18 | } 19 | 20 | let input = 21 | {|# document 22 | 23 | paragraph 24 | 25 | * li 1 26 | * li 2 27 | 28 | First Term 29 | : This is the definition of the first term. 30 | 31 | Second Term 32 | : This is one definition of the second term. 33 | : This is another definition of the second term. 34 | 35 | *** 36 | 37 | * This is the first list item. 38 | * Here's the second list item. 39 | 40 | > A blockquote would look great below the second list item. 41 | 42 | * And here's the third list item. 43 | 44 | --- 45 | 46 | 1. Open the file. 47 | 2. Find the following code block on line 21: 48 | 49 | 50 | 51 | Test 52 | 53 | 54 | 3. Update the title to match the name of your website.|} 55 | ;; 56 | 57 | let initial_model = { input; result = parse input } 58 | 59 | module Doc = Nominal.Convertible.Extend (Doc) 60 | 61 | let pp ppf { input; result } = 62 | Fmt.pf ppf "{ input = %s; result = %a }" input Doc.pp result 63 | ;; 64 | 65 | let ( = ) m1 m2 = 66 | let term_eq x y = Nominal.Term.(Doc.to_nominal x = Doc.to_nominal y) in 67 | String.(m1.input = m2.input) && term_eq m1.result m2.result 68 | ;; 69 | end 70 | 71 | module Action = struct 72 | type t = Evaluate of string 73 | end 74 | 75 | module Controller = struct 76 | let update (action : Action.t) _model = 77 | match action with Evaluate iput -> Model.{ input = iput; result = parse iput } 78 | ;; 79 | end 80 | 81 | module View = struct 82 | open Prelude 83 | 84 | let div = El.div 85 | 86 | let view model_s = 87 | let input_s = S.map ~eq:String.( = ) (fun Model.{ input; _ } -> input) model_s in 88 | let input_elem, input_evt = Multiline_input.mk ~at:[ class' "m-4" ] input_s in 89 | let enter_input_e = 90 | input_evt 91 | |> E.filter_map (function 92 | | Common.Evaluate_input str -> Some (Action.Evaluate str) 93 | | _ -> None) 94 | in 95 | let output_view = 96 | model_s |> S.map ~eq:phys_equal (fun model -> Md_viewer.of_doc model.Model.result) 97 | in 98 | let elem = 99 | div 100 | ~at:(classes "flex flex-row") 101 | [ input_elem; mk_reactive' ~at:[ class' "m-4" ] div output_view ] 102 | in 103 | enter_input_e, elem 104 | ;; 105 | end 106 | 107 | module Stateless_view = Stateless_view.Mk (Action) (Model) (View) (Controller) 108 | -------------------------------------------------------------------------------- /pages/Term_to_tex.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Brr 3 | open Note 4 | open Prelude 5 | 6 | module Model = struct 7 | type t = string 8 | 9 | let initial_model = {|\overbrace{a+b+c}^{\text{note}}|} 10 | let ( = ) = String.( = ) 11 | end 12 | 13 | module Action = struct 14 | type t = Evaluate of string 15 | end 16 | 17 | module Controller = struct 18 | let update (action : Action.t) _model = match action with Evaluate str -> str 19 | end 20 | 21 | module View = struct 22 | let div, h2, h3, txt' = El.(div, h2, h3, txt') 23 | 24 | let view model_s = 25 | let input, input_event = Multiline_input.mk model_s in 26 | let katex_area = div [] in 27 | let _sink : Logr.t = S.log model_s (Katex.render katex_area) in 28 | let evt : Action.t event = 29 | input_event 30 | |> E.filter_map (function 31 | | Common.Evaluate_input str -> Some (Action.Evaluate str) 32 | | _ -> None) 33 | in 34 | let elem = 35 | div 36 | [ h2 [ txt' "Term to TeX" ] 37 | ; div ~at:[ class' "container" ] [ input ] 38 | ; div ~at:[ class' "side" ] [ h3 [ txt' "(rendered)" ]; katex_area ] 39 | ] 40 | in 41 | evt, elem 42 | ;; 43 | end 44 | 45 | module Stateless_view = Stateless_view.Mk (Action) (Model) (View) (Controller) 46 | -------------------------------------------------------------------------------- /pages/Tree_view.mli: -------------------------------------------------------------------------------- 1 | type default_expanded_depth = 2 | | ExpandedTo of int (** Start tree expanded to this many levels *) 3 | | FullyExpanded (** Start tree fully expanded *) 4 | 5 | (** For the given term, create a DOM node and an event for selection of some range. *) 6 | val view_tm 7 | : ?source_column:bool 8 | (** Render a column displaying the name of the row's source file / buffer? *) 9 | -> ?range_column:bool 10 | (** Render a column displaying the row's range within its source file / buffer? *) 11 | -> ?default_expanded_depth:default_expanded_depth 12 | (** How many levels of the term to expand and display initially. Fully expanded by 13 | default. *) 14 | -> ?highlighted_ranges:Lvca_provenance.Source_ranges.t 15 | -> Lvca_syntax.Nominal.Term.t 16 | -> Brr.El.t * Lvca_provenance.Source_ranges.t Note.event 17 | -------------------------------------------------------------------------------- /pages/Web_util.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Brr 3 | open Prelude 4 | 5 | type platform = 6 | | Mac 7 | | IOs 8 | | Windows 9 | | Android 10 | | Linux 11 | | Unknown 12 | 13 | let get_platform () = 14 | let user_agent = Jstr.to_string Navigator.user_agent in 15 | let platform = Jstr.to_string Navigator.platform in 16 | List.find_map_exn 17 | String. 18 | [ is_substring platform ~substring:"Mac" (* Macintosh|MacIntel|MacPPC|Mac68K *), Mac 19 | ; is_substring platform ~substring:"iPhone", IOs 20 | ; is_substring platform ~substring:"iPad", IOs 21 | ; is_substring platform ~substring:"iPod", IOs 22 | ; is_substring platform ~substring:"Win" (* Win32|Win64|Windows|WinCE *), Windows 23 | ; is_substring user_agent ~substring:"Android", Android 24 | ; is_substring platform ~substring:"Linux", Linux 25 | ; true, Unknown 26 | ] 27 | ~f:(fun (matches, result) -> if matches then Some result else None) 28 | ;; 29 | 30 | let is_enter key_evt = String.(key_evt |> Ev.Keyboard.key |> Jstr.to_string = "Enter") 31 | 32 | (** Is this an enter keypress plus meta, shift, or ctrl, depending on the platform *) 33 | let is_special_enter key_evt = 34 | let platform = get_platform () in 35 | let is_meta = Ev.Keyboard.meta_key key_evt in 36 | let is_shift = Ev.Keyboard.shift_key key_evt in 37 | let is_ctrl = Ev.Keyboard.ctrl_key key_evt in 38 | let is_platform_special = 39 | match platform with 40 | | Mac -> is_meta || is_shift 41 | | Windows -> is_ctrl || is_shift 42 | | Linux -> is_ctrl || is_shift 43 | | Unknown -> is_ctrl || is_shift || is_meta 44 | | IOs | Android -> false 45 | in 46 | is_enter key_evt && is_platform_special 47 | ;; 48 | 49 | let platform_special_combo () : El.t list option = 50 | let txt str = El.txt (Jstr.v str) in 51 | let kbd str = El.kbd [ txt str ] in 52 | let template special = 53 | Some 54 | [ kbd special; txt "-"; kbd "Enter"; txt " or "; kbd "Shift"; txt "-"; kbd "Enter" ] 55 | in 56 | match get_platform () with 57 | | IOs | Android -> None 58 | | Mac -> template "⌘" 59 | | Windows -> template "⊞ Win" 60 | | Linux | Unknown -> template "Ctrl" 61 | ;; 62 | -------------------------------------------------------------------------------- /pages/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names devel_main) 3 | (modes js) 4 | (link_flags 5 | (:standard -no-check-prims)) 6 | (libraries angstrom base brr brr.note digestif.ocaml lvca_bidirectional 7 | lvca_languages lvca_parsing lvca_provenance lvca_syntax note) 8 | (preprocessor_deps 9 | (glob_files md/*.md)) 10 | (preprocess 11 | (pps ppx_blob ppx_jane ppx_lvca))) 12 | 13 | (dirs md) 14 | -------------------------------------------------------------------------------- /pages/favicon512.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/favicon512.png -------------------------------------------------------------------------------- /pages/fonts/KaTeX_AMS-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_AMS-Regular.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_AMS-Regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_AMS-Regular.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_AMS-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_AMS-Regular.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Caligraphic-Bold.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Caligraphic-Bold.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Caligraphic-Bold.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Caligraphic-Bold.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Caligraphic-Bold.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Caligraphic-Bold.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Caligraphic-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Caligraphic-Regular.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Caligraphic-Regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Caligraphic-Regular.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Caligraphic-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Caligraphic-Regular.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Fraktur-Bold.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Fraktur-Bold.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Fraktur-Bold.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Fraktur-Bold.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Fraktur-Bold.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Fraktur-Bold.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Fraktur-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Fraktur-Regular.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Fraktur-Regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Fraktur-Regular.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Fraktur-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Fraktur-Regular.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Main-Bold.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Main-Bold.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Main-Bold.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Main-Bold.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Main-Bold.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Main-Bold.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Main-BoldItalic.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Main-BoldItalic.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Main-BoldItalic.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Main-BoldItalic.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Main-BoldItalic.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Main-BoldItalic.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Main-Italic.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Main-Italic.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Main-Italic.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Main-Italic.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Main-Italic.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Main-Italic.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Main-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Main-Regular.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Main-Regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Main-Regular.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Main-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Main-Regular.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Math-BoldItalic.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Math-BoldItalic.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Math-BoldItalic.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Math-BoldItalic.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Math-BoldItalic.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Math-BoldItalic.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Math-Italic.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Math-Italic.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Math-Italic.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Math-Italic.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Math-Italic.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Math-Italic.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_SansSerif-Bold.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_SansSerif-Bold.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_SansSerif-Bold.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_SansSerif-Bold.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_SansSerif-Bold.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_SansSerif-Bold.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_SansSerif-Italic.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_SansSerif-Italic.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_SansSerif-Italic.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_SansSerif-Italic.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_SansSerif-Italic.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_SansSerif-Italic.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_SansSerif-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_SansSerif-Regular.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_SansSerif-Regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_SansSerif-Regular.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_SansSerif-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_SansSerif-Regular.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Script-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Script-Regular.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Script-Regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Script-Regular.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Script-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Script-Regular.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Size1-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Size1-Regular.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Size1-Regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Size1-Regular.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Size1-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Size1-Regular.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Size2-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Size2-Regular.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Size2-Regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Size2-Regular.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Size2-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Size2-Regular.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Size3-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Size3-Regular.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Size3-Regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Size3-Regular.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Size3-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Size3-Regular.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Size4-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Size4-Regular.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Size4-Regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Size4-Regular.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Size4-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Size4-Regular.woff2 -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Typewriter-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Typewriter-Regular.ttf -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Typewriter-Regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Typewriter-Regular.woff -------------------------------------------------------------------------------- /pages/fonts/KaTeX_Typewriter-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/KaTeX_Typewriter-Regular.woff2 -------------------------------------------------------------------------------- /pages/fonts/dune: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/fonts/dune -------------------------------------------------------------------------------- /pages/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | LVCA demos 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 |
14 | 15 | 16 | -------------------------------------------------------------------------------- /pages/md/are-constructors-functions.md: -------------------------------------------------------------------------------- 1 | ## Haskell 2 | 3 | In Haskell, constructors appear to be functions. 4 | 5 | ``` 6 | Prelude> :t Just 7 | Just :: a -> Maybe a 8 | Prelude> :t (:) 9 | (:) :: a -> [a] -> [a] 10 | Prelude> foldr (:) [] [1,2,3] 11 | [1,2,3] 12 | ``` 13 | 14 | But are they? Functions can do arbitrary computation. Constructors just build a cell in memory [1]. Functions can't be pattern-matched, but constructors can. Functions have lower-case names, but constructors are upper-case (ignoring operators). 15 | 16 | ``` 17 | foo (Just x) = x 18 | foo Nothing = 0 19 | ``` 20 | 21 | ## OCaml 22 | 23 | In OCaml, patterns are not functions. 24 | 25 | ``` 26 | utop # (+);; 27 | - : int -> int -> int = 28 | 29 | utop # None;; 30 | - : 'a option = None 31 | 32 | utop # Some;; 33 | Line 1, characters 0-4: 34 | Error: The constructor Some expects 1 argument(s), 35 | but is applied here to 0 argument(s) 36 | 37 | utop # List.fold_right [1;2;3] ~init:[] ~f:(fun x xs -> x::xs);; 38 | - : int list = [1; 2; 3] 39 | 40 | utop # List.fold_right [1;2;3] ~init:[] ~f:(::);; 41 | Line 1, characters 36-40: 42 | Error: The constructor :: expects 2 argument(s), 43 | but is applied here to 0 argument(s) 44 | ``` 45 | 46 | We have to explicitly write out a function which takes two arguments and applies a constructor (`fun x xs -> x::xs`). We can't use the same punning as in Haskell (`foldr (:)`). 47 | 48 | ## Tradeoffs 49 | 50 | Haskell is surely more convenient -- I wish I could write `~f:(::)` in OCaml instead of the verbose `~f:(fun x xs -> x::xs)` (there are [OCaml extensions](https://github.com/janestreet/ppx_variants_conv) to derive "constructor functions" for you). It's nice to be able to partially-apply constructors. 51 | 52 | OCaml is also inconsistent in some ways: 53 | 54 | * `x |> f` is equivalent to `f x`, but only for functions. `1 |> Some` doesn't compile, but `Some 1` does. 55 | * Constructor arguments can sometimes appear as a single value (I can pattern match on `(::) _`), but sometimes not (I can't apply `(::)` to a tuple). 56 | 57 | ``` 58 | utop # (::)(1, []);; 59 | - : int list = [1] 60 | 61 | utop # let pair = (1, []);; 62 | val pair : int * 'a list = (1, []) 63 | 64 | utop # (::)pair;; 65 | Line 1, characters 0-8: 66 | Error: The constructor :: expects 2 argument(s), 67 | but is applied here to 1 argument(s) 68 | 69 | utop # (function | (::) _ -> "::" | [] -> "[]") [1; 2; 3];; 70 | - : string = "::" 71 | ``` 72 | 73 | Meanwhile Haskell is inconsistent in others: function and construction application look the same, but functions do _computation_, while constructors (_simple_ constructors, ignoring extensions) can only construct a cell. 74 | 75 | ## The Point 76 | 77 | My point is that, even in something as simple and seemingly well understood as functions vs constructors, there are viable systems which have made both choices. Both are valid -- each has pros and cons. 78 | 79 | To my mind, Haskell is no doubt more convenient (this extends to other aspects of data types as well -- GHC's deriving is built-in, while OCaml requires a [ppx](https://github.com/ocaml-ppx/ppx_deriving) to do the same). But OCaml's inconsistencies have a distinctly shallow, syntactic flavor. Haskell's inconsistency is deeper -- conflating _constructors_ and _computations_. 80 | 81 | 1: Like everything in GHC, the story is actually more complicated, since view patterns and pattern synonyms can do arbitrary computation. 82 | -------------------------------------------------------------------------------- /pages/md/bidirectional-typechecking.md: -------------------------------------------------------------------------------- 1 | Bidirectional typechecking is the one typechecking algorithm LVCA has built-in 2 | support for. In this post I'd like to cover the basics of what bidirectional 3 | typechecking is and how it's supported in LVCA. 4 | 5 | ## What is Bidirectional Typechecking? 6 | 7 | In order of increasing formality / length (ie the order you should read them), the best references I know of are: 8 | * David Raymond Christiansen's [Bidirectional Typing Rules: A Tutorial](http://davidchristiansen.dk/tutorials/bidirectional.pdf) 9 | * Frank Pfenning's [Lecture Notes on Bidirectional Type Checking](https://www.cs.cmu.edu/~fp/courses/15312-f04/handouts/15-bidirectional.pdf). 10 | * Joshua Dunfield and Neel Krishnawami's [Bidirectional Typing](https://arxiv.org/pdf/1908.05839.pdf) 11 | -------------------------------------------------------------------------------- /pages/md/binding-aware-patterns.md: -------------------------------------------------------------------------------- 1 | ## Introduction 2 | 3 | Algebraic datatypes (ADTs) are core to typed functional programming. In their most basic form, ADTs are *sums of products*. For example: 4 | 5 | ``` 6 | data These a b = This a | That b | These a b 7 | ``` 8 | 9 | A type (`These`) is a sum of constructors (`This`, `That`, `These`), each of which contains a (possibly empty) product of types. 10 | 11 | Today I'll briefly cover several familiar extensions to ADTs, as well as an extension I haven't seen talked about before. 12 | 13 | ## GADTs, Inductive Types, and Higher Inductive Types 14 | 15 | Generalized algebraic datatypes (GADTs) allow one to explicitly write the types of data constructors. The example above would be written: 16 | 17 | ``` 18 | data These a b where 19 | This :: a -> These a b 20 | That :: b -> These a b 21 | These :: a -> b -> These a b 22 | ``` 23 | 24 | Allowing explicit type annotations allows TODO do we really want to cover all this? 25 | 26 | ``` 27 | data Expr a where 28 | EBool :: Bool -> Expr Bool 29 | EInt :: Int -> Expr Int 30 | EEqual :: Expr Int -> Expr Int -> Expr Bool 31 | ``` 32 | 33 | TODO: Inductive, higher inductive types 34 | https://cstheory.stackexchange.com/questions/10594/whats-the-difference-between-adts-gadts-and-inductive-types 35 | https://en.wikipedia.org/wiki/Inductive_type 36 | 37 | ## Binding Datatypes 38 | 39 | In Practical Foundations For Programming Languages (PFPL), Robert Harper uses *Abstract Binding Trees* TODO 40 | 41 | Let's see an example. 42 | 43 | ``` 44 | expr := 45 | | lam(expr. expr) // lambda: \x -> ... 46 | | app(expr; expr) // function application 47 | ``` 48 | 49 | The first constructor, `lam`, represents a lambda, and has binding structure. Its definition says it holds a single `expr` which binds a single `expr` variable (the `.` represents binding). 50 | 51 | The second constructor, `app`, represents function application. Its definition says it holds two `expr`s (the `;` separates children). This constructor has no binding so it could be represented by in a regular ADT. 52 | 53 | Let's see a slightly more involved example (this is the language `E` from PFPL) 54 | 55 | ``` 56 | exp := 57 | | num(int) 58 | | str(string) 59 | | plus(exp; exp) 60 | | times(exp; exp) 61 | | cat(exp; exp) 62 | | len(exp) 63 | | let(exp; exp. exp) 64 | ``` 65 | 66 | Everything here could be written 67 | 68 | ## Binding-Aware Patterns 69 | -------------------------------------------------------------------------------- /pages/md/binding-viewer.md: -------------------------------------------------------------------------------- 1 | After building a structured tree viewer for the [parsing language demo](/parsing-language/), I decided to extend it a bit to demonstrate binding structure in an interactive way. 2 | 3 | In the first image my cursor (which you can't see) is hovering over the first `x`. Highlighted in pink you can see where `x` is defined, in orange is a binding which shadows the outer `x`, and in blue is a use of the variable. The green background shows the scope of the variable. Notice the hole where it's being shadowed. 4 | 5 | ![Demo screenshot 1](/static/images/scopeview1.png) 6 | 7 | In the second image I've selected the second `x`, highlighted in pink for a definition site. In yellow we can see that the outer `x` is shadowed by this variable, and in blue is the one use of this new `x`. Notice how the scope of this `x` perfectly fills the gap in the shadowed `x`'s scope. 8 | 9 | ![Demo screenshot 2](/static/images/scopeview2.png) 10 | 11 | Third, I've selected `f`, which is a free variable, so its scope is (implicitly) global. 12 | 13 | ![Demo screenshot 3](/static/images/scopeview3.png) 14 | 15 | In the last two images I've selected the two use-sites of the two different `x`es. We can see both the use-site in blue and the definition in pink. 16 | 17 | ![Demo screenshot 4](/static/images/scopeview4.png) 18 | ![Demo screenshot 5](/static/images/scopeview5.png) 19 | 20 | Finally, a demo for you to try. 21 | 22 | ```demo 23 | binding-viewer 24 | ``` 25 | 26 | ## Conclusion 27 | 28 | There is a dedicated page with more info about [abstract syntax in LVCA](/abstract-syntax/). 29 | 30 | This tool is one example of a major theme in LVCA: building tools which are broadly applicable. Using this notation, which is meant to represent the abstract syntax for any language, this tool could in theory be used for any language. 31 | 32 | The next major projects I have planned are additional tools for pretty-printing and for typechecking. 33 | -------------------------------------------------------------------------------- /pages/md/checking-terms-and-patterns.md: -------------------------------------------------------------------------------- 1 | ## Introduction 2 | 3 | Having declared an abstract syntax, we want to be able to check that terms are well-formed. For example, say we've defined a sort of natural numbers. 4 | 5 | ``` 6 | nat := zero() | succ(nat) 7 | ``` 8 | 9 | Examples of well-formed terms include `zero()` and `succ(zero())`. Non-well-formed terms include `zero(zero())` and `succ()`. These demonstrate one way a term can be incorrect -- by having the wrong number of children, but there are many others. In this post I'll enumerate the checks that LVCA currently does and their limitations. 10 | 11 | ## Term Checks 12 | 13 | ## Patterns 14 | 15 | ## Typechecking 16 | -------------------------------------------------------------------------------- /pages/md/church-and-curry.md: -------------------------------------------------------------------------------- 1 | When defining a programming language and its typing rules there are two main 2 | approaches: 3 | 4 | 1. The *intrinsic* approach, also called Church-style (named after [Alonzo 5 | Church](https://en.wikipedia.org/wiki/Alonzo_Church), discoverer of the 6 | lambda calculus). In this approach, every term in a language *intrinsically* 7 | has a type which we can check. Some languages which exemplify this approach 8 | are Haskell, OCaml, Agda, and Coq. Branching out from functional languages, 9 | C / C++ and Java are also Church-style because terms have built-in types. 10 | 11 | 2. The *extrinsic* approach, also called Curry-style (named after 12 | [Haskell Curry](https://en.wikipedia.org/wiki/Haskell_Curry), founder of 13 | combinatory logic). In this style, a term in a language don't necessarily 14 | have a built-in type, though you may still be able to typecheck it. That is, 15 | types classify (untyped) terms. Most lisps are good examples of this 16 | approach. So is [NuPRL](https://www.nuprl.org/). 17 | 18 | ## In LVCA 19 | 20 | The reason I bring up this distinction is to clarify my thoughts on the two 21 | approaches as they relate to LVCA. 22 | 23 | A design decision that's been nagging at me for a while is, how are terms 24 | stored in LVCA? Is it Church-style, with statics attached? Or is it 25 | Curry-style, just the term without reference to its statics? 26 | 27 | I recently came to a conclusion that I'm happy with, realizing that allowing 28 | terms to be stored independently of their statics is strictly more general. For 29 | example, suppose we have some term `t`, typed by some statics `s`. Now, if we 30 | want to operate à la Curry, we can simply store the term `t`. Then `t` exists 31 | as an essentially untyped term in our store. Yet if we have a statics `s`, it's 32 | possible to check `t` against `s`. However, if we prefer to operate à la 33 | Church, we can define `typed(term; statics) = typed(term; statics)` and store 34 | the term `typed(t; s)`. Now our term is defined with reference to its statics, 35 | and we can check that it's a valid term if it typechecks. 36 | 37 | ## References 38 | 39 | * [Eric Normand, Church vs Curry Types](https://lispcast.com/church-vs-curry-types/) 40 | * [intrinsic and extrinsic views of typing (nLab)](https://ncatlab.org/nlab/show/intrinsic+and+extrinsic+views+of+typing) 41 | -------------------------------------------------------------------------------- /pages/md/comments-are-metadata.md: -------------------------------------------------------------------------------- 1 | * Comments are just text 2 | - not parsed, not checked 3 | - no links or richer data 4 | * by generalizing to metadata: 5 | - set an expiration date 6 | - collect TODOs 7 | - mention people or link to other code 8 | - richer annotation: text, images, etc 9 | -------------------------------------------------------------------------------- /pages/md/constructive-real-calculator.md: -------------------------------------------------------------------------------- 1 | [Last time](/progress-october-8-2020) I mentioned building a calculator for constructive reals. Today I have a demo of the initial version. 2 | 3 | ## What is this? 4 | 5 | In one sense this is just a calculator like you can find on any computer or phone (in fact, in some sense this is the same calculator you'd find on Android, since I ported [their algorithm](https://dl.acm.org/doi/abs/10.1145/3385412.3386037) to OCaml). The interesting part here is the implementation: the entire calculator is running in the browser. That includes parsing and evaluating to as many digits as you ask for. 6 | 7 | This seems mundane, and it should be. But if you open up your JavaScript console and enter `0.2 + 0.1`, it will respond `0.30000000000000004`. This is because floating-point is ubiquitous and easy, but wrong in subtle, confusing ways (It's not just issues like the one I showed -- did you know that floating point numbers include positive and negative infinity? Positive and negative _zero_? There's even a number literally called [Not a Number](https://en.wikipedia.org/wiki/NaN)). Because of these problems, it's usually not acceptable to expose floating-point calculations directly to end users. Which means we can't use the browser's built in `Math.PI`, `Math.cos`, etc. This is a real, difficult limitation. Instead, this calculator uses arbitrary-precision integers as a base, and heavily uses Taylor series approximations for everything beyond simple arithmetic. [Take a look at the code](https://github.com/joelburget/lvca/blob/main/constructive-real/ConstructiveReal.ml) if you're interested. 8 | 9 | This means calculations aren't nearly as fast as the corresponding floating-point operations, but every digit you see is exact and the calculator can produce as many digits as you ask for. 10 | 11 | The other fun thing about this demo is all the network requests it's _not_ making. [Wolfram Alpha](https://www.wolframalpha.com/input/?i=1+%2B+1) or Google's [built-in calculator](https://www.google.com/search?q=1+%2B+1&oq=1+%2B+1) (for example) do their work on the server, meaning queries can never return faster than it takes to round-trip to their servers. My hope is that this tool feels snappier to use. It's satisfying for me to peek at the network console and see absolutely nothing. It's nontrivial to do parsing and sophisticated numerical calculations in the browser. I'm excited both that I got it working and to extend this work to more interesting problems. 12 | 13 | ## Demo 14 | 15 | Be careful of asking for too many digits (more than 5000 digits of `pi` for example). It could cause your browser to hang since I didn't implement any safeguards. Also, see the language chart below for a comprehensive list of expressions the calculator understands. Note that the syntax for function application doesn't require parens, so `sin 1` is valid, though `sin(1)` also works if you prefer, and parens are required in `sin (1 + 1)`. 16 | 17 | ```demo 18 | calculator 19 | ``` 20 | 21 | ## Future work 22 | 23 | Today this makes for a decent calculator, but an impoverished language. There's a lot more one might want to do with a calculator language. The first things that come to mind are variables and user-defined functions. But real numbers also seem valuable to embed in other languages. I can imagine several domains where this functionality might be useful. So I'll be using this language as a base to explore and build on. 24 | 25 | Note that this language has only one type, real numbers. But one of the interesting parts of the implementation is that we have a decision procedure for telling if two numbers are equal. I'd like to extend the language to have comparisons as well (this implies the extended language will have booleans). 26 | 27 | Today the parser is really bad. Enter a malformed expression like `1 +` or `cos` and the error message is... less than helpful. I'm actively working on fixing this. I'm guessing there's also some low hanging performance optimization fruit, but I need to run some profiling to find out what's slow. Finally, it would be a lot of fun to have a debugger of sorts to understand what's happening under the hood, how many iterations it takes for the underlying sums to converge, etc. 28 | -------------------------------------------------------------------------------- /pages/md/finding-terms.md: -------------------------------------------------------------------------------- 1 | Content identification: 2 | * exactly the same, including formatting 3 | * the same term structure, including variable names 4 | * the same term structure, ignoring variable names 5 | 6 | Term indexing more generally. 7 | -------------------------------------------------------------------------------- /pages/md/lambda-concrete-and-abstract.md: -------------------------------------------------------------------------------- 1 | With LVCA I've been working on building a set of reusable language tools. This is the very first (modest) demo of what these tools can do. 2 | 3 | What is it? There are two panes: on the top is the input and on the bottom is the output. There are also two languages: the lambda calculus (concrete syntax) and LVCA's internal representation of its abstract syntax. Initially the lambda calculus is used as the input language and LVCA's term representation is the output. Using the "switch input languages" button you can make the term representation input and lambda calculus output. If lambda calculus is on the top, the function from input to output is parsing. If LVCA terms are on the top, the function is pretty-printing. 4 | 5 | The main novelty of this demo is that when you highlight a section of input, the corresponding output is highlighted as well. This is due to the fact that LVCA tools track provenance, in this case provenance is a range of characters in the input pane where the value was parsed from. Every time you highlight a range in the input, we simply highlight the terms in the output which came from (a subrange of) that range. 6 | 7 | I believe every good compiler eventually needs to implement provenance tracking, but it's mostly incidental complexity (a lot of plumbing). LVCA promises to do this work for free. The main use of provenance tracking is good error messaging, but this demo shows that there might be other interesting uses as well. 8 | 9 | Besides highlight tracking, the other novelty is the fact that this demo runs in the browser. This is unusual among language tools, but something I've always designed LVCA for. 10 | 11 | In future demos I'd like to show the stretch goals I mentioned last time (and didn't hit today): visualization of variable scope and a tool for renaming variables. I'd also like to show what it takes to build a language like the lambda calculus. But first (next time), I plan to write about the making of this demo. I think some of the code is very interesting and I'm using a rather unique technology stack that I've found very productive and would like to share. 12 | 13 | 14 | -------------------------------------------------------------------------------- /pages/md/never-waste-a-refactor.md: -------------------------------------------------------------------------------- 1 | You've decided to refactor your codebase. To remove some pattern that keeps popping up, but has proven error-prone. You write a query to find all the instances (and hopefully, to rewrite them). Now that query should enter the set of "patterns never to be repeated". 2 | -------------------------------------------------------------------------------- /pages/md/progress-august-8-2020.md: -------------------------------------------------------------------------------- 1 | Last time I promised to write a bit more about abstract syntax. I plan to do so today, but indirectly. I think that last time I sensed the project floundering a bit, noticing that some pieces weren't fitting together how I'd planned, and abstract syntax was the bit on my mind. 2 | 3 | When I notice that happening, I think it's best to take a step back, stop working on it for a week or two, walk a lot, and let my mind wander. I've been doing a bit of that and it certainly helped, but the thing that really helped most was that I actually implemented a small language, in OCaml, by hand (not using LVCA). This simple exercise helped me to refocus on what motivated me to start this project in the first place by highlighting the original pain points that I wanted to address. 4 | 5 | I think that in my approach to this project I was trying to do too much all at once. Some version of the [second system effect](https://wiki.c2.com/?SecondSystemEffect). You can see it in the (half-baked) Hutton's Razor I was [working on](https://github.com/joelburget/lvca/blob/9d6db7e4960e2aa53781c98a5ea0054909d11a1e/languages/LanguageHuttonsRazor.ml#L21-L61), where I was trying to use three half-built languages. Trying to build the perfect system all at once. 6 | 7 | What I need to start with is a system that makes it easier for me to build languages today (or at least this week). With that in mind, my most immediate goal is to write an *OCaml package* (not a language) that helps with parsing and pretty-printing. I started working on it earlier this week and was hoping to have a demo by today, but it didn't happen quite in time. So, my goal for next update is to have a demo of the following: 8 | 9 | * Two editor panes: 10 | - On the left is the concrete syntax of a language (probably the lambda calculus) 11 | - On the right is abstract syntax 12 | * Editing the left side should re-parse and cause the right to update. Similarly for editing the right. 13 | * Selecting a term on either side should show the corresponding term on the other side. 14 | * Stretch goals: 15 | - When you select a variable binding site we can highlight the scope where it's visible. 16 | - A tool to rename variables (the simplest refactoring tool I can think of) 17 | 18 | The two things I'm trying to solve here are: 19 | 20 | 1. A nice, general, reusable representation for abstract syntax that I can use for basically any language I want. 21 | 1. Automatic provenance handling. A good compiler will show you exactly where in the source an error originated. It's (a) boilerplate to plumb this information everywhere and (b) significant work to turn that provenance information into good error messages. My goal is to automate some of this. 22 | 23 | That's where things stand today. I can't wait to share the demo next time. 24 | -------------------------------------------------------------------------------- /pages/md/progress-december-28-2020.md: -------------------------------------------------------------------------------- 1 | import TreeViewWebm from "../../assets/treeview.webm" 2 | import TreeViewMp4 from "../../assets/treeview.mp4" 3 | 4 | Happily it's only been five days since the last update. I'm on "vacation" so I have a lot more time than usual to work on LVCA. This is a quick update on a new feature. 5 | 6 | ### Tree Viewer 7 | 8 | I added a tree viewer to the [parsing language](/parsing-language/) demo page. It's helpful for seeing the location data attached to terms, but I'm even more excited to use it as a base for the binding / scope viewer I mentioned in the [last update](/progress-december-23-2020/). 9 | 10 | 14 | 15 | ### Core / Quoting 16 | 17 | I settled on a compromise I'm fairly happy with. The parser language uses braces (`{...}`) to embed core terms and the core language also uses braces to embed quoted terms. This does mean we sometimes end up with double braces, eg `a=. ' '* '+' ' '* b=. -> {{add(a; b)}}`. As a compromise I added sugar for two common cases: 18 | 19 | * Counts: `'c'2` is short for `'c'{{2}}` 20 | * `fail`: `fail "message"` is short for `fail {{"message"}}` 21 | 22 | ### Upcoming work 23 | 24 | My next small project will be to enhance this tree viewer with scope information: 25 | 26 | * View the scope of a variable definition 27 | * View the use-sites of a variable definition 28 | * View the definition site of a variable 29 | * View places where a variable is shadowed 30 | 31 | I have three larger projects coming up, but haven't decided yet in which order they'll appear: 32 | 33 | * A typechecker debugger 34 | * Pretty-printing terms 35 | * A language of edits 36 | 37 | I'm excited to say more about these soon! 38 | -------------------------------------------------------------------------------- /pages/md/progress-june-9-2021.md: -------------------------------------------------------------------------------- 1 | I've been working on two projects I'd like to give an update about. 2 | 3 | ## `ppx_lvca` 4 | 5 | The purpose of this ppx is to translate LVCA-stuff into OCaml. For example 6 | 7 | ``` 8 | let test_nominal = [%lvca.nominal "foo(x. x)"] 9 | ``` 10 | 11 | [becomes](https://github.com/joelburget/lvca/blob/8d1282163623b3541eef021cdff92865890b0563/ppx_lvca/test/test.expected.ml) 12 | 13 | ``` 14 | let test_nominal = 15 | Nominal.Term.Operator 16 | ((Some (let open Lvca_provenance.Range in { start = 0; finish = 9 })), 17 | "foo", 18 | [Nominal.Scope.Scope 19 | ([Pattern.Var 20 | ((Some 21 | ((let open Lvca_provenance.Range in 22 | { start = 4; finish = 5 }))), "x")], 23 | (Nominal.Term.Var 24 | ((Some 25 | ((let open Lvca_provenance.Range in 26 | { start = 7; finish = 8 }))), "x")))]) 27 | ``` 28 | 29 | That's a simple example of a term. It gets a bit more complicated when talking about a language definition: 30 | 31 | ``` 32 | module Lang = 33 | [%lvca.abstract_syntax_module 34 | {| 35 | integer : * 36 | string : * 37 | 38 | foo := 39 | | Foo(integer) 40 | | Bar(foo[foo]. foo. foo) 41 | |} 42 | ``` 43 | 44 | This [outputs](https://github.com/joelburget/lvca/blob/8d1282163623b3541eef021cdff92865890b0563/ppx_lvca/test/test.expected.ml) a bunch more code. I'm not going to link the whole thing here (it's long), but the result is a module, with an OCaml type definition: 45 | 46 | ``` 47 | type 'info foo = 48 | | Foo of 'info * 'info Integer.t 49 | | Bar of 'info * ('info Pattern.t * string * 'info foo) 50 | ``` 51 | 52 | We also include a simpler `Plain` module without the `info` parameter. 53 | 54 | ``` 55 | module Plain = struct 56 | type foo = 57 | | Foo of Integer.Plain.t 58 | | Bar of (Pattern.Plain.t * string * foo) 59 | end 60 | ``` 61 | 62 | But most of the code is defining functions like `info`, `map_info`, `equal`, `to_nominal`, and `of_nominal`. 63 | 64 | This is all now working, except for `to_nominal` and `of_nominal`. Defining those two functions gives a bunch of other stuff for free -- (de)serialization, parsing, pretty-printing, etc. 65 | 66 | ## Core language 67 | 68 | The purpose of the core language is mostly mapping between languages. For example, translating a higher-level language to a lower-level one. 69 | 70 | My near-term goal is to use it to translate terms (in any language, but the simplest example is the lambda calculus) to the document language. 71 | 72 | ``` 73 | let rec to_doc \(tm : lc) -> 74 | let children = 75 | match tm with { 76 | | Lam(x. body) -> Cons(name x; Cons(to_doc body; Nil())) 77 | Concat( 78 | | App(t1; t2) -> Cons(to_doc t1; Cons(to_doc t2; Nil())) 79 | } 80 | in 81 | let desc = Concat(children) in 82 | Inline(desc; Nil()) 83 | ``` 84 | 85 | As an aside, this shows something interesting -- it's not good to translate directly from a language (or at least one that can nest) to a document -- we need a pretty-printing step, otherwise we're going to end up with deeply nested `Inline`s but no structure. 86 | 87 | Now both the abstract syntax and core languages have notions of externals, they ought to both have a notion of linking. Is this the same thing? For core, it should definitely be called *linking*. For abstract syntax, I'm not sure. Union? But it's not symmetric -- there's a notion of dependency. 88 | -------------------------------------------------------------------------------- /pages/md/progress-may-24-2021.md: -------------------------------------------------------------------------------- 1 | Long time no see! I've been working hard on LVCA, more focused on implementation than writing about it. I'm still focused on implementation, but I want to at least restart these progress updates. Today I have an example of the kind of thing I've been working on. Warning: this is fairly low-level, but I think still interesting. 2 | 3 | ## Parsing and Comments 4 | 5 | Say we're parsing something with a comment: `cons(1; cons(2; nil())) // the list [1, 2]`. What happens to the comment? The easy answer is that we throw it away in parsing (lexing). I think a better answer is that we should record it as metadata, so the parser is responsible for attaching the body of the comment to the term it's annotating. 6 | 7 | ## Implementation 8 | 9 | Before my latest change, parsers were implemented as the following (OCaml) [signature](https://github.com/joelburget/lvca/blob/7cbe48e1720475da1b336148adb0bcdac16944f3/syntax/Pattern.mli#L86-L89): 10 | 11 | ``` 12 | module Parse (Comment : ParseUtil.Comment_int) : sig 13 | val t : OptRange.t t ParseUtil.t 14 | val whitespace_t : OptRange.t t ParseUtil.t 15 | end 16 | ``` 17 | 18 | A parser for some language would take in a comment parser. This is neat because it means that (a) we can use the syntax for comments we prefer, and (b) when composing languages you can enforce that they all use the same comment syntax. 19 | 20 | Now they're implemented as this [signature](https://github.com/joelburget/lvca/blob/193d5b9fe65d0db88c130c77cb9a699282ee47bc/syntax/Pattern.mli#L86): 21 | 22 | ``` 23 | module Parse : sig 24 | val t : Lvca_provenance.OptRange.t t ParseUtil.t 25 | val whitespace_t : Lvca_provenance.OptRange.t t ParseUtil.t 26 | end 27 | ``` 28 | 29 | This has a number of advantages: 30 | 31 | * It's simpler. This is the biggest advantage. It's made implementation much easier. 32 | * A given language always uses the same comment syntax. This is more consistent in some ways (though it negates the previous advantage (a)). Also, previously there was a chance the given comment syntax could interfere with the language being defined. This is bad. 33 | 34 | Lastly, the thing I'm most interested for the purposes of this post, comments aren't necessarily just thrown away. We already record the locations of parsed terms: 35 | 36 | ``` 37 | cons(1; cons(2; nil())) // the list [1, 2] 38 | <---------------------> 39 | ^ <------------> 40 | ^ <---> 41 | ``` 42 | 43 | Now we might also record comments: 44 | 45 | ``` 46 | cons(1; cons(2; nil())) // the list [1, 2] 47 | <---------------------> "the list [1, 2]" 48 | ^ <------------> 49 | ^ <---> 50 | ``` 51 | 52 | ## Closing Thoughts 53 | 54 | This agrees nicely with the design principle of not unnecessarily throwing anything away. 55 | 56 | Broadening scope a bit, I'm thinking about the status of comments. Perhaps comments should have affordances for referring to other bits of code, using math notation or LaTeX, etc. Perhaps they should have affordances for mentioning preconditions, invariants, and other laws. 57 | -------------------------------------------------------------------------------- /pages/md/progress-november-7-2020.md: -------------------------------------------------------------------------------- 1 | ### Parser Language 2 | 3 | Since last time I've been focusing on implementing a language for writing parsers. 4 | 5 | This is important for a couple of reasons: 6 | 7 | * I'm embarrassed by the quality of the error messages in the constructive real calculator [demo](/constructive-real-calculator). 8 | 9 | * My goal with this project is basically to build a lot of languages. Better parser tooling should make that much easier. 10 | 11 | My starting point has been to look at existing parser combinator libraries, for example [Parsec](https://hackage.haskell.org/package/parsec) or [Angstrom](https://github.com/inhabitedtype/angstrom). The language has the same primitives you'd see in either of those libraries, but it has a few differences in focus: 12 | 13 | 1. It's its own language, not a Haskell or OCaml library. This means that we can use some terser syntax, which I prefer. For example, in Angstrom you can use the `char` or `string` functions to build a simple parser: `char 'c' | string "str"`. The syntax in the language I'm building is simply `'c' | "str"`. I don't want to say too much more because there are still a few places I haven't decided exactly what syntax I want to use. 14 | 15 | 2. Parsers built using this language can attach locations to terms for free. For example, say we're parsing the string `x + 1`. The result is a term with locations attached (this is essential for error messages and tooling): 16 | 17 | ``` 18 | add( // 0:5 19 | x; // 0:1 20 | 1 // 4:5 21 | ) 22 | ``` 23 | 24 | 3. Since this language runs in the browser I'm taking the opportunity to build a debugger which allows one to step through the state as the parser (and subparsers) try to consume the input string. 25 | 26 | ### Design Language 27 | 28 | Part of building the debugger has been creating a set of reusable components that I can use to build it (and future demos). Until now (for the previous demos), I've just used [TyXML](https://github.com/ocsigen/tyxml) to build HTML. This has been fine, except I've been writing custom CSS for every component. This means that I've been thinking at the level of "div with flexbox (flex-direction column) and 2px black border", but I should be thinking "rows". I'm trying to build a simple, consistent framework for everything on lvca.dev. At its most grandiose you might call this a design language. 29 | 30 | So far my primitives include: input, button, table, rows, cols, etc. This list is evolving as I work on the parser debugger and I'm sure it will continue to evolve with every new demo. 31 | 32 | One of my goals is that things should look good without too much effort. In fact, I prefer customizability to be as limited as possible. Today I was looking for styling ideas and discovered the fantastic [moderncss.dev](https://moderncss.dev). I'm currently exploring their [CSS Button Styling Guide](https://moderncss.dev/css-button-styling-guide/) and [Custom CSS Styles for Form Inputs and Textareas](https://moderncss.dev/custom-css-styles-for-form-inputs-and-textareas/). 33 | 34 | There are a few unorthodox design choices that I'd like to preview: 35 | 36 | * I'm building tools for programming. There should be minimal flourishes and customizability. Elements should be simple, even bare. 37 | * Interactivity should be intentionally limited. For example, if I'm trying to demonstrate a function, there should be clear input (A) and output (B) areas. Information flows from A to B, not vice-versa. 38 | * We're not just working with functions, but with data structures. There's an emphasis on tables, rows, and columns. 39 | 40 | That's all for now! I plan to have a parser demo ready in the next week or two. 41 | -------------------------------------------------------------------------------- /pages/md/progress-october-8-2020.md: -------------------------------------------------------------------------------- 1 | This week I have another quick progress update. I was originally planning to present a demo of the parser language I mentioned [last time](/progress-september-23-2020), but two things happened. First, I got stuck on one or two aspects of the implementation. Also, I discovered a fascinating paper that I started to implement instead. That's what I'd like to talk about today. 2 | 3 | ## Real numbers 4 | 5 | Real numbers are fantastically useful, but at the same time hideously complicated. We often use floating point as a pragmatic approximation to real arithmetic, but that introduces its own set of complexities (just ask Python what `0.1 + 0.2` is). 6 | 7 | In general, it's much nicer to use exact arithmetic when possible, but that introduces a complicated set of tradeoffs. Until now I've never considered implementing exact real arithmetic myself, but last week I came across the paper [Towards an API for the Real Numbers](https://dl.acm.org/doi/pdf/10.1145/3385412.3386037) by Hans-J. Boehm. This paper provides a set of primitives that can be computed exactly (to arbitrary precison), and an implementation in Java. The primitives are: 8 | 9 | * literals (eg `1.2`) 10 | * addition, subtraction, multiplication, division 11 | * exponentiation 12 | * "select" (ie `if`) 13 | * `cos`, `atan`, `ln`, `asin`, `sqrt` 14 | 15 | From these we can compute many more derived operators, like other trig operators, `pi`, logarithms of other bases, etc. This is a nice set of primitives / derived operators, good for 95% of cases. 16 | 17 | ## Implementation 18 | 19 | The implementation is quite difficult, but tons of fun. Each of `exp`, `cos`, `atan`, `ln`, `asin`, and `sqrt` involve evaluating a series until the error is less than the last digit requested. The final API is intuitive, but the code behind it is not. It's also been a challenge to port it from Java to [OCaml](https://github.com/joelburget/lvca/blob/f65952d0a4dd96719c8f6e7ff3ab619a59cee9be/languages/Calculator.ml). 20 | 21 | But I now have a fairly robust set of tests, and am starting to gain confidence in the implementation. There is a lot of cleaning up to do, but I think it shows a lot of promise. It's extremely satisfying to watch the tests run, evaluating all of the examples in the blink of an eye. 22 | 23 | ## Plans 24 | 25 | My primary reason for implementing this is to create a calculator for myself. I'll be able to run it both in the console and online. And in the style of LVCA languages it'll be extensible. I should be able to add variables, user-defined functions, etc. 26 | 27 | While implementing it I realized that this might be worth uploading to opam in some form. I can imagine that others in the OCaml community would enjoy using it as a library, so sometime this week I'd like to extract it from LVCA and start to shape it into a library. 28 | 29 | That's all for now. I'm looking forward to next time when I can share a demo of the calculator in action. 30 | -------------------------------------------------------------------------------- /pages/md/semantic-diffs-and-broken-tests.md: -------------------------------------------------------------------------------- 1 | This is a small point complementing the main [semantic diffs](/semantic-diffs) post. It's not quite important enough to roll into the main post, but still worth pointing out. 2 | 3 | When structuring a set of changes, two considerations are in tension. 4 | 5 | 1. The desire to have a clean history. In particular, we would like all tests to pass after every change. Never leave the codebase in a broken state. 6 | 2. Showing your work. It's worthwhile to record in granular detail all the steps you took to achieve your goal. 7 | 8 | I'd like to justify this second point with a couple of examples. 9 | 10 | 1. Recording failures and dead ends. In my experience I often try to make some change a few different ways before I find the one that ultimately ends up working. Usually my coworkers think of some of the same ways to accomplish the goal, so the conversation comes up, *why didn't you do it this way*? My explanation is sometimes satisfying, sometimes not. How nice it would be then, if I always had a complete log of my work, so I could point to an exact state of the codebase, *this is where I realized the approach wouldn't work*. 11 | 2. Analyzing changes and building tools for common workflows. Another style of change that I see frequently is the *heuristic*, *fixup* pair. I start by applying a heuristic change, for example a simple search and replace. But it's often lossy, with false positives or negatives which I need to fix up by hand. Again, I would like to record this process. Each of these changes would make good fodder for investment in better tools. If I notice the same pattern often enough it's a clue that I should either think of a more accurate heuristic or invest in building a better tool to do the same job. 12 | 13 | In both of these cases (especially the second), I want to record a broken state, but I would like this to not affect the cleanliness of the history. Structured diffs suggest a satisfying way to have both. I can simply enforce that all top-level changes maintain passing tests, but sub-changes can break freely. 14 | -------------------------------------------------------------------------------- /pages/md/software-evolution.md: -------------------------------------------------------------------------------- 1 | It's really hard to get software right the first time. We might start with a simplified model, an approximation, and slowly work our way towards what we really want. Computers require instruction at such a minute level of detail, we're working with bits, bytes, arrays, stacks, sets, etc. These are hard mathematical things, not so close to the real-world that we want to model. It's a small miracle that we're able to heap abstractions high enough to reach from bits all the way to controlling airplanes, translating sentences, and rendering video games (for just three examples). 2 | 3 | The point is, bits are quantized, hard, and idealized. The real world is fuzzy, soft, and [has a surprising amount of detail](http://johnsalvatier.org/blog/2017/reality-has-a-surprising-amount-of-detail). The only way to get anything done is to start small and simple. Slowly add more and more of the details, edge cases, and surprises. You start to asymptotically approach the ideal. Software projects are never done, never perfect. Eventually they peter out or enough other software depends on them that they can't change anymore, or they'll [break something](https://xkcd.com/1172/). 4 | 5 | Today I'm interested in software evolution. I want to look at it from a few angles, without addressing any too deeply (today). 6 | 7 | ## 1. Version control 8 | 9 | It's almost hard to believe now, but there was a time, not too long ago, when version control didn't exist and software developers had to, like, re-punch all their punch cards or something. 10 | 11 | /* 12 | Version control is one of the most important tools in a software developer's toolbox. No matter the size of your team, it's considered a good idea to track your changes over time. ... 13 | 14 | One interesting pattern that version control enables is different versions of some software evolving concurrently. In other words, branches, or more dramatically, forks. 15 | */ 16 | 17 | ## 2. Language evolution 18 | 19 | Like all software, programming languages must evolve (they *are* still software, after all). In fact, updating a language and updating an API have most all the same problems. 20 | 21 | ## 3. Merge conflicts 22 | 23 | ## 4. Large-scale updates 24 | 25 | -------------------------------------------------------------------------------- /pages/md/sorts-and-kind-checking.md: -------------------------------------------------------------------------------- 1 | I recently made two related changes to the sort / kind system in LVCA. 2 | 3 | ## Sorts 4 | 5 | Previously the syntax for sorts required `()` for even unary sorts. For example, the integer sort, taking no arguments, was written `integer()`. Similarly `string()`, etc. This was motivated by consistency with the syntax we use for terms, where an operator is always constructed with `()`. Likewise, for consistency with terms, variables could be bound, but these were not constructed with `()`. For example (old syntax): 6 | 7 | ``` 8 | example(a) := 9 | // An operator, first, taking an a 10 | | first(a) 11 | // An operator, second, taking an integer 12 | | second(integer()) 13 | ``` 14 | 15 | However, this has two problems -- one large and one small. 16 | 17 | The first problem is purely ergonomic. It's a pain to always write `integer()` and I found myself often forgetting the parens, to be reminded by the parser. 18 | 19 | The second problem is more substantial -- it's inconsistent. Sometimes unary sorts are written with parens but sometimes they're not. It just depends on whether the sort is bound (as in `example(a)`, binding `a`). But a unary sort should just be a unary sort. 20 | 21 | Because of these two considerations I've changed the sort syntax. There are variables, application (via juxtaposition), and parens for grouping. Here are three sorts for example. 22 | 23 | ``` 24 | integer // a unary sort 25 | list integer // list applied to integer 26 | foo (a b) string // foo applied to (a b) and string 27 | ``` 28 | 29 | And this is the new syntax for the previous example: 30 | 31 | ``` 32 | example a := 33 | | first(a) 34 | | second(integer) 35 | ``` 36 | 37 | ## Kind Checking 38 | 39 | This leads me to kind checking. We want to make sure that sorts have a consistent *kind* everywhere. That is, a given sort's arity should always be the same. For example, if we use `a` by itself, the kind checker will infer that it's unary -- `a : *`. If we apply it to an argument, `a integer`, the kind checker infers that it has kind `* -> *`. If we use it both ways in the same program, the kind checker will complain. 40 | 41 | This is implemented today. One thing I'd like to add in the future is optional kind annotations, so you could write: 42 | 43 | ``` 44 | integer : * 45 | list : * -> * 46 | 47 | foo (a : *) := 48 | | list(list integer) 49 | | a(a) 50 | ``` 51 | 52 | Here I've declared the types of two external dependencies, free variables which need to be linked in. The `foo` sort we're declaring also takes an `a` argument, which has kind `*`. If we don't use annotations the kind checker will infer them, but I think it would be nice to have the option to make kinds fully explicit. 53 | 54 | Finally, I'll note that users of Haskell will notice a similarity to GHC's [kind signatures](https://downloads.haskell.org/~ghc/7.8.4/docs/html/users_guide/kind-polymorphism.html), but LVCA doesn't support kind polymorphism or dependent types for that matter. Each sort has a fixed kind and sorts are not *indexed*. I don't anticipate the kind system ever becoming more complicated. 55 | 56 | 57 | -------------------------------------------------------------------------------- /pages/md/the-interop-story.md: -------------------------------------------------------------------------------- 1 | One of the most important concerns when developing a new language is how it interoperates with existing code. It's always tempting to ignore interop in the design phase, but the reality is that in most cases a language will only find adoption if it can play nice with existing systems, for three reasons: 2 | 3 | * Using the new language from existing infrastructure 4 | * Using existing infrastructure from the new language 5 | * Migrating pieces of a system without rewriting in one go 6 | 7 | ## How interop works in LVCA 8 | 9 | LVCA is intentionally very simple. My goal is that you should be able to reimplement it in a day. This is hugely important for dealing with other hardware platforms and languages. 10 | 11 | For example, by implementing LVCA in JavaScript, it's possible to: 12 | 13 | 1. Run LVCA programs in any browser or any platform that implements JavaScript 14 | 2. Call LVCA programs from JavaScript 15 | 3. Expose externals to LVCA implemented in JavaScript. This means that LVCA-in-JS could use libraries like D3 or React. 16 | -------------------------------------------------------------------------------- /pages/md/universes.md: -------------------------------------------------------------------------------- 1 | My mental image for how software development should work is not unlike how Github works today, except TODO describe how: 2 | * it's easy to fork and stuff, like more real-time 3 | * You can query over the whole universe 4 | 5 | But there's one big problem with working this way that I've never been able to resolve -- licenses. If I'm writing MIT-licensed code I should never rely on GPL code. It's a real mess if everybody is working in the same big sandbox. But today I realized that we can solve the problem by having separate *universes* (maybe think of a better name), where GPL and MIT live in separate universes. With some licenses it's okay to depend on others, with some it's not. The set of universes forms a DAG by the okay-to-include relation. 6 | -------------------------------------------------------------------------------- /pages/md/what-is-a-pl.md: -------------------------------------------------------------------------------- 1 | One goal for this site is to examine some questions relating to programming languages: 2 | 3 | - What is a PL? 4 | - How are they created (constructed)? (Why is this so hard? Can it be easier?) 5 | - What programming languages have interesting ideas, but aren't much used? 6 | - etc 7 | 8 | Let’s start with the first question 9 | 10 | 11 | ### What is a programming language? 12 | 13 | I think our first task should be to define what exactly a language is. There are a lot of complexities around how languages are implemented and how they tend to operate today. Our definition should be about the essence of what it means to be a language. 14 | 15 | A language has four parts: 16 | 17 | - abstract structure 18 | - concrete syntax 19 | - statics 20 | - dynamics 21 | 22 | TODO say a bit about each of these. 23 | 24 | Of course, these four parts only encompass the pure analytical (academic?) heart of what a PL is. There are many more pragmatic (and more important) concerns when actually using a language: 25 | 26 | - The core team building it 27 | - documentation 28 | - the ecosystem (the community (welcoming?, size), libraries) 29 | - how it runs, which platforms 30 | - is it compiled? interpreted? does it have a nice repl? editor integration? 31 | 32 | These are important, but we don't have much to say about them in this post (we’ll come back to most of these in the future). 33 | -------------------------------------------------------------------------------- /pages/md/what-lvca-doesnt-do.md: -------------------------------------------------------------------------------- 1 | I've made an effort to keep LVCA small and easy to implement (correctly). This 2 | focus means that there's a lot LVCA can't do. Today I'd like to explain what 3 | LVCA does and doesn't do (and why). 4 | 5 | ## Parsing 6 | ## Typechecking 7 | ## Builtins 8 | 9 | ## Files 10 | 11 | You should be able to use LVCA locally with files on your own computer. And maybe with version control integration. You should be able to use it on the web pointing to http urls. And I have plans to write a service which uses content-addressing to point to LVCA programs. The point is, these are all valid uses, and they're all work to implement. I don't want to require an implementation of LVCA to implement all of them. And I don't want to choose some arbitrary subset. Point is, LVCA is storage agnostic. It's up to different implementations to decide. 12 | -------------------------------------------------------------------------------- /pages/static/hl-demo1.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/static/hl-demo1.mp4 -------------------------------------------------------------------------------- /pages/static/hl-demo1.webm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/static/hl-demo1.webm -------------------------------------------------------------------------------- /pages/static/hl-demo2.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/static/hl-demo2.mp4 -------------------------------------------------------------------------------- /pages/static/hl-demo2.webm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/static/hl-demo2.webm -------------------------------------------------------------------------------- /pages/static/images/scopeview1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/static/images/scopeview1.png -------------------------------------------------------------------------------- /pages/static/images/scopeview2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/static/images/scopeview2.png -------------------------------------------------------------------------------- /pages/static/images/scopeview3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/static/images/scopeview3.png -------------------------------------------------------------------------------- /pages/static/images/scopeview4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/static/images/scopeview4.png -------------------------------------------------------------------------------- /pages/static/images/scopeview5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/static/images/scopeview5.png -------------------------------------------------------------------------------- /pages/static/treeview.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/static/treeview.mp4 -------------------------------------------------------------------------------- /pages/static/treeview.webm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joelburget/lvca/7dd22642204642f089c6a2fece16ab41321aabb7/pages/static/treeview.webm -------------------------------------------------------------------------------- /parsing/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lvca_parsing) 3 | (public_name lvca.parsing) 4 | (inline_tests) 5 | (libraries angstrom base fmt lvca_util lvca_provenance) 6 | (wrapped false) 7 | (preprocess 8 | (pps ppx_jane))) 9 | -------------------------------------------------------------------------------- /ppx_lvca/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_lvca) 3 | (public_name lvca.ppx) 4 | (inline_tests) 5 | (kind ppx_rewriter) 6 | (preprocess 7 | (pps ppx_jane ppxlib.metaquot)) 8 | (libraries base lvca_syntax lvca_syntax_quoter lvca_parsing lvca_provenance 9 | ppxlib)) 10 | -------------------------------------------------------------------------------- /ppx_lvca/test/.ocamlformat-ignore: -------------------------------------------------------------------------------- 1 | test.expected.ml 2 | -------------------------------------------------------------------------------- /ppx_lvca/test/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name pp) 3 | (modules pp) 4 | (preprocess ; this preprocess step isn't needed but it silences the dune warning ".merlin generated is inaccurate. Cannot mix preprocessed and non preprocessed specifications." 5 | (pps ppx_lvca)) 6 | (libraries ppx_lvca ppxlib)) 7 | 8 | (rule 9 | (targets test.actual.ml) 10 | (deps 11 | (:pp pp.exe) 12 | (:input test.ml)) 13 | (action 14 | (with-stdout-to 15 | test.actual.ml 16 | (run ./%{pp} --impl %{input} -o %{targets})))) 17 | 18 | (rule 19 | (alias runtest) 20 | (action 21 | (diff test.expected.ml test.actual.ml))) 22 | 23 | (test 24 | (name test) 25 | (modules test) 26 | (libraries lvca_syntax) 27 | (preprocess 28 | (pps ppx_lvca))) 29 | -------------------------------------------------------------------------------- /ppx_lvca/test/pp.ml: -------------------------------------------------------------------------------- 1 | let () = Ppxlib.Driver.standalone () 2 | -------------------------------------------------------------------------------- /ppx_lvca/test/test.ml: -------------------------------------------------------------------------------- 1 | open Lvca_syntax 2 | 3 | module Nominal_list = 4 | [%lvca.abstract_syntax_module 5 | {| 6 | term: * 7 | 8 | list := Nil() | Cons(term; list); 9 | |}, { term = "Nominal.Term" }] 10 | 11 | let test_nominal = [%lvca.nominal "Foo(Bar(1))"] 12 | let test_nonbinding = [%lvca.nonbinding "Foo(Bar(1))"] 13 | let test_pattern = [%lvca.pattern "Foo(x)"] 14 | let test_language = [%lvca.abstract_syntax "foo := Foo(integer);"] 15 | 16 | let test_concrete = [%lvca.concrete_syntax {| 17 | foo: 18 | | Foo(i) ~ i 19 | ; 20 | |}] 21 | 22 | module List_model : [%lvca.abstract_syntax_module_sig 23 | "list a := Nil() | Cons(a; list a);"] = 24 | [%lvca.abstract_syntax_module 25 | "list a := Nil() | Cons(a; list a);"] 26 | 27 | module List = struct 28 | type 'a t 29 | 30 | let to_nominal _ _ = Nominal.Term.Var (failwith "no provenance", "") 31 | let of_nominal _ tm = Error (Nominal.Conversion_error.mk_Term tm) 32 | let equivalent _a ~info_eq:_ _ _ = true 33 | end 34 | 35 | module Lang = 36 | [%lvca.abstract_syntax_module 37 | {| 38 | integer : * 39 | string : * 40 | maybe : * -> * 41 | list : * -> * 42 | 43 | foo := 44 | | Foo(integer) 45 | | Bar(foo[foo]. foo. foo) 46 | ; 47 | 48 | nat := Z() | S(nat); 49 | 50 | pair a b := Pair(a; b); 51 | pair_plus a b := PairPlus(a; b; foo); 52 | 53 | nonempty := Nonempty(string; list string); 54 | 55 | term := Operator(list term); 56 | 57 | mut_a := Mut_a(mut_b); 58 | mut_b := Mut_b(mut_a); 59 | |} 60 | , { integer = "Primitive.Integer" 61 | ; string = "Primitive.String" 62 | ; maybe = "List" (* Just for testing *) 63 | ; list = "List" 64 | }] 65 | 66 | module Ifz_lang : [%lvca.abstract_syntax_module_sig "ifz := Ifz(ifz; ifz. ifz; ifz);"] = 67 | [%lvca.abstract_syntax_module 68 | "ifz := Ifz(ifz; ifz. ifz; ifz);"] 69 | 70 | module List_lang = 71 | [%lvca.abstract_syntax_module 72 | {| 73 | string : * 74 | 75 | predefined := Predefined(); 76 | list a := Nil() | Cons(a; list a); 77 | list_external := List_external(list string); 78 | list_predefined := List_predefined(list predefined); 79 | 80 | list_list_a a := List_list_a(list (list a)); 81 | list_list_string_1 := List_list_string_1(list (list string)); 82 | list_list_string_2 := List_list_string_2(list_list_a string); 83 | list_list_predefined_1 := List_list_predefined_1(list (list predefined)); 84 | list_list_predefined_2 := List_list_predefined_2(list_list_a predefined); 85 | |} 86 | , { string = "Nominal.Term" }] 87 | 88 | module type Is_rec_sig = [%lvca.abstract_syntax_module_sig 89 | {| 90 | sort : * 91 | is_rec := Rec() | No_rec(); 92 | ty := Sort(sort) | Arrow(ty; ty); 93 | mut_a := Mut_a(mut_b); 94 | mut_b := Mut_b(mut_a); 95 | |} 96 | , { sort = "Sort" }] 97 | 98 | module Option_model : [%lvca.abstract_syntax_module_sig "option a := None() | Some(a);"] = 99 | [%lvca.abstract_syntax_module 100 | "option a := None() | Some(a);"] 101 | 102 | module Empty : [%lvca.abstract_syntax_module_sig "empty := ;"] = 103 | [%lvca.abstract_syntax_module 104 | "empty := ;"] 105 | 106 | module Empty_as_var = 107 | [%lvca.abstract_syntax_module 108 | {| 109 | list a := Nil() | Cons(a; list a); 110 | empty := ; 111 | foo := 112 | | Foo(empty. empty) 113 | | Bar((list empty)[foo]. foo) 114 | ; 115 | |}] 116 | -------------------------------------------------------------------------------- /ppx_lvca_del/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_lvca_del) 3 | (public_name lvca.ppx_del) 4 | (inline_tests) 5 | (kind ppx_rewriter) 6 | (preprocess 7 | (pps ppx_jane ppxlib.metaquot)) 8 | (libraries base lvca_del lvca_syntax lvca_syntax_quoter lvca_parsing 9 | lvca_provenance ppxlib ppx_lvca)) 10 | -------------------------------------------------------------------------------- /ppx_lvca_del/ppx_lvca_core.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | 3 | let expand_core ~(loc : Location.t) ~path:_ (expr : expression) : expression = 4 | let str, loc = Syntax_quoter.extract_string ~loc expr in 5 | match Lvca_parsing.(parse_string (whitespace *> Lvca_del.Core.Parse.term) str) with 6 | | Error msg -> Location.raise_errorf ~loc "%s" msg 7 | | Ok tm -> Core_syntax_quoter.Core.term ~loc tm 8 | ;; 9 | 10 | let core_extension = 11 | Extension.declare 12 | "lvca.del.core" 13 | Extension.Context.Expression 14 | Ast_pattern.(single_expr_payload __) 15 | expand_core 16 | ;; 17 | 18 | let () = 19 | Ppxlib.Driver.register_transformation 20 | "lvca_del_core" 21 | ~rules:[ Context_free.Rule.extension core_extension ] 22 | ;; 23 | -------------------------------------------------------------------------------- /provenance/Opt_range.ml: -------------------------------------------------------------------------------- 1 | type t = Range.t option 2 | 3 | let mk start finish = Some (Range.mk start finish) 4 | 5 | let extend_to opt_rng pos = 6 | match opt_rng with None -> None | Some rng -> Some (Range.extend_to rng pos) 7 | ;; 8 | 9 | let union a b = 10 | match a, b with 11 | | Some a', Some b' -> Some (Range.union a' b') 12 | | Some a, None | None, Some a -> Some a 13 | | None, None -> None 14 | ;; 15 | 16 | let list_range = Base.List.fold ~init:None ~f:union 17 | 18 | let ( = ) a b = 19 | match a, b with 20 | | Some a', Some b' -> Range.(a' = b') 21 | | Some _, None | None, Some _ -> false 22 | | None, None -> true 23 | ;; 24 | 25 | let is_before a b = 26 | match a, b with Some a', Some b' -> Range.is_before a' b' | _, _ -> false 27 | ;; 28 | 29 | let is_subset a b = 30 | match a, b with Some a', Some b' -> Range.is_subset a' b' | _, _ -> false 31 | ;; 32 | 33 | let intersect a b = 34 | match a, b with Some a', Some b' -> Range.intersect a' b' | _, _ -> None 35 | ;; 36 | 37 | let pp ppf rng_opt = 38 | match rng_opt with Some rng -> Range.pp ppf rng | None -> Fmt.pf ppf "_" 39 | ;; 40 | 41 | let open_stag ppf = function 42 | | Some rng -> Format.pp_open_stag ppf (Range.Stag rng) 43 | | None -> () 44 | ;; 45 | 46 | let close_stag ppf = function Some _rng -> Format.pp_close_stag ppf () | None -> () 47 | -------------------------------------------------------------------------------- /provenance/Opt_range.mli: -------------------------------------------------------------------------------- 1 | type t = Range.t option 2 | 3 | val mk : int -> int -> t 4 | 5 | (** Extend this range to include the given position *) 6 | val extend_to : t -> int -> t 7 | 8 | (** Append two ranges. This creates a new range spanning from the earlier start to the 9 | later finish. *) 10 | val union : t -> t -> t 11 | 12 | (** Combine a list of ranges. This creates a new range spanning from the earliest start to 13 | the latest finish. *) 14 | val list_range : t list -> t 15 | 16 | (** Are the two ranges equal *) 17 | val ( = ) : t -> t -> bool 18 | 19 | (** Does one range occur entirely before the other *) 20 | val is_before : t -> t -> bool 21 | 22 | (** Is the first entirely contained in the second? *) 23 | val is_subset : t -> t -> bool 24 | 25 | (** Do the two ranges intersect? *) 26 | val intersect : t -> t -> t 27 | 28 | (** Pretty-print this range. *) 29 | val pp : t Fmt.t 30 | 31 | val open_stag : Format.formatter -> t -> unit 32 | val close_stag : Format.formatter -> t -> unit 33 | -------------------------------------------------------------------------------- /provenance/Range.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | { start : int 3 | ; finish : int 4 | } 5 | 6 | type Stdlib.Format.stag += Stag of t 7 | 8 | let mk start finish = { start; finish } 9 | let extend_to { start; finish } pos = { start = min start pos; finish = max finish pos } 10 | let union r1 r2 = { start = min r1.start r2.start; finish = max r1.finish r2.finish } 11 | 12 | let list_range = 13 | let open Base in 14 | function 15 | | [] -> None 16 | | ps -> 17 | let start = 18 | ps 19 | |> List.min_elt ~compare:(fun r1 r2 -> compare r1.start r2.start) 20 | |> Option.value_exn 21 | |> fun r -> r.start 22 | in 23 | let finish = 24 | ps 25 | |> List.max_elt ~compare:(fun r1 r2 -> compare r1.finish r2.finish) 26 | |> Option.value_exn 27 | |> fun r -> r.finish 28 | in 29 | Some { start; finish } 30 | ;; 31 | 32 | exception Empty_list 33 | 34 | let list_range_nonempty lst = 35 | match list_range lst with None -> raise Empty_list | Some range -> range 36 | ;; 37 | 38 | let intersect r1 r2 = 39 | let start = max r1.start r2.start in 40 | let finish = min r1.finish r2.finish in 41 | if start >= finish then None else Some { start; finish } 42 | ;; 43 | 44 | let is_before x y = x.finish <= y.start 45 | let is_subset x y = x.start >= y.start && x.finish <= y.finish 46 | let ( = ) x y = x.start = y.start && x.finish = y.finish 47 | let pp ppf { start; finish } = Fmt.pf ppf "{%u,%u}" start finish 48 | let open_stag ppf rng = Format.pp_open_stag ppf (Stag rng) 49 | let close_stag ppf _ = Format.pp_close_stag ppf () 50 | 51 | let stag_functions = 52 | Format. 53 | { mark_open_stag = (function Stag rng -> Fmt.str "<%a>" pp rng | _ -> "") 54 | ; mark_close_stag = (function Stag rng -> Fmt.str "" pp rng | _ -> "") 55 | ; print_open_stag = (fun _ -> ()) 56 | ; print_close_stag = (fun _ -> ()) 57 | } 58 | ;; 59 | 60 | let%test_module "Range" = 61 | (module struct 62 | let print_result = function 63 | | None -> Fmt.pr "%s" "None" 64 | | Some rng -> Fmt.pr "%a" pp rng 65 | ;; 66 | 67 | let%expect_test _ = 68 | print_result (intersect (mk 0 1) (mk 2 3)); 69 | [%expect {| None |}] 70 | ;; 71 | 72 | let%expect_test _ = 73 | print_result (intersect (mk 0 4) (mk 2 3)); 74 | [%expect {| {2,3} |}] 75 | ;; 76 | 77 | let%expect_test _ = 78 | print_result (intersect (mk 0 2) (mk 1 3)); 79 | [%expect {| {1,2} |}] 80 | ;; 81 | 82 | let%expect_test _ = 83 | Fmt.pr "%b" (is_subset (mk 0 1) (mk 2 3)); 84 | [%expect {| false |}] 85 | ;; 86 | 87 | let%expect_test _ = 88 | Fmt.pr "%b" (is_subset (mk 0 4) (mk 2 3)); 89 | [%expect {| false |}] 90 | ;; 91 | 92 | let%expect_test _ = 93 | Fmt.pr "%b" (is_subset (mk 2 3) (mk 0 4)); 94 | [%expect {| true |}] 95 | ;; 96 | 97 | let%expect_test _ = 98 | Fmt.pr "%b" (is_subset (mk 2 3) (mk 2 3)); 99 | [%expect {| true |}] 100 | ;; 101 | 102 | let%expect_test _ = 103 | Fmt.pr "%b" (is_subset (mk 0 2) (mk 1 3)); 104 | [%expect {| false |}] 105 | ;; 106 | 107 | let%expect_test _ = 108 | Fmt.pr "%b" (is_subset (mk 18 19) (mk 21 24)); 109 | [%expect {| false |}] 110 | ;; 111 | end) 112 | ;; 113 | -------------------------------------------------------------------------------- /provenance/Range.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | { start : int 3 | ; finish : int 4 | } 5 | 6 | type Stdlib.Format.stag += Stag of t 7 | 8 | val mk : int -> int -> t 9 | 10 | (** Extend this range to include the given position *) 11 | val extend_to : t -> int -> t 12 | 13 | (** Append two ranges. This creates a new range spanning from the earlier start to the 14 | later finish. *) 15 | val union : t -> t -> t 16 | 17 | (** Combine a list of ranges. This creates a new range spanning from the earliest start to 18 | the latest finish. *) 19 | val list_range : t list -> t option 20 | 21 | (** Raised by [list_range_nonempty] when passed an empty list *) 22 | exception Empty_list 23 | 24 | (** Combine a list of ranges. This creates a new range spanning from the earliest start to 25 | the latest finish. 26 | 27 | @raise Empty_list *) 28 | val list_range_nonempty : t list -> t 29 | 30 | (** Are the two ranges equal *) 31 | val ( = ) : t -> t -> bool 32 | 33 | (** Does one range occur entirely before the other *) 34 | val is_before : t -> t -> bool 35 | 36 | (** Is the first entirely contained in the second? *) 37 | val is_subset : t -> t -> bool 38 | 39 | (** Do the two ranges intersect? *) 40 | val intersect : t -> t -> t option 41 | 42 | (** Pretty-print this range. *) 43 | val pp : t Fmt.t 44 | 45 | val open_stag : Format.formatter -> t -> unit 46 | val close_stag : Format.formatter -> t -> unit 47 | 48 | (** For testing only: used to enable outputting of the [Stag] semantic tag. *) 49 | val stag_functions : Stdlib.Format.formatter_stag_functions 50 | -------------------------------------------------------------------------------- /provenance/Ranges.mli: -------------------------------------------------------------------------------- 1 | (** The type of disjoint ranges in a buffer. 2 | 3 | Invariants: each range must be disjoint, ranges must be ordered. *) 4 | type t = Range.t list 5 | 6 | type Stdlib.Format.stag += Stag of t 7 | 8 | (** Test invariants. Returns true on success. *) 9 | val invariants : t -> bool 10 | 11 | val of_opt_range : Opt_range.t -> t 12 | val empty : t 13 | 14 | (** Convert from a (possibly unordered and overlapping) list of ranges. *) 15 | val of_list : Range.t list -> t 16 | 17 | (** Convert from a (possibly overlapping) set of ranges. *) 18 | val of_set : (Range.t, _) Base.Set.t -> t 19 | 20 | (** Are the two sets of ranges equal? *) 21 | val ( = ) : t -> t -> bool 22 | 23 | (** Union two sets of ranges. *) 24 | val union : t -> t -> t 25 | 26 | (** Is the first entirely contained in the second? *) 27 | val is_subset : t -> t -> bool 28 | 29 | (** The intersection of two ranges. *) 30 | val intersect : t -> t -> t 31 | 32 | (** Pretty-print this range. *) 33 | val pp : t Fmt.t 34 | 35 | type string_status = 36 | | Covered of Range.t 37 | | Uncovered of Range.t 38 | 39 | val open_stag : Format.formatter -> t -> unit 40 | val close_stag : Format.formatter -> t -> unit 41 | 42 | (** Mark all string segments as either covered or uncovered. *) 43 | val mark_string : t -> string -> string_status list 44 | 45 | (** For testing only: used to enable outputting of the [Stag] semantic tag. *) 46 | val stag_functions : Stdlib.Format.formatter_stag_functions 47 | -------------------------------------------------------------------------------- /provenance/Source_range.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = 4 | { source : string 5 | ; range : Range.t 6 | } 7 | 8 | type Stdlib.Format.stag += Stag of t 9 | 10 | let mk source p1 p2 = { source; range = Range.mk p1 p2 } 11 | let pp ppf { source; range } = Fmt.pf ppf "%s:%a" source Range.pp range 12 | let extend_to { source; range } pos = { source; range = Range.extend_to range pos } 13 | 14 | let union t1 t2 = 15 | if String.(t1.source = t2.source) 16 | then Some { source = t1.source; range = Range.union t1.range t2.range } 17 | else None 18 | ;; 19 | 20 | let ( = ) p1 p2 = String.(p1.source = p2.source) && Range.(p1.range = p2.range) 21 | 22 | let is_before p1 p2 = 23 | String.(p1.source = p2.source) && Range.(is_before p1.range p2.range) 24 | ;; 25 | 26 | let is_subset p1 p2 = 27 | String.(p1.source = p2.source) && Range.(is_subset p1.range p2.range) 28 | ;; 29 | 30 | let intersect p1 p2 = 31 | if String.(p1.source = p2.source) 32 | then ( 33 | match Range.intersect p1.range p2.range with 34 | | None -> None 35 | | Some range -> Some { source = p1.source; range }) 36 | else None 37 | ;; 38 | 39 | let open_stag ppf rng = Stdlib.Format.pp_open_stag ppf (Stag rng) 40 | let close_stag ppf _ = Stdlib.Format.pp_close_stag ppf () 41 | 42 | let stag_functions = 43 | Stdlib.Format. 44 | { mark_open_stag = (function Stag t -> Fmt.str "<%a>" pp t | _ -> "") 45 | ; mark_close_stag = (function Stag t -> Fmt.str "" pp t | _ -> "") 46 | ; print_open_stag = (fun _ -> ()) 47 | ; print_close_stag = (fun _ -> ()) 48 | } 49 | ;; 50 | -------------------------------------------------------------------------------- /provenance/Source_range.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | { source : string 3 | ; range : Range.t 4 | } 5 | 6 | type Stdlib.Format.stag += Stag of t 7 | 8 | val mk : string -> int -> int -> t 9 | 10 | (** Pretty-print this range. *) 11 | val pp : t Fmt.t 12 | 13 | (** Extend this range to include the given position *) 14 | val extend_to : t -> int -> t 15 | 16 | (** Append two ranges. This creates a new range spanning from the earlier start to the 17 | later finish. *) 18 | val union : t -> t -> t option 19 | 20 | (** Are the two ranges equal *) 21 | val ( = ) : t -> t -> bool 22 | 23 | (** Does one range occur entirely before the other *) 24 | val is_before : t -> t -> bool 25 | 26 | (** Is the first entirely contained in the second? *) 27 | val is_subset : t -> t -> bool 28 | 29 | (** Do the two ranges intersect? *) 30 | val intersect : t -> t -> t option 31 | 32 | val open_stag : Format.formatter -> t -> unit 33 | val close_stag : Format.formatter -> t -> unit 34 | 35 | (** For testing only: used to enable outputting of the [Stag] semantic tag. *) 36 | val stag_functions : Stdlib.Format.formatter_stag_functions 37 | -------------------------------------------------------------------------------- /provenance/Source_ranges.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lvca_util 3 | 4 | type t = Ranges.t String.Map.t 5 | type Stdlib.Format.stag += Stag of t 6 | 7 | let pp' ppf (buf, ranges) = Fmt.pf ppf "%s:%a" buf Ranges.pp ranges 8 | let pp ppf t = Fmt.(list ~sep:(any ",") pp') ppf (Map.to_alist t) 9 | let invariants t = Map.for_all t ~f:Ranges.invariants 10 | let ( = ) x y = Map.equal Ranges.( = ) x y 11 | 12 | let union x y = 13 | Map.merge x y ~f:(fun ~key:_ -> function 14 | | `Left v | `Right v -> Some v | `Both (v1, v2) -> Some (Ranges.union v1 v2)) 15 | ;; 16 | 17 | let empty = String.Map.empty 18 | let unions lst = Base.List.fold lst ~f:union ~init:empty 19 | let mk buf p1 p2 = String.Map.singleton buf (Ranges.of_list [ Range.mk p1 p2 ]) 20 | let of_range ~buf Range.{ start; finish } = mk buf start finish 21 | let of_source_range Source_range.{ source; range } = of_range ~buf:source range 22 | let of_opt_range ~buf = function Some range -> of_range ~buf range | None -> empty 23 | 24 | let is_subset p1 p2 = 25 | Map.for_alli p1 ~f:(fun ~key ~data:r1 -> 26 | match Map.find p2 key with None -> false | Some r2 -> Ranges.is_subset r1 r2) 27 | ;; 28 | 29 | let intersect p1 p2 = String.Map.intersect p1 p2 ~f:Ranges.intersect 30 | 31 | let restrict ~buf p = 32 | match Map.find p buf with 33 | | None -> empty 34 | | Some ranges -> String.Map.singleton buf ranges 35 | ;; 36 | 37 | let open_stag ppf rng = Stdlib.Format.pp_open_stag ppf (Stag rng) 38 | let close_stag ppf _ = Stdlib.Format.pp_close_stag ppf () 39 | 40 | let stag_functions = 41 | Stdlib.Format. 42 | { mark_open_stag = (function Stag t -> Fmt.str "<%a>" pp t | _ -> "") 43 | ; mark_close_stag = (function Stag t -> Fmt.str "" pp t | _ -> "") 44 | ; print_open_stag = (fun _ -> ()) 45 | ; print_close_stag = (fun _ -> ()) 46 | } 47 | ;; 48 | 49 | let%test_module "Range" = 50 | (module struct 51 | let%expect_test _ = 52 | Fmt.pr "%a" pp (unions []); 53 | [%expect {| |}] 54 | ;; 55 | 56 | let%expect_test _ = 57 | Fmt.pr "%a" pp (unions [ mk "input" 16 17 ]); 58 | [%expect {| input:{16,17} |}] 59 | ;; 60 | end) 61 | ;; 62 | -------------------------------------------------------------------------------- /provenance/Source_ranges.mli: -------------------------------------------------------------------------------- 1 | (** The type of disjoint ranges in a set of buffers. 2 | 3 | Invariants: each range must be disjoint, ranges must be ordered. *) 4 | type t = Ranges.t Lvca_util.String.Map.t 5 | 6 | type Stdlib.Format.stag += Stag of t 7 | 8 | (** Test invariants. Returns true on success. *) 9 | val invariants : t -> bool 10 | 11 | val empty : t 12 | val mk : string -> int -> int -> t 13 | val of_source_range : Source_range.t -> t 14 | val of_range : buf:string -> Range.t -> t 15 | val of_opt_range : buf:string -> Opt_range.t -> t 16 | 17 | (* (** Convert from a (possibly unordered and overlapping) list of ranges. *) val of_list 18 | : Range.t list -> t 19 | 20 | (** Convert from a (possibly overlapping) set of ranges. *) val of_set : (Range.t, _) 21 | Base.Set.t -> t *) 22 | 23 | (** Pretty-print this range. *) 24 | val pp : t Fmt.t 25 | 26 | (** Are the two sets of ranges equal *) 27 | val ( = ) : t -> t -> bool 28 | 29 | (** Union two sets of ranges. *) 30 | val union : t -> t -> t 31 | 32 | val unions : t list -> t 33 | 34 | (** Is the first entirely contained in the second? *) 35 | val is_subset : t -> t -> bool 36 | 37 | (** The intersection of two ranges *) 38 | val intersect : t -> t -> t 39 | 40 | (** Restrict to a given buffer *) 41 | val restrict : buf:string -> t -> t 42 | 43 | val open_stag : Format.formatter -> t -> unit 44 | val close_stag : Format.formatter -> t -> unit 45 | 46 | (** For testing only: used to enable outputting of the [Stag] semantic tag. *) 47 | val stag_functions : Stdlib.Format.formatter_stag_functions 48 | -------------------------------------------------------------------------------- /provenance/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lvca_provenance) 3 | (public_name lvca.provenance) 4 | (inline_tests) 5 | (libraries base fmt lvca_util) 6 | (preprocess 7 | (pps ppx_jane))) 8 | -------------------------------------------------------------------------------- /server.py: -------------------------------------------------------------------------------- 1 | import os 2 | import http.server 3 | import socketserver 4 | 5 | from http import HTTPStatus 6 | 7 | PORT = 8000 8 | ROOT_DIR = "_build/default/pages/" 9 | 10 | 11 | class Handler(http.server.SimpleHTTPRequestHandler): 12 | def __init__(self, request, client_address, server): 13 | super().__init__(request, client_address, server, directory=ROOT_DIR) 14 | 15 | def do_GET(self): 16 | if self.path.endswith("/"): 17 | with open(ROOT_DIR + "index.html", "rb") as f: 18 | fs = os.fstat(f.fileno()) 19 | self.send_response(HTTPStatus.OK) 20 | self.send_header("Content-type", "text/html") 21 | self.send_header("Content-Length", str(fs[6])) 22 | self.send_header("Last-Modified", self.date_time_string(fs.st_mtime)) 23 | self.end_headers() 24 | self.copyfile(f, self.wfile) 25 | else: 26 | # /parsing-language/devel_main.bc.js -> ["", "parsing-language", "devel_main.bc.js"] 27 | # /devel_main.bc.js -> ["", "devel_main.bc.js"] 28 | words = self.path.split("/") 29 | self.path = "/" + words[-1] 30 | super().do_GET() 31 | 32 | 33 | if __name__ == "__main__": 34 | httpd = http.server.HTTPServer(("", PORT), Handler) 35 | httpd.serve_forever() 36 | -------------------------------------------------------------------------------- /syntax/Abstract_syntax.mli: -------------------------------------------------------------------------------- 1 | open Lvca_util 2 | 3 | (** Types for describing the abstract syntax of a language. *) 4 | 5 | (** A mapping from the name of a sort to its arity -- the number of arguments it takes. *) 6 | type kind_map = int String.Map.t 7 | 8 | (** A mapping from the name of a sort to the different arities it was asserted or infered 9 | to have. *) 10 | type kind_mismap = Int.Set.t String.Map.t 11 | 12 | (** The abstract syntax of a language is the sorts it defines. Definition order is 13 | significant (so we'll always print definitions in the same order they were parsed. For 14 | the definition of a language without significant ordering, see [unordered]. *) 15 | type t = 16 | { externals : (string * Kind.t) list 17 | ; sort_defs : (string * Sort_def.t) list 18 | } 19 | 20 | module Unordered : sig 21 | (** The same as [t] but definition order is not significant (this is a map rather than a 22 | list). *) 23 | type t = 24 | { externals : Kind.t String.Map.t 25 | ; sort_defs : Sort_def.t String.Map.t 26 | } 27 | end 28 | 29 | val mk_unordered : t -> [ `Ok of Unordered.t | `Duplicate_key of string ] 30 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 31 | val ( = ) : t -> t -> bool 32 | 33 | (** {1 Misc} *) 34 | 35 | module Lookup_error : sig 36 | type t = 37 | | Sort_not_found of String.Set.t 38 | | Operator_not_found of String.Set.t 39 | 40 | val pp : t Fmt.t 41 | end 42 | 43 | val lookup_operator 44 | : t 45 | -> string (** sort name *) 46 | -> string (** operator name *) 47 | -> ((string * Kind.t option) list * Operator_def.t, Lookup_error.t) Result.t 48 | 49 | module Find_error : sig 50 | type t = 51 | | Ambiguous_operator 52 | | Operator_not_found 53 | 54 | val pp : t Fmt.t 55 | end 56 | 57 | val find_operator 58 | : t 59 | -> string (** operator name *) 60 | -> (string * Sort_def.t * Operator_def.t, Find_error.t) Result.t 61 | 62 | val pp : t Fmt.t 63 | 64 | (** Check that each sort in the syntax has a consistent arity. *) 65 | val kind_check : t -> (kind_map, kind_mismap) Result.t 66 | 67 | val parse : t Lvca_parsing.t 68 | -------------------------------------------------------------------------------- /syntax/Arity.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = Arity of Provenance.t * Valence.t list 4 | 5 | let mk ?(provenance = Provenance.of_here [%here]) valences = Arity (provenance, valences) 6 | 7 | let pp ppf (Arity (info, valences)) = 8 | Provenance.fmt_stag info Fmt.(parens (list ~sep:semi Valence.pp)) ppf valences 9 | ;; 10 | 11 | let equivalent 12 | ?(info_eq = fun _ _ -> true) 13 | (Arity (i1, valences1)) 14 | (Arity (i2, valences2)) 15 | = 16 | info_eq i1 i2 && List.equal Valence.(equivalent ~info_eq) valences1 valences2 17 | ;; 18 | 19 | let ( = ) = equivalent ~info_eq:Provenance.( = ) 20 | 21 | let instantiate env (Arity (info, valences)) = 22 | Arity (info, List.map ~f:(Valence.instantiate env) valences) 23 | ;; 24 | 25 | let parse = 26 | let open Lvca_parsing in 27 | let open C_comment_parser in 28 | let p = 29 | let+ _, valences = parens (sep_by (char ';') Valence.parse) in 30 | Arity (Provenance.of_here [%here], valences) 31 | in 32 | p "arity" 33 | ;; 34 | 35 | let%test_module "parsing" = 36 | (module struct 37 | let none = Provenance.of_here [%here] 38 | let tm = Sort.Name (none, "tm") 39 | let tm_v = Valence.Valence ([], tm) 40 | let integer = Sort.Name (none, "integer") 41 | let integer_v = Valence.Valence ([], integer) 42 | let ( = ) = equivalent 43 | let go = Lvca_parsing.(parse_string_or_failwith (C_comment_parser.junk *> parse)) 44 | 45 | let%test_unit _ = assert (go "(integer)" = Arity (none, [ integer_v ])) 46 | let%test_unit _ = assert (go "(tm; tm)" = Arity (none, [ tm_v; tm_v ])) 47 | 48 | let%test_unit _ = 49 | assert ( 50 | go "(tm. tm) // comment" 51 | = Arity (none, [ Valence.Valence ([ Sort_binding tm ], tm) ])) 52 | ;; 53 | 54 | let%test_unit _ = assert (go "(tm)" = Arity (none, [ Valence.Valence ([], tm) ])) 55 | 56 | let%test_unit _ = 57 | assert ( 58 | go "(tm[tm]. tm)" 59 | = Arity 60 | ( none 61 | , [ Valence.Valence ([ Sort_pattern { pattern_sort = tm; var_sort = tm } ], tm) 62 | ] )) 63 | ;; 64 | 65 | let expect_okay str = 66 | match Lvca_parsing.parse_string parse str with 67 | | Ok _ -> () 68 | | Error msg -> Stdio.print_string msg 69 | ;; 70 | 71 | let%expect_test _ = expect_okay "(tm[tm]. tm[tm]. tm)" 72 | let%expect_test _ = expect_okay "((foo bar)[baz quux]. tm)" 73 | let%expect_test _ = expect_okay "((foo bar)[baz quux]. tm)" 74 | let%expect_test _ = expect_okay "((foo bar)[baz quux]. tm) // comment" 75 | let%test_unit _ = assert (go "()" = Arity (none, [])) 76 | let%test_unit _ = assert (go "()" = Arity (none, [])) 77 | end) 78 | ;; 79 | -------------------------------------------------------------------------------- /syntax/Arity.mli: -------------------------------------------------------------------------------- 1 | (** An arity specifies the arguments to an operator. *) 2 | type t = Arity of Provenance.t * Valence.t list 3 | 4 | val mk : ?provenance:Provenance.t -> Valence.t list -> t 5 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 6 | val ( = ) : t -> t -> bool 7 | val pp : t Fmt.t 8 | 9 | (** Instantiate concrete vars in an arity *) 10 | val instantiate : Sort.t Lvca_util.String.Map.t -> t -> t 11 | 12 | val parse : t Lvca_parsing.t 13 | -------------------------------------------------------------------------------- /syntax/Binding_aware_pattern.mli: -------------------------------------------------------------------------------- 1 | (** Patterns for matching binding terms. *) 2 | open Lvca_util 3 | 4 | (** {1 Types} *) 5 | 6 | type t = 7 | | Operator of Provenance.t * string * scope list 8 | | Primitive of Primitive.All.t 9 | | Var of Provenance.t * string 10 | 11 | and scope = Scope of (Provenance.t * string) list * t 12 | 13 | val to_nominal : t -> Nominal.Term.t 14 | val of_nominal : Nominal.Term.t -> (t, Nominal.Conversion_error.t) Result.t 15 | 16 | module Capture_type : sig 17 | type t = 18 | | Bound_var of Sort.t 19 | | Bound_pattern of Pattern_sort.t 20 | | Bound_term of Sort.t 21 | 22 | val pp : t Fmt.t 23 | end 24 | 25 | module Capture : sig 26 | type t = 27 | | Binder of Pattern.t 28 | | Term of Nominal.Term.t 29 | 30 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 31 | val ( = ) : t -> t -> bool 32 | val pp : t Fmt.t 33 | end 34 | 35 | (** {1 Vars} *) 36 | 37 | (** A set of all the variables bound in a pattern. *) 38 | val vars_of_pattern : t -> String.Set.t 39 | 40 | (** A list of all the variables bound in a pattern. Why have this when [vars_of_pattern] 41 | exists? Because in a list we can also include the info for each var (which we can't do 42 | in a set). *) 43 | val list_vars_of_pattern : t -> (Provenance.t * string) list 44 | 45 | (** {1 Matching} *) 46 | 47 | val match_term : t -> Nominal.Term.t -> Capture.t String.Map.t option 48 | val match_scope : scope -> Nominal.Scope.t -> Capture.t String.Map.t option 49 | val match_all : t -> Nominal.Term.t -> Provenance.t list 50 | 51 | (** {1 Pretty-printing} *) 52 | val pp : t Fmt.t 53 | 54 | (** {1 Info} *) 55 | 56 | val info : t -> Provenance.t 57 | 58 | (** {1 Misc} *) 59 | val select_path : path:int list -> t -> (t, string) Result.t 60 | 61 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 62 | val ( = ) : t -> t -> bool 63 | 64 | (** Check that this pattern is valid and return the valence for each variable it binds. 65 | 66 | Checks performed: 67 | 68 | {ol 69 | {- Primitives: checked by the given primitive checker. } 70 | {- All used operators are found (in the sort corresponding to the pattern type). } 71 | {- All 72 | operators 73 | have 74 | the 75 | correct 76 | number 77 | of 78 | subterms 79 | for 80 | their 81 | arity. 82 | 83 | - Fixed arity patterns must have the exact number of subterms. 84 | - Variable arity patterns may have any number. 85 | } 86 | } *) 87 | val check 88 | : (Primitive.All.t -> Sort.t -> string option) (** Primitive checker *) 89 | -> Abstract_syntax.t (** Abstract syntax *) 90 | -> Sort.t (** Sort to check pattern against *) 91 | -> t 92 | -> (Capture_type.t String.Map.t, t Check_failure.t) Result.t 93 | 94 | (** {1 Parsing} *) 95 | val parse : String.Set.t -> t Lvca_parsing.t 96 | 97 | module Properties : sig 98 | val string_round_trip1 : t -> Property_result.t 99 | val string_round_trip2 : string -> Property_result.t 100 | end 101 | -------------------------------------------------------------------------------- /syntax/Check_failure.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | module Format = Stdlib.Format 3 | 4 | module Frame = struct 5 | type 'term t = 6 | { term : 'term 7 | ; sort : Sort.t 8 | } 9 | 10 | let pp term_pp ppf { term; sort } = 11 | Fmt.pf ppf "- @[%a,@ sort: %a@]" term_pp term Sort.pp sort 12 | ;; 13 | end 14 | 15 | type 'term t = 16 | { message : string 17 | ; stack : 'term Frame.t list 18 | } 19 | 20 | let err message = { message; stack = [] } 21 | 22 | let map_frame_terms ~f { message; stack } = 23 | let stack = 24 | stack |> List.map ~f:(fun { term; sort } -> Frame.{ term = f term; sort }) 25 | in 26 | { message; stack } 27 | ;; 28 | 29 | let pp term_pp ppf { message; stack } = 30 | Fmt.string ppf message; 31 | if List.length stack > 0 32 | then ( 33 | Format.pp_force_newline ppf (); 34 | Fmt.pf ppf "stack:"; 35 | List.iter stack ~f:(fun frame -> 36 | Format.pp_force_newline ppf (); 37 | Frame.pp term_pp ppf frame)) 38 | ;; 39 | -------------------------------------------------------------------------------- /syntax/Check_failure.mli: -------------------------------------------------------------------------------- 1 | (** A frame in the typechecking stack. *) 2 | module Frame : sig 3 | type 'term t = 4 | { term : 'term 5 | ; sort : Sort.t 6 | } 7 | 8 | val pp : 'term Fmt.t -> 'term t Fmt.t 9 | end 10 | 11 | (** A typechecking error carries a message and the context where the error occurred. *) 12 | type 'term t = 13 | { message : string 14 | ; stack : 'term Frame.t list 15 | } 16 | 17 | val map_frame_terms : f:('a -> 'b) -> 'a t -> 'b t 18 | val err : string -> 'term t 19 | val pp : 'term Fmt.t -> Stdlib.Format.formatter -> 'term t -> unit 20 | -------------------------------------------------------------------------------- /syntax/DeBruijn.mli: -------------------------------------------------------------------------------- 1 | (** Representation of terms that uses de Bruijn indices to represent scope. *) 2 | type term = 3 | | Operator of Provenance.t * string * (scope, term) Base.Either.t list 4 | | Bound_var of Provenance.t * int 5 | | Free_var of Provenance.t * string 6 | | Primitive of Primitive.All.t 7 | 8 | and scope = Scope of Provenance.t * string * term 9 | 10 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> term -> term -> bool 11 | val ( = ) : term -> term -> bool 12 | val pp : term Fmt.t 13 | 14 | (** Open a scope, substituting a term for the variable bound by this scope. *) 15 | val open_scope : term -> scope -> term 16 | 17 | (** Convert a de Bruijn term to a nominal term. This fails only in the case of invalid 18 | indices. *) 19 | val to_nominal : term -> Nominal.Term.t option 20 | 21 | (** Convert a nominal term to de Bruijn. Fails on scopes that bind patterns or more than 22 | one variable. *) 23 | val of_nominal : Nominal.Term.t -> (term, Nominal.Scope.t) Result.t 24 | 25 | val of_nominal_with_bindings 26 | : env:int Lvca_util.String.Map.t 27 | -> Nominal.Term.t 28 | -> (term, Nominal.Scope.t) Result.t 29 | 30 | (** Are the two terms equivalent up to variable renaming? *) 31 | val alpha_equivalent : term -> term -> bool 32 | 33 | val parse : Lvca_util.String.Set.t -> term Lvca_parsing.t 34 | 35 | (* module Properties : Properties_intf.S with type t := term *) 36 | -------------------------------------------------------------------------------- /syntax/Directed_graph.mli: -------------------------------------------------------------------------------- 1 | open Lvca_util 2 | 3 | module type Key_intf = sig 4 | type t 5 | 6 | include Base.Comparator.S with type t := t 7 | include Base.Hashtbl.Key.S with type t := t 8 | end 9 | 10 | (** Raised by [topsort_exn] if the graph is not a dag. *) 11 | exception NotDag 12 | 13 | module Int : sig 14 | module Connected_components : sig 15 | (** The output from connected component algorithm. *) 16 | type t = 17 | { scc_count : int (** The number of SCCs found. *) 18 | ; scc_numbering : int list 19 | (** A list corresponding to the input adjacency list, with the SCC number 20 | assigned to each node. Note that SCC numbers need not be contiguous: 21 | they're the numbers of a representative from each SCC (the lowest-numbered 22 | representative). So, each SCC number is in the range \[0,n). *) 23 | } 24 | end 25 | 26 | val graph_of_adjacency : int list list -> int list Int.Map.t 27 | 28 | (** Given an adjacency list, give the SCCs. *) 29 | val connected_components : int list Int.Map.t -> Connected_components.t 30 | 31 | (** Given an SCC numbering (see [connected_components]), return SCCs, each represented 32 | as a set of nodes contained in it. *) 33 | val make_sets : int list -> Int.Set.t Int.Map.t 34 | 35 | (** The composition of [connected_components] and [make_sets]. *) 36 | val connected_component_sets : int list Int.Map.t -> Int.Set.t Int.Map.t 37 | 38 | (** Topologically sort a graph given as an adjacency list. *) 39 | val topsort_exn : int list Int.Map.t -> int list 40 | 41 | (** Topologically sort a graph given as an adjacency list. *) 42 | val topsort : int list Int.Map.t -> int list option 43 | end 44 | 45 | module Make (Key : Key_intf) : sig 46 | module Graph : sig 47 | (** A graph is represented as a mapping from key to key list. *) 48 | type t = (Key.t, Key.t list, Key.comparator_witness) Base.Map.t 49 | end 50 | 51 | module Connected_components : sig 52 | (** The output from the connected component algorithm. *) 53 | type t = 54 | { scc_graph : int list Lvca_util.Int.Map.t (** The graph of SCCs. *) 55 | ; sccs : (Key.t, Key.comparator_witness) Base.Set.t Lvca_util.Int.Map.t 56 | (** Mapping from SCC number to keys contained in it. *) 57 | } 58 | end 59 | 60 | (** Find the (strongly) [connected_components] in a [graph]. *) 61 | val connected_components : Graph.t -> Connected_components.t 62 | 63 | (** Topologically sort a graph given as an adjacency list. *) 64 | val topsort_exn : Graph.t -> Key.t list 65 | 66 | (** Topologically sort a graph given as an adjacency list. *) 67 | val topsort : Graph.t -> Key.t list option 68 | end 69 | -------------------------------------------------------------------------------- /syntax/Kind.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = Kind of Provenance.t * int 4 | 5 | let mk ?(provenance = Provenance.of_here [%here]) n = Kind (provenance, n) 6 | 7 | let equivalent ?(info_eq = fun _ _ -> true) (Kind (i1, k1)) (Kind (i2, k2)) = 8 | info_eq i1 i2 && Int.(k1 = k2) 9 | ;; 10 | 11 | let ( = ) = equivalent ~info_eq:Provenance.( = ) 12 | let info (Kind (i, _)) = i 13 | 14 | let pp ppf (Kind (info, k)) = 15 | Provenance.fmt_stag 16 | info 17 | Fmt.(list ~sep:(any " -> ") (any "*")) 18 | ppf 19 | (List.init k ~f:(Fn.const ())) 20 | ;; 21 | 22 | module Parse = struct 23 | open Lvca_parsing 24 | open C_comment_parser 25 | 26 | let t = 27 | let p = 28 | let+ location, stars = sep_by1 (string "->") (char '*') in 29 | Kind (Provenance.of_range location, List.length stars) 30 | in 31 | p "kind" 32 | ;; 33 | 34 | let decl = 35 | lift3 36 | (fun (_, ident) _colon (_, kind) -> ident, kind) 37 | (lower_identifier Lvca_util.String.Set.empty) 38 | (char ':') 39 | t 40 | "kind declaration" 41 | ;; 42 | 43 | let%test_module "parsing" = 44 | (module struct 45 | let pp_decl ppf (name, decl) = Fmt.pf ppf "%s: %a" name pp decl 46 | 47 | let%expect_test _ = 48 | let x = parse_string_or_failwith (junk *> decl) "foo: * -> *" in 49 | Fmt.pr "%a" pp_decl x; 50 | [%expect {|foo: * -> *|}] 51 | ;; 52 | 53 | let%expect_test _ = 54 | let x = 55 | parse_string_or_failwith 56 | (junk *> many decl) 57 | {| 58 | foo: * -> * // comment 59 | bar: * -> * 60 | |} 61 | in 62 | Fmt.(pr "%a" (list pp_decl) x); 63 | [%expect {| 64 | foo: * -> * 65 | bar: * -> * 66 | |}] 67 | ;; 68 | end) 69 | ;; 70 | end 71 | -------------------------------------------------------------------------------- /syntax/Kind.mli: -------------------------------------------------------------------------------- 1 | (** The kind of a sort is the number of arguments it takes. Invariant: must be a natural 2 | number. *) 3 | type t = Kind of Provenance.t * int 4 | 5 | val mk : ?provenance:Provenance.t -> int -> t 6 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 7 | val ( = ) : t -> t -> bool 8 | val info : t -> Provenance.t 9 | val pp : t Fmt.t 10 | 11 | module Parse : sig 12 | val t : t Lvca_parsing.t 13 | val decl : (string * t) Lvca_parsing.t 14 | end 15 | -------------------------------------------------------------------------------- /syntax/Language_object_intf.ml: -------------------------------------------------------------------------------- 1 | open Lvca_util 2 | 3 | module type Has_info = sig 4 | type t 5 | 6 | val info : t -> Provenance.t 7 | end 8 | 9 | module type Json_convertible = sig 10 | type t 11 | 12 | val jsonify : t Json.serializer 13 | val unjsonify : t Json.deserializer 14 | end 15 | 16 | module type Serializable = sig 17 | type t 18 | 19 | (** Encode (using {{:https://cbor.io} CBOR}) as bytes. *) 20 | val serialize : t -> Bytes.t 21 | 22 | (** Decode from {{:https://cbor.io} CBOR}). *) 23 | val deserialize : Bytes.t -> t option 24 | 25 | (** The SHA-256 hash of the serialized term. This is useful for content-identifying 26 | terms. *) 27 | val hash : t -> string 28 | end 29 | 30 | (** A signature all language objects satisfy. *) 31 | module type S = sig 32 | (** {1 Data type with attached info} *) 33 | type t 34 | 35 | (** {1 Info} *) 36 | include Has_info with type t := t 37 | end 38 | -------------------------------------------------------------------------------- /syntax/Nonbinding.mli: -------------------------------------------------------------------------------- 1 | open Lvca_util 2 | 3 | (** Lots of interesting domains have no binding. At that point they're not really 4 | languages, just data types. This module gives a tighter representation for such types 5 | and allows conversion to / from binding types. *) 6 | type t = 7 | | Operator of Provenance.t * string * t list 8 | | Primitive of Primitive.All.t 9 | 10 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 11 | val ( = ) : t -> t -> bool 12 | 13 | (** {1 info} *) 14 | 15 | (** {1 de Bruijn conversion} *) 16 | 17 | type de_bruijn_conversion_error = 18 | | Scope_encountered of DeBruijn.scope 19 | | Var_encountered of DeBruijn.term 20 | 21 | val of_de_bruijn : DeBruijn.term -> (t, de_bruijn_conversion_error) Result.t 22 | val to_de_bruijn : t -> DeBruijn.term 23 | 24 | (** {1 Nominal conversion} *) 25 | 26 | val of_nominal : Nominal.Term.t -> (t, Nominal.Conversion_error.t) Result.t 27 | val to_nominal : t -> Nominal.Term.t 28 | 29 | (** {1 Printing} *) 30 | 31 | val pp : t Fmt.t 32 | 33 | (** {1 Parsing} *) 34 | val parse : t Lvca_parsing.t 35 | 36 | (** {1 Misc} *) 37 | val hash : t -> string 38 | 39 | val select_path : path:int list -> t -> (t, string) Result.t 40 | 41 | (** {1 Serialization} *) 42 | val jsonify : t Json.serializer 43 | 44 | val unjsonify : t Json.deserializer 45 | 46 | type nonbinding = t 47 | 48 | module type Convertible_s = sig 49 | include Language_object_intf.S with type t = t 50 | 51 | val of_nonbinding : nonbinding -> (t, nonbinding) Result.t 52 | val to_nonbinding : t -> nonbinding 53 | end 54 | -------------------------------------------------------------------------------- /syntax/Operator_def.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lvca_provenance 3 | 4 | type t = Operator_def of Provenance.t * string * Arity.t 5 | 6 | let mk ?(provenance = Provenance.of_here [%here]) name arity = 7 | Operator_def (provenance, name, arity) 8 | ;; 9 | 10 | let equivalent 11 | ?(info_eq = fun _ _ -> true) 12 | (Operator_def (info1, name1, arity1)) 13 | (Operator_def (info2, name2, arity2)) 14 | = 15 | info_eq info1 info2 && String.(name1 = name2) && Arity.equivalent ~info_eq arity1 arity2 16 | ;; 17 | 18 | let ( = ) = equivalent ~info_eq:Provenance.( = ) 19 | 20 | let kind_check env (Operator_def (_info, _name, Arity (_, valences))) = 21 | List.fold valences ~init:env ~f:Valence.kind_check 22 | ;; 23 | 24 | let pp ppf (Operator_def (info, name, arity)) = 25 | let pp' ppf () = Fmt.pf ppf "%s%a" name Arity.pp arity in 26 | Provenance.fmt_stag info pp' ppf () 27 | ;; 28 | 29 | let parse = 30 | let open Lvca_parsing in 31 | let p = 32 | let* _, ident = C_comment_parser.upper_identifier Lvca_util.String.Set.empty in 33 | let+ location, arity = Arity.parse in 34 | Operator_def (Provenance.of_range location, ident, arity) 35 | in 36 | p "operator definition" 37 | ;; 38 | 39 | let%test_module "parsing" = 40 | (module struct 41 | let ( = ) = equivalent 42 | 43 | let%test_unit _ = 44 | let info1 = Provenance.of_range (Opt_range.mk 0 5) in 45 | let info2 = Provenance.of_range (Opt_range.mk 3 5) in 46 | let parsed = 47 | Lvca_parsing.(parse_string_or_failwith (C_comment_parser.junk *> parse)) 48 | "Foo() // comment" 49 | in 50 | assert (parsed = Operator_def (info1, "Foo", Arity (info2, []))) 51 | ;; 52 | end) 53 | ;; 54 | -------------------------------------------------------------------------------- /syntax/Operator_def.mli: -------------------------------------------------------------------------------- 1 | open Lvca_util 2 | 3 | type t = 4 | | Operator_def of Provenance.t * string * Arity.t 5 | (** An operator is defined by its tag and arity. *) 6 | 7 | val mk : ?provenance:Provenance.t -> string -> Arity.t -> t 8 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 9 | val ( = ) : t -> t -> bool 10 | val pp : t Fmt.t 11 | val parse : t Lvca_parsing.t 12 | val kind_check : Int.Set.t String.Map.t -> t -> Int.Set.t String.Map.t 13 | -------------------------------------------------------------------------------- /syntax/Path.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | module T = struct 4 | type t = int list 5 | 6 | let compare = List.compare Int.compare 7 | let sexp_of_t = List.sexp_of_t Int.sexp_of_t 8 | end 9 | 10 | include T 11 | include Comparable.Make (T) 12 | 13 | let empty = [] 14 | let is_prefix ~path ~prefix = List.is_prefix path ~prefix ~equal:Int.( = ) 15 | let pp = Fmt.(list int ~sep:(any ".")) 16 | -------------------------------------------------------------------------------- /syntax/Path.mli: -------------------------------------------------------------------------------- 1 | (** A path (sometimes called "occurrence") points to some subterm. At each step we point 2 | to a subterm. For example [foo(a; bar(b; c))]. 3 | 4 | - [\[\]] points to [foo(a; bar(b; c))] 5 | - [\[0\]] points to [a] 6 | - [\[1; 0\]] points to [b] 7 | - [\[1; 1\]] points to [c] *) 8 | type t = int list 9 | 10 | val empty : t 11 | 12 | type comparator_witness 13 | 14 | val comparator : (t, comparator_witness) Base.Comparator.t 15 | val compare : t -> t -> int 16 | val sexp_of_t : t -> Sexplib0.Sexp.t 17 | val ( = ) : t -> t -> bool 18 | val is_prefix : path:t -> prefix:t -> bool 19 | val pp : t Fmt.t 20 | -------------------------------------------------------------------------------- /syntax/Pattern.mli: -------------------------------------------------------------------------------- 1 | (** Patterns for matching non-binding terms. *) 2 | open Lvca_util 3 | 4 | type t = 5 | | Operator of Provenance.t * string * t list 6 | | Primitive of Primitive_impl.All.t 7 | | Var of Provenance.t * string 8 | 9 | val mk_Operator : ?provenance:Provenance.t -> string -> t list -> t 10 | val mk_Primitive : Primitive_impl.All.t -> t 11 | val mk_Var : ?provenance:Provenance.t -> string -> t 12 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 13 | val ( = ) : t -> t -> bool 14 | 15 | (** {1 Vars} *) 16 | 17 | (** A set of all the variables bound in a pattern. *) 18 | val vars_of_pattern : t -> String.Set.t 19 | 20 | (** A list of all the variables bound in a pattern. Why have this when [vars_of_pattern] 21 | exists? Because in a list we can also include the info for each var (which we can't do 22 | in a set). *) 23 | val list_vars_of_pattern : t -> (Provenance.t * string) list 24 | 25 | (** {1 Printing} *) 26 | 27 | val pp : t Fmt.t 28 | 29 | (** {1 Serialization} *) 30 | 31 | val jsonify : t Json.serializer 32 | val unjsonify : t Json.deserializer 33 | 34 | (** {1 Info} *) 35 | 36 | val info : t -> Provenance.t 37 | 38 | (** {1 Misc} *) 39 | 40 | val select_path : path:int list -> t -> (t, string) Result.t 41 | 42 | (** Check that this pattern is valid and return the sort for each variable it binds. 43 | 44 | Checks performed: 45 | 46 | {ol 47 | {- Primitives: checked by the given primitive checker. } 48 | {- All used operators are found (in the sort corresponding to the pattern type). } 49 | {- All 50 | operators 51 | have 52 | the 53 | correct 54 | number 55 | of 56 | subterms 57 | for 58 | their 59 | arity. 60 | 61 | - Fixed arity patterns must have the exact number of subterms. 62 | - Variable arity patterns may have any number. 63 | } 64 | {- Patterns can't see valence: they can only bind subterms with some given sort. } 65 | } *) 66 | val check 67 | : Abstract_syntax.t (** Abstract syntax *) 68 | -> pattern_sort:Sort.t (** Sort to check pattern against *) 69 | -> var_sort:Sort.t (** Sort pattern must yield as variables *) 70 | -> t 71 | -> (Sort.t String.Map.t, t Check_failure.t) Result.t 72 | 73 | (** {1 Parsing} *) 74 | val parse : String.Set.t -> t Lvca_parsing.t 75 | 76 | module Properties : sig 77 | include Properties_intf.Parse_pretty_s with type t := t 78 | include Properties_intf.Json_s with type t := t 79 | end 80 | -------------------------------------------------------------------------------- /syntax/Pattern_sort.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | { pattern_sort : Sort.t 3 | ; var_sort : Sort.t 4 | } 5 | 6 | let equivalent ?(info_eq = fun _ _ -> true) ps1 ps2 = 7 | Sort.equivalent ~info_eq ps1.pattern_sort ps2.pattern_sort 8 | && Sort.equivalent ~info_eq ps1.var_sort ps2.var_sort 9 | ;; 10 | 11 | let ( = ) = equivalent ~info_eq:Provenance.( = ) 12 | 13 | let pp ppf { pattern_sort; var_sort } = 14 | match pattern_sort with 15 | | Sort.Name _ -> Fmt.pf ppf "%a[%a]" Sort.pp pattern_sort Sort.pp var_sort 16 | | _ -> Fmt.pf ppf "(%a)[%a]" Sort.pp pattern_sort Sort.pp var_sort 17 | ;; 18 | 19 | let instantiate env { pattern_sort; var_sort } = 20 | { pattern_sort = Sort.instantiate env pattern_sort 21 | ; var_sort = Sort.instantiate env var_sort 22 | } 23 | ;; 24 | -------------------------------------------------------------------------------- /syntax/Pattern_sort.mli: -------------------------------------------------------------------------------- 1 | (** A pattern sort represents the sort of a pattern with variables of some sort. This is 2 | written as [pattern_sort\[var_sort\]]. *) 3 | type t = 4 | { pattern_sort : Sort.t 5 | ; var_sort : Sort.t 6 | } 7 | 8 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 9 | val ( = ) : t -> t -> bool 10 | val pp : t Fmt.t 11 | val instantiate : Sort.t Lvca_util.String.Map.t -> t -> t 12 | -------------------------------------------------------------------------------- /syntax/Primitive.ml: -------------------------------------------------------------------------------- 1 | let mk_error tm = 2 | Error (Nominal.Conversion_error.mk_Term ~provenance:(Provenance.of_here [%here]) tm) 3 | ;; 4 | 5 | module Integer_kernel = struct 6 | include Primitive_impl.Integer 7 | 8 | let to_nominal (info, z) = Nominal.Term.Primitive (info, Integer z) 9 | 10 | let of_nominal tm = 11 | match tm with 12 | | Nominal.Term.Primitive (info, Integer z) -> Ok (info, z) 13 | | _ -> mk_error tm 14 | ;; 15 | end 16 | 17 | module Integer = Nominal.Convertible.Extend (Integer_kernel) 18 | 19 | module Int32_kernel = struct 20 | include Primitive_impl.Int32 21 | 22 | let to_nominal (info, z) = Nominal.Term.Primitive (info, Int32 z) 23 | 24 | let of_nominal tm = 25 | match tm with 26 | | Nominal.Term.Primitive (info, Int32 z) -> Ok (info, z) 27 | | _ -> mk_error tm 28 | ;; 29 | end 30 | 31 | module Int32 = struct 32 | include Nominal.Convertible.Extend (Int32_kernel) 33 | 34 | let parse = Primitive_impl.Int32.parse 35 | end 36 | 37 | module Float_kernel = struct 38 | include Primitive_impl.Float 39 | 40 | let to_nominal (info, f) = Nominal.Term.Primitive (info, Float f) 41 | 42 | let of_nominal tm = 43 | match tm with 44 | | Nominal.Term.Primitive (info, Float f) -> Ok (info, f) 45 | | _ -> mk_error tm 46 | ;; 47 | end 48 | 49 | module Float = Nominal.Convertible.Extend (Float_kernel) 50 | 51 | module Char_kernel = struct 52 | include Primitive_impl.Char 53 | 54 | let to_nominal (info, x) = Nominal.Term.Primitive (info, Char x) 55 | 56 | let of_nominal tm = 57 | match tm with 58 | | Nominal.Term.Primitive (info, Char x) -> Ok (info, x) 59 | | _ -> mk_error tm 60 | ;; 61 | end 62 | 63 | module Char = Nominal.Convertible.Extend (Char_kernel) 64 | 65 | module String_kernel = struct 66 | include Primitive_impl.String 67 | 68 | let to_nominal (info, x) = Nominal.Term.Primitive (info, String x) 69 | 70 | let of_nominal tm = 71 | match tm with 72 | | Nominal.Term.Primitive (info, String x) -> Ok (info, x) 73 | | _ -> mk_error tm 74 | ;; 75 | end 76 | 77 | module String = Nominal.Convertible.Extend (String_kernel) 78 | 79 | module All_kernel = struct 80 | include Primitive_impl.All 81 | 82 | let to_nominal (info, x) = Nominal.Term.Primitive (info, x) 83 | 84 | let of_nominal tm = 85 | match tm with Nominal.Term.Primitive (info, x) -> Ok (info, x) | _ -> mk_error tm 86 | ;; 87 | end 88 | 89 | module All = struct 90 | include Nominal.Convertible.Extend (All_kernel) 91 | module Properties = Primitive_impl.All.Properties 92 | 93 | let check = Primitive_impl.All.check 94 | end 95 | -------------------------------------------------------------------------------- /syntax/Primitive.mli: -------------------------------------------------------------------------------- 1 | (* TODO: potentially add (u)int8, (u)int64, etc via stdint. Downside: "integers 2 | smaller than the standard integer type are stored in a standard int." Or 3 | possibly using bitvec? (https://stackoverflow.com/a/65080349) *) 4 | module Integer : Nominal.Convertible.Extended_s with type t = Provenance.t * Z.t 5 | module Int32 : Nominal.Convertible.Extended_s with type t = Provenance.t * int32 6 | module Float : Nominal.Convertible.Extended_s with type t = Provenance.t * float 7 | module Char : Nominal.Convertible.Extended_s with type t = Provenance.t * char 8 | module String : Nominal.Convertible.Extended_s with type t = Provenance.t * string 9 | 10 | module All : sig 11 | include 12 | Nominal.Convertible.Extended_s with type t = Provenance.t * Primitive_impl.All_plain.t 13 | 14 | val check : t -> Sort.t -> string option 15 | 16 | module Properties : sig 17 | include Properties_intf.Parse_pretty_s with type t := t 18 | include Properties_intf.Json_s with type t := t 19 | end 20 | end 21 | -------------------------------------------------------------------------------- /syntax/Properties_intf.ml: -------------------------------------------------------------------------------- 1 | open Lvca_util 2 | 3 | module type Parse_pretty_s = sig 4 | type t 5 | 6 | val string_round_trip1 : t -> Property_result.t 7 | val string_round_trip2 : string -> Property_result.t 8 | end 9 | 10 | module type Json_s = sig 11 | type t 12 | 13 | val json_round_trip1 : t -> Property_result.t 14 | val json_round_trip2 : Lvca_util.Json.t -> Property_result.t 15 | end 16 | 17 | module type S = sig 18 | type t 19 | 20 | include Parse_pretty_s with type t := t 21 | include Json_s with type t := t 22 | end 23 | -------------------------------------------------------------------------------- /syntax/Provenance.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lvca_provenance 3 | 4 | module Parse_input = struct 5 | type t = 6 | | Input_unknown 7 | | Buffer_name of string 8 | | String of string 9 | 10 | let pp ppf = function 11 | | Input_unknown -> Fmt.pf ppf "Input_unknown" 12 | | Buffer_name name -> Fmt.pf ppf "Buffer_name %S" name 13 | | String name -> Fmt.pf ppf "String %S" name 14 | ;; 15 | 16 | let ( = ) a b = 17 | match a, b with 18 | | Input_unknown, Input_unknown -> true 19 | | Buffer_name s1, Buffer_name s2 | String s1, String s2 -> String.(s1 = s2) 20 | | _ -> false 21 | ;; 22 | end 23 | 24 | module Parse_located = struct 25 | type t = 26 | { input : Parse_input.t 27 | ; range : Opt_range.t 28 | } 29 | 30 | let pp ppf { input; range } = 31 | Fmt.pf ppf "{ input = %a; range = %a }" Parse_input.pp input Opt_range.pp range 32 | ;; 33 | 34 | let ( = ) a b = Parse_input.(a.input = b.input) && Opt_range.(a.range = b.range) 35 | end 36 | 37 | module Located = struct 38 | type t = 39 | | Source_located of Source_code_position.t 40 | | Parse_located of Parse_located.t 41 | 42 | let ( = ) a b = 43 | match a, b with 44 | | Source_located a, Source_located b -> Source_code_position.(a = b) 45 | | Parse_located a, Parse_located b -> Parse_located.(a = b) 46 | | _, _ -> false 47 | ;; 48 | 49 | let pp ppf = function 50 | | Source_located { pos_fname; pos_lnum; pos_cnum; _ } -> 51 | Fmt.pf ppf "%s:%d:%d" pos_fname pos_lnum pos_cnum 52 | | Parse_located opt_range -> Parse_located.pp ppf opt_range 53 | ;; 54 | end 55 | 56 | (* A term is either written directly or computed from others *) 57 | type t = 58 | | Located of Located.t 59 | | Calculated of Located.t * t list 60 | | Indexed of int 61 | 62 | type Stdlib.Format.stag += Stag of t 63 | 64 | let open_stag ppf rng = Stdlib.Format.pp_open_stag ppf (Stag rng) 65 | let close_stag ppf _ = Stdlib.Format.pp_close_stag ppf () 66 | let fmt_stag prov = Lvca_util.Format.fmt_stag (Stag prov) 67 | let calculated_here here provs = Calculated (Located.Source_located here, provs) 68 | let of_here here = Located (Located.Source_located here) 69 | 70 | let of_range ?(input = Parse_input.Input_unknown) range = 71 | Located (Located.Parse_located { input; range }) 72 | ;; 73 | 74 | let rec ( = ) a b = 75 | match a, b with 76 | | Located a, Located b -> Located.(a = b) 77 | | Calculated (x, xs), Calculated (y, ys) -> Located.(x = y) && List.equal ( = ) xs ys 78 | | Indexed a, Indexed b -> Int.(a = b) 79 | | _, _ -> false 80 | ;; 81 | 82 | let pp ppf = function 83 | | Located located -> Located.pp ppf located 84 | | Calculated (located, _) -> Located.pp ppf located 85 | | Indexed a -> Fmt.pf ppf "%i" a 86 | ;; 87 | 88 | let stag_functions = 89 | Stdlib.Format. 90 | { mark_open_stag = (function Stag t -> Fmt.str "<%a>" pp t | _ -> "") 91 | ; mark_close_stag = (function Stag t -> Fmt.str "" pp t | _ -> "") 92 | ; print_open_stag = (fun _ -> ()) 93 | ; print_close_stag = (fun _ -> ()) 94 | } 95 | ;; 96 | 97 | let make0 ?input f p = Lvca_parsing.make0 (fun ~info -> f ~info:(of_range ?input info)) p 98 | let make1 ?input f p = Lvca_parsing.make1 (fun ~info -> f ~info:(of_range ?input info)) p 99 | 100 | let make2 ?input f p1 p2 = 101 | Lvca_parsing.make2 (fun ~info -> f ~info:(of_range ?input info)) p1 p2 102 | ;; 103 | 104 | let make3 ?input f p1 p2 p3 = 105 | Lvca_parsing.make3 (fun ~info -> f ~info:(of_range ?input info)) p1 p2 p3 106 | ;; 107 | 108 | let make4 ?input f p1 p2 p3 p4 = 109 | Lvca_parsing.make4 (fun ~info -> f ~info:(of_range ?input info)) p1 p2 p3 p4 110 | ;; 111 | 112 | let make5 ?input f p1 p2 p3 p4 p5 = 113 | Lvca_parsing.make5 (fun ~info -> f ~info:(of_range ?input info)) p1 p2 p3 p4 p5 114 | ;; 115 | 116 | let make6 ?input f p1 p2 p3 p4 p5 p6 = 117 | Lvca_parsing.make6 (fun ~info -> f ~info:(of_range ?input info)) p1 p2 p3 p4 p5 p6 118 | ;; 119 | -------------------------------------------------------------------------------- /syntax/Provenance.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lvca_provenance 3 | 4 | module Parse_input : sig 5 | type t = 6 | | Input_unknown 7 | | Buffer_name of string 8 | | String of string 9 | 10 | val ( = ) : t -> t -> bool 11 | val pp : t Fmt.t 12 | end 13 | 14 | module Parse_located : sig 15 | (** A location that was parsed: the string it was parsed from and the range in that 16 | string *) 17 | type t = 18 | { (* parser : Provenance.t *) 19 | input : Parse_input.t 20 | ; range : Opt_range.t 21 | } 22 | 23 | val ( = ) : t -> t -> bool 24 | val pp : t Fmt.t 25 | end 26 | 27 | module Located : sig 28 | (** A location is either an (implementation) source code position or was parsed. *) 29 | type t = 30 | | Source_located of Source_code_position.t 31 | | Parse_located of Parse_located.t 32 | 33 | val ( = ) : t -> t -> bool 34 | val pp : t Fmt.t 35 | end 36 | 37 | (** A term is: 38 | 39 | - written directly 40 | - computed from others 41 | - or, indexed (a reference to some external data) *) 42 | type t = 43 | | Located of Located.t 44 | | Calculated of Located.t * t list 45 | | Indexed of int 46 | 47 | val calculated_here : Source_code_position.t -> t list -> t 48 | val of_here : Source_code_position.t -> t 49 | val of_range : ?input:Parse_input.t -> Opt_range.t -> t 50 | val ( = ) : t -> t -> bool 51 | val pp : t Fmt.t 52 | val open_stag : Stdlib.Format.formatter -> t -> unit 53 | val close_stag : Stdlib.Format.formatter -> t -> unit 54 | val fmt_stag : t -> 'a Fmt.t -> 'a Fmt.t 55 | 56 | (** For testing only: used to enable outputting of the [Stag] semantic tag. *) 57 | val stag_functions : Stdlib.Format.formatter_stag_functions 58 | 59 | val make0 60 | : ?input:Parse_input.t 61 | -> (info:t -> 'b) 62 | -> _ Lvca_parsing.t 63 | -> 'b Lvca_parsing.t 64 | 65 | val make1 66 | : ?input:Parse_input.t 67 | -> (info:t -> 'a -> 'b) 68 | -> 'a Lvca_parsing.t 69 | -> 'b Lvca_parsing.t 70 | 71 | val make2 72 | : ?input:Parse_input.t 73 | -> (info:t -> 'a -> 'b -> 'c) 74 | -> 'a Lvca_parsing.t 75 | -> 'b Lvca_parsing.t 76 | -> 'c Lvca_parsing.t 77 | 78 | val make3 79 | : ?input:Parse_input.t 80 | -> (info:t -> 'a -> 'b -> 'c -> 'd) 81 | -> 'a Lvca_parsing.t 82 | -> 'b Lvca_parsing.t 83 | -> 'c Lvca_parsing.t 84 | -> 'd Lvca_parsing.t 85 | 86 | val make4 87 | : ?input:Parse_input.t 88 | -> (info:t -> 'a -> 'b -> 'c -> 'd -> 'e) 89 | -> 'a Lvca_parsing.t 90 | -> 'b Lvca_parsing.t 91 | -> 'c Lvca_parsing.t 92 | -> 'd Lvca_parsing.t 93 | -> 'e Lvca_parsing.t 94 | 95 | val make5 96 | : ?input:Parse_input.t 97 | -> (info:t -> 'a -> 'b -> 'c -> 'd -> 'e -> 'f) 98 | -> 'a Lvca_parsing.t 99 | -> 'b Lvca_parsing.t 100 | -> 'c Lvca_parsing.t 101 | -> 'd Lvca_parsing.t 102 | -> 'e Lvca_parsing.t 103 | -> 'f Lvca_parsing.t 104 | 105 | val make6 106 | : ?input:Parse_input.t 107 | -> (info:t -> 'a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g) 108 | -> 'a Lvca_parsing.t 109 | -> 'b Lvca_parsing.t 110 | -> 'c Lvca_parsing.t 111 | -> 'd Lvca_parsing.t 112 | -> 'e Lvca_parsing.t 113 | -> 'f Lvca_parsing.t 114 | -> 'g Lvca_parsing.t 115 | -------------------------------------------------------------------------------- /syntax/Regex.mli: -------------------------------------------------------------------------------- 1 | module Class_base : sig 2 | type t = 3 | | Word (** \w / \W *) 4 | | Whitespace (** \s / \S *) 5 | | Digit (** \d / \D *) 6 | 7 | (* val to_re : t -> Re.t *) 8 | val ( = ) : t -> t -> bool 9 | val to_predicate : t -> char -> bool 10 | end 11 | 12 | module Class : sig 13 | (** Accept the positive or negative version of a class *) 14 | type t = 15 | | Pos of Class_base.t 16 | | Neg of Class_base.t 17 | 18 | val ( = ) : t -> t -> bool 19 | val pp : t Fmt.t 20 | val parse : t Angstrom.t 21 | val to_predicate : t -> char -> bool 22 | end 23 | 24 | module Set_member : sig 25 | type t = 26 | | Single_char of char 27 | | Range of char * char 28 | 29 | val ( = ) : t -> t -> bool 30 | val debug_pp : t Fmt.t 31 | val pp : t Fmt.t 32 | val parse : t Angstrom.t 33 | val to_angstrom : t -> char Angstrom.t 34 | end 35 | 36 | module Set : sig 37 | type t = Set_member.t list 38 | 39 | val debug_pp : t Fmt.t 40 | val pp : t Fmt.t 41 | val parse : t Angstrom.t 42 | val to_angstrom : t -> char Angstrom.t 43 | end 44 | 45 | (** A regular expression used for lexical analysis. *) 46 | type t = 47 | | Char of char (** Just a character, eg 'a' *) 48 | | Class of Class.t 49 | (** A character class, eg [\w] or [\d]. Syntactically, these are all started by a 50 | backslash. We just use javascript character classes. *) 51 | | Set of Set.t (** A character set, eg [\[a-z\]] or [\[^abc\]] *) 52 | | Star of t (** Zero-or-more repetition, eg [(ab)*] *) 53 | | Plus of t (** One-or-more repetition, eg [(ab)+] *) 54 | | Count of t * int 55 | (** A specific number of repetitions, eg [(ab){5}]. Must be greater than 0. *) 56 | | Option of t (** Option, eg [(ab)?] *) 57 | | Choice of t list (** Choice, eg [a|b] *) 58 | | Any (** Any character *) 59 | | Concat of t list 60 | 61 | val to_re : t -> Re.t 62 | val to_angstrom : t -> string Angstrom.t 63 | val accepts_empty : t -> bool 64 | val is_literal : t -> string option 65 | val to_nonbinding : t -> Nonbinding.t 66 | val debug_pp : ?need_parens:bool -> t Fmt.t 67 | val pp : t Fmt.t 68 | val parse : t Angstrom.t 69 | 70 | (** Common classes *) 71 | module Classes : sig 72 | (** [a-z] *) 73 | val lower_alpha : t 74 | 75 | (** [a-zA-Z] *) 76 | val alpha : t 77 | 78 | (** [a-zA-Z0-9] *) 79 | val words : t 80 | 81 | (** [a-zA-Z0-9_] *) 82 | val underscore_words : t 83 | end 84 | -------------------------------------------------------------------------------- /syntax/Single_var.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | { info : Provenance.t 3 | ; name : string 4 | } 5 | 6 | let equivalent ?(info_eq = fun _ _ -> true) t1 t2 = 7 | info_eq t1.info t2.info && Base.String.(t1.name = t2.name) 8 | ;; 9 | 10 | let ( = ) = equivalent ~info_eq:Provenance.( = ) 11 | let map_info ~f { info; name } = { info = f info; name } 12 | 13 | let to_nominal { info; name } = 14 | Nominal.Term.Primitive (info, Primitive_impl.All_plain.String name) 15 | ;; 16 | 17 | let of_nominal = function 18 | | Nominal.Term.Primitive (info, Primitive_impl.All_plain.String name) -> 19 | Ok { info; name } 20 | | tm -> 21 | Error 22 | (Nominal.Conversion_error.mk_Term 23 | ~provenance:(Provenance.of_here [%here]) 24 | ~message:"Single_var can only be converted from a string literal" 25 | tm) 26 | ;; 27 | 28 | let mk ~info name = { info; name } 29 | -------------------------------------------------------------------------------- /syntax/Sort.mli: -------------------------------------------------------------------------------- 1 | (** Sorts divide ASTs into syntactic categories. 2 | 3 | We don't allow higher-order sorts. In other words, no functions at the sort level. In 4 | other words, the head of an application is always concrete. *) 5 | open Lvca_util 6 | 7 | type t = 8 | | Ap of Provenance.t * string * t list (** A higher-kinded sort can be applied *) 9 | | Name of Provenance.t * string 10 | 11 | val mk_Ap : ?provenance:Provenance.t -> string -> t list -> t 12 | val mk_Name : ?provenance:Provenance.t -> string -> t 13 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 14 | val ( = ) : t -> t -> bool 15 | val info : t -> Provenance.t 16 | val pp : t Fmt.t 17 | val instantiate : t String.Map.t -> t -> t 18 | val split : t -> string * t list 19 | val name : t -> string 20 | val kind_check : Int.Set.t String.Map.t -> t -> Int.Set.t String.Map.t 21 | val parse : String.Set.t -> t Lvca_parsing.t 22 | -------------------------------------------------------------------------------- /syntax/Sort_def.mli: -------------------------------------------------------------------------------- 1 | open Lvca_util 2 | 3 | type t = 4 | | Sort_def of (string * Kind.t option) list * Operator_def.t list * string list 5 | (** A sort is defined by a set of variables and a set of operators. *) 6 | 7 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 8 | val ( = ) : t -> t -> bool 9 | val binds_vars : t -> bool 10 | val kind_check : Int.Set.t String.Map.t -> string -> t -> Int.Set.t String.Map.t 11 | val pp : name:string -> t Fmt.t 12 | val parse : (string * t) Lvca_parsing.t 13 | val find_operator_def : t -> string -> Operator_def.t option 14 | -------------------------------------------------------------------------------- /syntax/Sort_slot.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = 4 | | Sort_binding of Sort.t 5 | | Sort_pattern of Pattern_sort.t 6 | 7 | let equivalent ?(info_eq = fun _ _ -> true) slot1 slot2 = 8 | match slot1, slot2 with 9 | | Sort_binding s1, Sort_binding s2 -> Sort.equivalent ~info_eq s1 s2 10 | | Sort_pattern ps1, Sort_pattern ps2 -> Pattern_sort.equivalent ~info_eq ps1 ps2 11 | | _, _ -> false 12 | ;; 13 | 14 | let ( = ) = equivalent ~info_eq:Provenance.( = ) 15 | 16 | let pp ppf = function 17 | | Sort_binding sort -> Sort.pp ppf sort 18 | | Sort_pattern ps -> Pattern_sort.pp ppf ps 19 | ;; 20 | 21 | let instantiate env = function 22 | | Sort_binding s -> Sort_binding (Sort.instantiate env s) 23 | | Sort_pattern ps -> Sort_pattern (Pattern_sort.instantiate env ps) 24 | ;; 25 | 26 | let kind_check env = function 27 | | Sort_binding sort -> Sort.kind_check env sort 28 | | Sort_pattern { pattern_sort; var_sort } -> 29 | [ pattern_sort; var_sort ] |> List.fold ~init:env ~f:Sort.kind_check 30 | ;; 31 | 32 | let parse = 33 | let open Lvca_parsing in 34 | let* _, sort = Sort.parse Lvca_util.String.Set.empty in 35 | choice 36 | [ (C_comment_parser.brackets (Sort.parse Lvca_util.String.Set.empty) 37 | >>| fun var_sort -> Sort_pattern { pattern_sort = sort; var_sort }) 38 | ; return (Sort_binding sort) 39 | ] 40 | "sort slot" 41 | ;; 42 | -------------------------------------------------------------------------------- /syntax/Sort_slot.mli: -------------------------------------------------------------------------------- 1 | open Lvca_util 2 | 3 | (** Represents a place where a sort can go in a valence. *) 4 | type t = 5 | | Sort_binding of Sort.t 6 | | Sort_pattern of Pattern_sort.t 7 | 8 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 9 | val ( = ) : t -> t -> bool 10 | val pp : t Fmt.t 11 | val kind_check : Int.Set.t String.Map.t -> t -> Int.Set.t String.Map.t 12 | 13 | (** Instantiate concrete vars in a sort *) 14 | val instantiate : Sort.t String.Map.t -> t -> t 15 | 16 | val parse : t Lvca_parsing.t 17 | -------------------------------------------------------------------------------- /syntax/Valence.ml: -------------------------------------------------------------------------------- 1 | open Lvca_util 2 | 3 | type t = Valence of Sort_slot.t list * Sort.t 4 | 5 | let equivalent 6 | ?(info_eq = fun _ _ -> true) 7 | (Valence (slots1, sort1)) 8 | (Valence (slots2, sort2)) 9 | = 10 | List.equal Sort_slot.(equivalent ~info_eq) slots1 slots2 11 | && Sort.(equivalent ~info_eq) sort1 sort2 12 | ;; 13 | 14 | let ( = ) = equivalent ~info_eq:Provenance.( = ) 15 | 16 | let pp ppf (Valence (binders, result)) = 17 | match binders with 18 | | [] -> Sort.pp ppf result 19 | | _ -> 20 | Fmt.pf ppf "%a. %a" Fmt.(list ~sep:(any ".@ ") Sort_slot.pp) binders Sort.pp result 21 | ;; 22 | 23 | let instantiate env = function 24 | | Valence (binding_sort_slots, body_sort) -> 25 | Valence 26 | ( List.map binding_sort_slots ~f:(Sort_slot.instantiate env) 27 | , Sort.instantiate env body_sort ) 28 | ;; 29 | 30 | let kind_check env (Valence (binding_slots, value_sort)) = 31 | let env = binding_slots |> List.fold ~init:env ~f:Sort_slot.kind_check in 32 | Sort.kind_check env value_sort 33 | ;; 34 | 35 | let parse = 36 | let open Lvca_parsing in 37 | let t = 38 | sep_by1 (C_comment_parser.char '.') Sort_slot.parse 39 | >>= fun slots -> 40 | let binders, body_slot = List.unsnoc slots in 41 | match body_slot with 42 | | Sort_slot.Sort_binding body_sort -> return (Valence (binders, body_sort)) 43 | | _ -> 44 | fail 45 | (Fmt.str 46 | "Expected a simple sort, instead found a pattern sort (%a)" 47 | Sort_slot.pp 48 | body_slot) 49 | in 50 | t "valence" 51 | ;; 52 | -------------------------------------------------------------------------------- /syntax/Valence.mli: -------------------------------------------------------------------------------- 1 | open Lvca_util 2 | 3 | (** A valence represents a sort, as well as the number and sorts of the variables bound 4 | within it. Valences are most often used to represent slots in an operator. *) 5 | type t = Valence of Sort_slot.t list * Sort.t 6 | 7 | val equivalent : ?info_eq:(Provenance.t -> Provenance.t -> bool) -> t -> t -> bool 8 | val ( = ) : t -> t -> bool 9 | val pp : t Fmt.t 10 | 11 | (** Instantiate concrete vars in a valence *) 12 | val instantiate : Sort.t String.Map.t -> t -> t 13 | 14 | val parse : t Lvca_parsing.t 15 | val kind_check : Int.Set.t String.Map.t -> t -> Int.Set.t String.Map.t 16 | -------------------------------------------------------------------------------- /syntax/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lvca_syntax) 3 | (public_name lvca.syntax) 4 | (inline_tests) 5 | (libraries base fmt zarith zarith_stubs_js lvca_util lvca_parsing 6 | lvca_provenance re) 7 | (preprocess 8 | (pps ppx_jane))) 9 | -------------------------------------------------------------------------------- /syntax_quoter/Syntax_quoter.mli: -------------------------------------------------------------------------------- 1 | open Lvca_syntax 2 | 3 | val extract_string : loc:Ppxlib.location -> Ppxlib.expression -> string * Warnings.loc 4 | 5 | module Exp : sig 6 | val string : loc:Ppxlib.location -> string -> Ppxlib.expression 7 | val provenance : loc:Ppxlib.location -> Provenance.t -> Ppxlib.expression 8 | 9 | module Primitive : sig 10 | val integer : loc:Ppxlib.location -> Primitive.Integer.t -> Ppxlib.expression 11 | val int32 : loc:Ppxlib.location -> Primitive.Int32.t -> Ppxlib.expression 12 | val float : loc:Ppxlib.location -> Primitive.Float.t -> Ppxlib.expression 13 | val char : loc:Ppxlib.location -> Primitive.Char.t -> Ppxlib.expression 14 | val string : loc:Ppxlib.location -> Primitive.String.t -> Ppxlib.expression 15 | val all : loc:Ppxlib.location -> Primitive.All.t -> Ppxlib.expression 16 | end 17 | 18 | val sort : loc:Ppxlib.location -> Sort.t -> Ppxlib.expression 19 | 20 | val option 21 | : loc:Warnings.loc 22 | -> (loc:Warnings.loc -> 'a -> Ppxlib.expression) 23 | -> 'a option 24 | -> Ppxlib.expression 25 | 26 | val list : loc:Ppxlib.location -> Ppxlib.expression list -> Ppxlib.expression 27 | val pattern : loc:Ppxlib.location -> Pattern.t -> Ppxlib.expression 28 | val nominal : loc:Ppxlib.location -> Nominal.Term.t -> Ppxlib.expression 29 | val nonbinding : loc:Ppxlib.location -> Nonbinding.t -> Ppxlib.expression 30 | val language : loc:Ppxlib.location -> Abstract_syntax.t -> Ppxlib.expression 31 | val single_var : loc:Ppxlib.location -> Single_var.t -> Ppxlib.expression 32 | 33 | module Concrete : sig 34 | val t : loc:Ppxlib.location -> Concrete.t -> Ppxlib.expression 35 | end 36 | end 37 | 38 | module Pat : sig 39 | val list : loc:Ppxlib.location -> Ppxlib.pattern list -> Ppxlib.pattern 40 | end 41 | -------------------------------------------------------------------------------- /syntax_quoter/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lvca_syntax_quoter) 3 | (public_name lvca.syntax_quoter) 4 | (inline_tests) 5 | (preprocess 6 | (pps ppx_jane ppxlib.metaquot)) 7 | (wrapped false) 8 | (libraries base lvca_syntax lvca_provenance ppxlib)) 9 | -------------------------------------------------------------------------------- /util/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lvca_util) 3 | (public_name lvca.util) 4 | (inline_tests) 5 | (libraries angstrom base cbor digestif) 6 | (preprocess 7 | (pps ppx_jane))) 8 | --------------------------------------------------------------------------------