Walking through the format string example in the TDD of Idris2, and trying to do my own version of a format string. Here is what has worked:
data ShowableFmt = NatFmt | CharFmt | DoubleFmt
data CallableFmt = ShwFmt ShowableFmt | StrFmt
data Fmt = CalFmt CallableFmt Fmt | LitFmt String Fmt | EndFmt
FmtType: Fmt -> Type
FmtType fmt = case fmt of
EndFmt => String
LitFmt lit fmt => FmtType fmt
CalFmt callable fmt => case callable of
ShwFmt shwfmt => case shwfmt of
NatFmt => Nat -> FmtType fmt
CharFmt => Char -> FmtType fmt
DoubleFmt => Double -> FmtType fmt
StrFmt => String -> FmtType fmt
So I decide to tidy up a little bit, as we can see -> FmtType fmt is all over the place. So I do the following, refactoring the repetitive part out and leaving the data type unchanged:
FmtType: Fmt -> Type
FmtType fmt = case fmt of
EndFmt => String
LitFmt lit fmt => FmtType fmt
CalFmt callable fmt => (case callable of
ShwFmt shwfmt => case shwfmt of
NatFmt => Nat
CharFmt => Char
DoubleFmt => Double
StrFmt => String) -> FmtType fmt
Here is the error message:
Error: While processing right hand side of FmtType. Main.case block in case block in FmtType is not accessible in this context.
This kind of surprised me because I thought case expression is just a normal first class expression like any other expressions. Am I wrong?
Related
Consider the following code that converts a DateTime to a string, tries to parse it using the TryParse method on DateTime, and returns an DateTime option indicating whether parsing the string was successful or not:
let dt = DateTime.Now
printfn "%A" dt
let parseDateTime (str: string) =
match DateTime.TryParse str with
| (true, v) -> Some v
| _ -> None
let parsedDateTime =
dt.ToString () |> parseDateTime
match parsedDateTime with
| Some v ->
printfn "%A" v
assert (v = dt)
| _ -> ()
The assert statement fails, which I would not expect it to. printfn prints out the same string to the Console which further puzzles me.
If I change the assert statement above to assert (v.ToString() = dt.ToString()) the assert passes as I would have expected when comparing the two DateTime values.
Is there something that I'm missing here when it comes to DateTime equality? I've also tested this using int and Guid (swapping out DateTime.TryParse for Int32.TryParse and Guid.TryParse respectively) and the assert passes as I would expect it to when comparing values for equality.
The resolution of a DateTime value is a single "tick", which represents one ten-millionth of a second. You also need to consider time zone differences. The default output format doesn't include this level of detail. If you want to "round trip" a DateTime, write it out with ToString("o")and then use DateTimeStyles.RoundtripKind when parsing:
open System
open System.Globalization
let parseDateTime (str: string) =
match DateTime.TryParse(str, null, DateTimeStyles.RoundtripKind) with
| (true, v) -> Some v
| _ -> None
let parsedDateTime =
dt.ToString ("o") |> parseDateTime // e.g. "2021-11-15T15:36:07.6506924-05:00"
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);
on the 44th line it gives me a type error Type automate is not compatible with type formatter im trying to draw an automaton using graphviz
here is the code :
(*d'abord definissons le type automate*)
type automate = {
etat_initial : int;
ensemble_des_etats : int list;
alphabets : char list;
transitions :(int*char*int) list;
etats_finaux : int list
};;
(*prenons une variable a1 du type automate qu'on a definit precedemment
comme
exemple*)
let a1={
etat_initial=1;
ensemble_des_etats=[1;2];
alphabets=['a';'b'];
transitions=[(1,'b',2);(2,'c',3)];
etats_finaux=[2]
};;
let rec member a l =
match l with
| [] -> false
| x::rl -> x=a || member a rl;;
let fmt_transition auto fmt (inedge,by,outedge)=
if member outedge auto.etats_finaux=true then
Format.fprintf fmt "#[node [shape = doublecircle]%d;#]" outedge;
if inedge=auto.etat_initial then
Format.fprintf fmt "#[node [shape = point]start;node [shape = circle];start
-> %d ;#]" inedge;
Format.fprintf fmt "#[%d -> %d [label=\"%c\"];#]" inedge outedge by;;
let fmt_transitions auto fmt =
Format.fprintf fmt "#[<v 2>digraph output {#,%a#,#]}#,#."
(Format.pp_print_list (fmt_transition auto)) auto.transitions
;;
let call_dot auto =
let cmd = "dot -Tpng | display -" in
let (sout, sin, serr) as channels =
Unix.open_process_full cmd (Unix.environment ()) in
let fmt = Format.formatter_of_out_channel sin in
<b>Format.fprintf fmt "%a#." fmt_transitions auto;</b>
channels
let cleanup channels =
(* missing: flush channels, empty buffers *)
Unix.close_process_full channels;;
call_dot a1 ;;
You need to be careful when you use %a.
According to the OCaml documentation:
a: user-defined printer. Take two arguments and apply the first one to outchan (the current output channel) and to the second argument.
The first argument must therefore have type out_channel -> 'b -> unit ...
The first argument argument of your fmt_transitions auto fmt function has to be a formatter, so just switch the auto and fmt arguments and it should be OK.
let fmt_transitions auto fmt = ...
let fmt_transitions fmt auto = ...
I have this datatype:
datatype 'a stream' = Susp of unit -> 'a stream
and 'a stream = Empty | Cons of 'a * 'a stream'
and I want to write a flatten function which has the type below.
flatten: ’a stream’ stream’ -> ’a stream’
The flatten function will take stream of streams as input and flatten it by appending them.
How do I do this? Any ideas?
Thanks.
Edit: I know how to do it for lists. It is quite simple:
fun flatten [] = [] | flat (l::ls) = l # flatten ls;
Help me with streams please, I don't know how to pattern match a stream of a stream.
Let's write it for list first:
fun append(xs, ys) = case xs of
[] => ys
| (x::xs) => x :: append(xs, ys)
fun flatten(xss) = case xss of
[] => []
| (xs::xss) => append(xs, flatten(xss))
The above should be obvious. Now we only need to change it slightly to support stream, by Suspending and force-ing at the appropriate steps:
fun force(Susp(xs)) = xs()
fun append(xs, ys) = case force xs of
Empty => ys
| Cons(x,xs) => Susp(fn () => Cons(x, append(xs, ys)))
fun flatten(xss) = case force xss of
Empty => Susp(fn () => Empty)
| Cons(xs,xss) => append(xs, flatten(xss))
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