CLISP allows us to do
(compile nil #'(lambda(x) (+ x 1)))
This returns a compiled function object:
#<COMPILED-FUNCTION NIL>
Is it possible to export this as a binary string, in order to persist it? Say, saving it in a database, and later be able to load and run the compiled function.
Not in portable Common Lisp.
Instead write the function to a file, compile the file with COMPILE-FILE. Then you have the compiled code on the file system. You can later load the file and run the function. You could also store the file contents into the database. If you need it later, you would need to export the data from the database into a file and call LOAD to load the file.
CLISP
Yes, in CLISP you can:
> (defparameter *my-function* (compile nil #'(lambda(x) (+ x 1))))
*MY-FUNCTION*
> *MY-FUNCTION*
#<COMPILED-FUNCTION NIL>
> (write-to-string *my-function* :readably t :pretty nil)
"#Y(|COMMON-LISP|::|NIL| #15Y(00 00 00 00 01 00 00 00 20 02 AD 32 B1 19 02) () (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))"
> (defparameter *my-function-1* (read-from-string (write-to-string *my-function* :readably t)))
*MY-FUNCTION-1*
> (funcall *my-function-1* 10)
11
This is portable across all platforms supported by CLISP, and as long as the CLISP bytecode version is the same (it does not change at every release).
Other implementations
As Rainer said, other CL implementation do not necessarily support this, but you can certainly put your function into a file, compile the file, and read in the string:
(defun function-string (func)
(let ((lambda-expr (function-lambda-expression func)))
(unless lambda-expr
(error "no lambda expression for ~S" func))
(let ((tmp-file "tmp.lisp") comp-file ret)
(with-open-file (o tmp-file :direction :output)
(write (list* 'defun my-tmp-func (cdr lambda-expr))
:stream o :readably t))
(setq comp-file (compile-file tmp-file))
(with-open-file (compiled comp-file :direction :input
:element-type '(unsigned-byte 8))
(setq ret (make-array (file-length compiled)
:element-type '(unsigned-byte 8)))
(read-sequence ret compiled))
(delete-file tmp-file)
(delete-file comp-file)
ret)))
To recover the function, you would need to do use load:
(with-input-from-string (s (function-string *my-function*))
(load s))
(fdefinition 'my-tmp-func)
Notes:
function-lambda-expression's value can legitimately be always nil in a given implementation!
If the implementation compiles to native code, the above string will be platform-dependent.
I glossed over the package issues...
Related
I am learning Common Lisp (SBCL).
I want to create a facility to invoke two (or more) macros with several similar expressions that differ only in some parameters.
I would like to define the base of the expression, then modify it with the parameters I supply. For this a lambda function definition came to mind.
As far as I know, there is no analogue to funcall for macros, so I've also wrapped the macros in lambdas.
I feel like I'm overcomplicating with with all these lambda-s and funcall-s. Is there a more elegant way?
The macros are from an external lib, so I'd prefer not to modify them. (Specifically, the fiveam testing library's finishes and signals.)
Here is a sample code:
(defmacro macro1 (body) ())
(defmacro macro2 (body) ())
(defun check-expr-with-args (do-m func args)
(dolist (arg args)
(format t "~a " arg)
(funcall do-m (lambda () (funcall func arg)))))
(let ((test-expr
#'(lambda (val) (format t "~a" val)))
(cases (list
(list #'(lambda (func) ( macro1 (funcall func)))
(list 1 2 3 4 5))
(list #'(lambda (func) ( macro2 (funcall func)))
(list -4 -5 -6 -7 -8 -9)))))
(dolist (c cases)
(check-expr-with-args (first c) test-expr (second c))))
Originally I've tried to pass the macro names to my check-expr-with-args function, and the expressions in quoted form, relying on lexical scoping for the parameter insertion. That didn't work out.
I think you can write a wrapper macro that produces code that invokes macro1 (and macro2). For example here I'm defining m1 that takes (i) a test expression and (ii) an expression that is expected to evaluates at runtime to a list of values.
(defmacro m1 (test-expr input-expr)
(let ((arg (gensym)))
`(dolist (,arg ,input-expr)
(macro1 ,test-expr ,arg))))
Both test-expr and input-expr are injected in a dolist expression, which binds a variable named arg. Here arg is a fresh symbol introduced with gensym, to avoid accidentally shadowing a variable or symbol-macro possibly used in test-expr.
For example:
(m1 (some-test-p) (list 1 2 3 4))
The above expands as:
(DOLIST (#:G1909 (LIST 1 2 3 4))
(MACRO1 (SOME-TEST-P) #:G1909))
The resulting expression contains MACRO1, which will also be expanded. But it is now wrapped in an expression that iterates over some list computed at runtime. Here, it is a constant but you could replace it with any other expression.
In conclusion, it is often best to combine macros at the macro level, by expanding your own macros into other ones.
I want to create a facility to invoke two (or more) macros
(defmacro invoke-macros (macro-forms)
`(progn ,#macro-forms))
with several similar expressions that differ only in some parameters.
(defmacro invoke-macros (macro-names &rest macro-arguments)
`(progn ,#(loop for m in macro-names
appending (loop for a in macro-arguments
collecting `(,m ,#a)))))
Check:
[1]> (macroexpand '(invoke-macros (m1 m2) (a b c) (d e f)))
(PROGN (M1 A B C) (M1 D E F) (M2 A B C) (M2 D E F)) ;
T
Of course, this works with any operators, including functions, not only macros; we should call this invoke-operators. Or some better name reflecting that we are creating a cartesian product from operators and argument syntax.
If we need the returned values, we can change progn to list. Or possibly values if the number of combinations isn't expected to be large.
If this had to be a function:
(defun invoke-ops (op-names &rest op-arguments)
(loop for o in op-names
appending (loop for a in op-arguments
collecting (eval `(,o ,#a)))))
Check:
[1]> (invoke-ops '(list +) '(1 2) '(10 20))
((1 2) (10 20) 3 30)
Since invoke-ops is now a function, we have to quote the arguments.
There is no funcall for macros. If you gain access to the expander function of a macro, then there is a funcall, but all it does is perform the code transformation; it won't invoke the macro.
The only ways to invoke the code generated by a macro are: you can eval the code, or you can compile the code and funcall it. The latter approach requires a function, so you place the code into a lambda expression first:
(funcall (compile nil `(lambda () ,code-output-by-macro)))
The nil argument of compile is the function name; we are telling compile that we are not dealing with a named function definition. We supply the code in the second argument. In some Common Lisp implementations, there is no evaluator; the eval function does something similar to:
(defun eval (code)
(funcall (compile nil `(lambda () ,code))))
Let's consider the following functions:
(defun test (x)
"X."
(request "http://example.com"
:parser 'json-read
:complete (cl-function
(lambda (&key response &allow-other-keys)
(message "%s" x)))))
(defun test2 (x)
"X."
(funcall (cl-function (lambda (z) (message "%s" z))) x))
Calling (test2 3) Works fine and produces the desired message. Calling (test 3), however, fails with the following error:
error in process sentinel: let*: Symbol’s value as variable is void: x
error in process sentinel: Symbol’s value as variable is void: x
My guess is that request is a macro doing something weird to variable scoping. Unfortunately, the documentation does not mention anything like this. Is there a way to overcome that?
request is probably an ordinary function.
The problem is that the lambda you pass to it is not called immediately but is
saved and called later:
(defun make-function (x)
(lambda () (message "received %s" x)))
=> make-function
(defconst f (make-function 3))
=> f
(funcall f)
=> Lisp error: (void-variable x)
x that make-function bound no longer exists.
This is because by default Emacs uses dynamic binding and you need lexical binding to get the behavior you want.
If you add
;; -*- lexical-binding:t -*-
to the first line of your file, it will be compiled with lexical binding and
the code above will produce the message received 3 instead of an error.
I am making a compiler for a language in LISP, and the overall aim is for the compiler to produce LISP code from the original language. Trying to measure the performance of the generated code, I found that it is severely lacking in printing strings.
In the original language, characters are byte -arithmetic- values, thus strings are arrays of bytes, and the value of the byte corresponds to the character whose value is the ascii-code of the byte. A "printable" byte array must be null-terminated. Thus, to print a byte array as a character string, I have to map the original array's elements into characters before printing it. The function that handles this is as follows:
(defun writeString (X &AUX (NPOS 0) (i 0))
(declare (type (simple-VECTOR fixnum *) x))
(declare (type fixnum NPOS i))
(SETF NPOS (POSITION 0 X))
(IF (NOT NPOS)
(SETF NPOS (LENGTH X)))
(princ (MAKE-ARRAY NPOS
:INITIAL-CONTENTS (map 'vector
#'code-char
(SUBSEQ X 0 NPOS))
:ELEMENT-TYPE 'base-char)))
and it is injected into the generated code.
Running a sample code with time, I found out that the princ part results in a lot of consing during execution, which slows things down. When in the place of make-array... a static string is put, there is no slowdown and no consing, so I guess that's the part the damage is done.
While compiling, I have set flags full on speed, the byte values are declared as fixnum for now in the generated code.
Can anyone point me to a better way to print my byte array as character string while avoiding excessive consing?
I could store bytes as characters from the get-go, but that would result in the parts of the language that treat them as numbers being slower due to the need to convert.
Problems in your code
Your code:
(defun writeString (X &AUX (NPOS 0) (i 0))
(declare (type (simple-VECTOR fixnum *) x))
(declare (type fixnum NPOS i))
(SETF NPOS (POSITION 0 X))
(IF (NOT NPOS)
(SETF NPOS (LENGTH X)))
(princ (MAKE-ARRAY NPOS
:INITIAL-CONTENTS (map 'vector
#'code-char
(SUBSEQ X 0 NPOS))
:ELEMENT-TYPE 'base-char)))
There are a couple of mistakes in the code:
i is not used
the first type declaration is syntactical not valid
the declaration for NPOS is wrong. You define it as FIXNUM, but it can be NIL.
There are a bunch of programming mistakes:
there is no need to allocate any array if all you want is to output characters.
even if you want to generate an array, one can do it once
X is not a good name for a string
A simple solution:
(defun writestring (bytestring)
(loop for byte across bytestring
while (plusp byte)
do (write-char (code-char byte))))
A type declared version could be:
(defun writestring (bytestring)
(declare (vector bytestring))
(loop for byte of-type (integer 0 255) across bytestring
while (plusp byte)
do (write-char (code-char byte))))
Instead (integer 0 255) one can also use (unsigned-byte 8).
About generating vectors:
Let's also look how you try to create the array:
You create an array with make-array, using the contents from another array.
Why not tell MAP to generate the correct array?
CL-USER 46 > (map '(vector base-char) #'code-char #(102 111 111 98 97 114))
"foobar"
Now if you want to allocate arrays for some reason:
do it once
map the content into the generated array. Use map-into for that. It will stop with the shorter sequence.
Example:
CL-USER 48 > (let ((bytestring #(102 111 111 98 97 114 0 100 100 100)))
(map-into (make-array (or (position 0 bytestring)
(length bytestring))
:element-type 'base-char)
#'code-char
bytestring))
"foobar"
You could rely on write-sequence, which hopefully is optimized to write a sequence of characters or bytes. It also accepts an :end argument which is useful for delimiting the end of the written string.
I doubt you really need to use literal vectors (which are always simple-vector), but if so you maybe want to change them. You can do it at read-time:
(let ((input #.(coerce #(102 111 111 98 97 114 0 100 100 100)
'(vector (mod 256)))))
(write-sequence (map '(vector base-char)
#'code-char
input)
*standard-output*
:end (position 0 input)))
I never used something like the following, but you could also open the same file in both character and byte mode, and switch whenever necessary:
(with-open-file (out-c #P"/tmp/test"
:if-exists :supersede
:direction :output)
(with-open-file (out-8 #P"/tmp/test"
:element-type '(unsigned-byte 8)
:direction :output
:if-exists :append)
(format out-c "Hello [")
(file-position out-8 (file-position out-c))
(write-sequence #(102 111 111 98 97 114) out-8)
(file-position out-c (file-position out-8))
(format out-c "]")))
It prints "Hello [foobar]" in /tmp/test, and it seems to work with multibyte characters, but you probably need to test that more.
I've just discovered the shr package in emacs 24.5.1
i.e.
C-x C-f anyfile.html
M-x shr-render-buffer
Looks really good - just what I was after
Can I automate emacs to call shr-render-buffer when I open any .htm or .html file?
UPDATE
I've tried adding the following to my .emacs:
(add-to-list 'auto-mode-alist '("[.]htm$" . shr-render-buffer))
(add-to-list 'auto-mode-alist '("[.]html$" . shr-render-buffer))
but I get the error:
File mode specification error: (void-function shr-render-buffer)
The html file then gets opened in Fundamental mode and it looks even worse than HTML mode
It seems you want to run the function shr-render-buffer automatically once a html file is opened. As you said, the mode for .htm/.html is html-mode by default, you can add the function invocation to the html-mode-hook, such as:
(add-hook 'html-mode-hook '(lambda() (shr-render-buffer (current-buffer))))
As #lawlist pointed, put it after (require 'shr).
As this is emacs, the hardest part of doing what you want is deciding on what is the best approach. This largely depends on personal taste/workflows. I would highly recommend looking at the browse-url package in more detail. One thing I use is a function which allows me to switch between using eww or my default system browser - this means I can easily render web content either in emacs or in chrome/safari/whatever.
Some years ago, I wrote a utility which would allow me to view a number of different file formats, including rendered html, in emacs. I rarely use this now as doc-view has pretty much replaced most of this functionality and is much better. However, it does show how you can use defadvice to modify the view-file function so that id does different things depending on the file type. Note that as this is old emacs code and emacs has improved, there are probably better ways of doing this now. I also know that the 'advice' stuff has been re-worked, but this legacy stuff still works OK. Should get you started. Note that the functionality for MS doc, docx, pdf etc relies on external executables.
My preferred workflow would be to write a function which allows me to reset the browse-url-browser-function to either eww-browse-url or browse-url-default-browser and bind that to a key. I can then choose to display the html in emacs or the external browser and leverage of all the work already done in browse-url.
(require 'custom)
(require 'browse-url)
;; make-temp-file is part of apel prior to emacs 22
;;(static-when (= emacs-major-version 21)
;; (require 'poe))
(defgroup txutils nil
"Customize group for txutils."
:prefix "txutils-"
:group 'External)
(defcustom txutils-convert-alist
'( ;; MS Word
("\\.\\(?:DOC\\|doc\\)$" doc "/usr/bin/wvText" nil nil nil nil nil)
;; PDF
("\\.\\(?:PDF\\|pdf\\)$" pdf "/usr/bin/pdftotext" nil nil nil nil nil)
;; PostScript
("\\.\\(?:PS\\|ps\\)$" ps "/usr/bin/pstotext" "-output" t nil nil nil)
;; MS PowerPoint
("\\.\\(?:PPT\\|ppt\\)$" ppt "/usr/bin/ppthtml" nil nil nil t t))
"*Association for program convertion.
Each element has the following form:
(REGEXP SYMBOL CONVERTER SWITCHES INVERT REDIRECT-INPUT REDIRECT-OUTPUT HTML-OUTPUT)
Where:
REGEXP is a regexp to match file type to convert.
SYMBOL is a symbol to designate the fyle type.
CONVERTER is a program to convert the fyle type to text or HTML.
SWITCHES is a string which gives command line switches for the conversion
program. Nil means there are no switches needed.
INVERT indicates if input and output program option is to be
inverted or not. Non-nil means to invert, that is, output
option first then input option. Nil means do not invert,
that is, input option first then output option.
REDIRECT-INPUT indicates to use < to direct input from the input
file. This is useful for utilities which accept input
from stdin rather than a file.
REDIRECT-OUTPUT indicates to use > to direct output to the output
file. This is useful for utilities that only send output to
stdout.
HTML-OUTPUT Indicates the conversion program creates HTML output
rather than plain text."
:type '(repeat
(list :tag "Convertion"
(regexp :tag "File Type Regexp")
(symbol :tag "File Type Symbol")
(string :tag "Converter")
(choice :menu-tag "Output Option"
:tag "Output Option"
(const :tag "None" nil)
string)
(boolean :tag "Invert I/O Option")
(boolean :tag "Redirect Standard Input")
(boolean :tag "Redirect Standard Output")
(boolean :tag "HTML Output")))
:group 'txutils)
(defun txutils-run-command (cmd &optional output-buffer)
"Execute shell command with arguments, putting output in buffer."
(= 0 (shell-command cmd (if output-buffer
output-buffer
"*txutils-output*")
(if output-buffer
"*txutils-output*"))))
(defun txutils-quote-expand-file-name (file-name)
"Expand file name and quote special chars if required."
(shell-quote-argument (expand-file-name file-name)))
(defun txutils-file-alist (file-name)
"Return alist associated with file of this type."
(let ((al txutils-convert-alist))
(while (and al
(not (string-match (caar al) file-name)))
(setq al (cdr al)))
(if al
(cdar al)
nil)))
(defun txutils-make-temp-name (orig-name type-alist)
"Create a temp file name from original file name"
(make-temp-file (file-name-sans-extension
(file-name-nondirectory orig-name)) nil
(if (nth 7 type-alist)
".html"
".txt")))
(defun txutils-build-cmd (input-file output-file type-alist)
"Create the command string from conversion alist."
(let ((f1 (if (nth 3 type-alist)
output-file
input-file))
(f2 (if (nth 3 type-alist)
input-file
output-file)))
(concat
(nth 1 type-alist)
(if (nth 2 type-alist) ; Add cmd line switches
(concat " " (nth 2 type-alist)))
(if (nth 4 type-alist) ; redirect input (which may be output
(concat " < " f1) ; if arguments are inverted!)
(concat " " f1))
(if (nth 5 type-alist) ; redirect output (see above comment)
(concat " > " f2)
(concat " " f2)))))
(defun txutils-do-file-conversion (file-name)
"Based on file extension, convert file to text. Return name of text file"
(interactive "fFile to convert: ")
(let ((f-alist (txutils-file-alist file-name))
output-file)
(when f-alist
(message "Performing file conversion for %s." file-name)
(setq output-file (txutils-make-temp-name file-name f-alist))
(message "Command: %s" (txutils-build-cmd file-name output-file f-alist))
(if (txutils-run-command
(txutils-build-cmd (txutils-quote-expand-file-name file-name)
(txutils-quote-expand-file-name
output-file) f-alist))
output-file
file-name))))
(defadvice view-file (around txutils pre act comp)
"Perform file conversion or call web browser to view contents of file."
(let ((file-arg (ad-get-arg 0)))
(if (txutils-file-alist file-arg)
(ad-set-arg 0 (txutils-do-file-conversion file-arg)))
(if (string-match "\\.\\(?:HTML?\\|html?\\)$" (ad-get-arg 0))
(browse-url-of-file (ad-get-arg 0))
ad-do-it)))
(provide 'init-text-convert)
I'm trying to achieve parallell MySQL access with Scheme engines (light threads, as I've come to understand it).
My problem is, I don't know how to interact with C properly, thus can't take care of the results from the MySQL C API. This could also be a question about integrating C and Scheme.
My choice of Ypsilon is because it's fast (faster than Spark at least) and R6RS. Choosing another Scheme implementation is only relevant if it's R6RS and has speed comparable to Ypsilon.
This file bind the C API:
http://code.google.com/p/ypsilon/source/browse/trunk/sitelib/ypsilon/mysql.scm?spec=svn444&r=444
Top make it compile, I had to change all int8_t to int, unsigned-int to int, etc. There's a lot of C types I miss in my Ypsilon library, that is (it's the latest complete distribution, still).
My book about Scheme, The Scheme Programming Language by Dybvig (4:th edition) sais nothing about C integration.
The function mysql_fetch_row returns a MYSQL_ROW struct. This page present a way to handle this:
(google for) fixedpoint mysql-client-in-ypsilon.html
I cannot compile this. Have to check why.
This is used:
make-bytevector-mapping = Provides transparent access to an arbitrary memory block
In its FFI, Ypsilon has a function called define-c-struct-type:
http://www.littlewing.co.jp/ypsilon/doc-draft/libref.ypsilon.c-types.html#define-c-struct-methods
I haven't tried that yet. I'll be back with more information. If anyone has succeeded with something like this, please let me know.
Regards
Olle
My code so far:
(import (core)
(ypsilon ffi)
(ypsilon c-types)
(ypsilon mysql))
(define NULL 0)
(define host "localhost")
(define user "root")
(define passwd "bla")
(define database "bla")
(define mysql)
(define query "select bla from bla")
(begin
(set! mysql (mysql_init #f))
(mysql_real_connect mysql host user passwd database 0 #f 0)
(display (mysql_stat mysql))
(newline)
(display (string-append "mysql_query:\t" (number->string (mysql_query mysql query))))
(newline)
(let ([result (mysql_store_result mysql)])
(let rec ([n (mysql_num_fields result)] [row (mysql_fetch_row result)] [lengths (mysql_fetch_lengths result)])
(display (string-append "num_fields:\t" (number->string n)))
(newline)
(display (string-append "lengths:\t" (number->string lengths)))
(newline)
(display (string-append "row:\t\t" (number->string row)))
(newline)
(if (= row (- 0 1))
""
(let ([row (make-bytevector-mapping row (bytevector-c-int-ref (make-bytevector-mapping lengths sizeof:int)) (* 10 sizeof:int))])
(display (utf8->string row))
(newline)
(newline)
(newline)
(rec n (- lengths 1) (mysql_fetch_row result))
)))
(newline)))
This will output:
Uptime: 1203 Threads: 1 Questions: 204 Slow queries: 0 Opens: 569 Flush tables: 1 Open tables: 64 Queries per second avg: 0.169
mysql_query: 0
num_fields: 1
lengths: 8525640
row: 8541880
error in bytevector-c-int-ref: expected 2, but 1 argument given
irritants:
(#<bytevector-mapping 0x821748 4>)
backtrace:
0 (bytevector-c-int-ref (make-bytevector-mapping lengths sizeof:int))
..."/home/olle/scheme/div.scm" line 54
1 (rec n (- lengths 1) (mysql_fetch_row result))
..."/home/olle/scheme/div.scm" line 63
2 (let rec ((n (mysql_num_fields result)) (row (mysql_fetch_row result)) (lengths ...) ...) ...)
..."/home/olle/scheme/div.scm" line 37
I looked at the documentation for the for bytevector-c-int-ref the first thing that jumped out to me was that it requires two arguments (like the error says) the second being a non-negative byte offset. Does it run with that change?