├── .github └── workflows │ └── deploy-branches.yml ├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── dune-project ├── opam.export ├── scrots └── 2022-02-11-11.33.24-PM.png └── src ├── core ├── AnnotatedBlock.re ├── Block.re ├── Cell.re ├── Environment.re ├── Expression.re ├── FurledBlock.re ├── Interpreter.re ├── Lens.re ├── Name.re ├── Path.re ├── Pattern.re ├── UID.re ├── Value.re ├── Word.re ├── World.re └── dune ├── util ├── Either.re ├── IntMap.re ├── ListUtil.re ├── OptUtil.re ├── P.re ├── PairUtil.re ├── Result.re ├── StringUtil.re ├── TupleUtil.re └── dune └── web ├── Animate.re ├── FontMetrics.re ├── Keyboard.re ├── Main.re ├── Measure.re ├── Model.re ├── Os.re ├── State.re ├── Update.re ├── dune ├── util ├── AttrUtil.re ├── JsUtil.re ├── Memo.re ├── NodeUtil.re ├── SvgUtil.re ├── Unicode.re ├── ViewUtil.re └── WeakMap.re ├── view ├── BlockView.re ├── CommonView.re ├── ExpView.re ├── PatView.re ├── ValView.re └── View.re └── www ├── dune ├── fonts ├── FiraCode-Bold.woff2 ├── FiraCode-Regular.woff2 ├── HelveticaNeue-Bold.woff2 ├── HelveticaNeue-Regular.woff2 ├── SourceCodePro-Black.otf.woff2 ├── SourceCodePro-Bold.otf.woff2 └── SourceCodePro-Regular.otf.woff2 ├── index.html ├── style.css └── test-meeee.m4a /.github/workflows/deploy-branches.yml: -------------------------------------------------------------------------------- 1 | # General notes on github actions: Note that both the working directory 2 | # and environment variables generally are not shared between steps. 3 | name: deploy furl 4 | on: [push] 5 | jobs: 6 | Deploy: 7 | runs-on: ubuntu-latest 8 | steps: 9 | # NOTE: position the below lines in the code between two steps 10 | # and uncomment them to open an ssh connection at that point: 11 | #- name: Debugging with ssh 12 | # uses: lhotari/action-upterm@v1 13 | - name: Checkout furl repo on current branch # STEP 1 14 | uses: actions/checkout@v2 15 | with: 16 | path: source 17 | - name: Add name of current branch to environment as BRANCH_NAME 18 | uses: nelonoel/branch-name@v1.0.1 19 | - name: Retrieve build environment if cached # STEP 2 20 | id: opam-cache 21 | uses: actions/cache@v2 22 | with: 23 | path: '/home/runner/.opam/' 24 | key: ${{ runner.os }}-modules-${{ hashFiles('./source/opam.export') }} 25 | - name: Install dependencies and build furl # STEP 3 26 | run: | 27 | sudo apt --assume-yes install opam 28 | export OPAMYES=1 29 | opam init --compiler=ocaml-base-compiler.4.08.1 30 | eval $(opam env) 31 | make deps 32 | make release 33 | working-directory: ./source 34 | - name: Checkout website build artifacts repo # STEP 4 35 | uses: actions/checkout@v2 36 | with: 37 | repository: disconcision/disconcision.github.io 38 | token: ${{ secrets.DEPLOY_FURL }} 39 | path: server 40 | - name: Clear any old build of this branch # STEP 5 41 | run: if [ -d "furl/${BRANCH_NAME}" ] ; then rm -rf "furl/${BRANCH_NAME}" ; fi 42 | working-directory: ./server 43 | - name: Copy in newly built source # STEP 6 44 | run: | 45 | mkdir "./server/furl/${BRANCH_NAME}" && 46 | cp -r "./source/_build/default/src/web/www"/* "./server/furl/${BRANCH_NAME}" && 47 | if [ "${BRANCH_NAME}" == "plus" ] 48 | then 49 | cp -r "./source/_build/default/src/web/www"/* "./server/furl" 50 | fi 51 | - name: Commit to website aka deploy # STEP 7 52 | run: | 53 | git config user.name github-deploy-action 54 | git config user.email furl-deploy@disconcision.com 55 | git add -A 56 | git status 57 | git diff-index --quiet HEAD || (git commit -m "github-deploy-action-${BRANCH_NAME}"; git push) 58 | working-directory: ./server -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | _build 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022 Andrew Blinn based on a template by David Moon 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | HTML_DIR=_build/default/src/web/www 2 | HTML_FILE=$(HTML_DIR)/index.html 3 | 4 | all: 5 | dune build @src/fmt --auto-promote || true 6 | dune build src --profile dev 7 | 8 | deps: 9 | opam switch import opam.export 10 | 11 | release: 12 | dune build src --profile release 13 | 14 | echo-html: 15 | @echo "$(shell pwd)/_build/default/src/web/www/index.html" 16 | 17 | clean: 18 | dune clean 19 | 20 | open: 21 | open "$(HTML_FILE)" 22 | 23 | watch: 24 | dune build @src/fmt --auto-promote src --profile dev --watch -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # furl is furl 2 | 3 | 🌳 trees (data structure) are 🤡 harlequins, 📚 words (computer architecture) are 🤡 harlequins 4 | 5 | furl status: pre-explosion; moistrurized 🌧, unbothered 🧖‍. neutrinos: in repose. check back later! 6 | 7 | ![scrot](https://github.com/disconcision/furl/blob/main/scrots/2022-02-11-11.33.24-PM.png) 8 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.3) 2 | -------------------------------------------------------------------------------- /opam.export: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | compiler: [ 3 | "base-bigarray.base" 4 | "base-threads.base" 5 | "base-unix.base" 6 | "ocaml.4.08.1" 7 | "ocaml-base-compiler.4.08.1" 8 | "ocaml-config.1" 9 | ] 10 | roots: [ 11 | "bark.0.1.4" 12 | "deriving.0.8.1" 13 | "dune.2.8.2" 14 | "incr_dom.v0.14.0" 15 | "js_of_ocaml.3.9.0" 16 | "js_of_ocaml-tyxml.3.9.0" 17 | "merlin.3.4.2" 18 | "ocaml-base-compiler.4.08.1" 19 | "ocaml-lsp-server.1.4.0" 20 | "ocamlformat.0.15.0" 21 | "ocp-indent.1.8.1" 22 | "odoc.1.5.2" 23 | "ounit.2.2.4" 24 | "ppx_deriving.5.1" 25 | "ppx_expect.v0.14.0" 26 | "ppx_inline_test.v0.14.1" 27 | "ppx_let.v0.14.0" 28 | "ppx_sexp_conv.v0.14.1" 29 | "re.1.9.0" 30 | "reactiveData.0.2.2" 31 | "reason.3.7.0" 32 | "rtop.3.6.2" 33 | "sexplib.v0.14.0" 34 | "utop.2.7.0" 35 | ] 36 | installed: [ 37 | "angstrom.0.15.0" 38 | "astring.0.8.5" 39 | "async_js.v0.14.0" 40 | "async_kernel.v0.14.0" 41 | "async_rpc_kernel.v0.14.0" 42 | "bark.0.1.4" 43 | "base.v0.14.1" 44 | "base-bigarray.base" 45 | "base-bytes.base" 46 | "base-threads.base" 47 | "base-unix.base" 48 | "base_bigstring.v0.14.0" 49 | "base_quickcheck.v0.14.0" 50 | "bigarray-compat.1.0.0" 51 | "bigstringaf.0.7.0" 52 | "bin_prot.v0.14.0" 53 | "biniou.1.2.1" 54 | "camlp4.4.08+1" 55 | "camomile.1.0.2" 56 | "charInfo_width.1.1.0" 57 | "cmdliner.1.0.4" 58 | "conf-m4.1" 59 | "conf-pkg-config.2" 60 | "core_kernel.v0.14.1" 61 | "cppo.1.6.7" 62 | "csexp.1.4.0" 63 | "deriving.0.8.1" 64 | "dot-merlin-reader.3.4.2" 65 | "dune.2.8.2" 66 | "dune-build-info.2.8.4" 67 | "dune-configurator.2.8.2" 68 | "dune-private-libs.2.8.2" 69 | "easy-format.1.3.2" 70 | "fieldslib.v0.14.0" 71 | "fix.20201120" 72 | "fpath.0.7.3" 73 | "incr_dom.v0.14.0" 74 | "incr_map.v0.14.0" 75 | "incr_select.v0.14.0" 76 | "incremental.v0.14.0" 77 | "jane-street-headers.v0.14.0" 78 | "js_of_ocaml.3.9.0" 79 | "js_of_ocaml-compiler.3.9.1" 80 | "js_of_ocaml-ppx.3.9.0" 81 | "js_of_ocaml-tyxml.3.9.0" 82 | "jst-config.v0.14.0" 83 | "lambda-term.3.1.0" 84 | "lambdasoup.0.7.2" 85 | "lwt.5.4.0" 86 | "lwt_log.1.1.1" 87 | "lwt_react.1.1.4" 88 | "markup.1.0.0-1" 89 | "menhir.20201216" 90 | "menhirLib.20201216" 91 | "menhirSdk.20201216" 92 | "merlin.3.4.2" 93 | "merlin-extend.0.6" 94 | "mew.0.1.0" 95 | "mew_vi.0.5.0" 96 | "mmap.1.1.0" 97 | "num.1.4" 98 | "oasis.0.4.11" 99 | "ocaml.4.08.1" 100 | "ocaml-base-compiler.4.08.1" 101 | "ocaml-compiler-libs.v0.12.3" 102 | "ocaml-config.1" 103 | "ocaml-lsp-server.1.4.0" 104 | "ocaml-migrate-parsetree.1.8.0" 105 | "ocaml-syntax-shims.1.0.0" 106 | "ocamlbuild.0.14.0" 107 | "ocamlfind.1.8.1" 108 | "ocamlformat.0.15.0" 109 | "ocamlify.0.0.1" 110 | "ocamlmod.0.0.9" 111 | "ocp-indent.1.8.1" 112 | "ocplib-endian.1.1" 113 | "octavius.1.2.2" 114 | "odoc.1.5.2" 115 | "ounit.2.2.4" 116 | "ounit2.2.2.4" 117 | "parsexp.v0.14.0" 118 | "ppx_assert.v0.14.0" 119 | "ppx_base.v0.14.0" 120 | "ppx_bench.v0.14.1" 121 | "ppx_bin_prot.v0.14.0" 122 | "ppx_cold.v0.14.0" 123 | "ppx_compare.v0.14.0" 124 | "ppx_custom_printf.v0.14.0" 125 | "ppx_derivers.1.2.1" 126 | "ppx_deriving.5.1" 127 | "ppx_enumerate.v0.14.0" 128 | "ppx_expect.v0.14.0" 129 | "ppx_fail.v0.14.0" 130 | "ppx_fields_conv.v0.14.1" 131 | "ppx_fixed_literal.v0.14.0" 132 | "ppx_hash.v0.14.0" 133 | "ppx_here.v0.14.0" 134 | "ppx_inline_test.v0.14.1" 135 | "ppx_jane.v0.14.0" 136 | "ppx_js_style.v0.14.0" 137 | "ppx_let.v0.14.0" 138 | "ppx_module_timer.v0.14.0" 139 | "ppx_optcomp.v0.14.0" 140 | "ppx_optional.v0.14.0" 141 | "ppx_pattern_bind.v0.14.0" 142 | "ppx_pipebang.v0.14.0" 143 | "ppx_sexp_conv.v0.14.1" 144 | "ppx_sexp_message.v0.14.0" 145 | "ppx_sexp_value.v0.14.0" 146 | "ppx_stable.v0.14.1" 147 | "ppx_string.v0.14.1" 148 | "ppx_tools.6.3" 149 | "ppx_tools_versioned.5.4.0" 150 | "ppx_typerep_conv.v0.14.1" 151 | "ppx_variants_conv.v0.14.1" 152 | "ppx_yojson_conv_lib.v0.14.0" 153 | "ppxfind.1.4" 154 | "ppxlib.0.15.0" 155 | "protocol_version_header.v0.14.0" 156 | "re.1.9.0" 157 | "react.1.2.1" 158 | "reactiveData.0.2.2" 159 | "reason.3.7.0" 160 | "result.1.5" 161 | "rtop.3.6.2" 162 | "seq.base" 163 | "sexplib.v0.14.0" 164 | "sexplib0.v0.14.0" 165 | "splittable_random.v0.14.0" 166 | "stdio.v0.14.0" 167 | "stdlib-shims.0.3.0" 168 | "stringext.1.6.0" 169 | "time_now.v0.14.0" 170 | "topkg.1.0.3" 171 | "trie.1.0.0" 172 | "typerep.v0.14.0" 173 | "tyxml.4.4.0" 174 | "uchar.0.0.2" 175 | "uri.4.1.0" 176 | "uri-sexp.4.1.0" 177 | "utop.2.7.0" 178 | "uucp.13.0.0" 179 | "uuseg.13.0.0" 180 | "uutf.1.0.2" 181 | "variantslib.v0.14.0" 182 | "virtual_dom.v0.14.0" 183 | "yojson.1.7.0" 184 | "zed.3.1.0" 185 | ] 186 | -------------------------------------------------------------------------------- /scrots/2022-02-11-11.33.24-PM.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/disconcision/furl/4967561c010bdfc65a5100d6c2db266b3fcc0a50/scrots/2022-02-11-11.33.24-PM.png -------------------------------------------------------------------------------- /src/core/AnnotatedBlock.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | 3 | [@deriving sexp] 4 | type dynamic_error = 5 | | WrongSyntax 6 | | WrongType 7 | | Unbound; 8 | 9 | [@deriving sexp] 10 | type dynamic_status = 11 | | FineThanks 12 | | Error(dynamic_error); 13 | 14 | [@deriving sexp] 15 | type annotated_word_val = { 16 | word: Word.t, 17 | path: Path.t, 18 | form: Value.atom, 19 | }; 20 | 21 | [@deriving sexp] 22 | type annotated_word_pat = { 23 | word: Word.t, 24 | path: Path.t, 25 | form: option(Pattern.atom), 26 | }; 27 | 28 | [@deriving sexp] 29 | type annotated_word_exp = { 30 | word: Word.t, 31 | path: Path.t, 32 | form: Expression.atom, 33 | dynamic_status, 34 | }; 35 | 36 | [@deriving sexp] 37 | type annotated_val = { 38 | path: Path.t, 39 | form: Value.t, 40 | words: list(annotated_word_val), 41 | }; 42 | 43 | [@deriving sexp] 44 | type annotated_pat = { 45 | path: Path.t, 46 | form: option(Pattern.t), 47 | words: list(annotated_word_pat), 48 | }; 49 | 50 | [@deriving sexp] 51 | type annotated_exp = { 52 | path: Path.t, 53 | form: Expression.t, 54 | words: list(annotated_word_exp), 55 | }; 56 | 57 | [@deriving sexp] 58 | type status = 59 | | Alive 60 | | Dead; 61 | 62 | [@deriving sexp] 63 | type vars = { 64 | bound_here: option(Pattern.uses_ctx), 65 | num_refs: option(int), 66 | binding_status: option(status), 67 | used_here: Path.ctx, 68 | context: Path.ctx, 69 | }; 70 | 71 | [@deriving sexp] 72 | type annotated_cell = { 73 | path: Path.t, 74 | vars, 75 | pattern: annotated_pat, 76 | expression: annotated_exp, 77 | value: annotated_val, 78 | uid: UID.t, 79 | }; 80 | 81 | [@deriving sexp] 82 | type t = { 83 | path: Path.t, // always empty for now since only one block 84 | cells: list(annotated_cell), 85 | }; 86 | 87 | let annotate_word_val = (path, length, idx, word): annotated_word_val => { 88 | { 89 | //TODO: specialize parse for values 90 | path: path @ [Path.Word(Index(idx, length))], 91 | word, 92 | form: Value.parse_atom(word), 93 | }; 94 | }; 95 | 96 | let annotate_expression_word = (context, path, length, idx, word) => { 97 | { 98 | path: path @ [Path.Word(Index(idx, length))], 99 | form: Expression.parse_atom(context, word), 100 | word, 101 | dynamic_status: FineThanks, 102 | }; 103 | }; 104 | 105 | let annotate_val: (Path.t, Word.s) => annotated_val = 106 | (path, words) => { 107 | { 108 | path, 109 | words: List.mapi(annotate_word_val(path, List.length(words)), words), 110 | form: Value.parse(words), 111 | }; 112 | }; 113 | 114 | let annotate_pattern_word_forward = 115 | (path, length, idx, word): annotated_word_pat => { 116 | { 117 | path: path @ [Path.Word(Index(idx, length))], 118 | form: None, //will fill in reverse pass 119 | word, 120 | }; 121 | }; 122 | 123 | let annotate_pat: (Path.t, Word.s) => annotated_pat = 124 | (path, words) => { 125 | { 126 | path, 127 | words: 128 | List.mapi( 129 | annotate_pattern_word_forward(path, List.length(words)), 130 | words, 131 | ), 132 | form: None //will fill in reverse pass 133 | }; 134 | }; 135 | 136 | let annotate_exp: (Path.ctx, Path.t, Word.s) => annotated_exp = 137 | (context, path, words) => { 138 | let form = Expression.parse(context, words); 139 | let words = 140 | List.mapi( 141 | annotate_expression_word(context, path, List.length(words)), 142 | words, 143 | ); 144 | {path, form, words}; 145 | }; 146 | 147 | let get_pat_vars: annotated_pat => Path.ctx = 148 | ({words, _}) => 149 | List.map( 150 | ({path, word, _}: annotated_word_pat) => (word.name, path), 151 | words, 152 | ); 153 | 154 | let get_bound_exp_vars: annotated_exp => Path.ctx = 155 | ({words, _}) => 156 | words 157 | |> List.filter(({form, _}: annotated_word_exp) => 158 | Expression.is_bound_var(form) 159 | ) 160 | |> List.map(({path, word, _}) => (word.name, path)); 161 | 162 | let annotate_cell: (Path.ctx, Path.t, int, int, Cell.t) => annotated_cell = 163 | (context, path, length, idx, {pattern, expression, value, uid}) => { 164 | let path = path @ [Cell(Index(idx, length))]; 165 | let pattern = annotate_pat(path @ [Field(Pattern)], pattern); 166 | let expression = 167 | annotate_exp(context, path @ [Field(Expression)], expression); 168 | let value = annotate_val(path @ [Field(Value)], value); 169 | { 170 | path, 171 | vars: { 172 | num_refs: None, 173 | binding_status: None, 174 | bound_here: None, // Will fill in reverse pass 175 | used_here: get_bound_exp_vars(expression), 176 | context, 177 | }, 178 | pattern, 179 | expression, 180 | value, 181 | uid, 182 | }; 183 | }; 184 | 185 | let init_ctx = 186 | List.map(p => (p, [Path.Cell(Index(-1, -1))]), Expression.prims); 187 | 188 | let forward_pass: Block.t => t = 189 | block => { 190 | let path = []; 191 | 192 | let (cells, _) = 193 | Base.List.foldi( 194 | block, 195 | ~init=([], init_ctx), 196 | ~f=(idx, (acc_block, acc_ctx), cell) => { 197 | let ann_cell = 198 | annotate_cell(acc_ctx, path, List.length(block), idx, cell); 199 | let new_ctx = 200 | Environment.union(acc_ctx, get_pat_vars(ann_cell.pattern)); 201 | (acc_block @ [ann_cell], new_ctx); 202 | }, 203 | ); 204 | {path, cells}; 205 | }; 206 | 207 | let gather_uses: (Pattern.uses_ctx, annotated_exp) => Pattern.uses_ctx = 208 | (ctx, {words, _}) => 209 | List.fold_left( 210 | (acc_ctx, {path, word, _}: annotated_word_exp) => 211 | Environment.update_or_extend( 212 | acc_ctx, 213 | word.name, 214 | uses => uses @ [path], 215 | [path], 216 | ), 217 | ctx, 218 | words, 219 | ); 220 | 221 | let consume_uses: 222 | (Pattern.uses_ctx, annotated_pat) => (Pattern.uses_ctx, annotated_pat) = 223 | (co_ctx, {path, words, _}) => { 224 | let (new_words, new_ctx) = 225 | List.fold_left( 226 | ((acc_words, acc_ctx), {word, _} as ann_pat: annotated_word_pat) => { 227 | let form = Some(Pattern.parse_atom(acc_ctx, word)); 228 | let new_words = acc_words @ [{...ann_pat, form}]; 229 | let new_ctx = 230 | switch (Environment.lookup(acc_ctx, word.name)) { 231 | | Some(_) => Environment.update(acc_ctx, word.name, _ => []) 232 | | None => acc_ctx 233 | }; 234 | (new_words, new_ctx); 235 | }, 236 | ([], co_ctx), 237 | List.rev(words), 238 | ); 239 | ( 240 | new_ctx, 241 | { 242 | path, 243 | words: List.rev(new_words), 244 | form: 245 | //TODO: cleanup 246 | Some( 247 | Pattern.parse( 248 | new_ctx, 249 | List.map(({word, _}: annotated_word_pat) => word, new_words), 250 | ), 251 | ), 252 | }, 253 | ); 254 | }; 255 | 256 | let get_pat_var_uses: annotated_pat => Pattern.uses_ctx = 257 | ({words, _}) => 258 | List.fold_left( 259 | (acc, {form, _}: annotated_word_pat) => 260 | switch (form) { 261 | | Some(Var(name, uses)) => [(name, uses)] @ acc 262 | | _ => acc 263 | }, 264 | Environment.empty, 265 | words, 266 | ); 267 | 268 | let count_uses: Pattern.uses_ctx => int = 269 | uses_ctx => 270 | uses_ctx 271 | |> List.map(((_, x)) => List.length(x)) 272 | |> List.fold_left((+), 0); 273 | 274 | let init_live_ctx: list(annotated_cell) => list(Name.t) = 275 | reversed_block => 276 | switch (reversed_block) { 277 | | [last_cell, ..._] => 278 | List.map( 279 | ({word, _}: annotated_word_pat) => word.name, 280 | last_cell.pattern.words, 281 | ) 282 | | _ => [] 283 | }; 284 | 285 | let some_bound_here_in_live_ctx = (bound_here, live_ctx) => 286 | List.exists( 287 | word => None != List.find_opt((==)(word), live_ctx), 288 | Environment.keys(bound_here), 289 | ); 290 | 291 | let cell_binding_status = (bound_here, live_ctx) => 292 | some_bound_here_in_live_ctx(bound_here, live_ctx) ? Alive : Dead; 293 | 294 | let reverse_annonate_cell: 295 | (list(Name.t), Pattern.uses_ctx, annotated_cell) => 296 | (Pattern.uses_ctx, annotated_cell) = 297 | (live_ctx, co_ctx, {pattern, expression, vars, _} as ann_cell) => { 298 | let (co_ctx, pattern) = consume_uses(co_ctx, pattern); 299 | let co_ctx = gather_uses(co_ctx, expression); 300 | let uses = get_pat_var_uses(pattern); 301 | let vars = { 302 | ...vars, 303 | bound_here: Some(uses), 304 | num_refs: Some(count_uses(uses)), 305 | binding_status: Some(cell_binding_status(uses, live_ctx)), 306 | }; 307 | (co_ctx, {...ann_cell, vars, pattern}); 308 | }; 309 | 310 | let extend_live_ctx = (live_ctx, ann_cell) => 311 | //TODO: this approach is probably bugged... need to account for shadowing, 312 | // remove things from live ctx. better approach: don't just blindly append, 313 | // make sure no duplicates, and the remove on encountering bindings. 314 | //ALSO: composite patterns are alive as long as 1 of their sub-patterns is 315 | switch (ann_cell.vars.binding_status, ann_cell.vars.used_here) { 316 | | (Some(Alive), uses_ctx) => live_ctx @ Environment.keys(uses_ctx) 317 | | _ => live_ctx 318 | }; 319 | 320 | let reverse_pass: t => t = 321 | ({cells, path, _}) => { 322 | let rev_cells = List.rev(cells); 323 | let (new_cells, _, _) = 324 | Base.List.fold( 325 | rev_cells, 326 | ~init=([], Environment.empty, init_live_ctx(rev_cells)), 327 | ~f=((acc_block, acc_ctx, live_ctx), cell) => { 328 | let (uses_ctx, ann_cell) = 329 | reverse_annonate_cell(live_ctx, acc_ctx, cell); 330 | let live_ctx = extend_live_ctx(live_ctx, ann_cell); 331 | (acc_block @ [ann_cell], uses_ctx, live_ctx); 332 | }, 333 | ); 334 | {cells: List.rev(new_cells), path}; 335 | }; 336 | 337 | let mk = (block: Block.t): t => { 338 | block |> forward_pass |> reverse_pass; 339 | }; 340 | -------------------------------------------------------------------------------- /src/core/Block.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | 3 | [@deriving sexp] 4 | type t = Cell.s; 5 | 6 | [@deriving sexp] 7 | type cell_id = int; 8 | 9 | let nth_cell: (t, cell_id) => Cell.t = List.nth; 10 | let len = List.length; 11 | 12 | let update_cell: (t, int, Cell.t => Cell.t) => t = 13 | (block, cell_idx, f) => 14 | List.mapi((idx, cell) => idx == cell_idx ? f(cell) : cell, block); 15 | 16 | let update_expression: (t, int, Word.s => Word.s) => t = 17 | (block, cell_idx, f) => 18 | update_cell(block, cell_idx, ({expression, _} as cell) => 19 | {...cell, expression: f(expression)} 20 | ); 21 | 22 | let update_pattern: (t, int, Word.s => Word.s) => t = 23 | (block, cell_idx, f) => 24 | update_cell(block, cell_idx, ({pattern, _} as cell) => 25 | {...cell, pattern: f(pattern)} 26 | ); 27 | 28 | let get_words: (int, Cell.field, t) => Word.s = 29 | (cell_idx, field, block) => { 30 | //TODO: opt check 31 | let cell = nth_cell(block, cell_idx); 32 | switch (field) { 33 | | Expression => cell.expression 34 | | Pattern => cell.pattern 35 | | Value => cell.value 36 | }; 37 | }; 38 | 39 | let get_word: (int, Cell.field, int, t) => option(Word.t) = 40 | (cell_idx, field, word_idx, block) => 41 | List.nth_opt(get_words(cell_idx, field, block), word_idx); 42 | -------------------------------------------------------------------------------- /src/core/Cell.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | 3 | [@deriving sexp] 4 | type pattern = Word.s; 5 | [@deriving sexp] 6 | type expression = Word.s; 7 | [@deriving sexp] 8 | type value = Word.s; 9 | 10 | [@deriving sexp] 11 | type field = 12 | | Pattern 13 | | Expression 14 | | Value; 15 | 16 | [@deriving sexp] 17 | type t = { 18 | uid: UID.t, 19 | pattern, 20 | expression, 21 | value, 22 | }; 23 | 24 | [@deriving sexp] 25 | type s = list(t); 26 | 27 | [@deriving sexp] 28 | type word_idx = int; 29 | 30 | let ids: ref(list(UID.t)) = ref([]); 31 | 32 | let nth_word: (Word.s, word_idx) => Word.t = List.nth; 33 | 34 | let update_word: (Name.t => Name.t, int, Word.s) => Word.s = 35 | (f, idx) => 36 | List.mapi((i, {name, _} as w: Word.t) => 37 | {...w, name: i == idx ? f(name) : name} 38 | ); 39 | 40 | let mk_uid = () => { 41 | let uid = UID.mk(); 42 | ids := [uid, ...ids^]; 43 | uid; 44 | }; 45 | 46 | //TODO: betterize this (cyclical dep withe Expr issue) 47 | let init_w': Word.t => (Word.t, t) = 48 | w_exp => { 49 | let w = Word.mk(); 50 | ( 51 | w, 52 | {pattern: [w], expression: [w_exp], value: [w_exp], uid: mk_uid()}, 53 | ); 54 | }; 55 | 56 | let init_w: Name.t => (Word.t, t) = w_exp => init_w'(Word.mk_name(w_exp)); 57 | 58 | let init_name': Word.t => t = 59 | w => { 60 | { 61 | pattern: [w], 62 | expression: [Word.mk_empty()], 63 | value: [Word.mk_name("?")], 64 | uid: mk_uid(), 65 | }; 66 | }; 67 | 68 | let init_name: Name.t => t = n => init_name'(Word.mk_name(n)); 69 | 70 | let init_full: ((Name.s, Name.s)) => t = 71 | ((pat, exp)) => { 72 | let _ = Word.mk(); 73 | { 74 | pattern: List.map(Word.mk_name, pat), 75 | expression: List.map(Word.mk_name, exp), 76 | value: [Word.mk_name("?")], 77 | uid: mk_uid(), 78 | }; 79 | }; 80 | 81 | let init: 'a => t = () => init_name'(Word.mk()); 82 | 83 | let copy: t => t = cell => {...cell, uid: mk_uid()}; 84 | -------------------------------------------------------------------------------- /src/core/Environment.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | 3 | [@deriving sexp] 4 | type t_('a) = list((string, 'a)); 5 | 6 | let empty = []; 7 | 8 | let is_empty = 9 | fun 10 | | [] => true 11 | | [_, ..._] => false; 12 | 13 | let extend = (ctx, xa) => { 14 | let (x, _) = xa; 15 | [xa, ...List.remove_assoc(x, ctx)]; 16 | }; 17 | 18 | let lookup = (ctx, x) => List.assoc_opt(x, ctx); 19 | 20 | let contains = (ctx, x) => List.mem_assoc(x, ctx); 21 | 22 | let union = (ctx1, ctx2) => List.fold_left(extend, ctx2, ctx1); 23 | 24 | let update = (ctx, key, f) => { 25 | // NOTE: this somewhat reorders the list 26 | switch (lookup(ctx, key)) { 27 | | Some(v) => [(key, f(v)), ...List.remove_assoc(key, ctx)] 28 | | None => ctx 29 | }; 30 | }; 31 | 32 | let update_or_extend = (ctx, key, f, v) => { 33 | // NOTE: this somewhat reorders the list 34 | switch (lookup(ctx, key)) { 35 | | Some(v') => [(key, f(v')), ...List.remove_assoc(key, ctx)] 36 | | None => [(key, v), ...List.remove_assoc(key, ctx)] 37 | }; 38 | }; 39 | 40 | let keys = ctx => List.map(((k, _)) => k, ctx); 41 | 42 | let map = (f, xs) => List.map(((x, _) as xa) => (x, f(xa)), xs); 43 | 44 | /* 45 | 46 | let filter = List.filter; 47 | 48 | let length = List.length; 49 | 50 | let to_list = ctx => ctx; 51 | */ 52 | -------------------------------------------------------------------------------- /src/core/Expression.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | 3 | [@deriving sexp] 4 | type prim = 5 | | Not 6 | | And 7 | | Or 8 | | Add 9 | | Mult 10 | | Fact 11 | | Equal 12 | | LessThan 13 | | MoreThan; 14 | 15 | [@deriving sexp] 16 | type operator = 17 | | AndOp 18 | | OrOp 19 | | Times 20 | | Plus 21 | | Minus 22 | | EqualOp 23 | | LessThanOp 24 | | MoreThanOp; 25 | 26 | [@deriving sexp] 27 | type t = 28 | | Atom(atom) 29 | | App(prim, list(t)) 30 | | Seq(prim, list(t)) 31 | | Unknown(Word.s) 32 | | Let(list(binding), t) 33 | and binding = (Pattern.t, t) 34 | and atom = 35 | | Lit(lit) 36 | | Var(string, Path.t) 37 | | Unbound(string) 38 | | Operator(string) 39 | | Formless(string) 40 | and lit = 41 | | IntLit(int) 42 | | FloatLit(float) 43 | | BoolLit(bool) 44 | | Indet(t); 45 | 46 | let string_of_lit: lit => string = 47 | fun 48 | | BoolLit(b) => string_of_bool(b) 49 | | IntLit(n) => string_of_int(n) 50 | | FloatLit(f) => string_of_float(f) 51 | | Indet(_) => "??"; 52 | 53 | let prims = [ 54 | "not", 55 | "and", 56 | "or", 57 | "sum", 58 | "prod", 59 | "fact", 60 | "desc", 61 | "asc", 62 | "equal", 63 | ]; 64 | 65 | let prim_of_string: string => option(prim) = 66 | fun 67 | | "not" => Some(Not) 68 | | "and" => Some(And) 69 | | "or" => Some(Or) 70 | | "sum" => Some(Add) 71 | | "prod" => Some(Mult) 72 | | "fact" => Some(Fact) 73 | | "equal" => Some(Equal) 74 | | "desc" => Some(MoreThan) 75 | | "asc" => Some(LessThan) 76 | | _ => None; 77 | 78 | let prim_of: operator => option(prim) = 79 | fun 80 | | AndOp => Some(And) 81 | | OrOp => Some(Or) 82 | | Times => Some(Mult) 83 | | Plus => Some(Add) 84 | | EqualOp => Some(Equal) 85 | | LessThanOp => Some(LessThan) 86 | | MoreThanOp => Some(MoreThan) 87 | | Minus => None; 88 | 89 | let parse_operator: string => option(operator) = 90 | fun 91 | | "&" => Some(AndOp) 92 | | "|" => Some(OrOp) 93 | | "*" => Some(Times) 94 | | "+" => Some(Plus) 95 | | "-" => Some(Minus) 96 | | "=" => Some(EqualOp) 97 | | "<" => Some(LessThanOp) 98 | | ">" => Some(MoreThanOp) 99 | | _ => None; 100 | 101 | let is_operator: string => bool = s => parse_operator(s) != None; 102 | 103 | let word_is_operator: Word.t => bool = w => is_operator(w.name); 104 | 105 | let parse_lit: Name.t => option(lit) = 106 | name => 107 | switch ( 108 | bool_of_string_opt(name), 109 | int_of_string_opt(name), 110 | float_of_string_opt(name), 111 | ) { 112 | | (Some(b), _, _) => Some(BoolLit(b)) 113 | | (_, Some(n), _) => Some(IntLit(n)) 114 | | (_, _, Some(f)) => Some(FloatLit(f)) 115 | | _ => None 116 | }; 117 | 118 | type parse_tail_res = 119 | | Failure 120 | | Any 121 | | Success(prim, list(t)); 122 | 123 | //TODO: combine with below 124 | let parse_atom: (Path.ctx, Word.t) => atom = 125 | (context, {name, _}) => 126 | switch ( 127 | parse_lit(name), 128 | Name.is_valid_var(name), 129 | Environment.lookup(context, name), 130 | ) { 131 | | _ when is_operator(name) => Operator(name) 132 | | (Some(lit), _, _) => Lit(lit) 133 | | (_, true, Some(path)) => Var(name, path) 134 | | (_, true, None) => Unbound(name) 135 | | _ => Formless(name) 136 | }; 137 | 138 | let is_bound_var: atom => bool = 139 | form => 140 | switch (form) { 141 | | Var(_) => true 142 | | _ => false 143 | }; 144 | 145 | let rec parse: (Path.ctx, Word.s) => t = 146 | (ctx, words) => { 147 | let parse_word = (word: Word.t) => Atom(parse_atom(ctx, word)); 148 | switch (words) { 149 | | [] => Unknown(words) 150 | | [x] => parse_word(x) 151 | | [x, ...xs] => 152 | switch (prim_of_string(x.name)) { 153 | | Some(fn) => App(fn, List.map(parse_word, xs)) 154 | | _ => 155 | switch (parse_tail_seq(xs, parse_word, ctx)) { 156 | | Success(op, ps) => Seq(op, [parse_word(x), ...ps]) 157 | | Any 158 | | Failure => Unknown(words) 159 | } 160 | } 161 | }; 162 | } 163 | and parse_tail_seq = (xs, parse_word, ctx): parse_tail_res => 164 | switch (xs) { 165 | | [] => Any 166 | | [op, x1, ...xs] => 167 | switch (parse_operator(op.name), parse_tail_seq(xs, parse_word, ctx)) { 168 | | (Some(Minus), Success(Add, ps)) => 169 | Success(Add, [parse_word(Word.mapn(x1 => "-" ++ x1, x1)), ...ps]) 170 | | (Some(Minus), Any) => 171 | Success(Add, [parse_word(Word.mapn(x1 => "-" ++ x1, x1))]) 172 | | (Some(op), Success(prim, ps)) when prim_of(op) == Some(prim) => 173 | Success(prim, [parse_word(x1), ...ps]) 174 | | (Some(op), Any) when prim_of(op) != None => 175 | switch (prim_of(op)) { 176 | | Some(prim) => Success(prim, [parse_word(x1)]) 177 | | None => failwith("parse_tail_seq impossible") 178 | } 179 | | _ => Failure 180 | } 181 | | _ => Failure 182 | }; 183 | -------------------------------------------------------------------------------- /src/core/FurledBlock.re: -------------------------------------------------------------------------------- 1 | /* 2 | set acc=[] 3 | per row: 4 | 1. go over expression, substituting from acc. 5 | 2. if dead or zero uses, just drop it. 6 | 3. if (alive or) multiple uses, leave it. 7 | 4. if 1 use, drop and add to acc. 8 | (* with this strategy, shouldn't need to explictly transitively substitute) 9 | 5. move on to next cell 10 | 11 | what we're left with should be convertible into let block 12 | */ 13 | 14 | [@deriving sexp] 15 | type ctx = Environment.t_(Expression.t); 16 | 17 | let rec substitute: (ctx, Expression.t) => Expression.t = 18 | (ctx, form) => 19 | switch (form) { 20 | | Atom(a) => 21 | switch (a) { 22 | | Lit(_) 23 | | Unbound(_) 24 | | Operator(_) 25 | | Formless(_) => form 26 | | Var(name, _) => 27 | switch (Environment.lookup(ctx, name)) { 28 | | Some(thing) => thing 29 | | None => Atom(Var(name, [])) 30 | } 31 | } 32 | | App(prim, fs) => App(prim, List.map(substitute(ctx), fs)) 33 | | Seq(prim, fs) => Seq(prim, List.map(substitute(ctx), fs)) 34 | | Let(_) 35 | | Unknown(_) => form 36 | }; 37 | 38 | let furl_block': 39 | (ctx, list(AnnotatedBlock.annotated_cell)) => 40 | list(AnnotatedBlock.annotated_cell) = 41 | (ctx, ann_cells) => { 42 | let (new_cells, _) = 43 | List.fold_left( 44 | ( 45 | (acc_cells, acc_ctx), 46 | {expression, pattern, vars, _} as cell: AnnotatedBlock.annotated_cell, 47 | ) => { 48 | let new_form = substitute(acc_ctx, expression.form); 49 | let new_cell = { 50 | ...cell, 51 | expression: { 52 | ...expression, 53 | form: new_form, 54 | }, 55 | }; 56 | let new_acc_ctx = 57 | switch (pattern.form) { 58 | | Some(Atom(Var(name, _))) => 59 | Environment.extend(acc_ctx, (name, new_form)) 60 | | _ => acc_ctx 61 | }; 62 | switch (vars.binding_status, vars.num_refs) { 63 | | (Some(Dead), _) => (acc_cells, acc_ctx) 64 | | (_, Some(1)) => (acc_cells, new_acc_ctx) 65 | | (_, _n) => (acc_cells @ [new_cell], acc_ctx) 66 | }; 67 | }, 68 | ([], ctx), 69 | ann_cells, 70 | ); 71 | new_cells; 72 | }; 73 | 74 | let cell_to_binding: AnnotatedBlock.annotated_cell => Expression.binding = 75 | ann_cell => 76 | switch (ann_cell.pattern.form) { 77 | | Some(pat_form) => (pat_form, ann_cell.expression.form) 78 | | _ => (Unknown([]), ann_cell.expression.form) 79 | }; 80 | 81 | let furl_block: AnnotatedBlock.t => Expression.t = 82 | ({cells, _}) => { 83 | switch (cells |> furl_block'(Environment.empty) |> List.rev) { 84 | | [] => Unknown([]) 85 | | [{expression: {form, _}, _}] => form 86 | | [{expression: {form, _}, _}, ...xs] => 87 | Let(xs |> List.map(cell_to_binding) |> List.rev, form) 88 | }; 89 | }; 90 | -------------------------------------------------------------------------------- /src/core/Interpreter.re: -------------------------------------------------------------------------------- 1 | type env = Environment.t_(option(Expression.lit)); 2 | 3 | let rec factorial = x => 4 | if (x <= 2) { 5 | x; 6 | } else { 7 | x * factorial(x - 1); 8 | }; 9 | 10 | let eval_atom: (Expression.atom, env) => option(Expression.lit) = 11 | (form, env) => { 12 | switch (form) { 13 | | Lit(n) => Some(n) 14 | | Var(v, _) => 15 | switch (Environment.lookup(env, v)) { 16 | | None => None 17 | | Some(n) => n 18 | } 19 | | _ => None 20 | }; 21 | }; 22 | 23 | [@deriving sexp] 24 | type ty = 25 | | Bool 26 | | Int 27 | | Float 28 | | UnknownType; 29 | 30 | let ty_of_lit: Expression.lit => ty = 31 | fun 32 | | BoolLit(_) => Bool 33 | | IntLit(_) => Int 34 | | FloatLit(_) => Float 35 | | Indet(_) => UnknownType; 36 | 37 | let all_types_are = (ty: ty, xs: list(Expression.lit)) => 38 | List.for_all(lit => lit |> ty_of_lit |> (==)(ty), xs); 39 | 40 | let rec adjacent_pairs: list('a) => list(('a, 'a)) = 41 | fun 42 | | [] 43 | | [_] => [] 44 | | [a, b, ...cs] => [(a, b)] @ adjacent_pairs([b, ...cs]); 45 | 46 | let rec bin_op_int_float = 47 | ( 48 | int_op, 49 | float_op, 50 | a: option(Expression.lit), 51 | b: option(Expression.lit), 52 | ) => { 53 | switch (a, b) { 54 | | (Some(IntLit(i1)), Some(IntLit(i2))) => Some(int_op(i1, i2)) 55 | | (Some(FloatLit(f1)), Some(FloatLit(f2))) => Some(float_op(f1, f2)) 56 | /*| (Some(IntLit(i)), Some(FloatLit(f))) when Float.is_integer(f) => 57 | Some(int_op(i, Int.of_float(f)))*/ 58 | | (Some(IntLit(i)), Some(FloatLit(f))) => 59 | Some(float_op(Float.of_int(i), f)) 60 | | (Some(FloatLit(f)), Some(IntLit(i))) => 61 | Some(float_op(f, Float.of_int(i))) 62 | | _ => None 63 | }; 64 | } 65 | and fold_bin_op_int_float = (int_op, float_op, int_id: Expression.lit, xs) => { 66 | List.fold_left(bin_op_int_float(int_op, float_op), Some(int_id), xs); 67 | } 68 | and all = (xs: list(option(Expression.lit))) => 69 | List.fold_left( 70 | (acc: option(Expression.lit), x: option(Expression.lit)) => 71 | switch (acc, x) { 72 | | (Some(BoolLit(true)), Some(BoolLit(true))) => 73 | Some(BoolLit(true)) 74 | | _ => Some(BoolLit(false)) 75 | }, 76 | Some(BoolLit(true)), 77 | xs, 78 | ) 79 | and eval_expression: (env, Expression.t) => option(Expression.lit) = 80 | (env, form) => { 81 | switch (form) { 82 | | Unknown(_) => None 83 | | Atom(a) => eval_atom(a, env) 84 | | App(Not, xs) => 85 | switch (xs) { 86 | | [x] => 87 | switch (eval_expression(env, x)) { 88 | | Some(BoolLit(b)) => Some(BoolLit(!b)) 89 | | _ => None 90 | } 91 | | _ => None 92 | } 93 | | App(Fact, xs) => 94 | switch (xs) { 95 | | [x] => 96 | switch (eval_expression(env, x)) { 97 | | Some(IntLit(n)) => Some(IntLit(factorial(n))) 98 | | _ => None 99 | } 100 | | _ => None 101 | } 102 | | App(Add, xs) 103 | | Seq(Add, xs) => 104 | xs 105 | |> eval_all(env) 106 | |> fold_bin_op_int_float( 107 | (n, m) => IntLit(n + m), 108 | (n, m) => FloatLit(n +. m), 109 | IntLit(0), 110 | ) 111 | | App(Mult, xs) 112 | | Seq(Mult, xs) => 113 | xs 114 | |> eval_all(env) 115 | |> fold_bin_op_int_float( 116 | (n, m) => IntLit(n * m), 117 | (n, m) => FloatLit(n *. m), 118 | IntLit(1), 119 | ) 120 | 121 | // TODO: below ops should be short-circuiting 122 | | Seq(And, xs) 123 | | App(And, xs) => xs |> eval_all(env) |> bin_op_bool((&&), true) 124 | | Seq(Or, xs) 125 | | App(Or, xs) => xs |> eval_all(env) |> bin_op_bool((||), false) 126 | | Seq(Equal, xs) 127 | | App(Equal, xs) => 128 | xs 129 | |> eval_all(env) 130 | |> adjacent_pairs 131 | |> List.map(((a, b)) => Some(Expression.BoolLit(a == b))) 132 | |> all 133 | | Seq((MoreThan | LessThan) as op, xs) 134 | | App((MoreThan | LessThan) as op, xs) => 135 | let (op_int, op_float) = 136 | switch (op) { 137 | | MoreThan => 138 | let op = (n, m) => Expression.BoolLit(n > m); 139 | (op, op); 140 | | LessThan => 141 | let op = (n, m) => Expression.BoolLit(n < m); 142 | (op, op); 143 | | _ => failwith("eval_expression impossible") 144 | }; 145 | xs 146 | |> eval_all(env) 147 | |> adjacent_pairs 148 | |> List.map(((a, b)) => bin_op_int_float(op_int, op_float, a, b)) 149 | |> all; 150 | | Seq(Not | Fact, _) 151 | | Let(_) => None 152 | }; 153 | } 154 | and bin_op_bool = (bool_op, bool_id, xs) => { 155 | List.fold_left( 156 | (acc: option(Expression.lit), v: option(Expression.lit)) => 157 | switch (acc, v) { 158 | | (Some(BoolLit(n)), Some(BoolLit(m))) => 159 | Some(BoolLit(bool_op(n, m))) 160 | | _ => None 161 | }, 162 | Some(BoolLit(bool_id)), 163 | xs, 164 | ); 165 | } 166 | 167 | and eval_all: (env, list(Expression.t)) => list(option(Expression.lit)) = 168 | (env, xs) => xs |> List.map(eval_expression(env)) 169 | and eval_all_opt: (env, list(Expression.t)) => option(list(Expression.lit)) = 170 | (env, xs) => xs |> eval_all(env) |> Util.OptUtil.sequence; 171 | 172 | let run_block: Block.t => Block.t = 173 | block => 174 | List.fold_left( 175 | ( 176 | (block_acc: Block.t, env_acc: env), 177 | {pattern, expression, uid, _}: AnnotatedBlock.annotated_cell, 178 | ) => { 179 | let parsed_exp = expression.form; 180 | let result = eval_expression(env_acc, parsed_exp); 181 | // TODO: clean up this mess (pattern especially) 182 | let pattern = 183 | List.map( 184 | ({word, _}: AnnotatedBlock.annotated_word_pat) => word, 185 | pattern.words, 186 | ); 187 | let new_env = 188 | switch (Pattern.parse([], pattern)) { 189 | | Atom(Var(name, _)) => 190 | Environment.extend(env_acc, (name, result)) 191 | | _ => env_acc 192 | }; 193 | let value = 194 | switch (result) { 195 | | None => [Word.mk_name("?")] 196 | | Some(lit) => [Word.mk_name(Expression.string_of_lit(lit))] 197 | }; 198 | let expression = 199 | List.map( 200 | ({word, _}: AnnotatedBlock.annotated_word_exp) => word, 201 | expression.words, 202 | ); 203 | let new_block = block_acc @ [{pattern, expression, value, uid}]; 204 | (new_block, new_env); 205 | }, 206 | ([], Environment.empty), 207 | AnnotatedBlock.mk(block).cells, 208 | ) 209 | |> fst; 210 | -------------------------------------------------------------------------------- /src/core/Lens.re: -------------------------------------------------------------------------------- 1 | let lcell = (idx, b: Block.t) => List.nth(b, idx); 2 | let lexp = (f: Cell.t) => f.expression; 3 | let lpat = (f: Cell.t) => f.pattern; 4 | let lval = (f: Cell.t) => f.value; 5 | let lword = (idx, b) => List.nth(b, idx); 6 | let word_name = ({name, _}: Word.t) => name; 7 | 8 | let first_exp_len = w => w |> lcell(0) |> lexp |> List.length; 9 | let first_word_len = w => 10 | w |> lcell(0) |> lexp |> lword(0) |> word_name |> String.length; 11 | -------------------------------------------------------------------------------- /src/core/Name.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | 3 | [@deriving sexp] 4 | type t = string; 5 | [@deriving sexp] 6 | type s = list(t); 7 | 8 | let empty: t = ""; //"🕳️"; 9 | 10 | let var_regex = 11 | Re.Str.regexp("^\\([a-zA-Z]\\|_[_a-zA-Z0-9]\\)[_a-zA-Z0-9']*$"); 12 | 13 | let is_valid_var = s => Re.Str.string_match(var_regex, s, 0); 14 | 15 | let running_index = ref(0); 16 | 17 | let running_names = [ 18 | "bro", 19 | "greeze", 20 | "cloun", 21 | "foob", 22 | "pruby", 23 | "bez", 24 | "klork", 25 | "crunk", 26 | "dree", 27 | "bap", 28 | "gurb", 29 | "weeb", 30 | "shrork", 31 | ]; 32 | let emoji_names = [ 33 | "📎", 34 | "🌽", 35 | "💭", 36 | "🌘", 37 | "🍸", 38 | "🎈", 39 | "🍋", 40 | "🐠", 41 | "🖍", 42 | "🤘", 43 | "🍮", 44 | "👌", 45 | "🌈", 46 | "🐿", 47 | ]; 48 | 49 | // idea: when emoji-names are selected, 50 | // make uses/bindings animated, slowly growing and shrinking 51 | 52 | //TODO: better approach 53 | let emoji_of_default: string => string = 54 | fun 55 | | "bro" => "📎" 56 | | "greeze" => "🌽" 57 | | "cloun" => "💭" 58 | | "foob" => "🌘" 59 | | "pruby" => "🍸" 60 | | "bez" => "🎈" 61 | | "klork" => "🐠" 62 | | "crunk" => "🍋" 63 | | "dree" => "🖍" 64 | | "bap" => "🤘" 65 | | "gurb" => "🌈" 66 | | "weeb" => "🐿" 67 | | "shork" => "🦈" 68 | | "sum" => "sum" 69 | | "prod" => "prod" 70 | | "fact" => "fact" 71 | | _ => "🤔"; 72 | 73 | let mk = (): string => { 74 | let i = running_index^; 75 | running_index := running_index^ + 1; 76 | List.nth(running_names, i mod List.length(running_names)); 77 | }; 78 | -------------------------------------------------------------------------------- /src/core/Path.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | 3 | [@deriving sexp] 4 | type index = 5 | | Index(int, int); 6 | 7 | [@deriving sexp] 8 | type path_frame = 9 | | Cell(index) 10 | | Field(Cell.field) 11 | | Word(index) 12 | | Char(index); 13 | 14 | [@deriving sexp] 15 | type t = list(path_frame); 16 | 17 | [@deriving sexp] 18 | type ctx = Environment.t_(t); 19 | 20 | let is_to_cell: t => bool = 21 | path => 22 | switch (path) { 23 | | [Cell(_)] => true 24 | | _ => false 25 | }; 26 | 27 | let cell_idx = (path: t): option(Block.cell_id) => 28 | switch (path) { 29 | | [Cell(Index(i, _)), ..._] => Some(i) 30 | | _ => None 31 | }; 32 | 33 | let is_cell_idx = (p, path: t) => 34 | switch (path) { 35 | | [Cell(Index(i, _)), ..._] => p(i) 36 | | _ => false 37 | }; 38 | 39 | let update_cell_idx = (f, path: t): t => 40 | switch (path) { 41 | | [Cell(Index(i, k)), ...ps] => [Cell(Index(f(i), k)), ...ps] 42 | | _ => path 43 | }; 44 | 45 | let rec is_valid: (Block.t, t) => bool = 46 | (block, path) => 47 | switch (path) { 48 | | [Cell(Index(current, total)), ...ps] => 49 | List.length(block) == total 50 | && current < total 51 | && is_valid_path_cell(Block.nth_cell(block, current), ps) 52 | | _ => 53 | print_endline("path invalid: block"); 54 | false; 55 | } 56 | and is_valid_path_cell: (Cell.t, t) => bool = 57 | (cell, path) => 58 | switch (path) { 59 | | [Field(Pattern), ...ps] => is_valid_path_word(cell.pattern, ps) 60 | | [Field(Expression), ...ps] => is_valid_path_word(cell.expression, ps) 61 | | [Field(Value), ...ps] => is_valid_path_word(cell.value, ps) 62 | | _ => 63 | print_endline("path invalid: cell"); 64 | false; 65 | } 66 | and is_valid_path_word: (Word.s, t) => bool = 67 | (words, path) => 68 | switch (path) { 69 | | [Word(Index(current, total)), ...ps] => 70 | List.length(words) == total 71 | && current < total 72 | && is_valid_path_char(Cell.nth_word(words, current), ps) 73 | | _ => 74 | print_endline("path invalid: word"); 75 | false; 76 | } 77 | and is_valid_path_char: (Word.t, t) => bool = 78 | ({name, _}, path) => 79 | switch (path) { 80 | | [Char(Index(current, total))] => 81 | String.length(name) == total && current < total 82 | | _ => 83 | print_endline("path invalid: char"); 84 | false; 85 | }; 86 | 87 | let get_cell: (t, Block.t) => option(Cell.t) = 88 | (path, block) => 89 | switch (path) { 90 | | [Cell(Index(idx, _)), ..._] => Some(Block.nth_cell(block, idx)) 91 | | _ => None 92 | }; 93 | 94 | let get_word: (t, Block.t) => option(Word.t) = 95 | (path, block) => 96 | switch (path) { 97 | | [ 98 | Cell(Index(cell_idx, _)), 99 | Field(field), 100 | Word(Index(word_idx, _)), 101 | ..._, 102 | ] => 103 | Block.get_word(cell_idx, field, word_idx, block) 104 | | _ => None 105 | }; 106 | 107 | let get_words: (t, Block.t) => option(Word.s) = 108 | (path, block) => 109 | switch (path) { 110 | | [Cell(Index(cell_idx, _)), Field(field), ..._] => 111 | Some(Block.get_words(cell_idx, field, block)) //TODO: opt check 112 | | _ => None 113 | }; 114 | 115 | let get_num_words = (field_path, block) => 116 | switch (get_words(field_path, block)) { 117 | | Some(words) => List.length(words) 118 | | None => 0 119 | }; 120 | 121 | let prev_word_path = (block: Cell.s, path: t): t => 122 | switch (path) { 123 | | [c, f, Word(Index(n, k)), ...ps] when n >= 1 => [ 124 | c, 125 | f, 126 | Word(Index(n - 1, k)), 127 | ...ps, 128 | ] 129 | | [c, Field(Expression), Word(Index(0, _)), ...ps] => 130 | let pat_path = [c, Field(Pattern)]; 131 | let length = get_num_words(pat_path, block); 132 | [c, Field(Pattern), Word(Index(length - 1, length)), ...ps]; 133 | /* 134 | | [Cell(Index(i, k)), Field(Pattern), Word(Index(0, _)), ..._] 135 | when i > 0 => [ 136 | Cell(Index(i - 1, k)), 137 | ] 138 | | [Cell(Index(i, k))] => 139 | let new_path = [Cell(Index(i, k)), Field(Expression)]; 140 | let length = get_num_words(new_path, block); 141 | new_path @ [Word(Index(length - 1, length))]; 142 | */ 143 | | [Cell(Index(i, k)), Field(Pattern), Word(Index(0, _)), ...ps] 144 | when i != 0 => 145 | let prev_exp_path = [Cell(Index(i - 1, k)), Field(Expression)]; 146 | let length = get_num_words(prev_exp_path, block); 147 | [ 148 | Cell(Index(i - 1, k)), 149 | Field(Expression), 150 | Word(Index(length - 1, length)), 151 | ...ps, 152 | ]; 153 | | _ => path 154 | }; 155 | 156 | let next_word_path = (block: Cell.s, path: t): t => 157 | switch (path) { 158 | | [c, f, Word(Index(n, k)), ...ps] when n + 1 < k => [ 159 | c, 160 | f, 161 | Word(Index(n + 1, k)), 162 | ...ps, 163 | ] 164 | | [c, Field(Pattern), Word(Index(_n, _k)), ...ps] => 165 | let exp_path = [c, Field(Expression)]; 166 | let length = get_num_words(exp_path, block); 167 | [c, Field(Expression), Word(Index(0, length)), ...ps]; 168 | /* 169 | | [Cell(Index(i, k)), Field(Expression), Word(Index(wn, wk)), ..._] 170 | when i + 1 < k && wn + 1 == wk => [ 171 | Cell(Index(i + 1, k)), 172 | ] 173 | | [Cell(Index(i, k))] => 174 | let new_path = [Cell(Index(i, k)), Field(Pattern)]; 175 | let length = get_num_words(new_path, block); 176 | new_path @ [Word(Index(0, length))]; 177 | */ 178 | | [Cell(Index(i, k)), Field(Expression), Word(Index(_n, _k)), ...ps] 179 | when i + 1 < k => 180 | let next_pat_path = [Cell(Index(i + 1, k)), Field(Pattern)]; 181 | let length = get_num_words(next_pat_path, block); 182 | [ 183 | Cell(Index(i + 1, k)), 184 | Field(Pattern), 185 | Word(Index(0, length)), 186 | ...ps, 187 | ]; 188 | | _ => path 189 | }; 190 | 191 | let up_path = (block: Cell.s, path: t): t => 192 | switch (path) { 193 | | [Cell(Index(n, k))] when n != 0 => [Cell(Index(n - 1, k))] 194 | | [Cell(Index(i, k)), f, Word(Index(n, _k)), ...ps] when i != 0 => 195 | let up_f_path = [Cell(Index(i - 1, k)), f]; 196 | let length = get_num_words(up_f_path, block); 197 | let new_n = n > length - 1 ? length - 1 : n; 198 | [Cell(Index(i - 1, k)), f, Word(Index(new_n, length)), ...ps]; 199 | | _ => path 200 | }; 201 | 202 | let down_path = (block: Cell.s, path: t): t => 203 | switch (path) { 204 | | [Cell(Index(n, k))] when n + 1 < k => [Cell(Index(n + 1, k))] 205 | | [Cell(Index(i, k)), f, Word(Index(n, _k)), ...ps] when i + 1 < k => 206 | let down_f_path = [Cell(Index(i + 1, k)), f]; 207 | let length = get_num_words(down_f_path, block); 208 | let new_n = n > length - 1 ? length - 1 : n; 209 | [Cell(Index(i + 1, k)), f, Word(Index(new_n, length)), ...ps]; 210 | | _ => path 211 | }; 212 | 213 | let prev_word = (block: Cell.s, path: t): option(Word.t) => 214 | get_word(prev_word_path(block, path), block); 215 | 216 | let next_word = (block: Cell.s, path: t): option(Word.t) => 217 | get_word(next_word_path(block, path), block); 218 | 219 | let is_a_next_word = (block, path: t) => 220 | switch (next_word(block, path)) { 221 | | Some(_) => true 222 | | _ => false 223 | }; 224 | 225 | let is_word_p = (p, block, path: t) => 226 | switch (get_word(path, block)) { 227 | | Some(op) when p(op) => true 228 | | _ => false 229 | }; 230 | 231 | let is_next_word_p = (p, block, path: t) => 232 | switch (next_word(block, path)) { 233 | | Some(op) when p(op) => true 234 | | _ => false 235 | }; 236 | 237 | let is_prev_word_p = (p, block, path: t) => 238 | switch (prev_word(block, path)) { 239 | | Some(op) when p(op) => true 240 | | _ => false 241 | }; 242 | 243 | let decr_word = (path: t): t => 244 | switch (path) { 245 | | [c, _, Word(Index(0, _)), ..._] => [c] 246 | | [c, f, Word(Index(n, k)), ...ps] => [ 247 | c, 248 | f, 249 | Word(Index(n - 1, k)), 250 | ...ps, 251 | ] 252 | | _ => path 253 | }; 254 | 255 | let delete: (t, Block.t) => Block.t = 256 | (path, block) => { 257 | switch (path) { 258 | | [ 259 | Cell(Index(cell_idx, _)), 260 | Field(Expression), 261 | Word(Index(word_idx, _)), 262 | ..._, 263 | ] => 264 | Block.update_expression( 265 | block, 266 | cell_idx, 267 | Util.ListUtil.remove(word_idx), 268 | ) 269 | | [Cell(Index(cell_idx, _))] => Util.ListUtil.remove(cell_idx, block) 270 | | _ => block 271 | }; 272 | }; 273 | 274 | let update_word: (Name.t => Name.t, t, Block.t) => Block.t = 275 | (f, path, block) => 276 | switch (path) { 277 | | [ 278 | Cell(Index(cell_idx, _)), 279 | Field(Expression), 280 | Word(Index(word_idx, _)), 281 | ..._, 282 | ] => 283 | Block.update_expression(block, cell_idx, Cell.update_word(f, word_idx)) 284 | | _ => block 285 | }; 286 | 287 | let insert_word: (Word.t, t, int, Block.t) => Block.t = 288 | (word, path, sep_idx, block) => 289 | switch (path) { 290 | | [Cell(Index(cell_idx, _)), Field(Expression), ..._] => 291 | Block.update_expression( 292 | block, 293 | cell_idx, 294 | Util.ListUtil.insert_at(sep_idx, word), 295 | ) 296 | | _ => block 297 | }; 298 | 299 | let insert_cell: (int, Cell.t, Block.t) => Block.t = Util.ListUtil.insert_at; 300 | 301 | /* FOCUSING 302 | these functions are used to focus down a subpath for a specific cell or word or whatever 303 | */ 304 | 305 | let focus_word = (path: t, word_idx: Cell.word_idx): option(t) => 306 | switch (path) { 307 | | [Word(Index(idx, _)), ...subpath] => 308 | word_idx == idx ? Some(subpath) : None 309 | | _ => None 310 | }; 311 | 312 | let focus_cell = (path: t, cell_idx: Block.cell_id): option(t) => 313 | switch (path) { 314 | | [Cell(Index(idx, _)), ...subpath] => 315 | cell_idx == idx ? Some(subpath) : None 316 | | _ => None 317 | }; 318 | 319 | let is_word_sep_touching_empty = (exp_path, sep_idx, block) => { 320 | let prev_path = exp_path @ [Word(Index(sep_idx - 1, 666))]; 321 | let next_path = exp_path @ [Word(Index(sep_idx, 666))]; 322 | ( 323 | try(is_word_p(Word.is_empty, block, prev_path)) { 324 | | _ => false 325 | } 326 | ) 327 | || ( 328 | try(is_word_p(Word.is_empty, block, next_path)) { 329 | | _ => false 330 | } 331 | ); 332 | }; 333 | -------------------------------------------------------------------------------- /src/core/Pattern.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | 3 | [@deriving sexp] 4 | type atom = 5 | | Lit(int) 6 | | Var(string, list(Path.t)) 7 | | Formless(string); 8 | 9 | [@deriving sexp] 10 | type t = 11 | | Atom(atom) 12 | //| Cons(name, list(atom)) 13 | | Unknown(Word.s); 14 | 15 | [@deriving sexp] 16 | type uses_ctx = Environment.t_(list(Path.t)); 17 | 18 | let parse_atom: (uses_ctx, Word.t) => atom = 19 | (uses_map, {name, _}) => 20 | switch ( 21 | int_of_string_opt(name), 22 | Name.is_valid_var(name), //TODO: this will choke on emojis 23 | Environment.lookup(uses_map, name), 24 | ) { 25 | | (Some(n), _, _) => Lit(n) 26 | | (_, true, Some(uses)) => Var(name, uses) 27 | | (_, true, None) => Var(name, []) 28 | | _ => Formless(name) 29 | }; 30 | 31 | let parse: (uses_ctx, Word.s) => t = 32 | (ctx, words) => { 33 | switch (words) { 34 | | [x] => Atom(parse_atom(ctx, x)) 35 | | _ => Unknown(words) 36 | }; 37 | }; 38 | 39 | // idea: track variables that are used below but are unbound to suggest in pattern 40 | -------------------------------------------------------------------------------- /src/core/UID.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | 3 | [@deriving sexp] 4 | type t = int; 5 | let cell_uid_gen: ref(t) = ref(0); 6 | let ids: ref(list(t)) = ref([]); 7 | 8 | let mk = (): t => { 9 | let uid = cell_uid_gen^; 10 | cell_uid_gen := cell_uid_gen^ + 1; 11 | ids := [uid, ...ids^]; 12 | uid; 13 | }; 14 | -------------------------------------------------------------------------------- /src/core/Value.re: -------------------------------------------------------------------------------- 1 | [@deriving sexp] 2 | type atom = 3 | | Lit(Expression.lit) 4 | | Unknown(Word.t); 5 | 6 | [@deriving sexp] 7 | type t = 8 | | Atom(atom) 9 | | Unknown(Word.s); 10 | 11 | let parse_atom: Word.t => atom = 12 | w => 13 | switch (Expression.parse_lit(w.name)) { 14 | | Some(n) => Lit(n) 15 | | None => Unknown(w) 16 | }; 17 | 18 | let parse: Word.s => t = 19 | fun 20 | | [w] => Atom(parse_atom(w)) 21 | | ws => Unknown(ws); 22 | -------------------------------------------------------------------------------- /src/core/Word.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | 3 | [@deriving sexp] 4 | type t = { 5 | uid: UID.t, 6 | name: Name.t, 7 | }; 8 | 9 | [@deriving sexp] 10 | type s = list(t); 11 | 12 | let ids: ref(list(UID.t)) = ref([]); 13 | 14 | let is_empty: t => bool = ({name, _}) => name == Name.empty; 15 | 16 | let mk_name = (name: Name.t) => { 17 | let uid = UID.mk(); 18 | ids := [uid, ...ids^]; 19 | {uid, name}; 20 | }; 21 | 22 | let mk_empty = () => mk_name(Name.empty); 23 | 24 | let mk = () => mk_name(Name.mk()); 25 | 26 | let mapn = (f: Name.t => Name.t, {name, _} as w: t) => { 27 | ...w, 28 | name: f(name), 29 | }; 30 | -------------------------------------------------------------------------------- /src/core/World.re: -------------------------------------------------------------------------------- 1 | type t = Block.t; 2 | 3 | let init': list((Name.s, Name.s)) = [ 4 | (["bro"], ["sum", "77", "5", "123"]), 5 | (["greeze"], ["fact", "5"]), 6 | (["cloun"], ["prod", "bro", "greeze"]), 7 | (["foob"], ["112", "+", "813", "+", "bro"]), 8 | ]; 9 | 10 | let mk: list((Name.s, Name.s)) => t = List.map(Cell.init_full); 11 | 12 | let init: t = init' |> mk |> Interpreter.run_block; 13 | -------------------------------------------------------------------------------- /src/core/dune: -------------------------------------------------------------------------------- 1 | (include_subdirs unqualified) 2 | 3 | (library 4 | (name core) 5 | (libraries sexplib util) 6 | (js_of_ocaml 7 | (flags 8 | (:include js-of-ocaml-flags-%{profile}))) 9 | (preprocess 10 | (pps ppx_let ppx_sexp_conv))) 11 | 12 | (rule 13 | (write-file js-of-ocaml-flags-dev "(:standard --debuginfo --noinline)")) 14 | 15 | (rule 16 | (write-file js-of-ocaml-flags-release "(:standard)")) 17 | -------------------------------------------------------------------------------- /src/util/Either.re: -------------------------------------------------------------------------------- 1 | [@deriving sexp] 2 | type t('l, 'r) = 3 | | L('l) 4 | | R('r); 5 | 6 | let l = x => L(x); 7 | let r = x => R(x); 8 | 9 | let is_L = 10 | fun 11 | | L(_) => true 12 | | R(_) => false; 13 | let is_R = e => !is_L(e); 14 | 15 | let get_L = 16 | fun 17 | | L(l) => Some(l) 18 | | R(_) => None; 19 | let get_R = 20 | fun 21 | | R(r) => Some(r) 22 | | L(_) => None; 23 | -------------------------------------------------------------------------------- /src/util/IntMap.re: -------------------------------------------------------------------------------- 1 | include Map.Make(Int); 2 | -------------------------------------------------------------------------------- /src/util/ListUtil.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | 3 | let rec range = (~lo=0, hi) => 4 | if (lo > hi) { 5 | raise(Invalid_argument("ListUtil.range")); 6 | } else if (lo == hi) { 7 | []; 8 | } else { 9 | [lo, ...range(~lo=lo + 1, hi)]; 10 | }; 11 | 12 | // heads of prefix and suffix neighbor the subject 13 | [@deriving sexp] 14 | type frame('x) = (list('x), list('x)); 15 | 16 | let rec mk_frame = (n: int, xs: list('x)): frame('x) => { 17 | let invalid_arg = () => raise(Invalid_argument("ListUtil.mk_frame")); 18 | if (n < 0) { 19 | invalid_arg(); 20 | } else if (n == 0) { 21 | ([], xs); 22 | } else { 23 | switch (xs) { 24 | | [] => invalid_arg() 25 | | [x, ...xs] => 26 | let (prefix, suffix) = mk_frame(n - 1, xs); 27 | (prefix @ [x], suffix); 28 | }; 29 | }; 30 | }; 31 | 32 | let rec split_frame = (n: int, xs: list('x)): ('x, frame('x)) => 33 | switch (n, xs) { 34 | | (_, []) => failwith("list index out of bounds") 35 | | (0, [x, ...xs]) => (x, ([], xs)) 36 | | (_, [x, ...xs]) => 37 | let (subj, (prefix, suffix)) = split_frame(n - 1, xs); 38 | (subj, (prefix @ [x], suffix)); 39 | }; 40 | 41 | let of_frame = (~subject: list('x)=[], (prefix, suffix): frame('x)) => 42 | List.concat([List.rev(prefix), subject, suffix]); 43 | 44 | let combine_opt = (xs, ys) => 45 | switch (List.combine(xs, ys)) { 46 | | exception (Invalid_argument(_)) => None 47 | | xys => Some(xys) 48 | }; 49 | 50 | let is_empty = 51 | fun 52 | | [] => true 53 | | _ => false; 54 | 55 | let flat_map = (f, l) => List.flatten(List.map(f, l)); 56 | 57 | let rec join = (sep: 'x, xs: list('x)): list('x) => 58 | switch (xs) { 59 | | [] => [] 60 | | [x] => [x] 61 | | [x, ...xs] => [x, sep, ...join(sep, xs)] 62 | }; 63 | 64 | let hd_opt = 65 | fun 66 | | [] => None 67 | | [hd, ..._] => Some(hd); 68 | 69 | let rec nth_opt = (n, xs) => 70 | n < 0 71 | ? None 72 | : ( 73 | switch (xs) { 74 | | [] => None 75 | | [hd, ...tl] => n == 0 ? Some(hd) : nth_opt(n - 1, tl) 76 | } 77 | ); 78 | 79 | /** 80 | * `split_n_opt(n, xs)` splits the first `n` elements from `xs` 81 | * if `xs` has `n` or more elements 82 | */ 83 | let split_n_opt = (n: int, xs: list('x)): option((list('x), list('x))) => { 84 | let rec go = (n: int, xs: list('x)) => 85 | if (n < 0) { 86 | None; 87 | } else if (n == 0) { 88 | Some(([], xs)); 89 | } else { 90 | switch (xs) { 91 | | [] => None 92 | | [x, ...xs] => 93 | go(n - 1, xs) 94 | |> Option.map(((prefix, suffix)) => ([x, ...prefix], suffix)) 95 | }; 96 | }; 97 | go(n, xs); 98 | }; 99 | 100 | let split_n = (n: int, xs: list('x)): (list('x), list('x)) => 101 | switch (split_n_opt(n, xs)) { 102 | | None => 103 | raise(Invalid_argument("ListUtil.split_n: " ++ string_of_int(n))) 104 | | Some(r) => r 105 | }; 106 | 107 | /** 108 | * Returns sublist from index i (inclusive) 109 | * to index j (exclusive), coupled with the 110 | * surrounding prefix/suffix sublists. 111 | * Returns None if i > j. 112 | */ 113 | let split_sublist_opt = 114 | (i: int, j: int, xs: list('x)) 115 | : option((list('x), list('x), list('x))) => { 116 | switch (split_n_opt(j, xs)) { 117 | | None => None 118 | | Some((left, right)) => 119 | switch (split_n_opt(i, left)) { 120 | | None => None 121 | | Some((left, mid)) => Some((left, mid, right)) 122 | } 123 | }; 124 | }; 125 | let split_sublist = 126 | (i: int, j: int, xs: list('x)): (list('x), list('x), list('x)) => 127 | switch (split_sublist_opt(i, j, xs)) { 128 | | None => raise(Invalid_argument("ListUtil.split_sublist")) 129 | | Some(r) => r 130 | }; 131 | let sublist = ((i, j), xs: list('x)): list('x) => { 132 | let (_, sublist, _) = split_sublist(i, j, xs); 133 | sublist; 134 | }; 135 | 136 | let rec split_nth_opt = (n, xs) => 137 | switch (n, xs) { 138 | | _ when n < 0 => None 139 | | (_, []) => None 140 | | (0, [x, ...suffix]) => Some(([], x, suffix)) 141 | | (_, [x, ...xs]) => 142 | split_nth_opt(n - 1, xs) 143 | |> Option.map(((prefix, subject, suffix)) => 144 | ([x, ...prefix], subject, suffix) 145 | ) 146 | }; 147 | let split_nth = (n, xs) => 148 | switch (split_nth_opt(n, xs)) { 149 | | None => 150 | raise(Invalid_argument("ListUtil.split_nth: " ++ string_of_int(n))) 151 | | Some(r) => r 152 | }; 153 | 154 | let rec put_nth = (n: int, x: 'x, xs: list('x)): list('x) => 155 | switch (n, xs) { 156 | | (_, []) => failwith("out of bounds") 157 | | (0, [_, ...tl]) => [x, ...tl] 158 | | (_, [hd, ...tl]) => 159 | let tl = put_nth(n - 1, x, tl); 160 | [hd, ...tl]; 161 | }; 162 | 163 | let rec split_last_opt = (xs: list('x)): option((list('x), 'x)) => 164 | switch (xs) { 165 | | [] => None 166 | | [x] => Some(([], x)) 167 | | [x, ...xs] => 168 | split_last_opt(xs) 169 | |> Option.map(((leading, last)) => ([x, ...leading], last)) 170 | }; 171 | let last_opt = xs => xs |> split_last_opt |> Option.map(snd); 172 | 173 | let split_last = (xs: list('x)): (list('x), 'x) => 174 | switch (split_last_opt(xs)) { 175 | | None => raise(Invalid_argument("ListUtil.split_last")) 176 | | Some(r) => r 177 | }; 178 | let leading = xs => fst(split_last(xs)); 179 | 180 | let split_first = (xs: list('x)): ('x, list('x)) => 181 | switch (xs) { 182 | | [] => raise(Invalid_argument("ListUtil.split_first")) 183 | | [first, ...trailing] => (first, trailing) 184 | }; 185 | 186 | let rec fold_left_map = 187 | (f: ('acc, 'x) => ('acc, 'y), start: 'acc, xs: list('x)) 188 | : ('acc, list('y)) => 189 | switch (xs) { 190 | | [] => (start, []) 191 | | [x, ...xs] => 192 | let (new_acc, y) = f(start, x); 193 | let (final, ys) = fold_left_map(f, new_acc, xs); 194 | (final, [y, ...ys]); 195 | }; 196 | 197 | let rec take_while = (p: 'x => bool, xs: list('x)): (list('x), list('x)) => 198 | switch (xs) { 199 | | [] => ([], []) 200 | | [hd, ...tl] => 201 | if (p(hd)) { 202 | let (taken, rest) = take_while(p, tl); 203 | ([hd, ...taken], rest); 204 | } else { 205 | ([], xs); 206 | } 207 | }; 208 | 209 | let take_2 = 210 | fun 211 | | [x1, x2, ..._] => (x1, x2) 212 | | _ => raise(Invalid_argument("ListUtil.take_2")); 213 | let take_3 = 214 | fun 215 | | [x1, x2, x3, ..._] => (x1, x2, x3) 216 | | _ => raise(Invalid_argument("ListUtil.take_3")); 217 | let take_4 = 218 | fun 219 | | [x1, x2, x3, x4, ..._] => (x1, x2, x3, x4) 220 | | _ => raise(Invalid_argument("ListUtil.take_4")); 221 | let take_5 = 222 | fun 223 | | [x1, x2, x3, x4, x5, ..._] => (x1, x2, x3, x4, x5) 224 | | _ => raise(Invalid_argument("ListUtil.take_5")); 225 | 226 | // new: 227 | 228 | let rec intersperse: ('a, list('a)) => list('a) = 229 | (sep, ls) => 230 | switch (ls) { 231 | | [] 232 | | [_] => ls 233 | | [hd, ...tl] => [hd] @ [sep] @ intersperse(sep, tl) 234 | }; 235 | 236 | let rec interleave: (list('a), list('a)) => list('a) = 237 | (xs, ys) => 238 | switch (xs) { 239 | | [] => ys 240 | | [x, ...xs] => [x, ...interleave(ys, xs)] 241 | }; 242 | 243 | let swap: (int, int, list('a)) => list('a) = 244 | (u, v, xs) => { 245 | let e_u = List.nth(xs, u); 246 | let e_v = List.nth(xs, v); 247 | List.mapi((i, x) => i == u ? e_v : i == v ? e_u : x, xs); 248 | }; 249 | 250 | let insert_at: (int, 'a, list('a)) => list('a) = 251 | (i, n, xs) => 252 | if (i == List.length(xs)) { 253 | xs @ [n]; 254 | } else { 255 | List.fold_left2( 256 | (acc, x, idx) => {acc @ (i == idx ? [n, x] : [x])}, 257 | [], 258 | xs, 259 | List.init(List.length(xs), x => x), 260 | ); 261 | }; 262 | 263 | let remove: (int, list('a)) => list('a) = 264 | (i, xs) => 265 | List.fold_left2( 266 | (acc, x, idx) => {acc @ (i == idx ? [] : [x])}, 267 | [], 268 | xs, 269 | List.init(List.length(xs), x => x), 270 | ); 271 | -------------------------------------------------------------------------------- /src/util/OptUtil.re: -------------------------------------------------------------------------------- 1 | let get = (if_none, o) => 2 | switch (o) { 3 | | None => if_none() 4 | | Some(a) => a 5 | }; 6 | let get_or_fail = s => get(() => failwith(s)); 7 | let get_or_raise = e => get(() => raise(e)); 8 | 9 | let map2 = (f, o1, o2) => 10 | switch (o1, o2) { 11 | | (None, _) 12 | | (_, None) => None 13 | | (Some(v1), Some(v2)) => Some(f(v1, v2)) 14 | }; 15 | 16 | let zip = (o1, o2) => 17 | switch (o1, o2) { 18 | | (None, _) 19 | | (_, None) => None 20 | | (Some(a), Some(b)) => Some((a, b)) 21 | }; 22 | let unzip = (o: option(('a, 'b))): (option('a), option('b)) => 23 | switch (o) { 24 | | None => (None, None) 25 | | Some((a, b)) => (Some(a), Some(b)) 26 | }; 27 | 28 | let sequence = (l: list(option('a))): option(list('a)) => 29 | List.fold_right(map2((x, xs) => [x, ...xs]), l, Some([])); 30 | 31 | let and_then = (f, o) => Option.bind(o, f); 32 | 33 | module Syntax = { 34 | let ( let* ) = Option.bind; 35 | let (let+) = (o, f) => Option.map(f, o); 36 | let (and+) = zip; 37 | }; 38 | -------------------------------------------------------------------------------- /src/util/P.re: -------------------------------------------------------------------------------- 1 | let p = sexp => sexp |> Sexplib.Sexp.to_string_hum |> print_endline; 2 | 3 | let p' = (str, sexp) => 4 | sexp 5 | |> Sexplib.Sexp.to_string_hum 6 | |> (s => str ++ ": " ++ s) 7 | |> print_endline; 8 | 9 | let ps = sss => { 10 | let _ = List.map(((a, b)) => p'(a, b), sss); 11 | (); 12 | }; 13 | -------------------------------------------------------------------------------- /src/util/PairUtil.re: -------------------------------------------------------------------------------- 1 | let map_fst = (f, (x, y)) => (f(x), y); 2 | let map_snd = (f, (x, y)) => (x, f(y)); 3 | -------------------------------------------------------------------------------- /src/util/Result.re: -------------------------------------------------------------------------------- 1 | include Base.Result; 2 | 3 | module Syntax = { 4 | let ( let* ) = (result, f) => bind(~f, result); 5 | let (let+) = (result, f) => map(~f, result); 6 | }; 7 | -------------------------------------------------------------------------------- /src/util/StringUtil.re: -------------------------------------------------------------------------------- 1 | let is_var = s => Re.Str.string_match(Re.Str.regexp("[a-z]"), s, 0); 2 | let is_num = s => Re.Str.string_match(Re.Str.regexp("[0-9]"), s, 0); 3 | -------------------------------------------------------------------------------- /src/util/TupleUtil.re: -------------------------------------------------------------------------------- 1 | let map2 = (f, (a, b)) => (f(a), f(b)); 2 | 3 | let map3 = (f, (a, b, c)) => (f(a), f(b), f(c)); 4 | -------------------------------------------------------------------------------- /src/util/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name util) 3 | (libraries base sexplib re) 4 | (js_of_ocaml 5 | (flags 6 | (:include js-of-ocaml-flags-%{profile}))) 7 | (preprocess 8 | (pps ppx_let ppx_sexp_conv))) 9 | 10 | (rule 11 | (write-file js-of-ocaml-flags-dev "(:standard --debuginfo --noinline)")) 12 | 13 | (rule 14 | (write-file js-of-ocaml-flags-release "(:standard)")) 15 | -------------------------------------------------------------------------------- /src/web/Animate.re: -------------------------------------------------------------------------------- 1 | let mk_props = (elem: Js_of_ocaml.Js.t(JsUtil.Dom_html.element)): Model.box => { 2 | let container_rect = elem##getBoundingClientRect; 3 | { 4 | top: int_of_float(container_rect##.top), 5 | left: int_of_float(container_rect##.left), 6 | height: Js_of_ocaml.Js.Optdef.get(container_rect##.height, _ => (-1.0)), 7 | width: Js_of_ocaml.Js.Optdef.get(container_rect##.width, _ => (-1.0)), 8 | }; 9 | }; 10 | 11 | let get_box = (id): option(Model.box) => 12 | switch (JsUtil.get_elem_by_id_opt(id)) { 13 | | Some(elem) => Some(mk_props(elem)) 14 | | None => None 15 | }; 16 | 17 | let delta_box = (init: Model.box, final: Model.box): Model.box => { 18 | left: final.left - init.left, 19 | top: final.top - init.top, 20 | width: final.width -. init.width, 21 | height: final.height -. init.height, 22 | }; 23 | 24 | let delta_box_opt = 25 | (init: option(Model.box), final: option(Model.box)): option(Model.box) => 26 | switch (final, init) { 27 | | (Some(final), Some(init)) => Some(delta_box(init, final)) 28 | | _ => None 29 | }; 30 | 31 | let pos_timing_fn = "cubic-bezier(0.75, -0.5, 0.25, 1.5)"; 32 | let pos_duration = "150ms"; 33 | 34 | let init_transform = (x, y, sx, sy) => 35 | Printf.sprintf( 36 | "transform:translate(%dpx, %dpx) scale(%f, %f); transition: transform 0s;", 37 | y, 38 | x, 39 | sy, 40 | sx, 41 | ); 42 | 43 | let init_transform_scale = (sx, sy) => 44 | Printf.sprintf( 45 | "transform: scale(%f, %f); transition: transform 0s;", 46 | sy, 47 | sx, 48 | ); 49 | 50 | let final_tranform = 51 | Printf.sprintf( 52 | "transform:none; transition: transform %s %s;", 53 | pos_duration, 54 | pos_timing_fn, 55 | ); 56 | 57 | let set_style_init = ((id, box: option(Model.box))) => 58 | switch (box) { 59 | | None => 60 | // For now, scale up newly inserted elements 61 | JsUtil.set_style_by_id(id, init_transform_scale(0.0, 0.0)) 62 | | Some(box) => 63 | JsUtil.set_style_by_id(id, init_transform(box.top, box.left, 1.0, 1.0)) 64 | }; 65 | 66 | let set_style_final = ((id, _)) => 67 | JsUtil.set_style_by_id(id, final_tranform); 68 | 69 | let set_init_coords = (target_ids: list(string), state: State.t) => 70 | State.set_tracked_elems( 71 | state, 72 | List.map(i => (i, get_box(i)), target_ids), 73 | ); 74 | 75 | let animate_coords = (state: State.t) => { 76 | let delta_box = 77 | List.map( 78 | ((id, box)) => (id, delta_box_opt(get_box(id), box)), 79 | State.get_tracked_elems(state), 80 | ); 81 | List.iter(set_style_init, delta_box); 82 | JsUtil.request_frame(_ => List.iter(set_style_final, delta_box)); 83 | State.set_tracked_elems(state, []); 84 | }; 85 | 86 | let cells = (state: State.t) => 87 | set_init_coords(Core.Cell.ids^ |> List.map(string_of_int), state); 88 | 89 | let cells_except = (id: Core.UID.t, state: State.t) => 90 | set_init_coords( 91 | Core.Cell.ids^ |> List.filter((!=)(id)) |> List.map(string_of_int), 92 | state, 93 | ); 94 | 95 | let cells_and = (id: Core.UID.t, state: State.t) => 96 | set_init_coords( 97 | Core.Cell.ids^ |> List.cons(id) |> List.map(string_of_int), 98 | state, 99 | ); 100 | -------------------------------------------------------------------------------- /src/web/FontMetrics.re: -------------------------------------------------------------------------------- 1 | [@warning "-33"] 2 | open Sexplib.Std; 3 | 4 | [@deriving sexp] 5 | type t = { 6 | row_height: float, 7 | col_width: float, 8 | }; 9 | 10 | let init = {row_height: 1., col_width: 1.}; 11 | -------------------------------------------------------------------------------- /src/web/Keyboard.re: -------------------------------------------------------------------------------- 1 | open Virtual_dom.Vdom; 2 | 3 | let keydown = (model: Model.t, key: string): list(Update.t) => 4 | switch (key) { 5 | | "F3" => [DebugPrint] 6 | | "Shift" => [UpdateKeymap(km => {...km, shift: true})] 7 | | "ArrowDown" when model.keymap.shift => [UniFocus(SwapCellDown)] 8 | | "ArrowUp" when model.keymap.shift => [UniFocus(SwapCellUp)] 9 | | "ArrowRight" => [UniFocus(MoveRight)] 10 | | "ArrowLeft" => [UniFocus(MoveLeft)] 11 | | "ArrowUp" => [UniFocus(MoveUp)] 12 | | "ArrowDown" => [UniFocus(MoveDown)] 13 | | "Enter" when model.world == [] => [InsertNewCell(0)] 14 | | " " when model.world == [] => [InsertNewCell(0)] 15 | | "Enter" => [UniFocus(InsertNewCellF)] 16 | | " " => [UniFocus(InsertNewWordF)] 17 | | "Delete" => [UniFocus(DeleteF)] 18 | | "Backspace" => [UniFocus(Backspace)] 19 | | "Escape" => [SetFocus(SingleCell([]))] 20 | | x => [UniFocus(InsertChar(x))] 21 | }; 22 | 23 | let keyup = (_model: Model.t, key: string): list(Update.t) => 24 | switch (key) { 25 | | "Shift" => [Update.UpdateKeymap(km => {...km, shift: false})] 26 | | _ => [] 27 | }; 28 | //@ [Update.SetLastKey(KeyUp(key))]; 29 | 30 | let seq = (~inj, updates) => 31 | switch (updates) { 32 | | [] => Event.Ignore 33 | | [_, ..._] => 34 | Event.( 35 | Many([Prevent_default, Stop_propagation, ...List.map(inj, updates)]) 36 | ) 37 | }; 38 | 39 | let handlers = (~inj: Update.t => Event.t, model: Model.t) => [ 40 | Attr.on_keypress(_evt => Event.Prevent_default), 41 | Attr.on_keyup(evt => evt |> JsUtil.get_key |> keyup(model) |> seq(~inj)), 42 | Attr.on_keydown(evt => { 43 | let key = JsUtil.get_key(evt); 44 | //print_endline("key pressed:"); 45 | //print_endline(key); 46 | let held = m => JsUtil.held(m, evt); 47 | let updates: list(Update.t) = 48 | if (!held(Ctrl) && !held(Alt) && !held(Meta)) { 49 | keydown( 50 | model, 51 | key // @ [SetLastKey(KeyDown(key))]; 52 | ); 53 | } else if (! Os.is_mac^ && held(Ctrl) && !held(Alt) && !held(Meta)) { 54 | switch (key) { 55 | | "z" => held(Shift) ? [] : [] 56 | | _ => [] 57 | }; 58 | } else if (Os.is_mac^ && held(Meta) && !held(Alt) && !held(Ctrl)) { 59 | switch (key) { 60 | | "z" => held(Shift) ? [] : [] 61 | | _ => [] 62 | }; 63 | } else { 64 | []; 65 | }; 66 | seq(~inj, updates); 67 | }), 68 | ]; 69 | -------------------------------------------------------------------------------- /src/web/Main.re: -------------------------------------------------------------------------------- 1 | open Js_of_ocaml; 2 | open Incr_dom; 3 | open Web; 4 | open Sexplib.Std; 5 | 6 | let on_display = 7 | (model: Model.t, old_model, state: State.t, ~schedule_action as _) => 8 | model.animations_off || model === old_model 9 | ? () : Animate.animate_coords(state); 10 | 11 | module App = { 12 | module Model = Model; 13 | module Action = Update; 14 | module State = State; 15 | 16 | /* 17 | let observe_font_specimen = (id, update) => 18 | ResizeObserver.observe( 19 | ~node=JsUtil.get_elem_by_id(id), 20 | ~f= 21 | (entries, _) => { 22 | let specimen = Js.to_array(entries)[0]; 23 | let rect = specimen##.contentRect; 24 | update( 25 | Web.FontMetrics.{ 26 | row_height: rect##.bottom -. rect##.top, 27 | col_width: rect##.right -. rect##.left, 28 | }, 29 | ); 30 | }, 31 | (), 32 | ); 33 | */ 34 | 35 | let on_startup = (~schedule_action, _m: Model.t) => { 36 | /* 37 | let _ = 38 | observe_font_specimen("font-specimen", fm => 39 | schedule_action(Web.Update.SetFontMetrics(fm)) 40 | ); 41 | let _ = 42 | observe_font_specimen("logo-font-specimen", fm => 43 | schedule_action(Web.Update.SetLogoFontMetrics(fm)) 44 | ); 45 | */ 46 | schedule_action(Update.DoNothing); 47 | Os.is_mac := 48 | Dom_html.window##.navigator##.platform##toUpperCase##indexOf( 49 | Js.string("MAC"), 50 | ) 51 | >= 0; 52 | Async_kernel.Deferred.return(State.init_state); 53 | }; 54 | 55 | let create = (model: Incr.t(Web.Model.t), ~old_model, ~inject) => { 56 | open Incr.Let_syntax; 57 | let%map model = model 58 | and old_model = old_model; 59 | //let {anim_targets, _}: Model.t = model; 60 | Component.create( 61 | ~apply_action= 62 | (update: Update.t, state: State.t, ~schedule_action) => { 63 | //Util.P.p(State.sexp_of_t(state)); 64 | let m = Web.Update.apply(model, update, state, ~schedule_action); 65 | //Util.P.p(State.sexp_of_t(state)); 66 | m; 67 | }, 68 | /* 69 | ~on_display= 70 | (_, ~schedule_action as _) => { 71 | //Web.JsUtil.play_sound(); 72 | print_endline("on_display"); 73 | }, 74 | */ 75 | ~on_display=on_display(model, old_model), 76 | model, 77 | Web.View.view(~inj=inject, ~model), 78 | ); 79 | }; 80 | }; 81 | 82 | Incr_dom.Start_app.start( 83 | (module App), 84 | ~debug=false, 85 | ~bind_to_element_with_id="container", 86 | ~initial_model=Web.Model.init, 87 | ); 88 | -------------------------------------------------------------------------------- /src/web/Measure.re: -------------------------------------------------------------------------------- 1 | open Core.Block; 2 | 3 | /* 4 | type get_path_res = 5 | | EscapeAbove 6 | | EscapeBelow 7 | | EscapeLeft 8 | | EscapeRight 9 | | Path(Core.Path.t); 10 | 11 | let col_1_width = 20; 12 | let col_2_width = 60; 13 | let col_3_width = 10; 14 | 15 | /* 16 | initially assume: 17 | all cells are laid out vertically in a block 18 | all cells are 1 row high 19 | all field-cols have a fixed width (space-padded on the right) 20 | all fields are 1 row high 21 | all words are laid out horizontally in a field 22 | all words are 1 row high 23 | */ 24 | let rec get_path_to_coord = (block: t, (row: int, col: int)): get_path_res => 25 | switch (row, List.length(block)) { 26 | | (r, _) when r < 0 => EscapeAbove 27 | | (r, n) when r >= n => EscapeBelow 28 | | (r, n) => 29 | let cell = List.nth(block, row); 30 | switch (get_path_to_coord_cell(cell, (row, col))) { 31 | | Path(ps) => Path([Cell(Index(r, n)), ...ps]) 32 | | x => x 33 | }; 34 | } 35 | and get_path_to_coord_cell = 36 | (cell: Core.Cell.t, (row: int, col: int)): get_path_res => { 37 | switch (col) { 38 | | c when c < 0 => EscapeLeft 39 | | c when c < col_1_width => 40 | switch (get_path_to_coord_word(cell.pattern, (row, col))) { 41 | | Path(ps) => Path([Field(Pattern), ...ps]) 42 | | x => x 43 | } 44 | | c when c >= col_1_width && c < col_2_width => 45 | switch ( 46 | get_path_to_coord_word(cell.expression, (row, col - col_1_width)) 47 | ) { 48 | | Path(ps) => Path([Field(Expression), ...ps]) 49 | | x => x 50 | } 51 | | c when c >= col_2_width && c < col_3_width => 52 | switch ( 53 | get_path_to_coord_word( 54 | cell.value, 55 | (row, col - col_1_width - col_2_width), 56 | ) 57 | ) { 58 | | Path(ps) => Path([Field(Value), ...ps]) 59 | | x => x 60 | } 61 | | c when c >= col_3_width => EscapeRight 62 | | _ => failwith("get_path_to_coord_cell") 63 | }; 64 | } 65 | and get_path_to_coord_word = 66 | (words: Core.Word.s, (_row: int, col: int)): get_path_res => { 67 | let get_word_index = (col: int, words: Core.Word.s) => { 68 | let gap_constant = 1; 69 | let rec gwi = (col, words, index: int, c: int) => { 70 | switch (words) { 71 | | [] => None 72 | | [w, ...ws] => 73 | let start_int = c; 74 | let len = String.length(w); 75 | let end_int = c + len + gap_constant; 76 | col >= start_int && col < end_int 77 | ? Some((index + 1, col - start_int, len)) 78 | : gwi(col, ws, index + 1, end_int); 79 | }; 80 | }; 81 | gwi(col, words, -1, 0); 82 | }; 83 | let num_words = List.length(words); 84 | switch (get_word_index(col, words)) { 85 | | None when num_words == 0 => EscapeRight 86 | | None => 87 | let last_word = List.hd(List.rev(words)); 88 | let len = String.length(last_word); 89 | Path([ 90 | Word(Index(num_words - 1, num_words)), 91 | Char(Index(len - 1, len)), 92 | ]); 93 | //| None => EscapeRight // TODO: prob just want to round down to last index here 94 | | Some(((-1), _, _)) => EscapeLeft 95 | | Some((w, c, wlen)) => 96 | Path([Word(Index(w, num_words)), Char(Index(c, wlen))]) 97 | }; 98 | }; 99 | 100 | */ 101 | -------------------------------------------------------------------------------- /src/web/Model.re: -------------------------------------------------------------------------------- 1 | open Core; 2 | open Sexplib.Std; 3 | let cutoff = (===); 4 | 5 | [@deriving sexp] 6 | type focus = 7 | | SingleCell(Path.t); 8 | 9 | [@deriving sexp] 10 | type word_sep_id = int; 11 | [@deriving sexp] 12 | type cell_sep_id = int; 13 | 14 | //TODO: refactor paths 15 | [@deriving sexp] 16 | type word_path = (Block.cell_id, Cell.field, Cell.word_idx); 17 | //[@deriving sexp] 18 | //type char_path = (Block.cell_id, Cell.field, Cell.word_idx, int); 19 | 20 | type new_path = 21 | | BlockPath 22 | | CellPath(Block.cell_id) 23 | | WordPath(word_path); 24 | //| CharPath(char_path); 25 | 26 | [@deriving sexp] 27 | type drop_target = 28 | | NoTarget 29 | | Word(word_path) 30 | | WordSeparator(word_path) 31 | | CellSepatator(cell_sep_id); 32 | 33 | [@deriving sexp] 34 | type carry = 35 | | NoCarry 36 | | WordExp(AnnotatedBlock.annotated_word_exp) 37 | | WordPat(AnnotatedBlock.annotated_word_pat) 38 | | WordBrush(Name.t) 39 | | Cell(AnnotatedBlock.annotated_cell) 40 | | CellBrush(Cell.t); 41 | 42 | [@deriving sexp] 43 | type trash_idx = int; 44 | 45 | [@deriving sexp] 46 | type screen_coords = (int, int); 47 | 48 | [@deriving sexp] 49 | type box = { 50 | top: int, 51 | left: int, 52 | width: float, 53 | height: float, 54 | }; 55 | 56 | [@deriving sexp] 57 | type trash_item = 58 | | TrashedCell(Cell.t, screen_coords) 59 | | TrashedWord(Word.t, screen_coords); 60 | 61 | [@deriving sexp] 62 | type trash = list(trash_item); 63 | 64 | [@deriving sexp] 65 | type pattern_display = 66 | | Name 67 | | Emoji; 68 | 69 | [@deriving sexp] 70 | type cell_proj = 71 | //| PatternOnly 72 | //| ValueOnly 73 | //| ExpressionPatternValue 74 | | ExpressionPattern; 75 | 76 | [@deriving sexp] 77 | type keymap = { 78 | shift: bool, 79 | ctrl: bool, 80 | }; 81 | 82 | [@deriving sexp] 83 | type lastkey = 84 | | KeyUp(string) 85 | | KeyDown(string); 86 | 87 | [@deriving sexp] 88 | type t = { 89 | world: Block.t, 90 | cell_proj, 91 | focus, 92 | trash, 93 | drop_target, 94 | carry, 95 | pattern_display, 96 | keymap, 97 | animations_off: bool, 98 | lastkey, 99 | }; 100 | 101 | let world = World.init; 102 | 103 | let init_path: Path.t = 104 | Lens.[ 105 | Cell(Index(0, Block.len(world))), 106 | Field(Expression), 107 | Word(Index(0, first_exp_len(world))), 108 | Char(Index(0, first_word_len(world))), 109 | ]; 110 | 111 | assert(Path.is_valid(world, init_path)); 112 | 113 | let init = { 114 | world, 115 | focus: SingleCell(init_path), 116 | carry: NoCarry, 117 | drop_target: NoTarget, 118 | trash: [], 119 | keymap: { 120 | shift: false, 121 | ctrl: false, 122 | }, 123 | pattern_display: Name, 124 | cell_proj: ExpressionPattern, 125 | animations_off: false, 126 | lastkey: KeyUp(""), 127 | }; 128 | -------------------------------------------------------------------------------- /src/web/Os.re: -------------------------------------------------------------------------------- 1 | let is_mac = ref(false); 2 | -------------------------------------------------------------------------------- /src/web/State.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | 3 | [@deriving sexp] 4 | type tracked_elems = Core.Environment.t_(option(Model.box)); 5 | 6 | [@deriving sexp] 7 | type t = {mutable tracked_elems}; 8 | 9 | let get_tracked_elems = (state: t): tracked_elems => state.tracked_elems; 10 | 11 | let set_tracked_elems = (state: t, es: tracked_elems) => 12 | state.tracked_elems = es; 13 | 14 | let init_state: t = {tracked_elems: []}; 15 | -------------------------------------------------------------------------------- /src/web/Update.re: -------------------------------------------------------------------------------- 1 | open Sexplib.Std; 2 | open Util; 3 | open Core; 4 | 5 | [@deriving sexp] 6 | type single_focus_action = 7 | | SwapCellDown 8 | | SwapCellUp 9 | | MoveDown 10 | | MoveUp 11 | | MoveRight 12 | | MoveLeft 13 | | InsertChar(string) 14 | | UpdateWordF(Name.t => Name.t) 15 | | DeleteF 16 | | InsertNewWordF 17 | | InsertNewCellF 18 | | Backspace; 19 | 20 | [@deriving sexp] 21 | type t = 22 | | DoNothing 23 | | SetLastKey(Model.lastkey) 24 | //| SetAnimTargetCells 25 | | SetFocus(Model.focus) 26 | | UniFocus(single_focus_action) 27 | | Delete(Path.t) 28 | | TogglePatternDisplay 29 | | ToggleAnimations 30 | | UpdateKeymap(Model.keymap => Model.keymap) 31 | | DebugPrint 32 | // words 33 | | UpdateWord(Path.t, Name.t => Name.t) 34 | | InsertWord(Path.t, Model.word_sep_id, Word.t) 35 | | InsertNewWord(Path.t, Model.word_sep_id) 36 | // cells 37 | | InsertCell(Block.cell_id, Cell.t) 38 | | InsertNewCell(Block.cell_id) 39 | | ReorderCell(Block.cell_id, Model.cell_sep_id) 40 | | SwapCells(Block.cell_id, Block.cell_id) 41 | // drag-n-drop 42 | | Pickup(Model.carry) 43 | | SetDropTarget(Model.drop_target) 44 | | DropOnWord(Path.t) 45 | | DropOnWordSep(Path.t, Model.word_sep_id) 46 | | DropOnCellSep(Model.cell_sep_id) 47 | | DeleteCarrySource 48 | // trash 49 | | TrashCarry(Model.screen_coords) 50 | | PickupTrash(Model.trash_idx) 51 | | EmptyTrash; 52 | 53 | let update_focus = (f, {focus, _} as model: Model.t) => { 54 | ...model, 55 | focus: f(focus), 56 | }; 57 | 58 | let update_world = (f, {world, _} as model: Model.t) => { 59 | ...model, 60 | world: f(world), 61 | }; 62 | 63 | let update_carry = (f, {carry, _} as model: Model.t) => { 64 | ...model, 65 | carry: f(carry), 66 | }; 67 | 68 | let update_drop_target = (f, {drop_target, _} as model: Model.t) => { 69 | ...model, 70 | drop_target: f(drop_target), 71 | }; 72 | 73 | let update_trash = (f, {trash, _} as model: Model.t) => { 74 | ...model, 75 | trash: f(trash), 76 | }; 77 | 78 | let update_pattern_display = (f, {pattern_display, _} as model: Model.t) => { 79 | ...model, 80 | pattern_display: f(pattern_display), 81 | }; 82 | 83 | let update_keymap = (f, {keymap, _} as model: Model.t) => { 84 | ...model, 85 | keymap: f(keymap), 86 | }; 87 | 88 | let update_animations_off = (f, {animations_off, _} as model: Model.t) => { 89 | ...model, 90 | animations_off: f(animations_off), 91 | }; 92 | 93 | let rec apply: (Model.t, t, 'b, ~schedule_action: 'a) => Model.t = 94 | (model: Model.t, update: t, state: State.t, ~schedule_action) => { 95 | //let model = update_drop_target(_ => NoTarget, model); 96 | let app = (a, m) => apply(m, a, state, ~schedule_action); 97 | let model = 98 | switch (update) { 99 | | DoNothing => model 100 | | SetLastKey(k) => 101 | switch (model.lastkey, k) { 102 | | (KeyDown(qq), KeyDown(bb)) when qq == bb => () 103 | | _ => () 104 | }; 105 | {...model, lastkey: k}; 106 | | SetFocus(focus) => update_focus(_ => focus, model) 107 | | Pickup(thing) => update_carry(_ => thing, model) 108 | | EmptyTrash => update_trash(_ => [], model) 109 | | UpdateKeymap(f) => update_keymap(f, model) 110 | | SetDropTarget(target) => update_drop_target(_ => target, model) 111 | | SwapCells(a, b) => update_world(ListUtil.swap(a, b), model) 112 | | Delete(path) => update_world(Path.delete(path), model) 113 | | UpdateWord(path, f) => 114 | update_world(Path.update_word(f, path), model) 115 | | UniFocus(a) => apply_single(a, model, state, ~schedule_action) 116 | | PickupTrash(idx) => 117 | //TODO: retain trash if not restored 118 | switch (List.nth(model.trash, idx)) { 119 | | TrashedWord(word, _) => 120 | model 121 | |> update_trash(ListUtil.remove(idx)) 122 | |> app(Pickup(WordBrush(word.name))) 123 | | TrashedCell(cell, _) => 124 | model 125 | |> update_trash(ListUtil.remove(idx)) 126 | |> app(Pickup(CellBrush(cell))) 127 | } 128 | | DeleteCarrySource => 129 | switch (model.carry) { 130 | | NoCarry 131 | | WordBrush(_) 132 | | CellBrush(_) => model 133 | | WordExp({path, _}) 134 | | WordPat({path, _}) 135 | | Cell({path, _}) => app(Delete(path), model) 136 | } 137 | | TrashCarry(coords) => 138 | switch (model.carry) { 139 | | WordExp({path, _}) => 140 | let word = 141 | switch (Path.get_word(path, model.world)) { 142 | | Some(word) => word 143 | | None => Word.mk_name("lol. lmao.") 144 | }; 145 | model 146 | |> update_trash(trash => [TrashedWord(word, coords), ...trash]) 147 | |> app(DeleteCarrySource); 148 | | Cell({path, _}) => 149 | // TODO: refactor to use annotated_cell 150 | let cell = 151 | switch (Path.get_cell(path, model.world)) { 152 | | Some(cell) => cell 153 | | None => Cell.init() 154 | }; 155 | Animate.cells(state); 156 | model 157 | |> update_trash(trash => [TrashedCell(cell, coords), ...trash]) 158 | |> app(DeleteCarrySource); 159 | | _ => model 160 | } 161 | | InsertCell(sep_idx, cell) => 162 | //TODO: index 666, cleanup 163 | model 164 | |> update_world(Path.insert_cell(sep_idx, cell)) 165 | |> app( 166 | SetFocus( 167 | SingleCell([ 168 | Cell(Index(sep_idx, 1 + List.length(model.world))), 169 | Field(Expression), 170 | Word(Index(0, 666)), 171 | ]), 172 | ), 173 | ) 174 | | InsertNewCell(sep_idx) => 175 | let cell = Core.Cell.init(); 176 | Animate.cells_and(cell.uid, state); 177 | app(InsertCell(sep_idx, cell), model); 178 | | ReorderCell(cell_idx, new_idx) => 179 | let cell = Block.nth_cell(model.world, cell_idx); 180 | let new_idx = new_idx > cell_idx ? new_idx - 1 : new_idx; 181 | model 182 | |> app(Delete([Cell(Index(cell_idx, List.length(model.world)))])) 183 | |> app(InsertCell(new_idx, cell)); 184 | | DropOnCellSep(sep_idx) => 185 | let block = model.world; 186 | ( 187 | switch (model.carry) { 188 | // 1. unbound names get new cells 189 | | WordExp({form: Unbound(name), path, _}) 190 | when Path.is_cell_idx((==)(sep_idx), path) => 191 | let cell = Cell.init_name(name); 192 | app(InsertCell(sep_idx, cell), model); 193 | // 2. literals get abstracted 194 | | WordExp({form: Lit(lit), path, _}) 195 | when Path.is_cell_idx((==)(sep_idx), path) => 196 | switch (Path.cell_idx(path)) { 197 | | Some(i) when sep_idx == i => 198 | let incr_path = Path.update_cell_idx((+)(1), path); 199 | let (word, cell) = Cell.init_w(Expression.string_of_lit(lit)); 200 | model 201 | |> app(InsertCell(sep_idx, cell)) 202 | |> app(UpdateWord(incr_path, _ => word.name)); 203 | | _ => model 204 | } 205 | // 3. cells get copied if shift is pressed 206 | | Cell({path: [Cell(Index(carry_idx, _)), ..._], _}) 207 | when model.keymap.shift => 208 | let cell = carry_idx |> Block.nth_cell(block) |> Cell.copy; 209 | Animate.cells_except(cell.uid, state); 210 | app(InsertCell(sep_idx, cell), model); 211 | // 4. cells get reordered otherwise 212 | | Cell({path: [Cell(Index(carry_idx, _)), ..._], uid, _}) => 213 | Animate.cells_except(uid, state); 214 | let cell = Block.nth_cell(block, carry_idx); 215 | let new_idx = sep_idx > carry_idx ? sep_idx - 1 : sep_idx; 216 | model 217 | |> app(Delete([Cell(Index(carry_idx, List.length(block)))])) 218 | |> app(InsertCell(new_idx, cell)); 219 | // 5. restore cell from trash 220 | | CellBrush(cell) => 221 | Animate.cells(state); 222 | app(InsertCell(sep_idx, cell), model); 223 | | _ => model 224 | } 225 | ) 226 | |> app(Pickup(NoCarry)); 227 | | InsertWord(path, sep_idx, new_word) => 228 | let m = 229 | update_world(Path.insert_word(new_word, path, sep_idx), model); 230 | app( 231 | switch (path) { 232 | | [c, f, ..._] => 233 | //TODO: cleanup 234 | let k = 235 | switch (Path.get_words([c, f], m.world)) { 236 | | Some(ws) => List.length(ws) 237 | | None => 666 238 | }; 239 | SetFocus(SingleCell([c, f, Word(Index(sep_idx, k))])); 240 | | _ => SetFocus(SingleCell(path)) 241 | }, 242 | m, 243 | ); 244 | | InsertNewWord(path, sep_idx) => 245 | app(InsertWord(path, sep_idx, Core.Word.mk_empty()), model) 246 | | DropOnWordSep(path, sep_idx) => 247 | ( 248 | switch (model.carry) { 249 | | _ when Path.is_word_sep_touching_empty(path, sep_idx, model.world) => 250 | // HACK? annoying to allow drop if next to empty word 251 | model 252 | | WordPat({path: origin_path, word, _}) => 253 | switch (Path.cell_idx(path)) { 254 | | Some(target_cell_idx) 255 | when Path.is_cell_idx((>)(target_cell_idx), origin_path) => 256 | model |> app(InsertWord(path, sep_idx, word)) 257 | | _ => model 258 | } 259 | | WordExp({word, _}) when model.keymap.shift => 260 | // if holding shift, copy instead of move 261 | app(InsertWord(path, sep_idx, word), model) 262 | | WordExp({ 263 | path: [_, _, Word(Index(word_idx, _)), ..._] as word_path, 264 | word, 265 | _, 266 | }) 267 | when !model.keymap.shift => 268 | if (sep_idx > word_idx) { 269 | model 270 | |> app(InsertWord(path, sep_idx, word)) 271 | |> app(Delete(word_path)); 272 | } else { 273 | model 274 | |> app(Delete(word_path)) 275 | |> app(InsertWord(path, sep_idx, word)); 276 | } 277 | | WordBrush(name) => 278 | app(InsertWord(path, sep_idx, Word.mk_name(name)), model) 279 | | _ => model 280 | } 281 | ) 282 | // hack? sometimes ondragleave doesn't get triggered when dropping 283 | //|> update_drop_target(_ => NoTarget) 284 | |> app(Pickup(NoCarry)) 285 | | DropOnWord(path) => 286 | // TODO: figure out how to combine this with droponwordsep 287 | switch (path) { 288 | | [_, _, Word(Index(path_word_idx, _)), ..._] => 289 | ( 290 | switch (model.carry) { 291 | | WordPat({path: origin_path, word, _}) => 292 | switch (Path.cell_idx(path)) { 293 | | Some(target_cell_idx) 294 | when Path.is_cell_idx((>)(target_cell_idx), origin_path) => 295 | model 296 | |> app(Delete(path)) 297 | |> app(InsertWord(path, path_word_idx, word)) 298 | | _ => model 299 | } 300 | | WordExp({word, _}) when model.keymap.shift => 301 | // if holding shift, copy instead of move 302 | model 303 | |> app(Delete(path)) 304 | |> app(InsertWord(path, path_word_idx, word)) 305 | | WordExp({ 306 | path: [_, _, Word(Index(word_idx, _)), ..._] as word_path, 307 | word, 308 | _, 309 | }) 310 | when !model.keymap.shift => 311 | if (path_word_idx == word_idx) { 312 | model; 313 | } else if (path_word_idx > word_idx) { 314 | model 315 | |> app(InsertWord(path, path_word_idx, word)) 316 | |> app(Delete(word_path)) 317 | |> app(Delete(path)); 318 | } else { 319 | model 320 | |> app(Delete(word_path)) 321 | |> app(Delete(path)) 322 | |> app(InsertWord(path, path_word_idx, word)); 323 | } 324 | | WordBrush(name) => 325 | model 326 | |> app(Delete(path)) 327 | |> app(InsertWord(path, path_word_idx, Word.mk_name(name))) 328 | | _ => model 329 | } 330 | ) 331 | |> app(Pickup(NoCarry)) 332 | | _ => model 333 | } 334 | | TogglePatternDisplay => 335 | update_pattern_display( 336 | x => 337 | switch (x) { 338 | | Name => Emoji 339 | | Emoji => Name 340 | }, 341 | model, 342 | ) 343 | | ToggleAnimations => update_animations_off(b => !b, model) 344 | | DebugPrint => 345 | let ann_block = AnnotatedBlock.mk(model.world); 346 | let furled = FurledBlock.furl_block(ann_block); 347 | Util.P.ps([ 348 | ("FOCUS:", Model.sexp_of_focus(model.focus)), 349 | ("BLOCK:", Block.sexp_of_t(model.world)), 350 | ("ANN:", AnnotatedBlock.sexp_of_t(ann_block)), 351 | ("FURLED:", Expression.sexp_of_t(furled)), 352 | ]); 353 | model; 354 | }; 355 | update_world(Interpreter.run_block, model); 356 | } 357 | 358 | and apply_single: 359 | (single_focus_action, Model.t, 'b, ~schedule_action: 'a) => Model.t = 360 | (a, model, state, ~schedule_action) => { 361 | let SingleCell(current_path) = model.focus; 362 | let app = (a, m) => apply(m, a, state, ~schedule_action); 363 | let update_focus = (f: (Block.t, Path.t) => Path.t, m: Model.t) => { 364 | app(SetFocus(SingleCell(f(m.world, current_path))), m); 365 | }; 366 | switch (a) { 367 | | UpdateWordF(f) => app(UpdateWord(current_path, f), model) 368 | | DeleteF => 369 | // TODO: set focus 370 | switch (model.focus) { 371 | | SingleCell(path) => app(Delete(path), model) 372 | } 373 | | InsertNewCellF => 374 | let SingleCell(current_path) = model.focus; 375 | switch (current_path) { 376 | | [Cell(Index(cell_idx, _)), ..._] => 377 | app(InsertNewCell(cell_idx + 1), model) 378 | | _ => model 379 | }; 380 | | InsertNewWordF => 381 | let SingleCell(current_path) = model.focus; 382 | switch (current_path) { 383 | | [_, _, Word(Index(n, _)), ..._] 384 | when 385 | switch (Path.get_word(current_path, model.world)) { 386 | | Some(word) when !Word.is_empty(word) => true 387 | | _ => false 388 | } => 389 | app(InsertNewWord(current_path, n + 1), model) 390 | | _ => model 391 | }; 392 | | SwapCellDown => 393 | switch (current_path) { 394 | | [Cell(Index(cell_idx, k))] when cell_idx != k - 1 => 395 | Animate.cells(state); 396 | model 397 | |> app(ReorderCell(cell_idx + 1, cell_idx)) 398 | |> app(SetFocus(SingleCell([Cell(Index(cell_idx + 1, k))]))); 399 | | _ => model 400 | } 401 | | SwapCellUp => 402 | switch (current_path) { 403 | | [Cell(Index(cell_idx, k))] when cell_idx != 0 => 404 | Animate.cells(state); 405 | model 406 | |> app(ReorderCell(cell_idx, cell_idx - 1)) 407 | |> app(SetFocus(SingleCell([Cell(Index(cell_idx - 1, k))]))); 408 | | _ => model 409 | } 410 | | MoveDown => update_focus(Path.down_path, model) //|> app(SetAnimTargets(["-1"])) 411 | | MoveUp => update_focus(Path.up_path, model) //|> app(SetAnimTargets(["-1"])) 412 | | MoveRight => update_focus(Path.next_word_path, model) 413 | //|> app(SetAnimTargets(["-1"])) 414 | | MoveLeft => update_focus(Path.prev_word_path, model) 415 | //|> app(SetAnimTargets(["-1"])) 416 | | InsertChar(op) when Expression.is_operator(op) => 417 | let is_a_next_word = (block, path: Path.t) => 418 | switch (Path.next_word(block, path)) { 419 | | Some(_) => true 420 | | _ => false 421 | }; 422 | let is_next_word_op = Path.is_next_word_p(Expression.word_is_operator); 423 | switch (current_path, Path.get_word(current_path, model.world)) { 424 | | (_, Some(op1)) when Expression.word_is_operator(op1) => model 425 | | (_, Some(op1)) when Word.is_empty(op1) => 426 | app(UpdateWord(current_path, _ => op), model) 427 | | ([_, _, Word(Index(n, _)), ..._], _) 428 | when 429 | is_a_next_word(model.world, current_path) 430 | && !is_next_word_op(model.world, current_path) => 431 | app(InsertWord(current_path, n + 1, Word.mk_name(op)), model) 432 | 433 | | ([_, _, Word(Index(n, _)), ..._], _) => 434 | model 435 | |> app(InsertWord(current_path, n + 1, Word.mk_name(op))) 436 | |> app(InsertNewWord(current_path, n + 2)) 437 | | _ => model 438 | }; 439 | | InsertChar(x) => 440 | let SingleCell(current_path) = model.focus; 441 | switch (Path.get_word(current_path, model.world), current_path) { 442 | | (Some(word), [_, _, Word(Index(n, _)), ..._]) 443 | // if we're on an operator, advance to next word 444 | when Expression.word_is_operator(word) => 445 | app(InsertWord(current_path, n + 1, Word.mk_name(x)), model) 446 | | _ => 447 | app(UniFocus(UpdateWordF(n => Name.empty == n ? x : n ++ x)), model) 448 | }; 449 | | Backspace => 450 | let is_prev_word_op = Path.is_prev_word_p(Expression.word_is_operator); 451 | let remove_char = str => String.sub(str, 0, String.length(str) - 1); 452 | let words = Path.get_words(current_path, model.world); 453 | switch (current_path) { 454 | | [] when Block.len(model.world) != 0 => 455 | let len = Block.len(model.world); 456 | app(SetFocus(SingleCell([Cell(Index(len - 1, len))])), model); 457 | | [Cell(Index(i, k))] => 458 | let new_path = [Path.Cell(Index(i, k)), Field(Expression)]; 459 | let length = Path.get_num_words(new_path, model.world); 460 | if (length == 0) { 461 | let new_path: Path.t = k == 1 ? [] : [Cell(Index(i - 1, k - 1))]; 462 | model 463 | |> app(Delete(current_path)) 464 | |> app(SetFocus(SingleCell(new_path))); 465 | } else { 466 | app( 467 | SetFocus( 468 | SingleCell(new_path @ [Word(Index(length - 1, length))]), 469 | ), 470 | model, 471 | ); 472 | }; 473 | | _ => 474 | switch (words) { 475 | | Some([x]) when Word.is_empty(x) => 476 | // if only empty word, delete cell 477 | Animate.cells(state); 478 | switch (current_path) { 479 | | [Cell(Index(0, l)), ..._] => 480 | model 481 | |> app(Delete([Cell(Index(0, l))])) 482 | |> app(SetFocus(SingleCell([]))) 483 | | [Cell(Index(cell_idx, l)), ..._] => 484 | //TODO: select last word of cell 485 | let new_path: Path.t = [ 486 | Cell(Index(cell_idx - 1, List.length(model.world) - 1)), 487 | ]; 488 | model 489 | |> app(Delete([Cell(Index(cell_idx, l))])) 490 | |> app(SetFocus(SingleCell(new_path))); 491 | | _ => model 492 | }; 493 | | _ => 494 | /* Operators cannot be directly backspaced; if we try to 495 | backspace an empty word after an operator, we'll delete 496 | the operator. */ 497 | switch (Path.get_word(current_path, model.world)) { 498 | | Some(word) when Expression.word_is_operator(word) => 499 | app(UpdateWord(current_path, _ => Name.empty), model) 500 | | Some(word) 501 | when 502 | Word.is_empty(word) 503 | && is_prev_word_op(model.world, current_path) => 504 | model 505 | |> app(UniFocus(DeleteF)) 506 | |> app(SetFocus(SingleCell(Path.decr_word(current_path)))) 507 | |> app(UniFocus(DeleteF)) 508 | |> app( 509 | SetFocus( 510 | SingleCell( 511 | current_path |> Path.decr_word |> Path.decr_word, 512 | ), 513 | ), 514 | ) 515 | | Some(word) when Word.is_empty(word) => 516 | model 517 | |> app(UniFocus(DeleteF)) 518 | |> app(SetFocus(SingleCell(Path.decr_word(current_path)))) 519 | | _ => 520 | app( 521 | UniFocus( 522 | UpdateWordF( 523 | n => String.length(n) == 1 ? Name.empty : remove_char(n), 524 | ), 525 | ), 526 | model, 527 | ) 528 | } 529 | } 530 | }; 531 | }; 532 | }; 533 | 534 | //IDEA: dragging on numbers changes instead of moves? 535 | -------------------------------------------------------------------------------- /src/web/dune: -------------------------------------------------------------------------------- 1 | (include_subdirs unqualified) 2 | 3 | (env 4 | (dev 5 | (flags 6 | (:standard -w -33)))) 7 | 8 | (library 9 | (name web) 10 | (modules :standard \ Main) 11 | (libraries sexplib incr_dom util core) 12 | (js_of_ocaml 13 | (flags 14 | (:include js-of-ocaml-flags-%{profile}))) 15 | (preprocess 16 | (pps js_of_ocaml-ppx ppx_let ppx_sexp_conv))) 17 | 18 | (executable 19 | (name main) 20 | (modules Main) 21 | (libraries web) 22 | (modes js) 23 | (js_of_ocaml 24 | (flags 25 | (:include js-of-ocaml-flags-%{profile}))) 26 | (preprocess 27 | (pps js_of_ocaml-ppx ppx_let ppx_sexp_conv))) 28 | 29 | (rule 30 | (write-file js-of-ocaml-flags-dev "(:standard)")) 31 | 32 | (rule 33 | (write-file js-of-ocaml-flags-release "(:standard)")) 34 | -------------------------------------------------------------------------------- /src/web/util/AttrUtil.re: -------------------------------------------------------------------------------- 1 | open Virtual_dom.Vdom.Attr; 2 | 3 | let fstr = f => Printf.sprintf("%f", f); 4 | 5 | let cx = f => create("cx", fstr(f)); 6 | let cy = f => create("cy", fstr(f)); 7 | let rx = f => create("rx", fstr(f)); 8 | let ry = f => create("ry", fstr(f)); 9 | 10 | let x = f => create("x", fstr(f)); 11 | let y = f => create("y", fstr(f)); 12 | let width = f => create("width", fstr(f)); 13 | let height = f => create("height", fstr(f)); 14 | 15 | let stroke_width = f => create("stroke-width", fstr(f)); 16 | let vector_effect = s => create("vector-effect", s); 17 | let filter = s => create("filter", s); 18 | 19 | let offset = f => create("offset", Printf.sprintf("%f%%", 100. *. f)); 20 | let stop_color = s => create("stop-color", s); 21 | let stop_opacity = f => create("stop-opacity", Printf.sprintf("%f", f)); 22 | -------------------------------------------------------------------------------- /src/web/util/JsUtil.re: -------------------------------------------------------------------------------- 1 | open Js_of_ocaml; 2 | module Dom_html = Js_of_ocaml.Dom_html; 3 | 4 | let get_elem_by_id_opt = id => 5 | try( 6 | Some( 7 | Js.Opt.get(Dom_html.document##getElementById(Js.string(id)), () => { 8 | assert(false) 9 | }), 10 | ) 11 | ) { 12 | | _ => None 13 | }; 14 | 15 | let set_elem_style = (elem, style: string) => 16 | try(elem##setAttribute(Js.string("style"), Js.string(style))) { 17 | | _ => () 18 | }; 19 | 20 | let set_style_by_id = (id: string, style: string) => 21 | switch (get_elem_by_id_opt(id)) { 22 | | Some(elem) => set_elem_style(elem, style) 23 | | None => () 24 | }; 25 | 26 | let request_frame = kont => { 27 | let _ = Dom_html.window##requestAnimationFrame(Js.wrap_callback(kont)); 28 | (); 29 | }; 30 | 31 | type mod_key = 32 | | Shift 33 | | Alt 34 | | Ctrl 35 | | Meta; 36 | 37 | let held = (m: mod_key, evt) => 38 | switch (m) { 39 | | Shift => Js.to_bool(evt##.shiftKey) 40 | | Alt => Js.to_bool(evt##.altKey) 41 | | Ctrl => Js.to_bool(evt##.ctrlKey) 42 | | Meta => Js.to_bool(evt##.metaKey) 43 | }; 44 | 45 | let get_key = evt => 46 | Js.to_string(Js.Optdef.get(evt##.key, () => failwith("JsUtil.get_key"))); 47 | 48 | let date_now = () => { 49 | %js 50 | new Js.date_now; 51 | }; 52 | 53 | /* 54 | open WebAudio; 55 | let play_sound = () => { 56 | let context = { 57 | %js 58 | new WebAudio.audioContext; 59 | }; 60 | //const audioElement = document.querySelector('audio'); 61 | //const track = audioContext.createMediaElementSource(audioElement); 62 | /* 63 | let audioElement = Dom_html.document##querySelector(Js.string("audio")); 64 | let track = 65 | context##createMediaElementSource( 66 | (audioElement :> Js.t(Dom_html.mediaElement)), 67 | );*/ 68 | let oscillator = context##createOscillator; 69 | oscillator##.frequency##.value := 200.0; 70 | oscillator##._type := Js.string("sine"); 71 | let blah = context##.destination; 72 | oscillator##connect((blah :> Js.t(WebAudio.audioNode))); 73 | //oscillator##start; 74 | let _ = 75 | Js.Unsafe.coerce(Dom_html.document)##audioPlay( 76 | Js.string("test-meeee.m4a"), 77 | ); 78 | print_endline("oscillator_started"); 79 | }; 80 | */ 81 | 82 | /* 83 | let context = new%js WebAudio.audioContext in 84 | 85 | let oscillator = context##createOscillator in 86 | oscillator##.frequency##.value := 200.0; 87 | oscillator##._type := (Js.string "sine"); 88 | oscillator##(connect ((context##.destination :> WebAudio.audioNode Js.t))); 89 | 90 | debug "about to start oscillator"; 91 | oscillator##start; 92 | debug "oscillator started"; 93 | */ 94 | -------------------------------------------------------------------------------- /src/web/util/Memo.re: -------------------------------------------------------------------------------- 1 | let memoize = (f: 'k => 'v): ('k => 'v) => { 2 | let table: WeakMap.t('k, 'v) = WeakMap.mk(); 3 | k => 4 | switch (WeakMap.get(table, k)) { 5 | | None => 6 | let v = f(k); 7 | let _ = WeakMap.set(table, k, v); 8 | v; 9 | | Some(v) => v 10 | }; 11 | }; 12 | -------------------------------------------------------------------------------- /src/web/util/NodeUtil.re: -------------------------------------------------------------------------------- 1 | open Virtual_dom.Vdom; 2 | 3 | let svg = (attrs, children) => Node.create_svg("svg", attrs, children); 4 | 5 | let stop = attrs => Node.create_svg("stop", attrs, []); 6 | -------------------------------------------------------------------------------- /src/web/util/SvgUtil.re: -------------------------------------------------------------------------------- 1 | open Virtual_dom.Vdom; 2 | 3 | module Point = { 4 | type t = { 5 | x: float, 6 | y: float, 7 | }; 8 | }; 9 | 10 | module Vector = { 11 | type t = { 12 | dx: float, 13 | dy: float, 14 | }; 15 | }; 16 | 17 | module Path = { 18 | type t = list(cmd) 19 | and cmd = 20 | | Z 21 | | M(Point.t) 22 | | M_(Vector.t) 23 | | L(Point.t) 24 | | L_(Vector.t) 25 | | H({x: float}) 26 | | H_({dx: float}) 27 | | V({y: float}) 28 | | V_({dy: float}) 29 | | A_({ 30 | rx: float, 31 | ry: float, 32 | x_axis_rotation: float, 33 | large_arc_flag: bool, 34 | sweep_flag: bool, 35 | dx: float, 36 | dy: float, 37 | }); 38 | 39 | let scale_cmd = (~scale_x=1., ~scale_y=1.) => 40 | fun 41 | | (Z | M(_) | L(_) | H(_) | V(_) | A_(_)) as cmd => cmd 42 | | M_({dx, dy}) => M_({dx: scale_x *. dx, dy: scale_y *. dy}) 43 | | L_({dx, dy}) => L_({dx: scale_x *. dx, dy: scale_y *. dy}) 44 | | H_({dx}) => H_({dx: scale_x *. dx}) 45 | | V_({dy}) => V_({dy: scale_y *. dy}); 46 | 47 | let scale = s => List.map(scale_cmd(~scale_x=s, ~scale_y=s)); 48 | let scale_x = s => List.map(scale_cmd(~scale_x=s)); 49 | let scale_y = s => List.map(scale_cmd(~scale_y=s)); 50 | 51 | let reverse = List.rev_map(scale_cmd(~scale_x=-1., ~scale_y=-1.)); 52 | 53 | let transpose_cmd = (v: Vector.t) => 54 | fun 55 | | (Z | M_(_) | L_(_) | H_(_) | V_(_) | A_(_)) as cmd => cmd 56 | | M({x, y}) => M({x: x +. v.dx, y: y +. v.dy}) 57 | | L({x, y}) => L({x: x +. v.dx, y: y +. v.dy}) 58 | | H({x}) => H({x: x +. v.dx}) 59 | | V({y}) => V({y: y +. v.dy}); 60 | let transpose = v => List.map(transpose_cmd(v)); 61 | 62 | let string_of_flag = 63 | fun 64 | | false => "0" 65 | | true => "1"; 66 | 67 | let string_of_command = 68 | fun 69 | | Z => "Z" 70 | | M({x, y}) => Printf.sprintf("M %f %f", x, y) 71 | | M_({dx, dy}) => Printf.sprintf("m %f %f", dx, dy) 72 | | L({x, y}) => Printf.sprintf("L %f %f", x, y) 73 | | L_({dx, dy}) => Printf.sprintf("l %f %f", dx, dy) 74 | | H({x}) => Printf.sprintf("H %f", x) 75 | | H_({dx}) => Printf.sprintf("h %f", dx) 76 | | V({y}) => Printf.sprintf("V %f", y) 77 | | V_({dy}) => Printf.sprintf("v %f", dy) 78 | | A_({rx, ry, x_axis_rotation, large_arc_flag, sweep_flag, dx, dy}) => 79 | Printf.sprintf( 80 | "a %f %f %f %s %s %f %f", 81 | rx, 82 | ry, 83 | x_axis_rotation, 84 | string_of_flag(large_arc_flag), 85 | string_of_flag(sweep_flag), 86 | dx, 87 | dy, 88 | ); 89 | 90 | let view = (~attrs: Attrs.t, path: t): Node.t => { 91 | let buffer = Buffer.create(List.length(path) * 20); 92 | path 93 | |> List.iter(cmd => { 94 | Buffer.add_string(buffer, string_of_command(cmd)); 95 | Buffer.add_string(buffer, " "); 96 | }); 97 | Node.create_svg( 98 | "path", 99 | [Attr.create("d", Buffer.contents(buffer)), ...attrs], 100 | [], 101 | ); 102 | }; 103 | }; 104 | -------------------------------------------------------------------------------- /src/web/util/Unicode.re: -------------------------------------------------------------------------------- 1 | let lam = "λ"; 2 | let up_arrow = "↑"; 3 | let down_arrow = "↓"; 4 | let left_arrow = "←"; 5 | let right_arrow = "→"; 6 | let nbsp = "\xC2\xA0"; 7 | 8 | // copied from hazel 9 | // NOTE: 30% faster than Camomile 10 | let length = (s: string): int => { 11 | let stop = String.length(s); 12 | let rec distance_aux = (start: int, count: int) => 13 | if (start + count >= stop) { 14 | stop - count; 15 | } else { 16 | let n = Char.code(String.unsafe_get(s, start + count)); 17 | if (n < 0x80) { 18 | distance_aux(start + 1, count); 19 | } else if (n < 0xe0) { 20 | distance_aux(start + 1, count + 1); 21 | } else if (n < 0xf0) { 22 | distance_aux(start + 1, count + 2); 23 | } else { 24 | distance_aux(start + 1, count + 3); 25 | }; 26 | }; 27 | 28 | distance_aux(0, 0); 29 | }; 30 | -------------------------------------------------------------------------------- /src/web/util/ViewUtil.re: -------------------------------------------------------------------------------- 1 | open Virtual_dom.Vdom; 2 | open Virtual_dom.Vdom.Node; 3 | 4 | module Js = Js_of_ocaml.Js; 5 | module Dom = Js_of_ocaml.Dom; 6 | module Dom_html = Js_of_ocaml.Dom_html; 7 | 8 | let divc = (cls, contents) => div([Attr.class_(cls)], contents); 9 | 10 | let stop = a => Event.Many([Event.Stop_propagation, a]); 11 | 12 | let prevent = a => Event.Many([Event.Prevent_default, a]); 13 | 14 | let hash_of_string = str => 15 | List.fold_left( 16 | (acc, c) => acc + int_of_char(c), 17 | 0, 18 | List.of_seq(String.to_seq(str)), 19 | ); 20 | 21 | let random_offset = (~bound_x=5, ~bound_y=8, seed_str) => { 22 | Random.init(hash_of_string(seed_str)); 23 | let (x, y) = ( 24 | Random.int(bound_x) - bound_x / 2, 25 | Random.int(bound_y) - bound_y / 2, 26 | ); 27 | Attr.string_property( 28 | "style", 29 | "position: relative; left: " 30 | ++ string_of_int(x) 31 | ++ "px; top: " 32 | ++ string_of_int(y) 33 | ++ "px;", 34 | ); 35 | }; 36 | 37 | let random_skew = (~bound_x=32, ~bound_y=1.2, seed_str) => { 38 | Random.init(hash_of_string(seed_str)); 39 | let (x, y) = ( 40 | Random.int(bound_x) - bound_x / 2, 41 | Random.float(bound_y) -. bound_y /. 2., 42 | ); 43 | Attr.string_property( 44 | "style", 45 | Printf.sprintf("transform: SkewY(%fdeg) SkewX(%ddeg);", y, x), 46 | ); 47 | }; 48 | 49 | /* 50 | Attr.on("dragover", evt => { 51 | let container_rect = 52 | JsUtil.get_elem_by_id("root")##getBoundingClientRect; 53 | let (target_x, target_y) = ( 54 | float_of_int(evt##.clientX), 55 | float_of_int(evt##.clientY), 56 | ); 57 | let blee = 58 | Float.to_int(Float.round(target_y -. container_rect##.top) /. 30.); 59 | let blah = 60 | Float.to_int( 61 | Float.round(target_x -. container_rect##.left) /. 30., 62 | ); 63 | print_endline(string_of_int(evt##.clientX)); 64 | print_endline(string_of_int(evt##.clientY)); 65 | print_endline(string_of_int(blee)); 66 | print_endline(string_of_int(blah)); 67 | Event.Prevent_default; 68 | }) 69 | */ 70 | -------------------------------------------------------------------------------- /src/web/util/WeakMap.re: -------------------------------------------------------------------------------- 1 | // copied from hazel 2 | 3 | module Js = Js_of_ocaml.Js; 4 | 5 | module JS_MAP = { 6 | class type t ('k, 'v) = { 7 | pub get: 'k => Js.meth(Js.optdef('v)); 8 | pub has: 'k => Js.meth(bool); 9 | pub set: ('k, 'v) => Js.meth(t('k, 'v)); 10 | }; 11 | }; 12 | 13 | module JsMap = { 14 | type t('k, 'v) = Js.t(JS_MAP.t('k, 'v)); 15 | 16 | let mk: 'k 'v. unit => t('k, 'v) = 17 | () => { 18 | let c = Js.Unsafe.global##._Map; 19 | %js 20 | new c; 21 | }; 22 | }; 23 | 24 | module JsWeakMap = { 25 | type t('k, 'v) = Js.t(JS_MAP.t('k, 'v)); 26 | 27 | let mk: 'k 'v. unit => t('k, 'v) = 28 | () => { 29 | let c = Js.Unsafe.global##._WeakMap; 30 | %js 31 | new c; 32 | }; 33 | }; 34 | 35 | let is_primitive_representation_impl: Js.Unsafe.top => Js.t(bool) = 36 | // Based on https://stackoverflow.com/questions/8511281/check-if-a-value-is-an-object-in-javascript 37 | Js.Unsafe.pure_js_expr( 38 | " 39 | function (val) { 40 | return (val === null) || (typeof val !== 'function') && (typeof val !== 'object'); 41 | }", 42 | ); 43 | 44 | let is_primitive_representation: 'a. 'a => bool = 45 | x => Js.to_bool(is_primitive_representation_impl(Obj.magic(x))); 46 | 47 | type t('k, 'v) = { 48 | primitive_keys: JsMap.t('k, 'v), 49 | non_primitive_keys: JsWeakMap.t('k, 'v), 50 | }; 51 | 52 | let mk = (): t('k, 'v) => { 53 | {primitive_keys: JsMap.mk(), non_primitive_keys: JsWeakMap.mk()}; 54 | }; 55 | 56 | let get = (t: t('k, 'v), k: 'k): option('v) => { 57 | let map = 58 | if (is_primitive_representation(k)) { 59 | t.primitive_keys; 60 | } else { 61 | t.non_primitive_keys; 62 | }; 63 | Js.Optdef.to_option(map##get(k)); 64 | }; 65 | 66 | let set = (t: t('k, 'v), k: 'k, v: 'v): unit => { 67 | let map = 68 | if (is_primitive_representation(k)) { 69 | t.primitive_keys; 70 | } else { 71 | t.non_primitive_keys; 72 | }; 73 | ignore(map##set(k, v)); 74 | }; 75 | -------------------------------------------------------------------------------- /src/web/view/BlockView.re: -------------------------------------------------------------------------------- 1 | open Update; 2 | open Core; 3 | open ViewUtil; 4 | open CommonView; 5 | open Virtual_dom.Vdom; 6 | open Virtual_dom.Vdom.Node; 7 | 8 | let is_cell_sep_drop_target = (carry: Model.carry, sep_idx) => 9 | switch (carry) { 10 | | WordExp({form: Lit(_) | Unbound(_), path, _}) 11 | when Path.is_cell_idx((==)(sep_idx), path) => 12 | true 13 | | Cell(_) 14 | | CellBrush(_) => true 15 | | _ => false 16 | }; 17 | 18 | let drop_target_class = 19 | (~model as {drop_target, carry, _}: Model.t, this_target, sep_idx) => { 20 | let is_drop_target = 21 | drop_target != NoTarget 22 | && drop_target == this_target 23 | && is_cell_sep_drop_target(carry, sep_idx); 24 | is_drop_target ? ["active-drop-target"] : []; 25 | }; 26 | 27 | let cell_sep_view = (~inj, ~model: Model.t, sep_idx) => { 28 | let this_target: Model.drop_target = CellSepatator(sep_idx); 29 | div( 30 | [ 31 | Attr.classes( 32 | ["cell-separator"] @ drop_target_class(~model, this_target, sep_idx), 33 | ), 34 | Attr.on_click(_ => stop(inj(InsertNewCell(sep_idx)))), 35 | Attr.on("drop", _ => stop(inj(DropOnCellSep(sep_idx)))), 36 | Attr.on("dragover", _ => {Event.Prevent_default}), 37 | Attr.on("dragenter", _ => prevent(inj(SetDropTarget(this_target)))), 38 | ], 39 | [text("")], 40 | ); 41 | }; 42 | 43 | let cell_focus_class = (path: option(Path.t)) => 44 | switch (path) { 45 | | None => "unfocussed" 46 | | Some([]) => "focussed" 47 | | Some(_) => "on-path" 48 | }; 49 | 50 | let cell_view = 51 | ( 52 | ~inj, 53 | ~model, 54 | ~path: option(Path.t), 55 | {path: this_path, expression, pattern, value, uid, _} as ann_cell: AnnotatedBlock.annotated_cell, 56 | idx, 57 | ) 58 | : t => { 59 | let pattern_path = 60 | switch (path) { 61 | | Some([Field(Pattern), ...ps]) => Some(ps) 62 | | _ => None 63 | }; 64 | let expression_path = 65 | switch (path) { 66 | | Some([Field(Expression), ...ps]) => Some(ps) 67 | | _ => None 68 | }; 69 | let value_path = 70 | switch (path) { 71 | | Some([Field(Value), ...ps]) => Some(ps) 72 | | _ => None 73 | }; 74 | div( 75 | [ 76 | random_skew(string_of_int(idx)), 77 | Attr.id(string_of_int(uid)), 78 | Attr.classes(["cell-view", cell_focus_class(path)]), 79 | Attr.create("draggable", "true"), 80 | Attr.on_click(set_focus(this_path, inj)), 81 | Attr.on("drop", _ => stop(inj(DropOnCellSep(idx + 1)))), 82 | Attr.on("dragstart", _ => stop(inj(Pickup(Cell(ann_cell))))), 83 | Attr.on("dragend", _ => inj(SetDropTarget(NoTarget))), 84 | Attr.on("dragover", _evt => {Event.Prevent_default}), 85 | Attr.on("dragenter", _evt => {Event.Prevent_default}), 86 | ], 87 | [ 88 | PatView.view(pattern, ~path=pattern_path, ~inj, ~model), 89 | ExpView.view(expression, ~path=expression_path, ~inj, ~model), 90 | ValView.view(value, ~path=value_path, ~inj), 91 | ], 92 | ); 93 | }; 94 | 95 | let view = (~inj, ~model, ~path: Path.t, cells) => { 96 | let focus = Path.focus_cell(path); 97 | let cell_views = 98 | List.mapi( 99 | (idx, cell) => cell_view(~inj, ~model, ~path=focus(idx), cell, idx), 100 | cells, 101 | ); 102 | let sep_views = 103 | List.init(List.length(cell_views) + 1, cell_sep_view(~inj, ~model)); 104 | let views = Util.ListUtil.interleave(sep_views, cell_views); 105 | div( 106 | [Attr.class_("cells-view"), Attr.on("drop", _ => stop(Event.Ignore))], 107 | views, 108 | ); 109 | }; 110 | -------------------------------------------------------------------------------- /src/web/view/CommonView.re: -------------------------------------------------------------------------------- 1 | open Update; 2 | open Core; 3 | open ViewUtil; 4 | open Virtual_dom.Vdom; 5 | open Virtual_dom.Vdom.Node; 6 | 7 | let atom_focus_class: option(Path.t) => string = 8 | path => 9 | switch (path) { 10 | | None => "unfocussed" 11 | | Some([]) => "focussed" 12 | | Some(_) => "on-path" 13 | }; 14 | 15 | let set_focus = (this_path, inj, _evt) => 16 | stop(inj(SetFocus(SingleCell(this_path)))); 17 | 18 | let focus_word = (path: option(Path.t), i: int): option(Path.t) => 19 | switch (path) { 20 | | Some(path) => Path.focus_word(path, i) 21 | | None => None 22 | }; 23 | 24 | let core_word_view: (Model.pattern_display, Word.t) => t = 25 | (pattern_display, word) => 26 | switch (pattern_display) { 27 | | Emoji => text(Name.emoji_of_default(word.name)) 28 | | Name => text(word.name) 29 | }; 30 | 31 | let word_sep_view = 32 | ( 33 | ~inj, 34 | ~model as {drop_target, carry, world, _}: Model.t, 35 | exp_path: Path.t, 36 | idx, 37 | ) => { 38 | let this_target: Model.drop_target = 39 | switch (exp_path) { 40 | | [Cell(Index(cell_idx, _)), Field(f), ..._] => 41 | WordSeparator((cell_idx, f, idx)) 42 | | _ => NoTarget 43 | }; 44 | /* 45 | for separator at index idx, check if words at idx-1 and idx are empty 46 | */ 47 | 48 | let is_drop_target = 49 | !Path.is_word_sep_touching_empty(exp_path, idx, world) 50 | && drop_target != NoTarget 51 | && drop_target == this_target 52 | && ( 53 | switch (carry, Path.cell_idx(exp_path)) { 54 | | (WordPat({form: Some(Var(_)), path, _}), Some(exp_idx)) 55 | when Path.is_cell_idx((>)(exp_idx), path) => 56 | true 57 | | (WordExp(_) | WordBrush(_), _) => true 58 | | _ => false 59 | } 60 | ); 61 | div( 62 | [ 63 | Attr.classes( 64 | ["word-separator"] @ (is_drop_target ? ["active-drop-target"] : []), 65 | ), 66 | Attr.on_click(_ => stop(inj(InsertNewWord(exp_path, idx)))), 67 | Attr.on("drop", _ => stop(inj(DropOnWordSep(exp_path, idx)))), 68 | Attr.on("dragover", _ => Event.Prevent_default), 69 | Attr.on("dragenter", _ => prevent(inj(SetDropTarget(this_target)))), 70 | //Attr.on("dragleave", _evt => inj(SetDropTarget(NoTarget))), 71 | ], 72 | [text("·")], 73 | ); 74 | }; 75 | -------------------------------------------------------------------------------- /src/web/view/ExpView.re: -------------------------------------------------------------------------------- 1 | open Update; 2 | open Core; 3 | open ViewUtil; 4 | open CommonView; 5 | open Virtual_dom.Vdom; 6 | open Virtual_dom.Vdom.Node; 7 | 8 | let exp_atom_class: Expression.atom => string = 9 | fun 10 | | Lit(_) => "exp-atom-lit" 11 | | Var(_) => "exp-atom-var" 12 | | Unbound(_) => "exp-atom-unbound" 13 | | Operator(_) => "exp-atom-operator" 14 | | Formless(_) => "exp-atom-formless"; 15 | 16 | let expression_class: Expression.t => string = 17 | fun 18 | | Atom(_) => "expr-singleton" 19 | | App(_) => "expr-app" 20 | | Seq(_) => "expr-seq" 21 | | _ => "expr-unknown"; 22 | 23 | let exp_atom_view = 24 | ( 25 | {word, path: this_path, form, _} as ann_word: AnnotatedBlock.annotated_word_exp, 26 | ~path: option(Path.t), 27 | ~inj, 28 | ~model: Model.t, 29 | ) 30 | : t => { 31 | let this_target: Model.drop_target = 32 | switch (this_path) { 33 | | [Cell(Index(cell_idx, _)), Field(f), Word(Index(word_idx, _)), ..._] => 34 | Word((cell_idx, f, word_idx)) 35 | | _ => NoTarget 36 | }; 37 | let is_drop_target = 38 | model.drop_target != NoTarget 39 | && model.drop_target == this_target 40 | && ( 41 | switch (model.carry, Path.cell_idx(this_path)) { 42 | | (WordPat({form: Some(Var(_)), path, _}), Some(exp_idx)) 43 | when Path.is_cell_idx((>)(exp_idx), path) => 44 | true 45 | | (WordExp(_) | WordBrush(_), _) => true 46 | | _ => false 47 | } 48 | ); 49 | let binding_highlight_class = 50 | switch (form, model.focus) { 51 | | (Var(_, binding_path), SingleCell(focussed_path)) 52 | when binding_path == focussed_path => [ 53 | "binder-selected", 54 | ] 55 | | _ => [] 56 | }; 57 | let word_view = 58 | switch (form) { 59 | | Var(_) => core_word_view(model.pattern_display, word) 60 | | _ => text(word.name) 61 | }; 62 | div( 63 | [ 64 | random_offset(word.name), 65 | //Attr.id(atom_focus_class(path) == "focussed" ? "-1" : ""), 66 | Attr.classes( 67 | [ 68 | "atom", 69 | "expression-atom", 70 | exp_atom_class(form), 71 | atom_focus_class(path), 72 | ] 73 | @ binding_highlight_class 74 | @ (is_drop_target ? ["active-drop-target"] : []), 75 | ), 76 | Attr.on_click(set_focus(this_path, inj)), 77 | Attr.create("draggable", "true"), 78 | Attr.on("dragstart", _ => stop(inj(Pickup(WordExp(ann_word))))), 79 | Attr.on("dragenter", _ => 80 | stop(prevent(inj(SetDropTarget(this_target)))) 81 | ), 82 | Attr.on("dragend", _ => inj(SetDropTarget(NoTarget))), 83 | Attr.on("drop", _ => stop(inj(DropOnWord(this_path)))), 84 | ], 85 | [word_view], 86 | ); 87 | }; 88 | 89 | let view = 90 | ( 91 | {words, path: path_this, form, _}: AnnotatedBlock.annotated_exp, 92 | ~path: option(Path.t), 93 | ~inj, 94 | ~model, 95 | ) => { 96 | let word_views = 97 | List.mapi( 98 | (idx, word) => 99 | exp_atom_view(word, ~path=focus_word(path, idx), ~inj, ~model), 100 | words, 101 | ); 102 | let sep_views = 103 | List.init( 104 | List.length(word_views) + 1, 105 | word_sep_view(~inj, ~model, path_this), 106 | ); 107 | div( 108 | [ 109 | Attr.classes([ 110 | "expression-view", 111 | atom_focus_class(path), 112 | expression_class(form), 113 | ]), 114 | ], 115 | Util.ListUtil.interleave(sep_views, word_views), 116 | ); 117 | }; 118 | -------------------------------------------------------------------------------- /src/web/view/PatView.re: -------------------------------------------------------------------------------- 1 | open Update; 2 | open Core; 3 | open ViewUtil; 4 | open CommonView; 5 | open Virtual_dom.Vdom; 6 | open Virtual_dom.Vdom.Node; 7 | 8 | let pattern_class: option(Pattern.t) => string = 9 | fun 10 | | Some(Atom(_)) => "pat-singleton" 11 | | _ => "pat-unknown"; 12 | 13 | let pat_atom_classes: option(Pattern.atom) => list(string) = 14 | fun 15 | | Some(Lit(_)) => ["pat-atom-lit"] 16 | | Some(Var(_, uses)) => { 17 | let uses = 18 | switch (uses) { 19 | | [] => ["unused"] 20 | | [_] => ["single-use"] 21 | | _ => ["many-uses"] 22 | }; 23 | ["pat-atom-var"] @ uses; 24 | } 25 | | _ => ["pat-atom-formless"]; 26 | 27 | let use_highlight_classes = (form: option(Pattern.atom), focus: Model.focus) => 28 | switch (form, focus) { 29 | | (Some(Var(_, uses)), SingleCell(focussed_path)) 30 | when List.mem(focussed_path, uses) => [ 31 | "use-selected", 32 | ] 33 | | _ => [] 34 | }; 35 | 36 | let pat_word_view = 37 | (~pattern_display, {word, form, _}: AnnotatedBlock.annotated_word_pat) => 38 | switch (form) { 39 | | Some(Var(_)) => core_word_view(pattern_display, word) 40 | | _ => text(word.name) 41 | }; 42 | 43 | let pat_atom_view = 44 | ( 45 | {word, path: this_path, form, _} as ann_pat: AnnotatedBlock.annotated_word_pat, 46 | ~path: option(Path.t), 47 | ~inj, 48 | ~model as {pattern_display, focus, _}: Model.t, 49 | ) 50 | : t => { 51 | div( 52 | [ 53 | random_offset(word.name), 54 | Attr.classes( 55 | ["atom", "pattern-atom", atom_focus_class(path)] 56 | @ pat_atom_classes(form) 57 | @ use_highlight_classes(form, focus), 58 | ), 59 | Attr.on_click(set_focus(this_path, inj)), 60 | Attr.create("draggable", "true"), 61 | Attr.on("dragstart", _ => stop(inj(Pickup(WordPat(ann_pat))))), 62 | ], 63 | [pat_word_view(~pattern_display, ann_pat)], 64 | ); 65 | }; 66 | 67 | let view = 68 | ( 69 | {words, form, _}: AnnotatedBlock.annotated_pat, 70 | ~path: option(Path.t), 71 | ~inj, 72 | ~model, 73 | ) => 74 | div( 75 | [ 76 | Attr.classes([ 77 | "pattern-view", 78 | atom_focus_class(path), 79 | pattern_class(form), 80 | ]), 81 | ], 82 | List.mapi( 83 | (idx, word) => 84 | pat_atom_view(word, ~path=focus_word(path, idx), ~inj, ~model), 85 | words, 86 | ), 87 | ); 88 | -------------------------------------------------------------------------------- /src/web/view/ValView.re: -------------------------------------------------------------------------------- 1 | open Update; 2 | open Core; 3 | open ViewUtil; 4 | open CommonView; 5 | open Virtual_dom.Vdom; 6 | open Virtual_dom.Vdom.Node; 7 | 8 | let val_atom_view = 9 | ( 10 | {word, path: this_path, form, _}: AnnotatedBlock.annotated_word_val, 11 | ~path: option(Path.t), 12 | ~inj, 13 | ) 14 | : t => 15 | div( 16 | [ 17 | random_offset(word.name), 18 | Attr.classes( 19 | ["atom", "value-atom", atom_focus_class(path)] 20 | @ ( 21 | switch (form) { 22 | | Unknown(_) => ["value-unknown"] 23 | | _ => [] 24 | } 25 | ), 26 | ), 27 | Attr.on_click(set_focus(this_path, inj)), 28 | ], 29 | [text(word.name)], 30 | ); 31 | 32 | let view = 33 | ( 34 | {words, path: _, _}: AnnotatedBlock.annotated_val, 35 | ~path: option(Path.t), 36 | ~inj, 37 | ) => 38 | div( 39 | [Attr.classes(["value-view", atom_focus_class(path)])], 40 | List.mapi( 41 | (idx, word) => val_atom_view(word, ~path=focus_word(path, idx), ~inj), 42 | words, 43 | ), 44 | ); 45 | -------------------------------------------------------------------------------- /src/web/view/View.re: -------------------------------------------------------------------------------- 1 | open Update; 2 | open Core; 3 | open ViewUtil; 4 | open CommonView; 5 | open Virtual_dom.Vdom; 6 | open Virtual_dom.Vdom.Node; 7 | 8 | let title_view = (~model as _, ~inj as _) => 9 | div( 10 | [ 11 | Attr.class_("title"), 12 | Attr.on("dragover", _evt => {Event.Prevent_default}), 13 | Attr.on("dragenter", _evt => {Event.Prevent_default}), 14 | ], 15 | [ 16 | divc("title-f", [text("f")]), 17 | divc("title-u", [text("u")]), 18 | divc("title-r", [text("r")]), 19 | divc("title-l", [text("l")]), 20 | ], 21 | ); 22 | 23 | let brush_view = (~inj, ~model as _: Model.t, word): t => { 24 | div( 25 | [ 26 | random_offset(word), 27 | Attr.classes(["atom", "toolbar-atom"]), 28 | Attr.create("draggable", "true"), 29 | Attr.on_mousedown(_ => Event.(Many([Stop_propagation]))), 30 | Attr.on_click(_ => stop(inj(UniFocus(UpdateWordF(_ => word))))), 31 | Attr.on("dragstart", _ => stop(inj(Pickup(WordBrush(word))))), 32 | Attr.on("dragend", _ => inj(SetDropTarget(NoTarget))), 33 | ], 34 | [text(word)], 35 | ); 36 | }; 37 | 38 | let brushes_panel = (~inj, ~model): t => 39 | div( 40 | [Attr.classes(["toolbar"])], 41 | List.map( 42 | brush_view(~inj, ~model), 43 | ["sum", "prod", "fact", "1337", "0", "1", "+", "*"], 44 | ), 45 | ); 46 | 47 | let trash_item_view = (~inj, trash_idx, item) => { 48 | let (item_view, x, y) = 49 | switch (item) { 50 | | Model.TrashedWord(word, (x, y)) => (text(word.name), x, y) 51 | | Model.TrashedCell(cell, (x, y)) => 52 | switch (cell.pattern) { 53 | | [w, ..._] => (text(w.name ++ "..."), x, y) 54 | | _ => (text("lol"), x, y) 55 | } 56 | }; 57 | div( 58 | [ 59 | Attr.class_("trash-item"), 60 | Attr.create("draggable", "true"), 61 | Attr.on("dragstart", _ => stop(inj(PickupTrash(trash_idx)))), 62 | Attr.on("dragend", _ => inj(SetDropTarget(NoTarget))), 63 | Attr.string_property( 64 | "style", 65 | Printf.sprintf("position: absolute; top:%dpx; left: %dpx;", y, x), 66 | ), 67 | ], 68 | [item_view], 69 | ); 70 | }; 71 | 72 | let trash_view = (~inj, ~model as {trash, _}: Model.t) => 73 | div([Attr.class_("trash")], List.mapi(trash_item_view(~inj), trash)); 74 | 75 | let toggle_panel = (name, icon, action, ~inj, is_off) => 76 | div( 77 | [ 78 | Attr.classes([name] @ (is_off ? ["panel-off"] : [])), 79 | Attr.on_click(_ => inj(action)), 80 | ], 81 | [text(icon)], 82 | ); 83 | 84 | let trash_panel = toggle_panel("trash-panel", "🗑", EmptyTrash); 85 | let anim_control_panel = 86 | toggle_panel("anim-control-panel", "🎬", ToggleAnimations); 87 | 88 | let cell_control_panel = (~inj, pattern_display) => 89 | div( 90 | [ 91 | Attr.classes( 92 | ["cell-control-panel"] 93 | @ (pattern_display == Model.Emoji ? ["panel-off"] : []), 94 | ), 95 | Attr.on_click(_ => inj(TogglePatternDisplay)), 96 | ], 97 | [text("P")], 98 | ); 99 | 100 | let view = (~inj, ~model: Model.t) => { 101 | let {cells, _}: AnnotatedBlock.t = AnnotatedBlock.mk(model.world); 102 | let SingleCell(path) = model.focus; 103 | let block_class = 104 | switch (path) { 105 | | [] => "focussed" 106 | | _ => "on-path" 107 | }; 108 | let trash_carry = evt => inj(TrashCarry((evt##.clientX, evt##.clientY))); 109 | let focus_root = _ => inj(SetFocus(SingleCell([]))); 110 | div( 111 | [Attr.class_(block_class)] 112 | @ [ 113 | Attr.id("root"), 114 | Attr.on_click(focus_root), 115 | Attr.on("drop", trash_carry), 116 | Attr.on("dragover", _ => Event.Prevent_default), 117 | Attr.on("dragenter", _ => Event.Prevent_default), 118 | ...Keyboard.handlers(~inj, model), 119 | ], 120 | [ 121 | title_view(~inj, ~model), 122 | trash_panel(~inj, model.trash == []), 123 | anim_control_panel(~inj, model.animations_off), 124 | cell_control_panel(~inj, model.pattern_display), 125 | brushes_panel(~inj, ~model), 126 | trash_view(~inj, ~model), 127 | BlockView.view(~inj, ~model, ~path, cells), 128 | ], 129 | ); 130 | }; 131 | 132 | /* 133 | TODO: styling 134 | 135 | - expressions (context-sensitive): 136 | - operators: adjacent-to-bad-word: opacity 137 | - expressions (fancy-semantic) 138 | - word: type-mismatch: color 139 | 140 | - patterns (context-sensitive) 141 | - word: var: starred: color (same as 2+uses) 142 | 143 | - values (context-free) 144 | - word: warning tag: add ? 145 | 146 | MISC: seperate ? on atoms into div for styling 147 | */ 148 | -------------------------------------------------------------------------------- /src/web/www/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (copy ../main.bc.js furl.js)) 3 | -------------------------------------------------------------------------------- /src/web/www/fonts/FiraCode-Bold.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/disconcision/furl/4967561c010bdfc65a5100d6c2db266b3fcc0a50/src/web/www/fonts/FiraCode-Bold.woff2 -------------------------------------------------------------------------------- /src/web/www/fonts/FiraCode-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/disconcision/furl/4967561c010bdfc65a5100d6c2db266b3fcc0a50/src/web/www/fonts/FiraCode-Regular.woff2 -------------------------------------------------------------------------------- /src/web/www/fonts/HelveticaNeue-Bold.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/disconcision/furl/4967561c010bdfc65a5100d6c2db266b3fcc0a50/src/web/www/fonts/HelveticaNeue-Bold.woff2 -------------------------------------------------------------------------------- /src/web/www/fonts/HelveticaNeue-Regular.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/disconcision/furl/4967561c010bdfc65a5100d6c2db266b3fcc0a50/src/web/www/fonts/HelveticaNeue-Regular.woff2 -------------------------------------------------------------------------------- /src/web/www/fonts/SourceCodePro-Black.otf.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/disconcision/furl/4967561c010bdfc65a5100d6c2db266b3fcc0a50/src/web/www/fonts/SourceCodePro-Black.otf.woff2 -------------------------------------------------------------------------------- /src/web/www/fonts/SourceCodePro-Bold.otf.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/disconcision/furl/4967561c010bdfc65a5100d6c2db266b3fcc0a50/src/web/www/fonts/SourceCodePro-Bold.otf.woff2 -------------------------------------------------------------------------------- /src/web/www/fonts/SourceCodePro-Regular.otf.woff2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/disconcision/furl/4967561c010bdfc65a5100d6c2db266b3fcc0a50/src/web/www/fonts/SourceCodePro-Regular.otf.woff2 -------------------------------------------------------------------------------- /src/web/www/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | furl 10 | 11 | 12 | 13 | 14 | 26 | 27 | 28 | 29 | 30 |
31 | 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /src/web/www/style.css: -------------------------------------------------------------------------------- 1 | @font-face { 2 | font-family: 'Fira Code'; 3 | font-style: normal; 4 | font-weight: normal; 5 | src: url('fonts/FiraCode-Regular.woff2') format('woff2'); 6 | } 7 | 8 | @font-face { 9 | font-family: 'Fira Code'; 10 | font-style: normal; 11 | font-weight: bold; 12 | src: url('fonts/FiraCode-Bold.woff2') format('woff2'); 13 | } 14 | 15 | @font-face { 16 | font-family: 'Karla'; 17 | font-style: normal; 18 | font-weight: normal; 19 | src: url(https://fonts.gstatic.com/s/karla/v14/qkBIXvYC6trAT55ZBi1ueQVIjQTD-JqaE0lK.woff2) format('woff2'); 20 | unicode-range: U+0000-00FF, U+0131, U+0152-0153, U+02BB-02BC, U+02C6, U+02DA, U+02DC, U+2000-206F, U+2074, U+20AC, U+2122, U+2191, U+2193, U+2212, U+2215, U+FEFF, U+FFFD; 21 | } 22 | 23 | @font-face { 24 | font-family: 'Helvetica Neue'; 25 | font-style: normal; 26 | font-weight: normal; 27 | src: url('fonts/HelveticaNeue-Regular.woff2') format('woff2'); 28 | } 29 | 30 | @font-face { 31 | font-family: 'Helvetica Neue'; 32 | font-style: normal; 33 | font-weight: bold; 34 | src: url('fonts/HelveticaNeue-Bold.woff2') format('woff2'); 35 | } 36 | 37 | @font-face{ 38 | font-family: 'Source Code Pro'; 39 | font-weight: normal; 40 | font-style: normal; 41 | font-stretch: normal; 42 | src: url('fonts/SourceCodePro-Regular.otf.woff2') format('woff2'); 43 | } 44 | 45 | @font-face{ 46 | font-family: 'Source Code Pro'; 47 | font-weight: bold; 48 | font-style: normal; 49 | font-stretch: normal; 50 | src: url('fonts/SourceCodePro-Bold.otf.woff2') format('woff2'); 51 | } 52 | 53 | @font-face{ 54 | font-family: 'Source Code Pro'; 55 | font-weight: 900; 56 | font-style: normal; 57 | font-stretch: normal; 58 | src: url('fonts/SourceCodePro-Black.otf.woff2') format('woff2'); 59 | } 60 | 61 | :root { 62 | 63 | --base-radius: 0.1em; 64 | --main_background-color: #e8e2ff; 65 | 66 | } 67 | 68 | /* furl */ 69 | 70 | * { 71 | box-sizing: border-box; 72 | } 73 | 74 | body { 75 | background-image: radial-gradient(#f9a7fe 0.5px, #e8e2ff 1px); 76 | background-size: 1.6rem 1.6rem; 77 | } 78 | 79 | #root { 80 | min-height: 100vh; 81 | padding: 5em; 82 | font-family: 'Press Start 2P', monospace; 83 | font-size: 1.6rem; 84 | display: flex; 85 | justify-content: center; 86 | } 87 | 88 | .title { 89 | position: fixed; 90 | top: 0; 91 | left: 0; 92 | font-size: 1.5em; 93 | display: flex; 94 | height: 3em; 95 | transform: scale(66%) skewY(2deg) skewX(17deg); 96 | } 97 | .title-f { 98 | position: relative; 99 | color: #9699f6; 100 | background-color: #e1d8fd; 101 | border-bottom-left-radius: 1em; 102 | text-shadow: 3px 0 #7d346b; 103 | } 104 | .title *:hover { 105 | transform: skewY(7deg) scale(1.3); 106 | text-shadow: 3px 0 #fe00be; 107 | box-shadow: 6px 0px #edff00; 108 | } 109 | .title-u { 110 | position: relative; 111 | top: 4px; 112 | right: -2px; 113 | color: #f56197; 114 | background-color: #d3dcff; 115 | text-shadow: 3px 0 #00ffee; 116 | } 117 | .title-r { 118 | position: relative; 119 | top: -4px; 120 | right: -2px; 121 | color: rgb(44 210 196); 122 | background-color: #fdd6f6; 123 | text-shadow: 3px 0 #00ffee; 124 | } 125 | .title-l { 126 | position: relative; 127 | top: 1px; 128 | right: -3px; 129 | color: rgb(255 180 64); 130 | background-color: #caf1cd; 131 | border-bottom-right-radius: 3em; 132 | text-shadow: 3px 0 #009aff; 133 | } 134 | 135 | .cells-view { 136 | width: 38em; 137 | height: fit-content; 138 | padding: 1em 0 1em 0; 139 | } 140 | 141 | .cell-view { 142 | display: flex; 143 | justify-content: space-between; 144 | /*height: 1.5em;*/ 145 | border-radius: var(--base-radius); 146 | padding-left: 1em; /* HACK */ 147 | cursor: pointer; 148 | } 149 | 150 | .cell-view.on-path { 151 | background-color: #d1ccf877; 152 | outline: solid 0.2em #d1ccf877; 153 | border-radius: 0px; 154 | } 155 | .cell-view:hover { 156 | background-color: #caa2ff22; 157 | outline: solid 0.2em #caa2ff22; 158 | } 159 | .cell-view.focussed { 160 | background-color: #fffa9d; 161 | outline: solid 0.2em #fff881; 162 | border-radius: 0px; 163 | box-shadow: 0.2em 0.15em 0 0.2em #9799f6; 164 | } 165 | .cell-view.focussed .expression-view.expr-app, 166 | .cell-view.focussed .exp-atom-operator { 167 | background-color: #fffff1; 168 | outline: solid 0.3em #fffff0; 169 | box-shadow: 0px 4px 0px 0.3em #9699f6; 170 | } 171 | 172 | .expression-view, .pattern-view, .value-view { 173 | display: flex; 174 | /*gap: 1em;*/ 175 | height: 0.8em; 176 | align-items: center; 177 | } 178 | 179 | .pattern-view { 180 | } 181 | 182 | .pattern-atom.pat-atom-var.unused { 183 | color: #b0b2e3; 184 | text-shadow: 4px 2px #f3f3f3; 185 | } 186 | .pattern-atom.pat-atom-var.single-use { 187 | color: #f56197; 188 | /*text-shadow: 3px 2px #00fff1;*/ 189 | } 190 | .pattern-atom.pat-atom-var.many-uses { 191 | color: #f56197; 192 | /*text-shadow: 3px 2px #00fff1;*/ 193 | text-decoration: underline; 194 | } 195 | 196 | .pattern-atom.pat-atom-var.use-selected { 197 | color: #e4ff03 !important; 198 | text-shadow: 2px 2px #140614, -2px -2px #cbc6cb; 199 | } 200 | 201 | .expression-view { 202 | position: relative; 203 | } 204 | 205 | .expression-view.expr-app { 206 | background-color: #efe9fe; 207 | outline: solid 0.3em #efe9fe; 208 | box-shadow: 1px 1px 0px 0.3em #dcd6eb; 209 | border-top-left-radius: 0.1em; 210 | /* border-bottom-left-radius: 0.3em;*/ 211 | } 212 | .expression-view.expr-app .expression-atom:nth-child(2) { 213 | color: #83b8c9; 214 | } 215 | 216 | .value-view { 217 | color: rgb(44 210 196); 218 | /*text-shadow: 2px 1px #184a35;*/ 219 | } 220 | 221 | .value-atom.value-unknown { 222 | color: var(--main_background-color); 223 | background-color: rgb(44 210 196); 224 | outline: solid 1px rgb(44 210 196); 225 | } 226 | 227 | .expression-atom { 228 | color: #194b57; 229 | } 230 | 231 | .expression-atom, .pattern-atom { 232 | display: inline-block; 233 | cursor: pointer; 234 | } 235 | 236 | .expression-atom.binder-selected { 237 | color: #e4ff03; 238 | text-shadow: 2px 2px #140614, -2px -2px #cbc6cb; 239 | } 240 | 241 | .expression-atom.exp-atom-unbound, 242 | .expression-atom.exp-atom-formless { 243 | background-color: #a9a1cd; 244 | color: #e7e2fd; 245 | outline: solid 1px #a9a1cd; 246 | } 247 | .expression-atom.exp-atom-unbound.focussed, 248 | .expression-atom.exp-atom-formless.focussed { 249 | background-color: rgb(68 62 84); 250 | color: #e4ff03; 251 | outline: solid 1px rgb(68 62 84); 252 | } 253 | 254 | .expression-atom.exp-atom-unbound::after, .expression-atom.exp-atom-formless::after { 255 | content: "?"; 256 | } 257 | 258 | .expression-atom.exp-atom-operator{ 259 | background-color: #efe9fe; 260 | outline: solid 0.1em #efe9fe; 261 | box-shadow: 1px 1px 0px 0.1em #d5cfe3; 262 | color: #83b8c9; 263 | border-radius: 0.3em 0.3em 0.3em 0em; 264 | } 265 | 266 | .expression-atom.active-drop-target { 267 | color: #ff0000 !important; 268 | background-color: rgba(51 0 87 / 60%) !important; 269 | outline: none !important; 270 | transform: skew(10deg, 2deg) rotate(-5deg); 271 | text-decoration: line-through; 272 | /*transform: scale(135%);*/ 273 | } 274 | 275 | .atom.on-path, .atom.focussed { 276 | outline: solid 2px #e4ff00; 277 | background-color: #e4ff00; 278 | /*color: #9799f6 !important;*/ 279 | border-radius: 0em; 280 | box-shadow: 6px 3px #9799f6; 281 | text-shadow: none !important; 282 | /* temp, replace with random: */ 283 | transform: skewX(12deg) skewY(-1.4deg); 284 | } 285 | 286 | .atom:hover, 287 | .pattern-atom.pat-atom-var:hover, 288 | .expression-view.expr-app .expression-atom:hover { 289 | color: #00fbf1; 290 | text-shadow: 1px 2px #1ecdbb; 291 | transform: scale(1.13); 292 | } 293 | 294 | .word-separator{ 295 | display: flex; 296 | color: #0000; 297 | border-radius: var(--base-radius); 298 | cursor: cell; 299 | justify-content: center; 300 | } 301 | 302 | .word-separator:only-child{ 303 | width: 14em; 304 | } 305 | 306 | .word-separator:last-child{ 307 | position: absolute; 308 | right: -2em; 309 | width: 2em; 310 | } 311 | .word-separator:first-child{ 312 | position: absolute; 313 | left: -2em; 314 | width: 2em; 315 | } 316 | 317 | .word-separator:hover{ 318 | color: #9799f6; 319 | } 320 | 321 | .word-separator.active-drop-target { 322 | background-color: beige; 323 | outline: double 1em beige; 324 | border-radius: 0.1em; 325 | } 326 | 327 | .expression-atom.active-drop-target { 328 | background-color: beige; 329 | outline: double 1em beige; 330 | border-radius: 0.1em; 331 | } 332 | 333 | .cell-separator { 334 | height: 0.9em; 335 | border-radius: 0.1em; 336 | } 337 | 338 | .cell-separator.active-drop-target { 339 | background-color: beige; 340 | border-radius: 0.1em; 341 | } 342 | 343 | .cell-separator:first-child, .cell-separator:last-child { 344 | height: 0.8em; 345 | } 346 | 347 | .cell-separator:hover:first-child, .cell-separator:hover:last-child { 348 | /*outline: double 0.5em rgba(245 245 220 / 33%);*/ 349 | } 350 | .cell-separator:hover:not(:first-child):not(:last-child) { 351 | border-radius: 0.5em; 352 | } 353 | .cell-separator:hover{ 354 | background-color: rgb(245 245 220 / 33%); 355 | cursor: row-resize; 356 | } 357 | 358 | .toolbar { 359 | position: fixed; 360 | z-index: 1; 361 | top: 0.6em; 362 | right: 0.6em; 363 | background-color: #c4b4ff55; 364 | transform: skew(-3deg, 1deg); 365 | display: flex; 366 | flex-wrap: wrap; 367 | gap: 0.5em; 368 | border-radius: 1em 0 1em 0; 369 | padding: 0.2em; 370 | float: right; 371 | color: #bdfff6; 372 | text-shadow: 1px 1px #fe19b9; 373 | width: 9em; 374 | justify-content: space-around; 375 | box-shadow: -1px -1px 0px 0px #d9f5f9, 1px 1px 0px 0px #e3b9f1; 376 | } 377 | 378 | .toolbar-atom:hover { 379 | text-shadow: 3px 2px #00fff1; 380 | color: #e4ff00; 381 | } 382 | 383 | .trash-item { 384 | opacity: 0.1; 385 | text-decoration-line: line-through; 386 | transform: skewX(-20deg) skewY(3deg); 387 | color: #3500ff; 388 | } 389 | 390 | .trash-panel { 391 | position: fixed; 392 | top: 0.5em; 393 | left: 5.8em; 394 | z-index: 1; 395 | cursor: pointer; 396 | } 397 | 398 | .trash-panel:hover { 399 | transform: rotate(35deg); 400 | text-shadow: 9px 4px yellow; 401 | } 402 | 403 | .anim-control-panel { 404 | position: fixed; 405 | top: 0.5em; 406 | left: 7.5em; 407 | z-index: 1; 408 | cursor: pointer; 409 | } 410 | 411 | .cell-control-panel { 412 | position: fixed; 413 | top: 0.7em; 414 | left: 9.3em; 415 | z-index: 1; 416 | cursor: pointer; 417 | color: #f56197; 418 | } 419 | 420 | .trash-panel:hover, 421 | .cell-control-panel:hover, 422 | .anim-control-panel:hover { 423 | transform: rotate(35deg); 424 | text-shadow: 9px 4px yellow; 425 | } 426 | 427 | .panel-off { 428 | opacity: 21%; 429 | } -------------------------------------------------------------------------------- /src/web/www/test-meeee.m4a: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/disconcision/furl/4967561c010bdfc65a5100d6c2db266b3fcc0a50/src/web/www/test-meeee.m4a --------------------------------------------------------------------------------