diff --git a/index.html b/index.html
index a8bcb92..8f9a409 100644
--- a/index.html
+++ b/index.html
@@ -365,6 +365,16 @@
+
+ a.
+ (Even a)
+ -------
+ (Nat a)
+
+ a. asm |- ?
+
+
+
a.
(Nat a)
diff --git a/src/HOTerm.res b/src/HOTerm.res
index b5725ca..216cc1b 100644
--- a/src/HOTerm.res
+++ b/src/HOTerm.res
@@ -5,7 +5,7 @@ module IntCmp = Belt.Id.MakeComparable({
})
type rec t =
- | Symbol({name: string})
+ | Symbol({name: string, constructor: bool})
| Var({idx: int})
| Schematic({schematic: int})
| Lam({name: string, body: t})
@@ -369,13 +369,13 @@ let flexflex = (
subst: subst,
~gen: option,
): subst => {
+ if gen->Option.isNone {
+ raise(UnifyFail("no gen provided"))
+ }
if sa == sb {
if xs->Array.length != ys->Array.length {
raise(UnifyFail("flexible schematics have different number of arguments"))
}
- if gen->Option.isNone {
- raise(UnifyFail("no gen provided"))
- }
let len = xs->Array.length
let h = Schematic({schematic: fresh(Option.getExn(gen))})
let xs = Belt.Array.init(len, k => {
@@ -516,7 +516,12 @@ let rec stripLam = (it: t): (array, t) =>
}
let rec prettyPrint = (it: t, ~scope: array) =>
switch it {
- | Symbol({name}) => name
+ | Symbol({name, constructor}) =>
+ if constructor {
+ String.concat("@", name)
+ } else {
+ name
+ }
| Var({idx}) => prettyPrintVar(idx, scope)
| Schematic({schematic}) => "?"->String.concat(String.make(schematic))
| Lam(_) =>
@@ -543,7 +548,15 @@ let prettyPrintSubst = (sub: subst, ~scope: array) =>
let symbolRegexpString = "^([^\\s()]+)"
let nameRES = "^([^\\s.\\[\\]()]+)\\."
exception ParseError(string)
-type token = LParen | RParen | VarT(int) | SchematicT(int) | AtomT(string) | NameT(string) | EOF
+type token =
+ | LParen
+ | RParen
+ | VarT(int)
+ | SchematicT(int)
+ | AtomT(string)
+ | ConsT(string)
+ | NameT(string)
+ | EOF
let varRegexpString = "^\\\\([0-9]+)"
let schematicRegexpString = "^\\?([0-9]+)"
let tokenize = (str0: string): (token, string) => {
@@ -583,6 +596,16 @@ let tokenize = (str0: string): (token, string) => {
}
}
}
+ | "@" =>
+ let re = RegExp.fromStringWithFlags(symbolRegexpString, ~flags="y")
+ switch re->RegExp.exec(rest()) {
+ | None => raise(ParseError("invalid symbol"))
+ | Some(res) =>
+ switch RegExp.Result.matches(res) {
+ | [n] => (ConsT(n), String.sliceToEnd(rest(), ~start=RegExp.lastIndex(re)))
+ | _ => raise(ParseError("invalid symbol"))
+ }
+ }
| _ => {
let reName = RegExp.fromStringWithFlags(nameRES, ~flags="y")
switch reName->RegExp.exec(str) {
@@ -608,7 +631,7 @@ let tokenize = (str0: string): (token, string) => {
}
type rec simple =
| ListS({xs: array})
- | AtomS({name: string})
+ | AtomS({name: string, constructor: bool})
| VarS({idx: int})
| SchematicS({schematic: int})
| LambdaS({name: string, body: simple})
@@ -636,7 +659,8 @@ let rec parseSimple = (str: string): (simple, string) => {
| RParen => raise(ParseError("unexpected right parenthesis"))
| VarT(idx) => (VarS({idx: idx}), rest)
| SchematicT(schematic) => (SchematicS({schematic: schematic}), rest)
- | AtomT(name) => (AtomS({name: name}), rest)
+ | AtomT(name) => (AtomS({name, constructor: false}), rest)
+ | ConsT(name) => (AtomS({name, constructor: true}), rest)
| NameT(name) => {
let (result, rest1) = parseSimple(rest)
(LambdaS({name, body: result}), rest1)
@@ -679,12 +703,14 @@ let rec parseAll = (simple: simple, ~env: env, ~gen=?): t => {
->Array.reduce(ts[0]->Option.getExn, (acc, x) => App({func: acc, arg: x}))
}
}
- | AtomS({name}) =>
- if env->Map.has(name) {
+ | AtomS({name, constructor}) =>
+ if constructor {
+ Symbol({name, constructor: true})
+ } else if env->Map.has(name) {
let idx = env->Map.get(name)->Option.getExn
Var({idx: idx})
} else {
- Symbol({name: name})
+ Symbol({name, constructor: false})
}
| VarS({idx}) => Var({idx: idx})
| SchematicS({schematic}) =>
diff --git a/src/HOTerm.resi b/src/HOTerm.resi
index 901b55e..d56a09e 100644
--- a/src/HOTerm.resi
+++ b/src/HOTerm.resi
@@ -1,5 +1,5 @@
type rec t =
- | Symbol({name: string})
+ | Symbol({name: string, constructor: bool})
| Var({idx: int})
| Schematic({schematic: int})
| Lam({name: string, body: t})
diff --git a/src/InductiveSet.res b/src/InductiveSet.res
index a677e8c..98c4b4c 100644
--- a/src/InductiveSet.res
+++ b/src/InductiveSet.res
@@ -40,6 +40,8 @@ module Make = (
->Array.filterMap(((name, rule)) =>
extractConstructorSignature(rule)->Option.map(sig => (name, rule, sig))
)
+ // Only allow type constructors with arity 1
+ ->Array.filter(((_, _, (_cname, arity))) => arity == 1)
->Array.reduce(Dict.make(), (acc, (name, rule, (cname, arity))) => {
let key = makeKey(cname, arity)
Dict.set(acc, key, [(name, rule), ...Dict.get(acc, key)->Option.getOr([])])
@@ -111,7 +113,7 @@ module Make = (
{
Rule.vars: [],
premises: [],
- conclusion: HOTerm.app(HOTerm.Symbol({name: str}), HOTerm.mkvars(i)),
+ conclusion: HOTerm.app(HOTerm.Symbol({name: str, constructor: false}), HOTerm.mkvars(i)),
},
...subgoals,
],
@@ -183,12 +185,20 @@ module Make = (
let caseSubgoal = ((_constructorName: string, constructorRule: Rule.t)): Rule.t => {
let offset = Array.length(constructorRule.vars)
+ // Extract the argument from the constructor conclusion
+ // e.g., from (Nat 0) extract 0, from (Nat (S n)) extract (S n)
+ let (_head, args) = HOTerm.strip(constructorRule.conclusion)
+ let constructorArg = switch args[0] {
+ | Some(arg) => arg
+ | None => raise(Unreachable("Constructor conclusion must have one argument"))
+ }
+
let equalityPremise = {
Rule.vars: [],
premises: [],
conclusion: HOTerm.app(
- HOTerm.Symbol({name: "="}),
- [HOTerm.Var({idx: offset}), constructorRule.conclusion],
+ HOTerm.Symbol({name: "=", constructor: false}),
+ [HOTerm.Var({idx: offset}), constructorArg],
),
}
@@ -207,7 +217,10 @@ module Make = (
{
Rule.vars: [],
premises: [],
- conclusion: HOTerm.app(HOTerm.Symbol({name: str}), [HOTerm.Var({idx: 0})]),
+ conclusion: HOTerm.app(
+ HOTerm.Symbol({name: str, constructor: false}),
+ [HOTerm.Var({idx: 0})],
+ ),
},
...subgoals,
],
@@ -222,10 +235,7 @@ module Make = (
let mutualComponent = findMutuallyInductiveComponent(group, groupByConstructor(state))
let inductionRule = generateInductionRule(group, mutualComponent)
let casesRule = generateCasesRule(group)
- [
- ("§induction-" ++ makeKey(group.name, group.arity), inductionRule),
- ("§cases-" ++ makeKey(group.name, group.arity), casesRule),
- ]
+ [("§induction-" ++ group.name, inductionRule), ("§cases-" ++ group.name, casesRule)]
})
->Dict.fromArray
let serialise = (state: state) =>
diff --git a/src/Method.res b/src/Method.res
index 3faeac8..ca6033e 100644
--- a/src/Method.res
+++ b/src/Method.res
@@ -365,7 +365,7 @@ module Elimination = (Term: TERM, Judgment: JUDGMENT with module Term := Term) =
possibleElims->Array.forEach(((elimName, elim)) => {
let ruleInsts = rule->Rule.genSchemaInsts(gen, ~scope=ctx.fixes)
let rule' = rule->Rule.instantiate(ruleInsts)
- Judgment.unify((rule'.premises[0]->Option.getExn).conclusion, elim.conclusion)
+ Judgment.unify((rule'.premises[0]->Option.getExn).conclusion, elim.conclusion, ~gen)
->Seq.take(seqSizeLimit)
->Seq.forEach(
elimSub => {
diff --git a/tests/HOTermTest.res b/tests/HOTermTest.res
index e665e94..038a7b3 100644
--- a/tests/HOTermTest.res
+++ b/tests/HOTermTest.res
@@ -51,8 +51,8 @@ let testUnify = (t: Zora.t, at: string, bt: string, ~subst=?, ~msg=?, ~reduce=fa
testUnify0(t, bt, at, ~subst?, ~msg?, ~reduce)
}
zoraBlock("parse symbol", t => {
- t->block("single char", t => t->Util.testParse("x", Symbol({name: "x"})))
- t->block("multi char", t => t->Util.testParse("xyz", Symbol({name: "xyz"})))
+ t->block("single char", t => t->Util.testParse("x", Symbol({name: "x", constructor: false})))
+ t->block("multi char", t => t->Util.testParse("xyz", Symbol({name: "xyz", constructor: false})))
})
zoraBlock("parse var", t => {
@@ -66,14 +66,23 @@ zoraBlock("parse schematic", t => {
zoraBlock("parse application", t => {
t->block("multiple", t => {
- t->Util.testParse("(a b)", App({func: Symbol({name: "a"}), arg: Symbol({name: "b"})}))
+ t->Util.testParse(
+ "(a b)",
+ App({
+ func: Symbol({name: "a", constructor: false}),
+ arg: Symbol({name: "b", constructor: false}),
+ }),
+ )
})
t->block("multiple more", t => {
t->Util.testParse(
"(a b c)",
App({
- func: App({func: Symbol({name: "a"}), arg: Symbol({name: "b"})}),
- arg: Symbol({name: "c"}),
+ func: App({
+ func: Symbol({name: "a", constructor: false}),
+ arg: Symbol({name: "b", constructor: false}),
+ }),
+ arg: Symbol({name: "c", constructor: false}),
}),
)
})
@@ -81,7 +90,7 @@ zoraBlock("parse application", t => {
t->Util.testParse(
"(a \\1 ?1)",
App({
- func: App({func: Symbol({name: "a"}), arg: Var({idx: 1})}),
+ func: App({func: Symbol({name: "a", constructor: false}), arg: Var({idx: 1})}),
arg: Schematic({schematic: 1}),
}),
)
@@ -114,6 +123,9 @@ zoraBlock("parse lambda", t => {
Lam({name: "x", body: App({func: Var({idx: 0}), arg: Var({idx: 0})})}),
)
})
+ t->block("constructor", t => {
+ t->Util.testParse("@cons", Symbol({name: "cons", constructor: true}))
+ })
// TODO: test if remaining strings are returned correctly
})
@@ -121,6 +133,7 @@ zoraBlock("parse and prettyprint", t => {
t->block("examples", t => {
t->Util.testParsePrettyPrint("\\1", "\\1")
t->Util.testParsePrettyPrint("?1", "?1")
+ t->Util.testParsePrettyPrint("@cons", "@cons")
t->Util.testParsePrettyPrint("(x. x)", "(x. x)")
t->Util.testParsePrettyPrint("(x. x. \\0)", "(x. x. x)")
t->Util.testParsePrettyPrint("(x. x. \\1)", "(x. x. \\1)")
@@ -150,7 +163,7 @@ zoraBlock("unify test", t => {
t->block("flex-rigid", t => {
let x = "?0"
let y = "y"
- t->testUnify(x, y, ~subst=emptySubst->substAdd(0, Symbol({name: "y"})))
+ t->testUnify(x, y, ~subst=emptySubst->substAdd(0, Symbol({name: "y", constructor: false})))
})
t->block("flex-rigid2", t => {
let x = "(x. ?0 x)"
@@ -162,15 +175,28 @@ zoraBlock("unify test", t => {
~reduce=false,
~subst=emptySubst->substAdd(
0,
- Lam({name: "x", body: App({func: Symbol({name: "y"}), arg: Var({idx: 0})})}),
+ Lam({
+ name: "x",
+ body: App({func: Symbol({name: "y", constructor: false}), arg: Var({idx: 0})}),
+ }),
),
)
- t->testUnify(x, y, ~reduce=true, ~subst=emptySubst->substAdd(0, Symbol({name: "y"})))
+ t->testUnify(
+ x,
+ y,
+ ~reduce=true,
+ ~subst=emptySubst->substAdd(0, Symbol({name: "y", constructor: false})),
+ )
})
t->block("flex-rigid3", t => {
let x = "(?0 \\10)"
let y = "(fst \\10)"
- t->testUnify(x, y, ~reduce=true, ~subst=emptySubst->substAdd(0, Symbol({name: "fst"})))
+ t->testUnify(
+ x,
+ y,
+ ~reduce=true,
+ ~subst=emptySubst->substAdd(0, Symbol({name: "fst", constructor: false})),
+ )
})
t->block("flex-rigid", t => {
let x = "(?0 \\10)"
@@ -183,8 +209,8 @@ zoraBlock("unify test", t => {
Lam({
name: "x",
body: App({
- func: Symbol({name: "r"}),
- arg: App({func: Symbol({name: "fst"}), arg: Var({idx: 0})}),
+ func: Symbol({name: "r", constructor: false}),
+ arg: App({func: Symbol({name: "fst", constructor: false}), arg: Var({idx: 0})}),
}),
}),
),
@@ -265,7 +291,7 @@ zoraBlock("unify test", t => {
"(x. ?0 x)",
"a",
~reduce=true,
- ~subst=emptySubst->substAdd(0, Symbol({name: "a"})),
+ ~subst=emptySubst->substAdd(0, Symbol({name: "a", constructor: false})),
)
})
t->block("divergent", t => {
@@ -279,6 +305,11 @@ zoraBlock("unify test", t => {
let b = "\\0"
t->testUnify(a, b, ~subst=emptySubst->substAdd(0, t->Util.parse("(x. x. \\0)")))
})
+ t->block("dup var 2", t => {
+ let a = "(k. ?0 k k)"
+ let b = "(k. G k)"
+ t->testUnify(a, b, ~subst=emptySubst->substAdd(0, t->Util.parse("(x. x. G x)")))
+ })
// Yokoyama et al.'s example in A Functional Implementation of Function-as-Constructor Higher-Order Unification Makoto Hamana1
t->block("break global resctriction", t => {
t->testUnify(