I'm trying to write a program in Coq to parse a relatively simple context-free grammar (one type of parenthesis) and my general algorithm is for the parser to potentially return the remainder of a string. For example, parsing "++]>><<" should return CBTerminated [Incr Incr] ">><<" and then, say a parser that is parsing "[++]>><<" would be able to pick up the ">><<" and continue with that.
So obviously, the string is smaller, but convincing Coq of that is another matter. It is giving me the error
Recursive definition of parseHelper is ill-formed. [...] Recursive call to parseHelper has principal argument equal to "rest'" instead
of "rest".
Which I assume means that it isn't convinced that rest' < input in the way that it's convinced that rest < input. (where < means "is smaller than").
I'd thought of instead returning a count of how many characters to skip, but that seems rather inelegant and uneccessary.
Require Import Coq.Strings.String.
Require Import Coq.Strings.Ascii.
Require Import Coq.Lists.List.
Require Import ZArith.
Open Scope char_scope.
Open Scope list_scope.
Notation " [ ] " := nil (format "[ ]") : list_scope.
Notation " [ x ] " := (cons x nil) : list_scope.
Notation " [ x ; y ; .. ; z ] " := (cons x (cons y .. (cons z nil) ..)) : list_scope.
Inductive BF :=
| Incr : BF
| Decr : BF
| Left : BF
| Right : BF
| In : BF
| Out : BF
| Sequence : list BF -> BF
| While : BF -> BF.
Inductive BF_Parse_Result :=
| UnmatchedOpen
| EOFTerminated (u : list BF)
| CBTerminated (u : list BF) (rest : string).
Definition bind (val : BF) (onto : BF_Parse_Result) :=
match onto with
| UnmatchedOpen => UnmatchedOpen
| EOFTerminated values => EOFTerminated (cons val values)
| CBTerminated values rest => CBTerminated (cons val values) rest
end.
Fixpoint parseHelper (input : string) : BF_Parse_Result :=
match input with
| EmptyString => EOFTerminated nil
| String first rest =>
match first with
| "+" => bind Incr (parseHelper rest)
| "-" => bind Decr (parseHelper rest)
| "<" => bind Left (parseHelper rest)
| ">" => bind Right (parseHelper rest)
| "," => bind In (parseHelper rest)
| "." => bind Out (parseHelper rest)
| "]" => CBTerminated nil rest
| "[" =>
match parseHelper rest with
| UnmatchedOpen => UnmatchedOpen
| EOFTerminated _ => UnmatchedOpen
| CBTerminated vals rest' =>
bind (While (Sequence vals)) (parseHelper rest')
end
| _ => parseHelper rest
end
end.
Have you considered using well-founded recursion? Coq's standard library has a series of useful combinators for defining functions over well-founded relations. Reference 1 shows two techniques (well-founded recursion and a monad) for general recursion.
Other technique that is also very useful in context of Agda, is the so-called Bove-Capretta method, which defines an inductive predicate that mimics the call graph of defined function.
Coq also has the Function command that can be used to define more general recursive functions. Whenever I needed to define non-structurally recursive functions, I have used well-founded recursion.
Hope that this helps you.
Related
I have this datatype
datatype json =
Num of real
| String of string
| False
| True
| Null
| Array of json list
| Object of (string * json) list
and this code
fun mymatch (jobj,str) =
case jobj of
Array [] => NONE
| Array(Object oh::[]) => mymatch (Object oh, str)
| Array (Object oh::ot) =>
if isSome (assoc(str, oh)) then assoc(str, oh) else mymatch (Array ot, str)
| Object xs => assoc (str, xs)
| _ => NONE
with this helper function
fun assoc (k, ls) =
case ls of
[] => NONE
| (a,b)::[] => if k = a then SOME b else NONE
| (a,b)::xs => if k = a then SOME b else assoc (k,xs)
which should take something like this
mymatch (Array [Object [("n", Num (4.0)),("b", True)],Object [("last", Num (4.0)),("foo", True)]],"foo")
and return a match on the string "foo", searching each Object in the Array. As you can see in the code, I'm really only handling the two things in json that qualify for a match, i.e., an Array that contains Objectss, then sending the Objects to be checked. This code works, but it's surely from the brutalist school of programming, i.e., it feels like a kludge. Why? Because of the case in mymatch where I need to recurse down through the Array
...
| Array (Object oh::ot) =>
if isSome (assoc(str, oh)) then assoc(str, oh) else mymatch (Array ot, str)
...
Until now, I've only dealt with recursion on lists where you check the car, then recurse on the cdr. Again, this code works, but I can sense I'm missing something. I need to check the head Object of Array and terminate if it matches; otherwise, keep recursing -- all within the option return world. Is there a more elegant way of doing this?
Write a function for matching the "innards" of arrays:
fun match_array (str, Object ob :: obs) = (case assoc (str, ob) of
NONE => match_array (str, obs)
| something => something)
| match_array _ = NONE;
then rewrite mymatch:
fun mymatch (str, Array a) = match_array (str, a)
| mymatch (str, Object ob) = assoc (str, ob)
| mymatch _ = NONE;
You can also simplify assoc a little bit:
fun assoc (k, []) = NONE
| assoc (k, (a,b)::xs) = if k = a then SOME b else assoc (k,xs);
Idiomatic F# can nicely represent the classic recursive expression data structure:
type Expression =
| Number of int
| Add of Expression * Expression
| Multiply of Expression * Expression
| Variable of string
together with recursive functions thereon:
let rec simplify_add (exp: Expression): Expression =
match exp with
| Add (x, Number 0) -> x
| Add (Number 0, x) -> x
| _ -> exp
... oops, that doesn't work as written; simplify_add needs to recur into subexpressions. In this toy example that's easy enough to do, only a couple of extra lines of code, but in a real program there would be dozens of expression types; one would prefer to avoid adding dozens of lines of boilerplate to every function that operates on expressions.
Is there any way to express 'by default, recur on subexpressions'? Something like:
let rec simplify_add (exp: Expression): Expression =
match exp with
| Add (x, Number 0) -> x
| Add (Number 0, x) -> x
| _ -> recur simplify_add exp
where recur might perhaps be some sort of higher-order function that uses reflection to look up the type definition or somesuch?
Unfortunately, F# does not give you any recursive function for processing your data type "for free". You could probably generate one using reflection - this would be valid if you have a lot of recursive types, but it might not be worth it in normal situations.
There are various patterns that you can use to hide the repetition though. One that I find particularly nice is based on the ExprShape module from standard F# libraries. The idea is to define an active pattern that gives you a view of your type as either leaf (with no nested sub-expressions) or node (with a list of sub-expressions):
type ShapeInfo = Shape of Expression
// View expression as a node or leaf. The 'Shape' just stores
// the original expression to keep its original structure
let (|Leaf|Node|) e =
match e with
| Number n -> Leaf(Shape e)
| Add(e1, e2) -> Node(Shape e, [e1; e2])
| Multiply(e1, e2) -> Node(Shape e, [e1; e2])
| Variable s -> Leaf(Shape e)
// Reconstruct an expression from shape, using new list
// of sub-expressions in the node case.
let FromLeaf(Shape e) = e
let FromNode(Shape e, args) =
match e, args with
| Add(_, _), [e1; e2] -> Add(e1, e2)
| Multiply(_, _), [e1; e2] -> Multiply(e1, e2)
| _ -> failwith "Wrong format"
This is some boilerplate code that you'd have to write. But the nice thing is that we can now write the recursive simplifyAdd function using just your special cases and two additional patterns for leaf and node:
let rec simplifyAdd exp =
match exp with
// Special cases for this particular function
| Add (x, Number 0) -> x
| Add (Number 0, x) -> x
// This now captures all other recursive/leaf cases
| Node (n, exps) -> FromNode(n, List.map simplifyAdd exps)
| Leaf _ -> exp
Ok, so I'm trying to change this function into Tail Recursive. The Definition I have of Tail Recursive is to use a "Local Helper Function" to accumulate my answer and return it without calling the primary function recursively.
these functions work properly.
fun same_string(s1 : string, s2 : string) =
s1 = s2
fun all_except_option (name, []) = NONE
| all_except_option (name, x::xs)=
case same_string (x , name) of
true => SOME xs
| false => case all_except_option(name,xs) of
NONE => NONE
| SOME z => SOME(x::z)
fun get_substitutions1 ([],name2) = [] (*get_substitutions2 is same but tail recursive *)
| get_substitutions1 (x::xs,name2) =
case all_except_option (name2,x) of
NONE => get_substitutions1 (xs,name2)
| SOME z => z # get_substitutions1(xs,name2)
So here are my attempts at tail recursion which do not work and I think I am missing something fairly basic that I am overlooking due to my lack of experience in SML.
fun get_substitutions2 (lst,name3) =
let fun aux (xs,acc) =
case all_except_option(name3,x::xs) of
NONE => aux(xs, acc)
| SOME z => aux(xs, z::acc)
in
aux(lst,[])
end
and
fun get_substitutions2 (lst,name3) =
let fun aux (xs,acc) =
case all_except_option(name3,x::xs) of
NONE => aux(xs, acc)
| SOME z => aux(xs, z#acc)
in
aux(lst,[""])
end
Both "get_substitutions" functions are supposed to do the same thing.
compare String1 to string list list, return single list made up of all lists containing String1 minus String1.
My attempts at using Tail Recursion have resulted in the following error.
Error: unbound variable or constructor: x
uncaught exception Error
raised at: ../compiler/TopLevel/interact/evalloop.sml:66.19-66.27
../compiler/TopLevel/interact/evalloop.sml:44.55
../compiler/TopLevel/interact/evalloop.sml:296.17-
Here are a few examples of calling get_substitutions2:
get_substitutions2 ([["foo"],["there"]], "foo"); (* = [] *)
get_substitutions2 ([["fred","fredrick","freddie","F","freddy"],["Will","William","Willy","Bill"]],"Bill"); (* = ["Will","William","Willy"] *)
get_substitutions2 ([["a","b"],["a","c"],["x","y"]], "a"); (* = ["c","b"] *)
You need to use the same patterns you had for get_substitutions1 in your aux function definition:
fun get_substitutions2 (lst,name3) =
let fun aux ([],acc) = acc (* BASE CASE *)
| aux (x::xs,acc) = (* BINDING x IN PATTERN *)
case all_except_option(name3,x) of
NONE => aux(xs, acc)
| SOME z => aux(xs, z#acc)
in
aux(lst,[])
end
I'm creating sum of list and using option in it. When I pass an empty list, I should get NONE or else SOME value.
I'm able to do that in the following way:
fun sum_list xs =
case xs of
[] => NONE
| x =>
let
fun slist x =
case x of
[] => 0
| x::xs' => x + slist xs'
in
SOME (slist x)
end
But I want to do it in the other way round using pattern matching, in which I want to eval the result of sum_list to see whether it is NONE or contains some other value.
I have tried in various ways but I cannot get a hang of how to do in that way.
I think what you currently have is very clear and easy to understand.
If you want to avoid using slist, you have to call sum_list recursively on the tail of the list, pattern-match on that option value and return appropriate results:
fun sum_list xs =
case xs of
[] => NONE
| x::xs' => (case (sum_list xs') of
NONE => SOME x
| SOME y => SOME (x+y))
I'm coding in SML for an assignment and I've done a few practice problems and I feel like I'm missing something- I feel like I'm using too many case statements. Here's what I'm doing and the problem statements for what I'm having trouble with.:
Write a function all_except_option, which takes a string and a string list. Return NONE if the string is not in the list, else return SOME lst where lst is like the argument list except the string is not in it.
fun all_except_option(str : string, lst : string list) =
case lst of
[] => NONE
| x::xs => case same_string(x, str) of
true => SOME xs
| false => case all_except_option(str, xs) of
NONE => NONE
| SOME y=> SOME (x::y)
Write a function get_substitutions1, which takes a string list list (a list of list of strings, the substitutions) and a string s and returns a string list. The result has all the strings that are in some list in substitutions that also has s, but s itself should not be in the result.
fun get_substitutions1(lst : string list list, s : string) =
case lst of
[] => []
| x::xs => case all_except_option(s, x) of
NONE => get_substitutions1(xs, s)
| SOME y => y # get_substitutions1(xs, s)
-
same_string is a provided function,
fun same_string(s1 : string, s2 : string) = s1 = s2
First of all I would start using pattern matching in the function definition
instead of having a "top-level" case statement. Its basically boils down to the
same thing after de-sugaring. Also I would get rid of the explicit type annotations, unless strictly needed:
fun all_except_option (str, []) = NONE
| all_except_option (str, x :: xs) =
case same_string(x, str) of
true => SOME xs
| false => case all_except_option(str, xs) of
NONE => NONE
| SOME y => SOME (x::y)
fun get_substitutions1 ([], s) = []
| get_substitutions1 (x :: xs, s) =
case all_except_option(s, x) of
NONE => get_substitutions1(xs, s)
| SOME y => y # get_substitutions1(xs, s)
If speed is not of importance, then you could merge the two cases in the first function:
fun all_except_option (str, []) = NONE
| all_except_option (str, x :: xs) =
case (same_string(x, str), all_except_option(str, xs)) of
(true, _) => SOME xs
| (false, NONE) => NONE
| (false, SOME y) => SOME (x::y)
But since you are using append (#), in the second function, and since it is not
tail recursive, I don't believe that it your major concern. Keep in mind that
append is potential "evil" and you should almost always use concatenation (and
then reverse your result when returning it) and tail recursion when possible (it
always is).
If you really like the explicit type annotations, then you could do it like this:
val rec all_except_option : string * string list -> string list option =
fn (str, []) => NONE
| (str, x :: xs) =>
case (same_string(x, str), all_except_option(str, xs)) of
(true, _) => SOME xs
| (false, NONE) => NONE
| (false, SOME y) => SOME (x::y)
val rec get_substitutions1 : string list list * string -> string list =
fn ([], s) => []
| (x :: xs, s) =>
case all_except_option(s, x) of
NONE => get_substitutions1(xs, s)
| SOME y => y # get_substitutions1(xs, s)
But that is just my preferred way, if I really have to add type annotations.
By the way, why on earth do you have the same_string function? You can just do the comparison directly instead. Using an auxilary function is just wierd, unless you plan to exchange it with some special logic at some point. However your function names doesn't sugest that.
In addition to what Jesper.Reenberg mentioned, I just wanted to mention that a match on a bool for true and false can be replaced with an if-then-else. However, some people consider if-then-else uglier than a case statement
fun same_string( s1: string, s2: string ) = if String.compare( s1, s2 ) = EQUAL then true else false
fun contains( [], s: string ) = false
| contains( h::t, s: string ) = if same_string( s, h ) then true else contains( t, s )
fun all_except_option_successfully( s: string, [] ) = []
| all_except_option_successfully( s: string, h::t ) = if same_string( s, h ) then t else ( h :: all_except_option_successfully( s, t ) )
fun all_except_option( s: string, [] ) = NONE
| all_except_option( s: string, h::t ) = if same_string( s, h ) then SOME t else if contains( t, s ) then SOME ( h :: all_except_option_successfully( s, t ) ) else NONE