New feature proposal: Support C-code inline?

[nalaginrut <nalaginrut@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2139 bytes --]

hi all!
I think somebody will need such a C-inline feature when he wants to
write a smart C-function to replace the critical function in his
algorithm.
And I found a similar feature in Ruby. So I wrote a module to provide
this. 
Anyway, I think the best solution is a AOT compiler for guile. But it
seems to be dystocia. So this module provides an easy solution.

Let me show it's usage:
(use-modules (inline inline))

(define in (make <inline> #:name "mytest")) 
;; this name is arbitrary. But if you made more than one inline instance
;; in your program, each must has an unique name. Or shit happens.

(inline:eat-code in "int func(int a ,int b){ return a+b;}")
;; well~this example is too stupid. Try another as you will...

(let ((myfunc (inline:get in)))
   (myfunc 5 6)
  )

===> 11

Drawback:
1. Though this module will parse the function type list, it's not
perfect. Users can only chose "int/float/double/char/long/void".
2. Can't support "unsigned" in the function declaration. But you can use
them in the function body.
3. Can't support "pointers" in the function declaration, it's a big
drawback. This inline feature is restricted so much because of this
pity. The good news is you can use it in the function body.
4. ...Anyone find more?

Future:
1. Fix the known drawbacks.
2. Each inline instance will generate a share lib file. That means each
inline function will have one share lib file. 
Though they won't conflict because the lib file name is bound to the
program name which use it, I think it's not proper.
Maybe we can add several inline functions to one inline instance, and
generate just one share lib for each program.

I don't know how much people is interested it. For some low-level
programming guys, this module even provides inline assemble. I know this
module is too simple for some guys, but it's easy to implement and easy
to use.

My patch is attached(actually it's not a patch...).
Any advices?

-- 
GNU Powered it
GPL Protected it
GOD Blessed it

HFG - NalaGinrut

--hacker key--
v4sw7CUSMhw6ln6pr8OSFck4ma9u8MLSOFw3WDXGm7g/l8Li6e7t4TNGSb8AGORTDLMen6g6RASZOGCHPa28s1MIr4p-x hackerkey.com
---end key---

[-- Attachment #2: inline.scm --]
[-- Type: text/x-scheme, Size: 4988 bytes --]

;; guile-inline
;; Copyright (C) 2011 
;; NalaGinrut <NalaGinrut@gmail.com>

;; This library is free software; you can redistribute it and/or modify
;; it under the terms of the GNU Lesser General Public License as
;; published by the Free Software Foundation; either version 3 of the
;; License, or (at your option) any later version.
;;                                                                  
;; This library is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Lesser General Public License for more details.
;;                                                                  
;; You should have received a copy of the GNU Lesser General Public
;; License along with this program; if not, contact:
;;
;; Free Software Foundation           Voice:  +1-617-542-5942
;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
;; Boston, MA  02111-1307,  USA       gnu@gnu.org



(define-module (inline inline)
  #:use-module (oop goops)
  #:use-module (ice-9 regex)
  #:use-module (system foreign)

  #:export (<inline>
	    inline:eat-code
	    inline:get
	    )
  )

(define type-regexp "([A-Za-z0-9_]+) ([A-Za-z0-9_]+)\\(([A-Z0-9a-z_ ,]*)\\)")
(define arg-type-regexp "([a-zA-Z0-9_]+) [a-zA-Z0-9_]+")
(define func-type 1)
(define func-name 2)
(define args 3)

(define fname 0)
(define fargs 1)
(define ftype 2)
(define fargs-types 3)

(define match-decl
  (lambda (decl)
    (lambda (which)
      (match:substring 
       (string-match type-regexp decl)
       which))))

(define get-args-type-list
  (lambda (args)
    (let* ((al (string-split args #\,))
	   (sl (map (lambda (x)
		      (string->type
		       (match:substring (string-match arg-type-regexp x) 1)))
		    al))
	   )
      sl
      )))

(define string->type
  (lambda (str)
    (eval (string->symbol str) (current-module))))

(define gen-load-path
  (lambda ()
    (string-append %compile-fallback-path (getcwd) "/")))

(define-class <inline> ()
  ;; this name will be the .so file name
  (name #:init-value "example" #:init-keyword #:name)
  
  (so-path #:init-form (gen-load-path) #:init-keyword #:so-path)
  (tmp-path #:init-value "/tmp/")

  ;; target name with complete path
  (target #:init-value #f #:accessor inline:target)

  ;; func is C-side function info
  (info #:init-value #f #:accessor inline:info)

  ;; keep the code string in case we need regenerate .so
  (code #:init-value #f #:accessor inline:code)

  ;; this is dynamic FFI
  (ffi #:init-value #f #:accessor inline:ffi)
  )

(define-method (inline:gen-so (in <inline>))
  (let* (;; NOTE: I chose -fpic which implies -msmall-data
	 ;;       And I think inline code must be smart.So
	 ;;       please take care of this.
	 (name (slot-ref in 'name))
	 (c-name (string-append 
		  (slot-ref in 'tmp-path) name ".c"))
	 (so-name (string-append 
		   (slot-ref in 'so-path) (basename (car (command-line))) "." name ".so"))
	 (cc-cmd (string-append
		  "cc -shared -fpic "
		  c-name " -o" so-name))
	 (code (inline:code in))
	 (output (open-file c-name "w"))
	 )

    ;; write C code to a tmp file
    (format output "~a~%" code)
    (close output)
    
    (if
     (eqv? (system cc-cmd) 0)
     (set! (inline:target in) so-name)
     (error inline:gen-so "compile inline function error")
     )))    

(define-method (inline:update-code (in <inline>) (code <string>))
  (if (not (inline:code in))
      (set! (inline:code in) code)))

(define-method (inline:update-info (in <inline>) (info <list>))
  (if (not (inline:code in))
      (set! (inline:info in) info)))
 
(define-method (inline:update-ffi (in <inline>))
  (let* ((so-file (inline:target in))
	 (dso (dynamic-link so-file))
	 (info (inline:info in))
	 (fn (list-ref info fname))
	 (args (list-ref info fargs))
	 (ft (list-ref info ftype))
	 (at (list-ref info fargs-types))
	 (ffi
	  (pointer->procedure ft
			      (dynamic-func fn dso)
			      at
			      ))
	 )
    
    (set! (inline:ffi in) ffi)
    ))
	
		
(define-method (inline:eat-code (in <inline>) (code <string>))
  (let* ((decl (string-copy code 0 (string-index code #\{)))
	 (match-type (match-decl decl))
	 (ft (string->type (match-type func-type)))
	 (args (match-type args))
	 (at (get-args-type-list args))
	 (fn (match-type func-name))
	 (info (list fn args ft at))
	 )
    (inline:update-info in info)
    (inline:update-code in code)
    ;; generate .so file
    (inline:gen-so in)
    (inline:update-ffi in)
    ))

(define-method (inline:get (in <inline>))
  (let* ((target (inline:target in))
	 (code (inline:code in))
	 (status #f)
	 )
    ;; if target isn't exist, re-generate it.
    (if (not target) 
	(inline:eat-code in code))

    (set! status (stat target))

    ;; if target is newer than last accession,
    ;; update the ffi.
    (if (> (stat:mtime status) (stat:atime status))
	(inline:update-ffi in))
    
    ;; return ffi
    (inline:ffi in)
    ))