the next generation of the in-browser educational proof assistant
1
fork

Configure Feed

Select the types of activity you want to include in your feed.

add atom prelude functionality #2

open opened by joshcbrown.tngl.sh targeting main from joshcbrown.tngl.sh/holbert-ng: assoc-comm-atom

this is an mvp to show a way of adding special builtins with access to the internal structure of atoms. the immediate use case is providing a length function on strings, which evaluates to a Nat. this expands quite drastically the set of predicates we're able to describe, because previously there was no way to separate ground parts of a string given that epsilon can unify with anything.

it's nice in that there's no need to change any of the signatures, apart from the introduction of reduce--- Preludic.Atom simply has type t = anyValue and gives a dummy wrap definition. where a prelude function can be evaluated syntactically, this evaluation can take place in parse, which directly produces the right tag and anyValue.

where we need to defer evaluation of a prelude function until a concrete substitution has been chosen, we parse into a two-dimensional anyValue:

  length("$s")
        │
        │parse()
        │
        │
        ▼
┌───────────────┐ sub(0 -> [a b])┌───────────────┐ reduce()     ┌────────────┐
│   PreludeTag  ├───────────────►│  PreludeTag   ├─────────────►│ NatTag     │
└───────┬───────┘                └───────────────┘              └─────┬──────┘
        │                                │                            │
        │                                │                            │
        │                                │                            │
┌───────┴───────┐                ┌───────┴───────┐             ┌──────────────┐
│  LengthTag    │                │  LengthTag    │             │      2       │
└───────┬───────┘                └───────┬───────┘             └──────────────┘
        │                                │
        │                                │
        │                                │
┌───────┴───────┐                ┌───────┴───────┐
│[Var({idx: 0})]│                │ [ a, b]       │
└───────────────┘                └───────────────┘
Labels

None yet.

assignee

None yet.

