Use meta-programming in F* for a syntactic check on a function argument - fstar

I would like to write a function that enforces that its argument is, syntactically, a constant string. Here's what I tried:
module Test
module R = FStar.Reflection
let is_literal (t: R.term) =
match R.inspect_ln t with
| R.Tv_Const (R.C_String _) -> true
| _ -> false
let check_literal (s: string { normalize (is_literal (`s)) }) =
()
let test () =
check_literal ""; // should work
let s = "" in
check_literal s // should not work
However, I'm pretty sure static quotations (with `) are not what I want, but instead dynamic quotations with quote. But this would put my precondition into the Tac effect. Is there any way to do what I want in the current state of things?

I don't know if you finally found a solution, but what about implicit meta arguments?
They somehow allow running Tac code at function invocation time, making quote usable.
Changing your code a bit doing so seems to work:
module Is_lit
open FStar.Tactics
let is_literal (t: term) =
match inspect_ln t with
| Tv_Const (C_String _) -> true
| _ -> false
let check_literal (s: string)
(#[(if (normalize_term (is_literal (quote s)))
then exact (`())
else fail "not a litteral")
] witness: unit)
: unit =
()
// success
let _ = check_literal "hey"
// failure
[#expect_failure]
let _ = let s = "hey" in check_literal s

Related

Simple parsing of strings in Ocaml

I'm not sure about the best way to approach this, so I figured I'd ask. I have a line like this :
NAME="/dev/sda" TYPE="disk" MODEL="KINGSTON SV300S3"
(gotten from lsblk with a few options) and I'd like to extract each field as simply as possible. Yes, I know lsblk has a very nice --json, but that's unfortunately a recent addition I can't use, we have some pretty old servers still in production.
Maybe using Str with some regex ? Google seems to say menhir a lot, I've never used it, but I'm afraid that might be a bit heavy just for a few variables like that ?
I've tried using String.split_on_char and String.slice, but it starts getting complicated when model contains spaces, String.split_on_char doesn't ignore spaces between double quotes of course.
For simple format like this, the Scanf module might be a viable alternative:
let extract s = Scanf.sscanf s "NAME=%S TYPE=%S MODEL=%S" (fun x y z -> x, y ,z);;
;; extract {|NAME="/dev/sda" TYPE="disk" MODEL="KINGSTON SV300S3"|}
yields
("/dev/sda", "disk", "KINGSTON SV300S3")
as expected.
While Str could probably do the trick, the lesser-known Genlex module from the standard library can come quite handy for not-too-heavy string manipulation, at least for formats that more or less obey OCaml's lexical convention. Basically, it will transform your char stream into a stream of tokens that you can parse much more easily. I imagine that the full output format of lsblk might require some refinements, but for your example, the following is sufficient:
let lexer = Genlex.make_lexer [ "=" ]
let test = "NAME=\"/dev/sda\" TYPE=\"disk\" MODEL=\"KINGSTON SV300S3\""
let test_stream = Stream.of_string test
let test_stream_token = lexer test_stream
let info =
let l = ref [] in
try
while true do
let kw = Stream.next test_stream_token in
let eq = Stream.next test_stream_token in
let v = Stream.next test_stream_token in
let kw =
match kw with Ident s -> s | _ -> failwith "Unrecognized pattern"
in
let () = match eq with Kwd "=" -> () | _ -> failwith "Expected '='" in
let v = match v with String s -> s | _ -> failwith "Expected string" in
l:=(kw,v)::!l
done;
assert false
with Stream.Failure -> List.rev !l
Basically, the main loop considers that the information contained in the input is a sequence of items of the form <key>="<value>", decomposed in three tokens by the Genlex-generated lexer.
It results in: [("NAME", "/dev/sda"); ("TYPE", "disk"); ("MODEL", "KINGSTON SV300S3")]
Got it :
let re = Str.regexp "NAME=\"\\(.*\\)\" TYPE=\"\\(.*\\)\" MODEL=\"\\(.*\\)\"" in
match Str.string_match re line 0 with
| false -> [`Null]
| true ->
let name = Str.matched_group 1 line in
let typ = Str.matched_group 2 line in
let model = Str.matched_group 3 line in
Printf.printf "%s, %s, %s\n" name typ model

SML: Error: non-constructor applied to argument in pattern: -

I'am writing this function for a MOOC. It's job is to remove a string from the list and return that list without the string as a SOME or return NONE is the string is not there.
I wrote the code below but whenever I try to run it I get the following error: Error: non-constructor applied to argument in pattern: -.
exception NotFound
fun all_except_option (str : string, strs : string list) =
let
fun remove_str (strs : string list) =
case strs of
[] => raise NotFound
| str'::strs' => if same_string(str, str') then strs' else str'::remove_str strs'
in
SOME (remove_str strs) handle NotFound => NONE
end
And where's one test to run it:
val test01-01 = all_except_option ("string", ["string"]) = SOME []
edit
forgot to include the same_string function that was provided to us to simplify types
fun same_string(s1 : string, s2 : string) =
s1 = s2
Figured out the problem. Seems like SML doesn't like hyphens, like the one I had in the test:
val test01-01 = all_except_option ("string", ["string"]) = SOME []
I changed to underscore instead and now it works.
val test01_01 = all_except_option ("string", ["string"]) = SOME []
Since you've already solved this task, here's a way to write it without using exceptions:
fun all_except_option (_, []) = NONE
| all_except_option (t, s :: ss) =
if s = t
then SOME ss (* don't include s in result, and don't recurse further *)
else case all_except_option (t, ss) of
SOME ss' => SOME (s :: ss')
| NONE => NONE
Having a recursive function return t option rather than t makes it more difficult to deal with, since upon every recursive call, you must inspect if it returned SOME ... or NONE. This can mean a lot of case ... of ... s!
They can be abstracted away using the library function Option.map. The definition is found in the standard library and translates into:
fun (*Option.*)map f opt =
case opt of
SOME v => SOME (f v)
| NONE => NONE
This bit resembles the case ... of ... in all_except_option; rewriting it would look like:
fun all_except_option (_, []) = NONE
| all_except_option (t, s :: ss) =
if s = t
then SOME ss (* don't include s in result, and don't recurse further *)
else Option.map (fn ss' => s :: ss') (all_except_option (t, ss))

Extracting data from a tuple in OCaml

I'm trying to use the CIL library to parse C source code. I'm searching for a particular function using its name.
let cil_func = Caml.List.find (fun g ->
match g with
| GFun(f,_) when (equal f.svar.vname func) -> true
| _ -> false
) cil_file.globals in
let body g = match g with GFun(f,_) -> f.sbody in
dumpBlock defaultCilPrinter stdout 1 (body cil_func)
So I have a type GFun of fundec * location, and I'm trying to get the sbody attribute of fundec.
It seems redundant to do a second pattern match, not to mention, the compiler complains that it's not exhaustive. Is there a better way of doing this?
You can define your own function that returns just the fundec:
let rec find_fundec fname = function
| [] -> raise Not_found
| GFun (f, _) :: _ when equal (f.svar.vname fname) -> f (* ? *)
| _ :: t -> find_fundec fname t
Then your code looks more like this:
let cil_fundec = find_fundec func cil_file.globals in
dumpBlock defaultCilPrinter stdout 1 cil_fundec.sbody
For what it's worth, the line marked (* ? *) looks wrong to me. I don't see why f.svar.vname would be a function. I'm just copying your code there.
Update
Fixed an error (one I often make), sorry.

Any side effect of using underscore wildcard in let command (i.e., let _ = ... in) in OCaml?

When using OCaml, I almost always use underscore wildcard in let _ = exp, especially when the result of exp is not important, but the computation inside it is. For example:
let _ = print_endline "abc" in
...
let _ = a := !a + 1 in
...
let _ = do_some_thing ... in
So, I just wonder if there is any side effect of extensively using let _ = ... ?
The side effect is annoying bugs to track in your software in the future. The problem with let _ = is that it will silently ignore partial applications you intended to be total. Suppose you write the following:
let f a b = ...
let _ = f 3 4
And that in the future you add an argument to f:
let f a b c = ...
The expression let _ = f 3 4 will still silently compile and your program will not invoke the function, leaving you wondering what is happening. It is much better to always let to () and use ignore when if you need to ignore a non unit result:
let () = ignore (f 3 4)
let () = print_endline "abc"
Using let _ = ... should be considered bad style.
No, there is absolutely no consequence to using let _ = extensively. The compiler does not add a name to the global environment since you didn't give one.
The purpose of let is to bind values to identifiers. If you doing side-effects only it's its better to wrap it in a begin .. end block. In your case:
begin
print_endline "abc";
a := !a + 1;
do_some_thing ();
end

OCaml error: wrong type of expression in constructor

I have a function save that take standard input, which is used individually like this:
./try < input.txt (* save function is in try file *)
input.txt
2
3
10 29 23
22 14 9
and now i put the function into another file called path.ml which is a part of my interpreter. Now I have a problem in defining the type of Save function and this is because save function has type in_channel, but when i write
type term = Save of in_channel
ocamlc complain about the parameter in the command function.
How can i fix this error? This is the reason why in my last question posted on stackoverflow, I asked for the way to express a variable that accept any type. I understand the answers but actually it doesn't help much in make the code running.
This is my code:
(* Data types *)
open Printf
type term = Print_line_in_file of int*string
| Print of string
| Save of in_channel (* error here *)
;;
let input_line_opt ic =
try Some (input_line ic)
with End_of_file -> None
let nth_line n filename =
let ic = open_in filename in
let rec aux i =
match input_line_opt ic with
| Some line ->
if i = n then begin
close_in ic;
(line)
end else aux (succ i)
| None ->
close_in ic;
failwith "end of file reached"
in
aux 1
(* get all lines *)
let k = ref 1
let first = ref ""
let second = ref ""
let sequence = ref []
let append_item lst a = lst # [a]
let save () =
try
while true do
let line = input_line stdin in
if k = ref 1
then
begin
first := line;
incr k;
end else
if k = ref 2
then
begin
second := line;
incr k;
end else
begin
sequence := append_item !sequence line;
incr k;
end
done;
None
with
End_of_file -> None;;
let rec command term = match term with
| Print (n) -> print_endline n
| Print_line_in_file (n, f) -> print_endline (nth_line n f)
| Save () -> save ()
;;
EDIT
Error in code:
Save of in_channel:
Error: This pattern matches values of type unit
but a pattern was expected which matches values of type in_channel
Save of unit:
Error: This expression has type 'a option
but an expression was expected of type unit
There are many errors in this code, so it's hard to know where to start.
One problem is this: your save function has type unit -> 'a option. So it's not the same type as the other branches of your final match. The fix is straightforward: save should return (), not None. In OCaml these are completely different things.
The immediate problem seems to be that you have Save () in your match, but have declared Save as taking an input channel. Your current code doesn't have any way to pass the input channel to the save function, but if it did, you would want something more like this in your match:
| Save ch -> save ch
Errors like this suggest (to me) that you're not so familiar with OCaml's type system. It would probably save you a lot of trouble if you went through a tutorial of some kind before writing much more code. You can find tutorials at http://ocaml.org.