Getting access to Coq's rich XML-like AST output - coq

In older versions of Coq (< 8.5), the main coqtop process would interchange data with IDEs using strings.
This was supposedly recently changed - how does one query the richer XML-like structure representing ASTs?
Use case: I would like to interpret whatever Coq computes in a different way - that is, I need its results after performing operations (such as invoking tactics) in a form that's not string that I need to parse.


Note: this answer has been edited to make it up to date
The only reasonable option as of end of 2018 is SerAPI, a Coq language server that supports full serialization of Coq documents. Using SerAPI you can get a full representation of any Coq document or internal structure:
$ rlwrap sertop --printer=human
(Add () "Lemma u n : n + 0 = n.")
> (Answer 0 (StmAdded 2 (...) NewTip))
(Query ((sid 2)) Ast)
> (Answer 1(ObjList
> ((CoqAst
> (VernacStartTheoremProof Lemma
> ((((((Id u)) ()))
> (((LocalRawAssum
> (((Name (Id n))))
> (Default Explicit)
> (CHole () IntroAnonymous ())))
> (CNotation
> "_ = _"
> (((CNotation
> "_ + _"
> (((CRef
> (Ident
> (Id n)))
> ())
> (CPrim
> (Numeral (Ser_Bigint 0))))
> () ()))
> (CRef
> (Ident
> (Id n)))
> ()))
> () ()))
> ())))
> false)))))
Note that SerAPI is experimental software and I am the main author.

Related

Ocamlbuild plugin: build dynamic dependencies only if the target has changed