Participants 1
AT URI
at://did:plc:2b3sedxepcp6u7s2najxr2zm/sh.tangled.repo.pull/3mke3eh2j2t22
+178 -6
Diff #1
+35
index.html
··· 248 248 .symbol-nat { 249 249 color: var(--symbol-nat-col) 250 250 } 251 + .symbol-prelude { 252 + color: var(--symbol-prelude-col) 253 + } 251 254 .symbol-turnstile { 252 255 padding-left: 6px; 253 256 padding-right: 6px; ··· 675 678 (Term (Cons (f nat(2)) (Cons (a nat(0)) Empty)) (Func f (Cons (Const a) (Cons (Var nat(1)) Empty)))) 676 679 |- ? 677 680 </hol-string-proof> 681 + <hol-string id="index.html/palindrome" deps="index.html/myconfig"> 682 + a. 683 + -------- Eq 684 + (Eq a a) 685 + 686 + s. 687 + (Eq length("$s") nat(1)) 688 + ---------------------- Singleton 689 + (Singleton "$s") 690 + 691 + s. (Singleton "$s") 692 + ---------------------- Rev-1 693 + (Rev "$s" "$s") 694 + 695 + s. ss. ssRev. (Rev "$ss" "$ssRev") (Singleton "$s") 696 + ----------------------- Rev-n 697 + (Rev "$s $ss" "$ssRev $s") 698 + 699 + s. sRev. (Rev "$s" "$sRev") 700 + ---------------------- Palindrome-Even 701 + (Palindrome "$s $sRev") 702 + 703 + s. sRev. m. (Rev "$s" "$sRev") 704 + ---------------------- Palindrome-Odd 705 + (Palindrome "$s $m $sRev") 706 + </hol-string> 707 + <hol-string-proof id="index.html/foobar" deps="index.html/myconfig index.html/palindrome"> 708 + ------------------ dlads 709 + (Palindrome "a b c b a") 710 + |- ? 711 + </hol-string-proof> 712 + 678 713 <hol-string id="index.html/string-silliness" deps="index.html/myconfig"> 679 714 a. 680 715 -------------- eq-refl
+1
src/AssocComm.res
··· 204 204 let full = term->between(token(Const.openTerm), token(Const.closeTerm)) 205 205 Parser.runParser(full, str) 206 206 } 207 + let reduce = t => t 207 208 208 209 let substitute = (atom: t, subst: subst): t => { 209 210 let substituted =
+4
src/AtomDef.res
··· 11 11 let upshift: (t, int, ~from: int=?) => t 12 12 let substDeBruijn: (t, array<option<t>>, ~from: int=?) => t 13 13 let concrete: t => bool 14 + let reduce: t => t 14 15 let coerce: anyValue => option<t> 15 16 } 16 17 ··· 45 46 let upshift = (_, _, ~from as _=?) => throw(AtomExpected) 46 47 let substDeBruijn = (_, _, ~from as _=?) => throw(AtomExpected) 47 48 let concrete = _ => throw(AtomExpected) 49 + let reduce = _ => throw(AtomExpected) 48 50 } 49 51 50 52 module MakeAtomChoice = (Left: ATOM, Right: ATOM_CHOICE): ( ··· 105 107 )->LeftBase.wrap 106 108 ) 107 109 ->getOrElse(() => Right.substDeBruijn(atom, substs, ~from?)) 110 + let reduce = atom => 111 + atom->onLeft(val => Left.reduce(val)->LeftBase.wrap)->getOrElse(() => Right.reduce(atom)) 108 112 let concrete = atom => atom->onLeft(Left.concrete)->getOrElse(() => Right.concrete(atom)) 109 113 } 110 114
+108
src/Preludic.res
··· 1 + module Base = { 2 + type t = AtomBase.anyValue 3 + type AtomBase.atomTag<_> += Tag: AtomBase.atomTag<t> 4 + let wrap = t => t 5 + let wrapForReal = t => AtomBase.AnyValue(Tag, t) 6 + } 7 + 8 + type AtomBase.atomTag<_> += LengthTag: AtomBase.atomTag<StringA.t> 9 + 10 + exception ShouldNotCallPrelude 11 + exception NonPreludicValuePassed 12 + module Atom = { 13 + module Base = Base 14 + type t = AtomBase.anyValue 15 + type subst = Map.t<int, t> 16 + // this is probably wrong: we want to unify with any nat 17 + let unify = (AtomBase.AnyValue(tagA, a), AtomBase.AnyValue(tagB, b), ~gen=?) => { 18 + switch (tagA, tagB) { 19 + | (LengthTag, LengthTag) => 20 + StringA.Atom.unify(a, b, ~gen?)->Seq.map(subst => 21 + subst->Util.mapMapValues(s => AtomBase.AnyValue(AtomBase.String.Tag, s)) 22 + ) 23 + | _ => Seq.empty 24 + } 25 + } 26 + let prettyPrint = (AtomBase.AnyValue(tag, a), ~scope: array<string>) => { 27 + switch tag { 28 + | LengthTag => `length(${StringA.Atom.prettyPrint(a, ~scope)})` 29 + | _ => throw(NonPreludicValuePassed) 30 + } 31 + } 32 + let parse = (str, ~scope: array<string>, ~gen=?) => { 33 + open Parser 34 + liftParse(StringA.Atom.parse, ~scope, ~gen?) 35 + ->between(token("length("), token(")")) 36 + ->map(s => AtomBase.AnyValue(LengthTag, s)->Base.wrapForReal) 37 + ->runParser(str) 38 + } 39 + 40 + let substitute = (AtomBase.AnyValue(tag, a), subst) => { 41 + switch tag { 42 + | LengthTag => 43 + AtomBase.AnyValue( 44 + LengthTag, 45 + a->StringA.Atom.substitute(subst->Util.Map.filterMap((_, v) => StringA.Atom.coerce(v))), 46 + )->Base.wrapForReal 47 + | _ => throw(NonPreludicValuePassed) 48 + } 49 + } 50 + let substDeBruijn = (AtomBase.AnyValue(tag, a), subst, ~from=?) => { 51 + switch tag { 52 + | LengthTag => { 53 + let subst = 54 + a->StringA.Atom.substDeBruijn( 55 + subst->Array.map(v => v->Option.flatMap(StringA.Atom.coerce)), 56 + ~from?, 57 + ) 58 + 59 + AtomBase.AnyValue(LengthTag, subst)->Base.wrapForReal 60 + } 61 + | _ => throw(NonPreludicValuePassed) 62 + } 63 + } 64 + 65 + let reduce = atom => { 66 + let AtomBase.AnyValue(tag, a) = atom 67 + switch tag { 68 + | LengthTag => 69 + if ( 70 + a->Array.every(p => 71 + switch p { 72 + | AtomBase.String.String(_) => true 73 + | _ => false 74 + } 75 + ) 76 + ) { 77 + AtomBase.AnyValue(AssocCommBase.Nat.Tag, AssocCommBase.Nat.const(Array.length(a))) 78 + } else { 79 + atom 80 + } 81 + | _ => throw(NonPreludicValuePassed) 82 + } 83 + } 84 + let concrete = _ => true 85 + let upshift = (AtomBase.AnyValue(tag, a), amount, ~from=?) => { 86 + switch tag { 87 + | LengthTag => AtomBase.AnyValue(LengthTag, a->StringA.Atom.upshift(amount, ~from?))->Base.wrap 88 + | _ => throw(NonPreludicValuePassed) 89 + } 90 + } 91 + let coerce = atom => Some(atom) 92 + } 93 + 94 + module AtomView: AtomDef.ATOM_VIEW with module Atom := Atom = { 95 + type props = {atom: Atom.t, scope: array<string>} 96 + let make = ({atom, scope}) => { 97 + let AtomBase.AnyValue(tag, a) = atom 98 + switch tag { 99 + | LengthTag => 100 + <span> 101 + <span className="symbol"> {React.string("length(")} </span> 102 + {StringA.AtomView.make({atom: a, scope})} 103 + <span className="symbol"> {React.string(")")} </span> 104 + </span> 105 + | _ => throw(NonPreludicValuePassed) 106 + } 107 + } 108 + }
+6 -1
src/SExp.res
··· 38 38 let equivalent = (a: t, b: t) => { 39 39 a == b 40 40 } 41 - let reduce = (term: t) => term 41 + let rec reduce = (term: t) => 42 + switch term { 43 + | Atom(a) => Atom(Atom.reduce(a)) 44 + | Compound({subexps}) => Compound({subexps: subexps->Array.map(reduce)}) 45 + | _ => term 46 + } 42 47 let rec schematicsIn: t => Belt.Set.t<int, IntCmp.identity> = (it: t) => 43 48 switch it { 44 49 | Schematic({schematic, _}) => Belt.Set.make(~id=module(IntCmp))->Belt.Set.add(schematic)
+9 -5
src/Scratch.res
··· 60 60 StringSymbol.Atom, 61 61 StringSymbol.AtomView, 62 62 ) 63 - module StringSExp = SExp.Make(StringNatSymbol.Atom) 64 - module TermView = SExpView.Make(StringNatSymbol.Atom, StringNatSymbol.AtomView, StringSExp) 65 - module StringSExpJView = TermViewAsJudgmentView.Make(StringSExp, StringSExp, TermView) 66 - module AxiomStr = Editable.TextArea( 67 - StringAxiomSet.Make(StringNatSymbol.Atom, StringSExp, StringSExpJView), 63 + module Final = AtomDef.MakeAtomChoiceAndView( 64 + Preludic.Atom, 65 + Preludic.AtomView, 66 + StringNatSymbol.Atom, 67 + StringNatSymbol.AtomView, 68 68 ) 69 + module StringSExp = SExp.Make(Final.Atom) 70 + module TermView = SExpView.Make(Final.Atom, Final.AtomView, StringSExp) 71 + module StringSExpJView = TermViewAsJudgmentView.Make(StringSExp, StringSExp, TermView) 72 + module AxiomStr = Editable.TextArea(StringAxiomSet.Make(Final.Atom, StringSExp, StringSExpJView)) 69 73 70 74 module DerivationsOrLemmasStrView = MethodView.CombineMethodView( 71 75 StringSExp,
+2
src/StringA.res
··· 454 454 455 455 acc.contents->Result.map(r => (r, str->String.sliceToEnd(~start=pos.contents))) 456 456 } 457 + let reduce = t => t 457 458 let concrete = t => 458 459 t->Array.every(p => 459 460 switch p { ··· 471 472 | Schematic({schematic, allowed}) => Schematic({schematic, allowed}) 472 473 }, 473 474 ]) 475 + | AtomBase.String.Tag => Some(a) 474 476 | AssocCommBase.Nat.Tag => { 475 477 module IntMap = Belt.Map.Int 476 478 if a.schemas->IntMap.size == 0 && a.vars->IntMap.size == 0 {
+1
src/Symbolic.res
··· 23 23 let substDeBruijn = (name, _, ~from as _=?) => name 24 24 let concrete = _ => true 25 25 let upshift = (t, _, ~from as _=?) => t 26 + let reduce = t => t 26 27 let coerce = _ => None 27 28 } 28 29
+12
tests/PreludeTest.res
··· 1 + open Zora 2 + 3 + module Util = TestUtil.MakeAtomTester(Preludic.Atom) 4 + module ParseUtil = Util.ParseTester 5 + 6 + zoraBlock("parse prelude", t => 7 + t->ParseUtil.testParse( 8 + `length("$s")`, 9 + ~scope=["s"], 10 + Preludic.Base.wrap(AtomBase.AnyValue(Preludic.LengthTag, [AtomBase.String.Var({idx: 0})])), 11 + ) 12 + )

History

2 rounds 0 comments
sign up or login to add to the discussion
1 commit
expand
add atom prelude functionality
no conflicts, ready to merge
expand 0 comments
1 commit
expand
add atom prelude functionality
expand 0 comments