I'm trying to write an ocamlbuild plugin. The goal is to build Qt apps (without OCaml code for the time being). To handle the final linking phase, I have written the list of objs, mocs, uis and rcs in a .qtobjs file (like a .itarget), and the list of Qt libs in a .qtpackages file. The rule that applies to these files parses these lists and dynamically builds the objects, mocs and so on before linking everything.
The problem is that I would like not to dynamically build the targets that have not changed. See the rule below:
rule "Link a c++ executable that uses Qt."
~deps:["%.qtobjs"; "%.qtpackages"]
~prod:"%.cxxnative"
(fun env build ->
let dir = Pathname.dirname (env "%.qtobjs") in
let output = env "%.cxxnative" in
let objlist = pwd / (env "%.qtobjs") in
let liblist = pwd / (env "%.qtpackages") in
let packages = read_lines liblist in
let lflags = List.map (fun p -> "-l"^p) packages
# find_all "lflags" in
let objs = List.map (fun o -> dir / o) (read_lines objlist) in
(* Here, I would like to forget the targets that have not changed *)
let objs_to_build = List.filter
(fun target ->
(* something to tell if "target" has to be rebuilt *))
objs in
(* This is where I build the dependencies : *)
let success_builds = build
(List.map (fun o -> [o])
objs_to_build) in
let objects = filter_map
(function
| Outcome.Good x when get_extension x = "opp" ->
Some (pwd / "_build" / (update_extension "o" x))
| Outcome.Good _ -> None
(* Because I don't want to link the ui.h file generated by uic *)
| Outcome.Bad exn -> raise exn)
success_builds in
let tags_objs = tags_of_pathname (env "%.qtobjs") ++ "link" in
let tags_packs = tags_of_pathname (env "%.qtpackages") in
Cmd (S [A (find_one "cxx"); T tags_objs; T tags_packs; Command.atomize lflags;
A "-o"; P output; Command.atomize objects]));
I would like not to call "build" when it's not necessary.
NB: a function
newer_than: Pathname.t -> Pathname.t -> bool
could solve my problem.

Problem solved.
For those who are interested, the problem was in the COMPILING rule : because the ".o" rule was already used by ocamlbuild, I registered it to officially produce ".opp" files but the command actually wrote .o files. So when recompiling, ocamlbuild had no clue that the object file was already present.
Three options:
replace the default ".o" rule (I don't even know if it is possible ?),
produce ".opp" files (but it's less standard),
or alter the compiling rule to do Nop if the .o file exists:
if Pathname.exists (env "%.o") then Nop
else Cmd (S [A ("c++");
A "-c";
A "-o"; P (env "%.o"); P (env "%.cpp")]));

How to use FFI:def-call-in in clisp

I have figured out how to make use of shared objects created from C code into Clisp using FFI:def-call-out but I am not able to figure out how to use FFI:Def-call-in.
I don't know the process and actually I am confused if clisp will also create some .so file that some C function can use or something else.
Can someone please explain a minimal working example for writing such callback functions ?

Example 32.7. Calling Lisp from C:
To sort an array of double-floats using the Lisp function SORT instead of the C library function qsort, one can use the following interface code sort1.c. The main problem is to pass a variable-sized array.
extern void lispsort_begin (int);
void* lispsort_function;
void lispsort_double (int n, double * array) {
double * sorted_array;
int i;
lispsort_begin(n); /* store #'sort2 in lispsort_function */
sorted_array = ((double * (*) (double *)) lispsort_function) (array);
for (i = 0; i < n; i++) array[i] = sorted_array[i];
free(sorted_array);
}
This is accompanied by sort2.lisp:
(DEFPACKAGE "FFI-TEST" (:use “COMMON-LISP” “FFI”))
(IN-PACKAGE "FFI-TEST")
(EVAL-WHEN (compile) (setq FFI:*OUTPUT-C-FUNCTIONS* t))
(FFI:DEF-CALL-IN lispsort_begin (:ARGUMENTS (n int))
(:RETURN-TYPE nil)
(:LANGUAGE :stdc))
(FFI:DEF-C-VAR lispsort_function (:type c-pointer))
(defun lispsort_begin (n)
(setf (cast lispsort_function
`(c-function
(:ARGUMENTS (v (c-ptr (c-array double-float ,n))))
(:RETURN-TYPE (c-ptr (c-array double-float ,n))
:malloc-free)))
#'sort2))
(defun sort2 (v)
(declare (type vector v))
(sort v #'<))
To test this, use the following test file sorttest.lisp:
(EVAL-WHEN (compile) (setq FFI:*OUTPUT-C-FUNCTIONS* t))
(FFI:DEF-CALL-OUT sort10
(:name "lispsort_double")
(:LANGUAGE :stdc)
(:ARGUMENTS (n int)
(array (c-ptr (c-array double-float 10)) :in-out)))
Now try
$ clisp-link create sort sort2.c sorttest.c
$ cc -O -c sort1.c
$ cd sort
$ ln -s ../sort1.o sort1.o
Add sort1.o to NEW_LIBS and NEW_FILES in link.sh. Create a file package.lisp containing the form
(MAKE-PACKAGE "FFI-TEST" :use '(“COMMON-LISP” “FFI”))
and add package.lisp to TO_PRELOAD in link.sh. Proceed:
$ cd ..
$ base/lisp.run -M base/lispinit.mem -c sort2.lisp sorttest.lisp
$ clisp-link add base base+sort sort
$ base+sort/lisp.run -M base+sort/lispinit.mem -i sort2 sorttest
> (sort10 10 '#(0.501d0 0.528d0 0.615d0 0.550d0 0.711d0
0.523d0 0.585d0 0.670d0 0.271d0 0.063d0))
#(0.063d0 0.271d0 0.501d0 0.523d0 0.528d0 0.55d0 0.585d0 0.615d0 0.67d0 0.711d0)
$ rm -r base+sort

Verified software toolchain: if-then-else proof

I'm learning using the Verified Software Toolchain (VST). I get stuck at proving a simple "if-then-else" block.
Here is the .c file:
int iftest(int a){
int r=0;
if(a==2){
r=0;
else{
r=0;
}
return r;
}
I write a specification about the iftest() as follow:
Definition if_spec :=`
DECLARE _iftest`
WITH a0:int
PRE [_a OF tint]
PROP ()
LOCAL (`(eq (Vint a0)) (eval_id _a))
SEP ()
POST [tint]
PROP ()
LOCAL ((`(eq (Vint (Int.repr 0))) retval))
SEP ().`
the proof steps are:
Lemma body_iftest : semax_body Vprog Gtot f_iftest if_spec.Proof.
start_function.
name a _a.
name r _r.
forward. (*r=0*)
simplify_typed_comparison.
forward. (*if(E)*). go_lower. subst. normalize.
it generates a hypothesis:Post := EX x : ?214, ?215 x : environ -> mpred and the "then" clause can't go on by "go_lower" and "normalize".

In the current version of VST there is a forward_if PRED tactic. Here is how you can use it to solve your goal:
Require Import floyd.proofauto.
Require Import iftest.
Local Open Scope logic.
Local Open Scope Z.
Definition if_spec :=
DECLARE _iftest
WITH a0:int
PRE [_a OF tint]
PROP ()
LOCAL (`(eq (Vint a0)) (eval_id _a))
SEP ()
POST [tint]
PROP ()
LOCAL ((`(eq (Vint (Int.repr 0))) retval))
SEP ().
Definition Vprog : varspecs := nil.
Definition Gtot : funspecs := if_spec :: nil.
Lemma body_iftest : semax_body Vprog Gtot f_iftest if_spec.
Proof.
start_function.
name a _a.
name r _r.
forward.
forward_if (PROP ()
LOCAL (`(eq (Vint (Int.repr 0))) (eval_id _r)) SEP()).
+ forward.
entailer.
+ forward.
entailer.
+ forward.
Qed.
P.S. #bazza is right about a missing } before else. I assume it is fixed.

Potentially a non-helpful answer, but I can't help noticing that your .c code has 3 {'s and only 2 }'s, suggesting that it doesn't compile. Could the error message you're receiving have something to do with that?

Best way to read (MATLAB) structures from a text file in Clojure / Incanter

I exported my matlab structs to text files so that I can read them in clojure.
I have a text file like:
name
Ali
age
33
friends-ages
30
31
25
47
know I can read this file, but what's the clojure way to convert it into something like:
(def person1
{:name "Ali"
:age 33
:friends-ages [30 31 25 47]})
or lets make it easier:
name
Ali
age
33
to:
(def person1
{:name "Ali"
:age 33})

Assuming each file has a single record,
(defn parse [f]
(let [[_ name _ age _ & friends] (.split (slurp f) "\n")]
{:name name :age age :friends (map read-string friends)}))
(parse "../../../Desktop/t.txt")
you get,
{:name "Ali", :age "33", :friends-ages (30 31 25 47)}

I guess you would need to manually do this conversion from text file (which isn't in any standard serialization formats) to the required set format. If possible, I would suggest that you should extract the MATLAB data in JSON format and that would be easy to read in clojure using the json library.

Here's a solution for your easier problem:
(ns example
(:require [clojure.string :as str]))
(def input "name\nAli\nage\n33\n") ; you'd get this by reading the file
(defn process [data]
(->> (str/split data #"\n")
(partition 2)
(map (fn [[k v]]
[(keyword k)
(try
(Integer/valueOf v)
(catch NumberFormatException _
v))]))
(into {})))
(prn (process input))
The full problem requires better specification of the format: how do you know that the list of ages is done?

I ended up writing an .m file to export my .mat files to text, then imported them by something like the following:
(use '[clojure.string :only (split join)])
(defn kv [[k v]]
[(keyword k) v])
(let [a (split (slurp (java.io.FileReader. fileName)) #"\n")]
(def testNeuron (into {} (map kv (partition 2 a)))))
Thanks to the answers by Hamza and Jouni.
The actual code is more like this:
(def dataPath "/home/ali/Dropbox/Projects/Neurojure/")
(def testFileName "dae062.c1.cylinder.DID.txt")
(defn kv [[k v]]
[(keyword k)
(if (< 0 (count (re-seq #"\d\d\d\dSpikes|\d\d\d\dOcodes|\d\d\d\dOSpikes" k)))
(into [] (map (fn [x] (Integer/valueOf x)) (split v #",")))
(try (Integer/valueOf v)
(catch NumberFormatException _ v)))])
(let [a (split (slurp (java.io.FileReader. (str dataPath testFileName))) #"\n")]
(def testNeuron (into {} (map kv (partition 2 a)))))
and the converted data file looks like this:
ConvertDate
18-Nov-2011
Name
/bgc/data/dae/062/dae062.mat
frameperiod
83.2500000037253
Spike2Version
1.27
unstored
167
rfstr
cm=rf-3.10,9.61:0.00x0.00,-135deg pe20 -2.0,-3.0 fx=0.00,fy=0.00cm=rf-3.10,9.61:0.00x0.00,-135deg pe20 -2.0,-3.0 fx=0.00,fy=0.00
rf
-3.1,9.61,0,0,-135,20,-2,-3,0,0
trange
47371169.75,100193717.5
psych
1
rc
0
Options
expname
cylinder.dxXIdD
Start
94745610.75
End
100193717.5
Area
MT
Ex
perimenter Ali
Trial=>0001Start
47377343
Trial=>0001TrialStart
47377343
Trial=>0001End
47397224.25
Trial=>0001dur
19881.2500000075
Trial=>0001uStim
0
Trial=>0001op
40980
Trial=>0001Trial
1860
Trial=>0001id
15897
Trial=>0001Startev
47377149.5
Trial=>0001serdelay
-46.25
Trial=>0001bstimes
47377195.75
Trial=>0001delay
147.25
Trial=>0001TrueEnd
47397224.25
Trial=>0001CorLoop
0
Trial=>0001dx
0
Trial=>0001Spikes
-1402,-1232,1577,1931,2165,2222,2478,2773,2903,3229,3745,3820,4071,4588,4920,5141,5752,6440,6490,6664,6770,7042,7958,8081,8307,8622,8732,9021,9082,9343,9619,9695,9877,10357,10668,10943,11105,11364,11720,12272,12499,12762,12907,13621,14121,14351,14542,14588,15104,15420,15501,16331,16596,16843,17476,17698,17996,18169,18401,18532,18706,19029,19081,19418,19603,19750,20222
Trial=>0001count
65
Trial=>0001OptionCode
+do+aa+sq+72+se+fc+fb+ap+wt+cf+ws+ts+sw+bw+cs+2a+bm+gm+x2+sp+da+ao+cS+C3+CF
Trial=>0001me
0
Trial=>0001OSpikes
-1976,-1802,-1423,-1360,-1268,-1248,-1140,-244,-220,-164,632,681,730,760,779,786,867,879,924,1062,1161,1252,1268,1431,1533,1632,1946,2210,2235,2273,2285,2296,2305,2496,2532,2541,2732,2787,2806,2822,2840,3095,3292,3431,3598,3614,3837,4100,4482,4504,4515,4651,4768,4794,4936,5020,5160,5184,5300,5314,5710,5764,6431,6453,6471,6553,6561,6584,6791,7018,7124,7880,7905,7940,7968,8011,8315,8330,8352,8568,8666,8748,8756,8766,8797,8836,9038,9297,9328,9360,9471,9632,9639,9721,9939,10196,10363,10375,10387,10410,10931,10953,10969,10986,11038,11118,11135,11405,11692,12018,12163,12258,12492,12512,12525,12884,12899,12919,13156,13183,13638,13674,13842,13988,14110,14298,14310,14321,14606,14617,15124,15132,15150,15289,15341,15620,16293,16305,16342,16364,16441,16604,16692,16932,16997,17059,17086,17210,17368,17495,17626,17639,17651,17677,17718,18013,18247,18353,18553,18691,18722,18887,18941,19438,19774,19938,19959,19967,20004,20240,20306,20500,20623
Trial=>0002Start
47406914
Trial=>0002TrialStart
47406914
Trial=>0002End
47426795.25
Trial=>0002dur
19881.2499999925
...

Racket Server & PostgreSQL - BLOB upload/download without saving to memory or disk

I am trying to make a servlet for the Racket Web Server that would allow a user to upload pictures to the site and display the already uploaded files as images on the same page. I would like to stream the pictures directly in and out of a PostgreSQL database, rather than saving them to a temporary file on disk or in memory. Is it possible? If so, what is the best way to do it? Can it be done with a stateless servlet? Any help is greatly appreciated!

Should be. I recommend the db package from PLaneT (because I wrote it). You can read the docs online.
The PostgreSQL table should have a bytea field for the image contents; on the Racket side it will be represented as a byte string.
In your servlet, you should probably return a response/full structure with the image contents. You'll have to deal with the return code, MIME type, etc yourself. (See the example in the documentation.)

In the name of science, I am posting one half of the answer to my own question. This page will show images that are already in the database. The upload page is still an open question.
Ryan Culpepper helped me in private correspondence beyond of what is posted here. I thank him for his help. All things that may look like black magic come from him, and all clumsy goofs are mine. I will be grateful for all suggestions on how to improve the code.
#lang racket
#|
================================================================================================================
We are assuming that the PostgreSQL database we are connecting to
has a table "person" with columns
"id", "firstname", "lastname" and "portrait".
The "portrait" column contains the OID of a BLOB
that stores the image file we want to display.
Suppose further that the table "person" has a legitimate entry with
id=22, firstname="John", lastname="Doe"
Then the page
http://127.0.0.1/page/22
should display greetings "Hello, John Doe!"
and show the portrait of the person below the greeting.
The portrait itself should be at
http://127.0.0.1/portrait/22.jpg
The program should be run via Racket -t "<filename>"
after defining the environment variables
"DB_USER", "DB_NAME", "DB_PORT", "DB_PASSWORD".
================================================================================================================
|#
(require
web-server/servlet
web-server/servlet-env
web-server/dispatch
web-server/stuffers/hmac-sha1
web-server/http
web-server/http/response-structs
(planet ryanc/db:1:4)
(planet ryanc/db:1:4/util/connect)
net/base64)
;---------------------------------------------------------------------------------------------------------------
; response
;---------------------------------------------------------------------------------------------------------------
(define (start given-request)
(site-dispatch given-request))
(define-values (site-dispatch given-request)
(dispatch-rules
[("page" (integer-arg)) show-page]
[("portrait" (string-arg)) show-portrait]))
(define (show-page given-request given-person-id)
(let* ( [db-person_firstname_lastname
(query-maybe-row my-connection
"SELECT firstname, lastname FROM person WHERE id = $1"
given-person-id)]
[my-firstname (vector-ref db-person_firstname_lastname 0)]
[my-lastname (vector-ref db-person_firstname_lastname 1)])
(response/xexpr
`(html ([xmlns "http://www.w3.org/1999/xhtml"])
(head
(title "Page with a portrait"))
(body
(div ([id "greetings"])
,(string-append
"Hello, " my-firstname " " my-lastname "! "))
(img ( [src ,(string-append "/portrait/"
(number->string given-person-id) ".jpg")])))))))
(define (show-portrait given-request given-portrait-file)
(let* ( [my-user-id (car (regexp-match #rx"^([0-9]+)"
given-portrait-file))]
[my-portrait-oid (query-value my-connection
"SELECT portrait FROM person WHERE id = $1"
(string->number my-user-id))]
[STREAMOUT_CHUNK_SIZE 1000]
[INV_READ #x00040000])
(response
200 ; code
#"Okay" ; message
(current-seconds) ; seconds
#"image/jpeg" ; mime type
empty ; headers
(lambda (given-output-stream) ; body generator
(start-transaction my-connection)
(define object-descriptor
(query-value my-connection
"SELECT LO_OPEN( $1, $2 )" my-portrait-oid INV_READ))
(define (stream-next-chunk)
(begin
(define my-next-chunk
(query-value my-connection
"SELECT LOREAD( $1, $2 )"
object-descriptor STREAMOUT_CHUNK_SIZE))
(if (> (bytes-length my-next-chunk) 0)
(begin
(write-bytes my-next-chunk given-output-stream)
(stream-next-chunk)
#t)
#f)))
(stream-next-chunk)
(commit-transaction my-connection)))))
;---------------------------------------------------------------------------------------------------------------
; database connection
;---------------------------------------------------------------------------------------------------------------
(define my-connection
(virtual-connection
(connection-pool
(lambda ()
(eprintf "(Re)establishing database connection...\n")
(postgresql-connect
#:user (getenv "DB_USER")
#:database (getenv "DB_NAME")
#:port (string->number (getenv "DB_PORT"))
#:socket #f
#:password (getenv "DB_PASSWORD")
#:allow-cleartext-password? #f
#:ssl 'optional ; other choices: 'yes 'no
)))))
;---------------------------------------------------------------------------------------------------------------
; servlet parameters
;---------------------------------------------------------------------------------------------------------------
(serve/servlet start
#:command-line? #t ; #t to use serve/servlet in a start up script for a Web application, and don't want a browser opened or the DrRacket banner printed
#:connection-close? #f ; #t to close every connection after one request. (Otherwise, the client decides based on what HTTP version it uses.)
#:launch-browser? #f
#:quit? #f ; #t makes the URL "/quit" end the server
#:banner? #t ; #t to print an informative banner
#:listen-ip #f ; give an IP to accept connections from external machines
#:port 80 ; 443 is the default for SSL, 80 - for open connections
#:servlet-regexp #rx"" ; #rx"" captures top-level requests
#:stateless? #t
#:server-root-path ; where the server files are rooted, default=(the distribution root)
(build-path ".")
#:ssl? #f
#:log-file (build-path "server.log"))