From 1d9bb537a1e4a43650cefb663858987b63ceca94 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 13 Apr 2020 16:59:44 -0400 Subject: [PATCH 01/50] Initial stub --- libs/cyclone/foreign.sld | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100644 libs/cyclone/foreign.sld diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld new file mode 100644 index 00000000..b21338d5 --- /dev/null +++ b/libs/cyclone/foreign.sld @@ -0,0 +1,24 @@ +;;;; Cyclone Scheme +;;;; https://github.com/justinethier/cyclone +;;;; +;;;; Copyright (c) 2014-2019, Justin Ethier +;;;; All rights reserved. +;;;; +;;;; TBD +;;;; +(define-library (cyclone foreign) + (import + (scheme base) + ;(scheme write) ;; TODO: debugging only! + ) + ;(include-c-header "") + (export + ;; TODO + ) + (begin + ;; TODO: internal to compiler? Anything to define in this library?? + ;; internal name could be different (Cyc-foreign-code) to facilitate + ;; library renaming, etc here + ;(foreign-code STRING ...) + ) +) From d345d71da91c58d333237742bf9dc536c70d5871 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 13 Apr 2020 18:51:16 -0400 Subject: [PATCH 02/50] Prototype code for Cyc-foreign-code --- scheme/cyclone/cgen.sld | 6 ++++++ scheme/cyclone/primitives.sld | 4 ++++ 2 files changed, 10 insertions(+) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 285771cd..19c73b62 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -986,6 +986,12 @@ "\n" "continue;")))) + ((eq? 'Cyc-foreign-code fun) + (c-code/vars + (string-append + "boolean_f") + args)) + ((prim? fun) (let* ((c-fun (c-compile-prim fun cont ast-id)) diff --git a/scheme/cyclone/primitives.sld b/scheme/cyclone/primitives.sld index 0d268a8d..7ff22701 100644 --- a/scheme/cyclone/primitives.sld +++ b/scheme/cyclone/primitives.sld @@ -89,6 +89,7 @@ Cyc-stderr Cyc-list Cyc-if + Cyc-foreign-code Cyc-fast-plus Cyc-fast-sub Cyc-fast-mul @@ -238,6 +239,7 @@ (Cyc-stdin 0 0) (Cyc-stderr 0 0) (Cyc-if 3 3) + (Cyc-foreign-code 1 #f) (Cyc-fast-plus 2 2) (Cyc-fast-sub 2 2) (Cyc-fast-mul 2 2) @@ -529,6 +531,7 @@ ((eq? p 'Cyc-stderr) "Cyc_stderr") ((eq? p 'Cyc-list) "Cyc_list") ((eq? p 'Cyc-if) "Cyc_if") + ((eq? p 'Cyc-foreign-code) "TODO") ((eq? p 'Cyc-fast-plus) "Cyc_fast_sum") ((eq? p 'Cyc-fast-sub) "Cyc_fast_sub") ((eq? p 'Cyc-fast-mul) "Cyc_fast_mul") @@ -701,6 +704,7 @@ (or (memq p '( Cyc-list + Cyc-foreign-code Cyc-fast-plus Cyc-fast-sub Cyc-fast-mul From 4006ca560d8845651ea7bb8edf5c5fb90d7458f4 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 14 Apr 2020 18:57:36 -0400 Subject: [PATCH 03/50] Proof-of-concept for Cyc-foreign-value --- scheme/cyclone/cgen.sld | 7 +++++++ scheme/cyclone/primitives.sld | 6 +++++- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 19c73b62..3c3af3df 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -992,6 +992,13 @@ "boolean_f") args)) + ((eq? 'Cyc-foreign-value fun) + ;; TODO: take type into account, do not hardcode int + (c-code/vars + (string-append + "obj_int2obj(" (car args) ")") + (list))) + ((prim? fun) (let* ((c-fun (c-compile-prim fun cont ast-id)) diff --git a/scheme/cyclone/primitives.sld b/scheme/cyclone/primitives.sld index 7ff22701..5dd4ec34 100644 --- a/scheme/cyclone/primitives.sld +++ b/scheme/cyclone/primitives.sld @@ -90,6 +90,7 @@ Cyc-list Cyc-if Cyc-foreign-code + Cyc-foreign-value Cyc-fast-plus Cyc-fast-sub Cyc-fast-mul @@ -240,6 +241,7 @@ (Cyc-stderr 0 0) (Cyc-if 3 3) (Cyc-foreign-code 1 #f) + (Cyc-foreign-value 2 2) (Cyc-fast-plus 2 2) (Cyc-fast-sub 2 2) (Cyc-fast-mul 2 2) @@ -531,7 +533,8 @@ ((eq? p 'Cyc-stderr) "Cyc_stderr") ((eq? p 'Cyc-list) "Cyc_list") ((eq? p 'Cyc-if) "Cyc_if") - ((eq? p 'Cyc-foreign-code) "TODO") + ((eq? p 'Cyc-foreign-code) "UNDEF") + ((eq? p 'Cyc-foreign-value) "UNDEF") ((eq? p 'Cyc-fast-plus) "Cyc_fast_sum") ((eq? p 'Cyc-fast-sub) "Cyc_fast_sub") ((eq? p 'Cyc-fast-mul) "Cyc_fast_mul") @@ -705,6 +708,7 @@ (memq p '( Cyc-list Cyc-foreign-code + Cyc-foreign-value Cyc-fast-plus Cyc-fast-sub Cyc-fast-mul From a5366007bcada783c764addfb8c4d24912086cc6 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 15 Apr 2020 22:59:17 -0400 Subject: [PATCH 04/50] Added TODO --- libs/cyclone/foreign.sld | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index b21338d5..d74b1bb3 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -20,5 +20,34 @@ ;; internal name could be different (Cyc-foreign-code) to facilitate ;; library renaming, etc here ;(foreign-code STRING ...) + + +;; TODO: how to handle this? + +;could maybe have a macro (define-c-foreign) that takes below and rewrites it as a define-c +;would be nice if we could have foreign-lambda though, which seems much more flexible. +;maybe we can work up to that + + ;(define strlen + ; (foreign-lambda int "strlen" char-vector) ) + +; (define-syntax define-curl-const +; (er-macro-transformer +; (lambda (expr rename compare) +; (let* ((sym (cadr expr)) +; (str (symbol->string sym)) +; (lib_fnc_str (string-append "_" str)) +; (lib_fnc (string->symbol lib_fnc_str)) ;; Internal library function +; (args "(void *data, int argc, closure _, object k)") +; (body +; (string-append +; "return_closcall1(data, k, obj_int2obj(" str "));")) +; ) +; `(begin +; (define-c ,lib_fnc ,args ,body) +; (define ,sym (,lib_fnc)) +; ))))) + + ) ) From 1a797b154be735e7a548dd384cc1d97b193ac77a Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 16 Apr 2020 09:45:13 -0400 Subject: [PATCH 05/50] Added TODO --- libs/cyclone/foreign.sld | 1 + 1 file changed, 1 insertion(+) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index d74b1bb3..c3ce25bb 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -49,5 +49,6 @@ ; ))))) +TODO: macros for foreign-value, foreign-code ) ) From 1adb0e290d3c35b6afb25ff81276ebe4b409c436 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 16 Apr 2020 19:05:19 -0400 Subject: [PATCH 06/50] Added 'foreign-code' macro --- libs/cyclone/foreign.sld | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index c3ce25bb..12627bbb 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -13,7 +13,7 @@ ) ;(include-c-header "") (export - ;; TODO + foreign-code ) (begin ;; TODO: internal to compiler? Anything to define in this library?? @@ -49,6 +49,14 @@ ; ))))) -TODO: macros for foreign-value, foreign-code + (define-syntax foreign-code + (er-macro-transformer + (lambda (expr rename compare) + (for-each + (lambda (arg) + (if (not (string? arg)) + (error "foreign-code" "Invalid argument: string expected, received " arg))) + (cdr expr)) + `(Cyc-foreign-code ,@(cdr expr))))) ) ) From 3a2fbeab757a4d4834ecc482e56d2630e7fdbf9e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 17 Apr 2020 19:21:49 -0400 Subject: [PATCH 07/50] WIP --- libs/cyclone/foreign.sld | 26 ++++++++++++++++++++++---- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 12627bbb..f1179b5c 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -14,6 +14,7 @@ ;(include-c-header "") (export foreign-code + foreign-value ) (begin ;; TODO: internal to compiler? Anything to define in this library?? @@ -22,11 +23,15 @@ ;(foreign-code STRING ...) -;; TODO: how to handle this? +;; TODO: foreign-lambda +;; +;; We are going to use the CHICKEN interface: +;; (foreign-lambda RETURNTYPE NAME ARGTYPE ...) +;; +;; We need to develop a macro to accept this interface and generate a +;; define-c equivalent. Not nearly as flexible as CHICKEN but will work +;; with our existing infrastructure. This is good enough for version 1. -;could maybe have a macro (define-c-foreign) that takes below and rewrites it as a define-c -;would be nice if we could have foreign-lambda though, which seems much more flexible. -;maybe we can work up to that ;(define strlen ; (foreign-lambda int "strlen" char-vector) ) @@ -49,6 +54,19 @@ ; ))))) + (define-syntax foreign-value + (er-macro-transformer + (lambda (expr rename compare) + (let* ((code-arg (cadr expr)) + (type-arg (caddr expr)) + ) + ;(for-each + ; (lambda (arg) + ; (if (not (string? arg)) + ; (error "foreign-value" "Invalid argument: string expected, received " arg))) + ; (cdr expr)) + `(Cyc-foreign-value ,code-arg ,type-arg))))) + (define-syntax foreign-code (er-macro-transformer (lambda (expr rename compare) From cb75d5373d6c441cc4389c2d9960677e0efa23b7 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 17 Apr 2020 19:36:37 -0400 Subject: [PATCH 08/50] Added comments --- libs/cyclone/foreign.sld | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index f1179b5c..1c9dd52b 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -28,6 +28,10 @@ ;; We are going to use the CHICKEN interface: ;; (foreign-lambda RETURNTYPE NAME ARGTYPE ...) ;; +;; And modify it a bit for our infrastructure: +;; +;; (define-foreign-lambda SCM-NAME RETURNTYPE C-NAME ARGTYPE ...) +;; ;; We need to develop a macro to accept this interface and generate a ;; define-c equivalent. Not nearly as flexible as CHICKEN but will work ;; with our existing infrastructure. This is good enough for version 1. From dfde2007b8d274649c1b5f23de258dc2a0bb089c Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 17 Apr 2020 19:36:57 -0400 Subject: [PATCH 09/50] Temporary test file --- test-foreign.scm | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 test-foreign.scm diff --git a/test-foreign.scm b/test-foreign.scm new file mode 100644 index 00000000..e1f268af --- /dev/null +++ b/test-foreign.scm @@ -0,0 +1,44 @@ +(import (scheme base) (scheme write)) + +(define-syntax foreign-code + (er-macro-transformer + (lambda (expr rename compare) + (for-each + (lambda (arg) + (if (not (string? arg)) + (error "foreign-code" "Invalid argument: string expected, received " arg))) + (cdr expr)) + `(Cyc-foreign-code ,@(cdr expr))))) + +(define-syntax define-foreign-code + (er-macro-transformer + (lambda (expr rename compare) + (let* ((scm-fnc (cadr expr)) + (c-fnc (cadddr expr)) + (rv-type (caddr expr)) + (arg-types (cddddr expr)) +; (str (symbol->string sym)) +; (lib_fnc_str (string-append "_" str)) +; (lib_fnc (string->symbol lib_fnc_str)) ;; Internal library function +; (args "(void *data, int argc, closure _, object k)") +; (body +; (string-append +; "return_closcall1(data, k, obj_int2obj(" str "));")) + ) + `((define-c ,lib_fnc ,args ,body) + ))))) + +;(define-c foreign-value +; "(void *data, int argc, closure _, object k, object code, object type)" +; " // TODO: need to dispatch conversion based on type +; return_closcall1(data, k, obj_int2obj(code +; ") + +(define-foreign-lambda scm-strlen int "strlen" string) + +;(write (Cyc-foreign-value "errno" "3")) +;(newline) +(write (foreign-code + "printf(\"test %d %d \\n\", 1, 2);" + "printf(\"test %d %d %d\\n\", 1, 2, 3);")) +(newline) From 7c2da7b4fd00d5acb186b67532cfd0448ce86871 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 17 Apr 2020 20:01:06 -0400 Subject: [PATCH 10/50] WIP --- test-foreign.scm | 47 ++++++++++++++++++++++++++++++++++------------- 1 file changed, 34 insertions(+), 13 deletions(-) diff --git a/test-foreign.scm b/test-foreign.scm index e1f268af..9943d5e6 100644 --- a/test-foreign.scm +++ b/test-foreign.scm @@ -1,4 +1,7 @@ -(import (scheme base) (scheme write)) +(import + (scheme base) + (scheme write) + (scheme cyclone pretty-print)) (define-syntax foreign-code (er-macro-transformer @@ -10,23 +13,41 @@ (cdr expr)) `(Cyc-foreign-code ,@(cdr expr))))) -(define-syntax define-foreign-code - (er-macro-transformer +(pretty-print +( +;(define-syntax define-foreign-code +; (er-macro-transformer (lambda (expr rename compare) (let* ((scm-fnc (cadr expr)) (c-fnc (cadddr expr)) (rv-type (caddr expr)) (arg-types (cddddr expr)) -; (str (symbol->string sym)) -; (lib_fnc_str (string-append "_" str)) -; (lib_fnc (string->symbol lib_fnc_str)) ;; Internal library function -; (args "(void *data, int argc, closure _, object k)") -; (body -; (string-append -; "return_closcall1(data, k, obj_int2obj(" str "));")) + (arg-syms (map gensym arg-types)) ;; TODO: need mangled strings, no syms!!! + (arg-mangled "TODO") ;; TODO: convert above + (arg-strings + (map + (lambda (sym) + (string-append " object " sym) + ) + arg-syms)) + + ; TODO: append mangled args to other args + ; cyclone> (string-join '("a" "b" "c") ",") + ; "a,b,c" + + (args "(void *data, int argc, closure _, object k)") + (body + ;; TODO: need to unbox all args, pass to C function, then box up the result + (string-append + "return_closcall1(data, k, obj_int2obj(" "str" "));")) ) - `((define-c ,lib_fnc ,args ,body) - ))))) + `((define-c ,scm-fnc ,args ,body) + ))) + '(define-foreign-lambda scm-strlen int "strlen" string dummy dummy) + list + list) +) +(newline) ;(define-c foreign-value ; "(void *data, int argc, closure _, object k, object code, object type)" @@ -34,7 +55,7 @@ ; return_closcall1(data, k, obj_int2obj(code ; ") -(define-foreign-lambda scm-strlen int "strlen" string) +;(define-foreign-lambda scm-strlen int "strlen" string) ;(write (Cyc-foreign-value "errno" "3")) ;(newline) From 82d6379cdf2871ed37edc634cbecdc5fa5ae93e3 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sun, 19 Apr 2020 19:31:27 -0400 Subject: [PATCH 11/50] WIP --- test-foreign.scm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/test-foreign.scm b/test-foreign.scm index 9943d5e6..ebf5d46e 100644 --- a/test-foreign.scm +++ b/test-foreign.scm @@ -1,6 +1,8 @@ (import (scheme base) (scheme write) + (scheme cyclone cgen) + (scheme cyclone util) (scheme cyclone pretty-print)) (define-syntax foreign-code @@ -22,8 +24,11 @@ (c-fnc (cadddr expr)) (rv-type (caddr expr)) (arg-types (cddddr expr)) - (arg-syms (map gensym arg-types)) ;; TODO: need mangled strings, no syms!!! - (arg-mangled "TODO") ;; TODO: convert above + (arg-syms + (map + (lambda (type) + (mangle (gensym type))) + arg-types)) (arg-strings (map (lambda (sym) From 3a9777735a05a2aaedea7759876923e5d397b631 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 21 Apr 2020 18:11:31 -0400 Subject: [PATCH 12/50] WIP --- test-foreign.scm | 44 +++++++++++++++++++++++++++----------------- 1 file changed, 27 insertions(+), 17 deletions(-) diff --git a/test-foreign.scm b/test-foreign.scm index ebf5d46e..9185c5d1 100644 --- a/test-foreign.scm +++ b/test-foreign.scm @@ -15,43 +15,53 @@ (cdr expr)) `(Cyc-foreign-code ,@(cdr expr))))) -(pretty-print -( -;(define-syntax define-foreign-code -; (er-macro-transformer +;(pretty-print +;( +(define-syntax define-foreign-code + (er-macro-transformer (lambda (expr rename compare) (let* ((scm-fnc (cadr expr)) (c-fnc (cadddr expr)) (rv-type (caddr expr)) (arg-types (cddddr expr)) - (arg-syms + (arg-syms/unbox (map (lambda (type) - (mangle (gensym type))) + (let ((var (mangle (gensym 'arg)))) + (cons var (string-append "string_str(" var ")")))) arg-types)) - (arg-strings - (map - (lambda (sym) - (string-append " object " sym) - ) - arg-syms)) + ;(arg-strings + ; (map + ; (lambda (sym) + ; (string-append " object " sym) + ; ) + ; arg-syms)) ; TODO: append mangled args to other args ; cyclone> (string-join '("a" "b" "c") ",") ; "a,b,c" - (args "(void *data, int argc, closure _, object k)") + (args (string-append + "(void *data, int argc, closure _, object k " + (apply string-append + (map + (lambda (sym/unbox) + (string-append "," (car sym/unbox))) + arg-syms/unbox)) + ")")) (body ;; TODO: need to unbox all args, pass to C function, then box up the result (string-append - "return_closcall1(data, k, obj_int2obj(" "str" "));")) + "return_closcall1(data, k, obj_int2obj(" c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")));")) ) `((define-c ,scm-fnc ,args ,body) ))) - '(define-foreign-lambda scm-strlen int "strlen" string dummy dummy) - list - list) +; '(define-foreign-lambda scm-strlen int "strlen" string) +; list +; list) ) +(define-foreign-lambda scm-strlen int "strlen" string) +(display (scm-strlen "testing 1, 2, 3")) (newline) ;(define-c foreign-value From 2faa5fbb9ac40d61b3c980224b011c52b28fbdb4 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 21 Apr 2020 19:08:33 -0400 Subject: [PATCH 13/50] Working prototype with strlen() --- test-foreign.scm | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/test-foreign.scm b/test-foreign.scm index 9185c5d1..275a409a 100644 --- a/test-foreign.scm +++ b/test-foreign.scm @@ -15,9 +15,8 @@ (cdr expr)) `(Cyc-foreign-code ,@(cdr expr))))) -;(pretty-print -;( -(define-syntax define-foreign-code +;(pretty-print ( +(define-syntax define-foreign-lambda (er-macro-transformer (lambda (expr rename compare) (let* ((scm-fnc (cadr expr)) @@ -46,7 +45,7 @@ (apply string-append (map (lambda (sym/unbox) - (string-append "," (car sym/unbox))) + (string-append ", object " (car sym/unbox))) arg-syms/unbox)) ")")) (body @@ -54,12 +53,14 @@ (string-append "return_closcall1(data, k, obj_int2obj(" c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")));")) ) - `((define-c ,scm-fnc ,args ,body) - ))) -; '(define-foreign-lambda scm-strlen int "strlen" string) -; list -; list) + `(define-c ,scm-fnc ,args ,body) + )) + '(define-foreign-lambda scm-strlen int "strlen" string) + list + list ) +) + (define-foreign-lambda scm-strlen int "strlen" string) (display (scm-strlen "testing 1, 2, 3")) (newline) From 41548f4d64dc5eb09d885179ce59b2832d27c6ad Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 22 Apr 2020 16:35:07 -0400 Subject: [PATCH 14/50] WIP --- test-foreign.scm | 37 ++++++++++++++++++++++++++++++++----- 1 file changed, 32 insertions(+), 5 deletions(-) diff --git a/test-foreign.scm b/test-foreign.scm index 275a409a..17270c50 100644 --- a/test-foreign.scm +++ b/test-foreign.scm @@ -1,6 +1,7 @@ (import (scheme base) (scheme write) + (cyclone test) (scheme cyclone cgen) (scheme cyclone util) (scheme cyclone pretty-print)) @@ -61,9 +62,26 @@ ) ) -(define-foreign-lambda scm-strlen int "strlen" string) -(display (scm-strlen "testing 1, 2, 3")) -(newline) +;; Unbox scheme object +(define (scm->c code type) + (cond + (else + (error "scm->c unable to convert" type)))) + +;; Box C object, basically the meat of (foreign-value) +(define (c->scm code type) + (case type + ((int integer) + (string-append "obj_int2obj(" code ")")) + ((bool) + (string-append "(" code " == 0 ? boolean_f : boolean_t)")) + ((string) + TODO: how to handle the allocation here? + (string-append " + )) + (else + (error "c->scm unable to convert" type)))) + ;(define-c foreign-value ; "(void *data, int argc, closure _, object k, object code, object type)" @@ -75,7 +93,16 @@ ;(write (Cyc-foreign-value "errno" "3")) ;(newline) +(test-group "basic" (write (foreign-code "printf(\"test %d %d \\n\", 1, 2);" - "printf(\"test %d %d %d\\n\", 1, 2, 3);")) -(newline) + "printf(\"test %d %d %d\\n\", 1, 2, 3);")) (newline) +) + +;; Must be top-level +(define-foreign-lambda scm-strlen int "strlen" string) + +(test-group "foreign lambda" + (test 15 (scm-strlen "testing 1, 2, 3")) +) +(test-exit) From a7c660d52aead262c0fffa3a2663f82813a42d4e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 22 Apr 2020 19:13:21 -0400 Subject: [PATCH 15/50] WIP --- test-foreign.scm | 40 ++++++++++++++++++++++++++++++++-------- 1 file changed, 32 insertions(+), 8 deletions(-) diff --git a/test-foreign.scm b/test-foreign.scm index 17270c50..06955f6c 100644 --- a/test-foreign.scm +++ b/test-foreign.scm @@ -20,6 +20,19 @@ (define-syntax define-foreign-lambda (er-macro-transformer (lambda (expr rename compare) + +;; Temporary definition, this does not stay here! +(define (scm->c code type) + (case type + ((int integer) + (string-append "obj_obj2int(" code ")")) + ((bool) + (string-append "(" code " == boolean_f)")) + ((string) + (string-append "string_str(" code ")")) + (else + (error "scm->c unable to convert scheme object of type " type)))) + (let* ((scm-fnc (cadr expr)) (c-fnc (cadddr expr)) (rv-type (caddr expr)) @@ -28,7 +41,11 @@ (map (lambda (type) (let ((var (mangle (gensym 'arg)))) - (cons var (string-append "string_str(" var ")")))) + (cons + var + (scm->c var type) + ;(string-append "string_str(" var ")") + ))) arg-types)) ;(arg-strings ; (map @@ -64,9 +81,15 @@ ;; Unbox scheme object (define (scm->c code type) - (cond + (case type + ((int integer) + (string-append "obj_obj2int(" code ")")) + ((bool) + (string-append "(" code " == boolean_f)")) + ((string) + (string-append "string_str(" code ")")) (else - (error "scm->c unable to convert" type)))) + (error "scm->c unable to convert scheme object of type " type)))) ;; Box C object, basically the meat of (foreign-value) (define (c->scm code type) @@ -75,12 +98,13 @@ (string-append "obj_int2obj(" code ")")) ((bool) (string-append "(" code " == 0 ? boolean_f : boolean_t)")) - ((string) - TODO: how to handle the allocation here? - (string-append " - )) +; ((string) +; TODO: how to handle the allocation here? +; may need to return a c-code pair??? +; (string-append " +; )) (else - (error "c->scm unable to convert" type)))) + (error "c->scm unable to convert C object of type " type)))) ;(define-c foreign-value From 653319c290156571501cce6abb438ac8dfe5e722 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 23 Apr 2020 17:30:58 -0400 Subject: [PATCH 16/50] WIP --- test-foreign.scm | 97 +++++++++++++++++++++++++++++------------------- 1 file changed, 58 insertions(+), 39 deletions(-) diff --git a/test-foreign.scm b/test-foreign.scm index 06955f6c..d11e4a7b 100644 --- a/test-foreign.scm +++ b/test-foreign.scm @@ -22,6 +22,17 @@ (lambda (expr rename compare) ;; Temporary definition, this does not stay here! +;; TODO: extract these out, probably into cgen! + +;; Unbox scheme object +;; +;; scm->c :: string -> symbol -> string +;; +;; Inputs: +;; - code - C variable used to reference the Scheme object +;; - type - Data type of the Scheme object +;; Returns: +;; - C code used to unbox the data (define (scm->c code type) (case type ((int integer) @@ -33,6 +44,42 @@ (else (error "scm->c unable to convert scheme object of type " type)))) +;; Box C object, basically the meat of (foreign-value) +;; +;; c->scm :: string -> symbol -> string +;; +;; Inputs: +;; - C expression +;; - Data type used to box the data +;; Returns: +;; - Allocation code? +;; - C code +(define (c->scm code type) + (case type + ((int integer) + (cons + "" + (string-append "obj_int2obj(" code ")"))) + ((float double) + (let ((var (mangle (gensym 'var)))) + (cons + (string-append + "make_double(" var ", " code ");") + (string-append "&" var) + ))) + ((bool) + (cons + "" + (string-append "(" code " == 0 ? boolean_f : boolean_t)"))) +; ((string) +; TODO: how to handle the allocation here? +; may need to return a c-code pair??? +; (string-append " +; )) + (else + (error "c->scm unable to convert C object of type " type)))) + + (let* ((scm-fnc (cadr expr)) (c-fnc (cadddr expr)) (rv-type (caddr expr)) @@ -47,17 +94,13 @@ ;(string-append "string_str(" var ")") ))) arg-types)) - ;(arg-strings - ; (map - ; (lambda (sym) - ; (string-append " object " sym) - ; ) - ; arg-syms)) - - ; TODO: append mangled args to other args - ; cyclone> (string-join '("a" "b" "c") ",") - ; "a,b,c" - + (returns + (c->scm + (string-append + c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")") + rv-type)) + (return-alloc (car returns)) + (return-expr (cdr returns)) (args (string-append "(void *data, int argc, closure _, object k " (apply string-append @@ -69,7 +112,8 @@ (body ;; TODO: need to unbox all args, pass to C function, then box up the result (string-append - "return_closcall1(data, k, obj_int2obj(" c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")));")) + return-alloc + "return_closcall1(data, k, " return-expr ");")) ) `(define-c ,scm-fnc ,args ,body) )) @@ -79,33 +123,6 @@ ) ) -;; Unbox scheme object -(define (scm->c code type) - (case type - ((int integer) - (string-append "obj_obj2int(" code ")")) - ((bool) - (string-append "(" code " == boolean_f)")) - ((string) - (string-append "string_str(" code ")")) - (else - (error "scm->c unable to convert scheme object of type " type)))) - -;; Box C object, basically the meat of (foreign-value) -(define (c->scm code type) - (case type - ((int integer) - (string-append "obj_int2obj(" code ")")) - ((bool) - (string-append "(" code " == 0 ? boolean_f : boolean_t)")) -; ((string) -; TODO: how to handle the allocation here? -; may need to return a c-code pair??? -; (string-append " -; )) - (else - (error "c->scm unable to convert C object of type " type)))) - ;(define-c foreign-value ; "(void *data, int argc, closure _, object k, object code, object type)" @@ -125,8 +142,10 @@ ;; Must be top-level (define-foreign-lambda scm-strlen int "strlen" string) +(define-foreign-lambda scm-strlend double "strlen" string) (test-group "foreign lambda" (test 15 (scm-strlen "testing 1, 2, 3")) + (test 15.0 (scm-strlend "testing 1, 2, 3")) ) (test-exit) From 739486b9e36ca790452158862f8e6719178dd320 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 24 Apr 2020 17:15:11 -0400 Subject: [PATCH 17/50] Added foreign-value tests --- test-foreign.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/test-foreign.scm b/test-foreign.scm index d11e4a7b..5babf118 100644 --- a/test-foreign.scm +++ b/test-foreign.scm @@ -134,7 +134,11 @@ ;(write (Cyc-foreign-value "errno" "3")) ;(newline) -(test-group "basic" +(test-group "foreign-value" + (test 3 (Cyc-foreign-value "1 + 2" 'integer)) +) + +(test-group "foreign-code" (write (foreign-code "printf(\"test %d %d \\n\", 1, 2);" "printf(\"test %d %d %d\\n\", 1, 2, 3);")) (newline) From c747e8c8e1276d6016333f25f91bf7950b86acb9 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Apr 2020 15:56:32 -0400 Subject: [PATCH 18/50] Convert functions to macros --- test-foreign.scm | 91 +++++++++++++++++++++++++----------------------- 1 file changed, 47 insertions(+), 44 deletions(-) diff --git a/test-foreign.scm b/test-foreign.scm index 5babf118..b0531531 100644 --- a/test-foreign.scm +++ b/test-foreign.scm @@ -2,7 +2,6 @@ (scheme base) (scheme write) (cyclone test) - (scheme cyclone cgen) (scheme cyclone util) (scheme cyclone pretty-print)) @@ -16,14 +15,6 @@ (cdr expr)) `(Cyc-foreign-code ,@(cdr expr))))) -;(pretty-print ( -(define-syntax define-foreign-lambda - (er-macro-transformer - (lambda (expr rename compare) - -;; Temporary definition, this does not stay here! -;; TODO: extract these out, probably into cgen! - ;; Unbox scheme object ;; ;; scm->c :: string -> symbol -> string @@ -33,16 +24,21 @@ ;; - type - Data type of the Scheme object ;; Returns: ;; - C code used to unbox the data -(define (scm->c code type) - (case type - ((int integer) - (string-append "obj_obj2int(" code ")")) - ((bool) - (string-append "(" code " == boolean_f)")) - ((string) - (string-append "string_str(" code ")")) - (else - (error "scm->c unable to convert scheme object of type " type)))) +;(define (scm->c code type) +(define-syntax scm->c + (er-macro-transformer + (lambda (expr rename compare) + (let ((code (cadr expr)) + (type (caddr expr))) + `(case ,type + ((int integer) + (string-append "obj_obj2int(" ,code ")")) + ((bool) + (string-append "(" ,code " == boolean_f)")) + ((string) + (string-append "string_str(" ,code ")")) + (else + (error "scm->c unable to convert scheme object of type " ,type))))))) ;; Box C object, basically the meat of (foreign-value) ;; @@ -54,32 +50,39 @@ ;; Returns: ;; - Allocation code? ;; - C code -(define (c->scm code type) - (case type - ((int integer) - (cons - "" - (string-append "obj_int2obj(" code ")"))) - ((float double) - (let ((var (mangle (gensym 'var)))) - (cons - (string-append - "make_double(" var ", " code ");") - (string-append "&" var) - ))) - ((bool) - (cons - "" - (string-append "(" code " == 0 ? boolean_f : boolean_t)"))) -; ((string) -; TODO: how to handle the allocation here? -; may need to return a c-code pair??? -; (string-append " -; )) - (else - (error "c->scm unable to convert C object of type " type)))) - +(define-syntax c->scm + (er-macro-transformer + (lambda (expr rename compare) + (let ((code (cadr expr)) + (type (caddr expr))) + `(case ,type + ((int integer) + (cons + "" + (string-append "obj_int2obj(" ,code ")"))) + ((float double) + (let ((var (mangle (gensym 'var)))) + (cons + (string-append + "make_double(" var ", " ,code ");") + (string-append "&" var) + ))) + ((bool) + (cons + "" + (string-append "(" ,code " == 0 ? boolean_f : boolean_t)"))) + ; ((string) + ; TODO: how to handle the allocation here? + ; may need to return a c-code pair??? + ; (string-append " + ; )) + (else + (error "c->scm unable to convert C object of type " ,type))))))) +;(pretty-print ( +(define-syntax define-foreign-lambda + (er-macro-transformer + (lambda (expr rename compare) (let* ((scm-fnc (cadr expr)) (c-fnc (cadddr expr)) (rv-type (caddr expr)) From c7b692e3325bda3ef48cf46e763eabf0423e670f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Apr 2020 16:35:12 -0400 Subject: [PATCH 19/50] Relocate macros --- libs/cyclone/foreign.sld | 155 +++++++++++++++++------ test-foreign.scm | 257 ++++++++++++++++++++------------------- 2 files changed, 244 insertions(+), 168 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 1c9dd52b..2d9b2b16 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -10,53 +10,18 @@ (import (scheme base) ;(scheme write) ;; TODO: debugging only! + ;(scheme cyclone pretty-print) + (scheme cyclone util) ) ;(include-c-header "") (export foreign-code foreign-value + define-foreign-lambda + c->scm + scm->c ) (begin - ;; TODO: internal to compiler? Anything to define in this library?? - ;; internal name could be different (Cyc-foreign-code) to facilitate - ;; library renaming, etc here - ;(foreign-code STRING ...) - - -;; TODO: foreign-lambda -;; -;; We are going to use the CHICKEN interface: -;; (foreign-lambda RETURNTYPE NAME ARGTYPE ...) -;; -;; And modify it a bit for our infrastructure: -;; -;; (define-foreign-lambda SCM-NAME RETURNTYPE C-NAME ARGTYPE ...) -;; -;; We need to develop a macro to accept this interface and generate a -;; define-c equivalent. Not nearly as flexible as CHICKEN but will work -;; with our existing infrastructure. This is good enough for version 1. - - - ;(define strlen - ; (foreign-lambda int "strlen" char-vector) ) - -; (define-syntax define-curl-const -; (er-macro-transformer -; (lambda (expr rename compare) -; (let* ((sym (cadr expr)) -; (str (symbol->string sym)) -; (lib_fnc_str (string-append "_" str)) -; (lib_fnc (string->symbol lib_fnc_str)) ;; Internal library function -; (args "(void *data, int argc, closure _, object k)") -; (body -; (string-append -; "return_closcall1(data, k, obj_int2obj(" str "));")) -; ) -; `(begin -; (define-c ,lib_fnc ,args ,body) -; (define ,sym (,lib_fnc)) -; ))))) - (define-syntax foreign-value (er-macro-transformer @@ -80,5 +45,115 @@ (error "foreign-code" "Invalid argument: string expected, received " arg))) (cdr expr)) `(Cyc-foreign-code ,@(cdr expr))))) + + ;; Unbox scheme object + ;; + ;; scm->c :: string -> symbol -> string + ;; + ;; Inputs: + ;; - code - C variable used to reference the Scheme object + ;; - type - Data type of the Scheme object + ;; Returns: + ;; - C code used to unbox the data + ;(define (scm->c code type) + (define-syntax scm->c + (er-macro-transformer + (lambda (expr rename compare) + (let ((code (cadr expr)) + (type (caddr expr))) + `(case ,type + ((int integer) + (string-append "obj_obj2int(" ,code ")")) + ((bool) + (string-append "(" ,code " == boolean_f)")) + ((string) + (string-append "string_str(" ,code ")")) + (else + (error "scm->c unable to convert scheme object of type " ,type))))))) + + ;; Box C object, basically the meat of (foreign-value) + ;; + ;; c->scm :: string -> symbol -> string + ;; + ;; Inputs: + ;; - C expression + ;; - Data type used to box the data + ;; Returns: + ;; - Allocation code? + ;; - C code + (define-syntax c->scm + (er-macro-transformer + (lambda (expr rename compare) + (let ((code (cadr expr)) + (type (caddr expr))) + `(case ,type + ((int integer) + (cons + "" + (string-append "obj_int2obj(" ,code ")"))) + ((float double) + (let ((var (mangle (gensym 'var)))) + (cons + (string-append + "make_double(" var ", " ,code ");") + (string-append "&" var) + ))) + ((bool) + (cons + "" + (string-append "(" ,code " == 0 ? boolean_f : boolean_t)"))) + ; ((string) + ; TODO: how to handle the allocation here? + ; may need to return a c-code pair??? + ; (string-append " + ; )) + (else + (error "c->scm unable to convert C object of type " ,type))))))) + + ;(pretty-print ( + (define-syntax define-foreign-lambda + (er-macro-transformer + (lambda (expr rename compare) + (let* ((scm-fnc (cadr expr)) + (c-fnc (cadddr expr)) + (rv-type (caddr expr)) + (arg-types (cddddr expr)) + (arg-syms/unbox + (map + (lambda (type) + (let ((var (mangle (gensym 'arg)))) + (cons + var + (scm->c var type) + ;(string-append "string_str(" var ")") + ))) + arg-types)) + (returns + (c->scm + (string-append + c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")") + rv-type)) + (return-alloc (car returns)) + (return-expr (cdr returns)) + (args (string-append + "(void *data, int argc, closure _, object k " + (apply string-append + (map + (lambda (sym/unbox) + (string-append ", object " (car sym/unbox))) + arg-syms/unbox)) + ")")) + (body + ;; TODO: need to unbox all args, pass to C function, then box up the result + (string-append + return-alloc + "return_closcall1(data, k, " return-expr ");")) + ) + `(define-c ,scm-fnc ,args ,body) + )) + '(define-foreign-lambda scm-strlen int "strlen" string) + list + list)) + ) ) diff --git a/test-foreign.scm b/test-foreign.scm index b0531531..347385c5 100644 --- a/test-foreign.scm +++ b/test-foreign.scm @@ -2,137 +2,138 @@ (scheme base) (scheme write) (cyclone test) + (cyclone foreign) (scheme cyclone util) (scheme cyclone pretty-print)) -(define-syntax foreign-code - (er-macro-transformer - (lambda (expr rename compare) - (for-each - (lambda (arg) - (if (not (string? arg)) - (error "foreign-code" "Invalid argument: string expected, received " arg))) - (cdr expr)) - `(Cyc-foreign-code ,@(cdr expr))))) - -;; Unbox scheme object -;; -;; scm->c :: string -> symbol -> string -;; -;; Inputs: -;; - code - C variable used to reference the Scheme object -;; - type - Data type of the Scheme object -;; Returns: -;; - C code used to unbox the data -;(define (scm->c code type) -(define-syntax scm->c - (er-macro-transformer - (lambda (expr rename compare) - (let ((code (cadr expr)) - (type (caddr expr))) - `(case ,type - ((int integer) - (string-append "obj_obj2int(" ,code ")")) - ((bool) - (string-append "(" ,code " == boolean_f)")) - ((string) - (string-append "string_str(" ,code ")")) - (else - (error "scm->c unable to convert scheme object of type " ,type))))))) - -;; Box C object, basically the meat of (foreign-value) -;; -;; c->scm :: string -> symbol -> string -;; -;; Inputs: -;; - C expression -;; - Data type used to box the data -;; Returns: -;; - Allocation code? -;; - C code -(define-syntax c->scm - (er-macro-transformer - (lambda (expr rename compare) - (let ((code (cadr expr)) - (type (caddr expr))) - `(case ,type - ((int integer) - (cons - "" - (string-append "obj_int2obj(" ,code ")"))) - ((float double) - (let ((var (mangle (gensym 'var)))) - (cons - (string-append - "make_double(" var ", " ,code ");") - (string-append "&" var) - ))) - ((bool) - (cons - "" - (string-append "(" ,code " == 0 ? boolean_f : boolean_t)"))) - ; ((string) - ; TODO: how to handle the allocation here? - ; may need to return a c-code pair??? - ; (string-append " - ; )) - (else - (error "c->scm unable to convert C object of type " ,type))))))) - -;(pretty-print ( -(define-syntax define-foreign-lambda - (er-macro-transformer - (lambda (expr rename compare) - (let* ((scm-fnc (cadr expr)) - (c-fnc (cadddr expr)) - (rv-type (caddr expr)) - (arg-types (cddddr expr)) - (arg-syms/unbox - (map - (lambda (type) - (let ((var (mangle (gensym 'arg)))) - (cons - var - (scm->c var type) - ;(string-append "string_str(" var ")") - ))) - arg-types)) - (returns - (c->scm - (string-append - c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")") - rv-type)) - (return-alloc (car returns)) - (return-expr (cdr returns)) - (args (string-append - "(void *data, int argc, closure _, object k " - (apply string-append - (map - (lambda (sym/unbox) - (string-append ", object " (car sym/unbox))) - arg-syms/unbox)) - ")")) - (body - ;; TODO: need to unbox all args, pass to C function, then box up the result - (string-append - return-alloc - "return_closcall1(data, k, " return-expr ");")) - ) - `(define-c ,scm-fnc ,args ,body) - )) - '(define-foreign-lambda scm-strlen int "strlen" string) - list - list -) -) - - -;(define-c foreign-value -; "(void *data, int argc, closure _, object k, object code, object type)" -; " // TODO: need to dispatch conversion based on type -; return_closcall1(data, k, obj_int2obj(code -; ") - +;(define-syntax foreign-code +; (er-macro-transformer +; (lambda (expr rename compare) +; (for-each +; (lambda (arg) +; (if (not (string? arg)) +; (error "foreign-code" "Invalid argument: string expected, received " arg))) +; (cdr expr)) +; `(Cyc-foreign-code ,@(cdr expr))))) +; +;;; Unbox scheme object +;;; +;;; scm->c :: string -> symbol -> string +;;; +;;; Inputs: +;;; - code - C variable used to reference the Scheme object +;;; - type - Data type of the Scheme object +;;; Returns: +;;; - C code used to unbox the data +;;(define (scm->c code type) +;(define-syntax scm->c +; (er-macro-transformer +; (lambda (expr rename compare) +; (let ((code (cadr expr)) +; (type (caddr expr))) +; `(case ,type +; ((int integer) +; (string-append "obj_obj2int(" ,code ")")) +; ((bool) +; (string-append "(" ,code " == boolean_f)")) +; ((string) +; (string-append "string_str(" ,code ")")) +; (else +; (error "scm->c unable to convert scheme object of type " ,type))))))) +; +;;; Box C object, basically the meat of (foreign-value) +;;; +;;; c->scm :: string -> symbol -> string +;;; +;;; Inputs: +;;; - C expression +;;; - Data type used to box the data +;;; Returns: +;;; - Allocation code? +;;; - C code +;(define-syntax c->scm +; (er-macro-transformer +; (lambda (expr rename compare) +; (let ((code (cadr expr)) +; (type (caddr expr))) +; `(case ,type +; ((int integer) +; (cons +; "" +; (string-append "obj_int2obj(" ,code ")"))) +; ((float double) +; (let ((var (mangle (gensym 'var)))) +; (cons +; (string-append +; "make_double(" var ", " ,code ");") +; (string-append "&" var) +; ))) +; ((bool) +; (cons +; "" +; (string-append "(" ,code " == 0 ? boolean_f : boolean_t)"))) +; ; ((string) +; ; TODO: how to handle the allocation here? +; ; may need to return a c-code pair??? +; ; (string-append " +; ; )) +; (else +; (error "c->scm unable to convert C object of type " ,type))))))) +; +;;(pretty-print ( +;(define-syntax define-foreign-lambda +; (er-macro-transformer +; (lambda (expr rename compare) +; (let* ((scm-fnc (cadr expr)) +; (c-fnc (cadddr expr)) +; (rv-type (caddr expr)) +; (arg-types (cddddr expr)) +; (arg-syms/unbox +; (map +; (lambda (type) +; (let ((var (mangle (gensym 'arg)))) +; (cons +; var +; (scm->c var type) +; ;(string-append "string_str(" var ")") +; ))) +; arg-types)) +; (returns +; (c->scm +; (string-append +; c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")") +; rv-type)) +; (return-alloc (car returns)) +; (return-expr (cdr returns)) +; (args (string-append +; "(void *data, int argc, closure _, object k " +; (apply string-append +; (map +; (lambda (sym/unbox) +; (string-append ", object " (car sym/unbox))) +; arg-syms/unbox)) +; ")")) +; (body +; ;; TODO: need to unbox all args, pass to C function, then box up the result +; (string-append +; return-alloc +; "return_closcall1(data, k, " return-expr ");")) +; ) +; `(define-c ,scm-fnc ,args ,body) +; )) +; '(define-foreign-lambda scm-strlen int "strlen" string) +; list +; list +;) +;) +; +; +;;(define-c foreign-value +;; "(void *data, int argc, closure _, object k, object code, object type)" +;; " // TODO: need to dispatch conversion based on type +;; return_closcall1(data, k, obj_int2obj(code +;; ") +; ;(define-foreign-lambda scm-strlen int "strlen" string) ;(write (Cyc-foreign-value "errno" "3")) From cea927bd831b9b4e1d40aec12bab4ea225bdf2c4 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Apr 2020 16:35:29 -0400 Subject: [PATCH 20/50] Relocate --- test-foreign.scm => libs/test-foreign.scm | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename test-foreign.scm => libs/test-foreign.scm (100%) diff --git a/test-foreign.scm b/libs/test-foreign.scm similarity index 100% rename from test-foreign.scm rename to libs/test-foreign.scm From 0011facf41f52c99f9e12d472ba7e21ff65172ff Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Apr 2020 16:36:25 -0400 Subject: [PATCH 21/50] Adjust paren --- libs/test-foreign.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index 347385c5..6bff298e 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -4,7 +4,8 @@ (cyclone test) (cyclone foreign) (scheme cyclone util) - (scheme cyclone pretty-print)) + (scheme cyclone pretty-print) + ) ;(define-syntax foreign-code ; (er-macro-transformer From ecec144dc4292e0593ebd700b6917e6c223befa5 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Apr 2020 18:46:27 -0400 Subject: [PATCH 22/50] Cleanup --- libs/cyclone/foreign.sld | 4 +- libs/test-foreign.scm | 143 +++------------------------------------ 2 files changed, 11 insertions(+), 136 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 2d9b2b16..6db6a098 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -4,7 +4,7 @@ ;;;; Copyright (c) 2014-2019, Justin Ethier ;;;; All rights reserved. ;;;; -;;;; TBD +;;;; This module makes it easier to interface directly with C code using the FFI. ;;;; (define-library (cyclone foreign) (import @@ -34,7 +34,7 @@ ; (if (not (string? arg)) ; (error "foreign-value" "Invalid argument: string expected, received " arg))) ; (cdr expr)) - `(Cyc-foreign-value ,code-arg ,type-arg))))) + `((lambda () (Cyc-foreign-value ,code-arg ,type-arg))))))) (define-syntax foreign-code (er-macro-transformer diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index 6bff298e..c9d82870 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -7,146 +7,21 @@ (scheme cyclone pretty-print) ) -;(define-syntax foreign-code -; (er-macro-transformer -; (lambda (expr rename compare) -; (for-each -; (lambda (arg) -; (if (not (string? arg)) -; (error "foreign-code" "Invalid argument: string expected, received " arg))) -; (cdr expr)) -; `(Cyc-foreign-code ,@(cdr expr))))) -; -;;; Unbox scheme object -;;; -;;; scm->c :: string -> symbol -> string -;;; -;;; Inputs: -;;; - code - C variable used to reference the Scheme object -;;; - type - Data type of the Scheme object -;;; Returns: -;;; - C code used to unbox the data -;;(define (scm->c code type) -;(define-syntax scm->c -; (er-macro-transformer -; (lambda (expr rename compare) -; (let ((code (cadr expr)) -; (type (caddr expr))) -; `(case ,type -; ((int integer) -; (string-append "obj_obj2int(" ,code ")")) -; ((bool) -; (string-append "(" ,code " == boolean_f)")) -; ((string) -; (string-append "string_str(" ,code ")")) -; (else -; (error "scm->c unable to convert scheme object of type " ,type))))))) -; -;;; Box C object, basically the meat of (foreign-value) -;;; -;;; c->scm :: string -> symbol -> string -;;; -;;; Inputs: -;;; - C expression -;;; - Data type used to box the data -;;; Returns: -;;; - Allocation code? -;;; - C code -;(define-syntax c->scm -; (er-macro-transformer -; (lambda (expr rename compare) -; (let ((code (cadr expr)) -; (type (caddr expr))) -; `(case ,type -; ((int integer) -; (cons -; "" -; (string-append "obj_int2obj(" ,code ")"))) -; ((float double) -; (let ((var (mangle (gensym 'var)))) -; (cons -; (string-append -; "make_double(" var ", " ,code ");") -; (string-append "&" var) -; ))) -; ((bool) -; (cons -; "" -; (string-append "(" ,code " == 0 ? boolean_f : boolean_t)"))) -; ; ((string) -; ; TODO: how to handle the allocation here? -; ; may need to return a c-code pair??? -; ; (string-append " -; ; )) -; (else -; (error "c->scm unable to convert C object of type " ,type))))))) -; -;;(pretty-print ( -;(define-syntax define-foreign-lambda -; (er-macro-transformer -; (lambda (expr rename compare) -; (let* ((scm-fnc (cadr expr)) -; (c-fnc (cadddr expr)) -; (rv-type (caddr expr)) -; (arg-types (cddddr expr)) -; (arg-syms/unbox -; (map -; (lambda (type) -; (let ((var (mangle (gensym 'arg)))) -; (cons -; var -; (scm->c var type) -; ;(string-append "string_str(" var ")") -; ))) -; arg-types)) -; (returns -; (c->scm -; (string-append -; c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")") -; rv-type)) -; (return-alloc (car returns)) -; (return-expr (cdr returns)) -; (args (string-append -; "(void *data, int argc, closure _, object k " -; (apply string-append -; (map -; (lambda (sym/unbox) -; (string-append ", object " (car sym/unbox))) -; arg-syms/unbox)) -; ")")) -; (body -; ;; TODO: need to unbox all args, pass to C function, then box up the result -; (string-append -; return-alloc -; "return_closcall1(data, k, " return-expr ");")) -; ) -; `(define-c ,scm-fnc ,args ,body) -; )) -; '(define-foreign-lambda scm-strlen int "strlen" string) -; list -; list -;) -;) -; -; -;;(define-c foreign-value -;; "(void *data, int argc, closure _, object k, object code, object type)" -;; " // TODO: need to dispatch conversion based on type -;; return_closcall1(data, k, obj_int2obj(code -;; ") -; -;(define-foreign-lambda scm-strlen int "strlen" string) +(define *my-global* #f) -;(write (Cyc-foreign-value "errno" "3")) -;(newline) (test-group "foreign-value" (test 3 (Cyc-foreign-value "1 + 2" 'integer)) ) (test-group "foreign-code" -(write (foreign-code - "printf(\"test %d %d \\n\", 1, 2);" - "printf(\"test %d %d %d\\n\", 1, 2, 3);")) (newline) + (test #f *my-global*) + (foreign-code + "printf(\"test %d %d \\n\", 1, 2);" + "printf(\"test %d %d %d\\n\", 1, 2, 3);" + "__glo__85my_91global_85 = boolean_t;") + (test #t *my-global*) + (set! *my-global* 1) + (test 1 *my-global*) ) ;; Must be top-level From d8ed752c9d97d3bac6ce0fde024026584d05260f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Apr 2020 19:06:53 -0400 Subject: [PATCH 23/50] Remove boolean_f --- scheme/cyclone/cgen.sld | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 3c3af3df..dac68b08 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -989,7 +989,7 @@ ((eq? 'Cyc-foreign-code fun) (c-code/vars (string-append - "boolean_f") + "") args)) ((eq? 'Cyc-foreign-value fun) From 3e87799a3b3744035f5b05c69ec7ac4c14d0bc96 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Apr 2020 19:09:26 -0400 Subject: [PATCH 24/50] Added header comments --- libs/test-foreign.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index c9d82870..1bb20abf 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -1,3 +1,5 @@ +;; Unit tests for the (cyclone foreign) module. +;; (import (scheme base) (scheme write) From 0e160060a1a0f0d3d4ca847000fea588ad082e7e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Apr 2020 19:14:50 -0400 Subject: [PATCH 25/50] Include foreign.meta --- Makefile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Makefile b/Makefile index c1fe43d2..086b025a 100644 --- a/Makefile +++ b/Makefile @@ -78,6 +78,7 @@ install : libs install-libs install-includes install-bin $(INSTALL) -m0644 scheme/cyclone/*.scm $(DESTDIR)$(DATADIR)/scheme/cyclone $(INSTALL) -m0644 libs/cyclone/test.meta $(DESTDIR)$(DATADIR)/cyclone $(INSTALL) -m0644 libs/cyclone/match.meta $(DESTDIR)$(DATADIR)/cyclone + $(INSTALL) -m0644 libs/cyclone/foreign.meta $(DESTDIR)$(DATADIR)/cyclone $(INSTALL) -m0644 scheme/cyclone/*.o $(DESTDIR)$(DATADIR)/scheme/cyclone $(INSTALL) -m0755 scheme/cyclone/*.so $(DESTDIR)$(DATADIR)/scheme/cyclone $(INSTALL) -m0644 libs/cyclone/*.sld $(DESTDIR)$(DATADIR)/cyclone @@ -271,6 +272,7 @@ bootstrap : icyc libs cp scheme/cyclone/macros.c $(BOOTSTRAP_DIR)/scheme/cyclone cp libs/cyclone/match.c $(BOOTSTRAP_DIR)/cyclone cp libs/cyclone/match.meta $(BOOTSTRAP_DIR)/cyclone + cp libs/cyclone/foreign.meta $(BOOTSTRAP_DIR)/cyclone cp scheme/cyclone/pretty-print.c $(BOOTSTRAP_DIR)/scheme/cyclone cp scheme/cyclone/primitives.c $(BOOTSTRAP_DIR)/scheme/cyclone cp scheme/cyclone/transforms.c $(BOOTSTRAP_DIR)/scheme/cyclone From ebeb0e86516af6273d74f65e03ff34f395302cd9 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 29 Apr 2020 22:36:19 -0400 Subject: [PATCH 26/50] Rename macros --- libs/cyclone/foreign.sld | 26 +++++++++++++------------- libs/test-foreign.scm | 12 ++++++------ 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 6db6a098..470212b5 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -15,15 +15,15 @@ ) ;(include-c-header "") (export - foreign-code - foreign-value - define-foreign-lambda + c-code + c-value + c-defun c->scm scm->c ) (begin - (define-syntax foreign-value + (define-syntax c-value (er-macro-transformer (lambda (expr rename compare) (let* ((code-arg (cadr expr)) @@ -32,17 +32,17 @@ ;(for-each ; (lambda (arg) ; (if (not (string? arg)) - ; (error "foreign-value" "Invalid argument: string expected, received " arg))) + ; (error "c-value" "Invalid argument: string expected, received " arg))) ; (cdr expr)) `((lambda () (Cyc-foreign-value ,code-arg ,type-arg))))))) - (define-syntax foreign-code + (define-syntax c-code (er-macro-transformer (lambda (expr rename compare) (for-each (lambda (arg) (if (not (string? arg)) - (error "foreign-code" "Invalid argument: string expected, received " arg))) + (error "c-code" "Invalid argument: string expected, received " arg))) (cdr expr)) `(Cyc-foreign-code ,@(cdr expr))))) @@ -71,7 +71,7 @@ (else (error "scm->c unable to convert scheme object of type " ,type))))))) - ;; Box C object, basically the meat of (foreign-value) + ;; Box C object, basically the meat of (c-value) ;; ;; c->scm :: string -> symbol -> string ;; @@ -111,7 +111,7 @@ (error "c->scm unable to convert C object of type " ,type))))))) ;(pretty-print ( - (define-syntax define-foreign-lambda + (define-syntax c-defun (er-macro-transformer (lambda (expr rename compare) (let* ((scm-fnc (cadr expr)) @@ -150,10 +150,10 @@ "return_closcall1(data, k, " return-expr ");")) ) `(define-c ,scm-fnc ,args ,body) - )) - '(define-foreign-lambda scm-strlen int "strlen" string) - list - list)) + )))) + ; '(c-defun scm-strlen int "strlen" string) + ; list + ; list)) ) ) diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index 1bb20abf..9889aae8 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -11,13 +11,13 @@ (define *my-global* #f) -(test-group "foreign-value" - (test 3 (Cyc-foreign-value "1 + 2" 'integer)) +(test-group "foreign value" + (test 3 (c-value "1 + 2" 'integer)) ) -(test-group "foreign-code" +(test-group "foreign code" (test #f *my-global*) - (foreign-code + (c-code "printf(\"test %d %d \\n\", 1, 2);" "printf(\"test %d %d %d\\n\", 1, 2, 3);" "__glo__85my_91global_85 = boolean_t;") @@ -27,8 +27,8 @@ ) ;; Must be top-level -(define-foreign-lambda scm-strlen int "strlen" string) -(define-foreign-lambda scm-strlend double "strlen" string) +(c-defun scm-strlen int "strlen" string) +(c-defun scm-strlend double "strlen" string) (test-group "foreign lambda" (test 15 (scm-strlen "testing 1, 2, 3")) From ca06ad2b0bd6b495f6d71aa7853b5a7f6248d190 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 30 Apr 2020 11:21:30 -0400 Subject: [PATCH 27/50] Rename macro to "c-define" per discussion w/Arthur --- libs/cyclone/foreign.sld | 6 +++--- libs/test-foreign.scm | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 470212b5..7d82e001 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -17,7 +17,7 @@ (export c-code c-value - c-defun + c-define c->scm scm->c ) @@ -111,7 +111,7 @@ (error "c->scm unable to convert C object of type " ,type))))))) ;(pretty-print ( - (define-syntax c-defun + (define-syntax c-define (er-macro-transformer (lambda (expr rename compare) (let* ((scm-fnc (cadr expr)) @@ -151,7 +151,7 @@ ) `(define-c ,scm-fnc ,args ,body) )))) - ; '(c-defun scm-strlen int "strlen" string) + ; '(c-define scm-strlen int "strlen" string) ; list ; list)) diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index 9889aae8..3635011f 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -27,8 +27,8 @@ ) ;; Must be top-level -(c-defun scm-strlen int "strlen" string) -(c-defun scm-strlend double "strlen" string) +(c-define scm-strlen int "strlen" string) +(c-define scm-strlend double "strlen" string) (test-group "foreign lambda" (test 15 (scm-strlen "testing 1, 2, 3")) From 12e110f60182766390051a0a6e729b575b25db96 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 30 Apr 2020 22:39:59 -0400 Subject: [PATCH 28/50] Initial file --- docs/api/cyclone/foreign.md | 40 +++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 docs/api/cyclone/foreign.md diff --git a/docs/api/cyclone/foreign.md b/docs/api/cyclone/foreign.md new file mode 100644 index 00000000..50673ac7 --- /dev/null +++ b/docs/api/cyclone/foreign.md @@ -0,0 +1,40 @@ +# Foreign Library + +The `(cyclone foreign)` provides a convenient interface for integrating with C code. It is based in concept on the `(chicken foreign)` module from CHICKEN Scheme. Similarly to that module, this library manipulates the C code directly before it is compiled to a native binary. It is not possible to call these forms at runtime. + +TODO: list of type specifiers + +- [`c-code`](#c-code) +- [`c-value`](#c-value) +- [`c-define`](#c-define) + +# c-code + +*Syntax* + + (c-code CODE ...) + +Insert C code directly into the compiled program. Each `CODE` parameter must be a string containing C code. + +# c-value + +*Syntax* + + (c-value CODE TYPE) + +Generate code that takes the C code specified by the string `CODE` and converts it to a Scheme object of type `TYPE`. + +# c-define + +*Syntax* + + (c-define SCM-FUNC RETURN-TYPE C-FUNC TYPE ...) + +Define a Scheme function `SCM-FUNC` returning an object of type `RETURN-TYPE`. The function will call C function specified by the string `C-FUNC` passed parameters of type specified by any `TYPE` arguments. + +For example, to define a function that calls `strlen`: + + (c-define scm-strlen int "strlen" string) + +Note that these definitions are introduced at the top-level. + From 5e7d896a95efc74c95ebf4a4edab5cccf31be0bc Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 30 Apr 2020 22:56:24 -0400 Subject: [PATCH 29/50] Do not require TYPE arg of c-vlaue to be quoted in user code --- libs/cyclone/foreign.sld | 2 +- libs/test-foreign.scm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 7d82e001..7011e07e 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -34,7 +34,7 @@ ; (if (not (string? arg)) ; (error "c-value" "Invalid argument: string expected, received " arg))) ; (cdr expr)) - `((lambda () (Cyc-foreign-value ,code-arg ,type-arg))))))) + `((lambda () (Cyc-foreign-value ,code-arg (quote ,type-arg)))))))) (define-syntax c-code (er-macro-transformer diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index 3635011f..861de539 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -12,7 +12,7 @@ (define *my-global* #f) (test-group "foreign value" - (test 3 (c-value "1 + 2" 'integer)) + (test 3 (c-value "1 + 2" integer)) ) (test-group "foreign code" From 41e6aedb25d6346364c8fcd69fe923b94ac6cf6a Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 4 May 2020 16:24:07 -0400 Subject: [PATCH 30/50] WIP --- docs/api/cyclone/foreign.md | 13 +++++++++++++ libs/cyclone/foreign.sld | 28 +++++++++++++++++++++++++++- 2 files changed, 40 insertions(+), 1 deletion(-) diff --git a/docs/api/cyclone/foreign.md b/docs/api/cyclone/foreign.md index 50673ac7..51fd29b7 100644 --- a/docs/api/cyclone/foreign.md +++ b/docs/api/cyclone/foreign.md @@ -3,6 +3,19 @@ The `(cyclone foreign)` provides a convenient interface for integrating with C code. It is based in concept on the `(chicken foreign)` module from CHICKEN Scheme. Similarly to that module, this library manipulates the C code directly before it is compiled to a native binary. It is not possible to call these forms at runtime. TODO: list of type specifiers +built-in types +Scheme | C +int | int +integer | int +bool | int +char | int +string | char * +symbol | const char * +bytevector | char * +float | double +double | double +bignum | mp_int +opaque | void * - [`c-code`](#c-code) - [`c-value`](#c-value) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 7011e07e..57e97df6 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -64,10 +64,22 @@ `(case ,type ((int integer) (string-append "obj_obj2int(" ,code ")")) + ((double float) + (string-append "double_value(" ,code ")")) + ((bignum bigint) + (string-append "bignum_value(" ,code ")")) ((bool) (string-append "(" ,code " == boolean_f)")) + ((char) + (string-append "obj_obj2char(" ,code ")")) ((string) (string-append "string_str(" ,code ")")) + ((symbol) + (string-append "symbol_desc(" ,code ")")) + ((bytevector) + (string-append "(((bytevector_type *)" ,code ")->data)")) + ((opaque + (string-append "opaque_ptr(" ,code ")")) (else (error "scm->c unable to convert scheme object of type " ,type))))))) @@ -102,11 +114,25 @@ (cons "" (string-append "(" ,code " == 0 ? boolean_f : boolean_t)"))) - ; ((string) + ((char) + (cons + "" + (string-append "obj_char2obj(" ,code ")"))) + ((string) + (let ((var (mangle (gensym 'var)))) + (cons + (string-append + "make_double(" var ", " ,code ");") + (string-append "&" var) + ))) ; TODO: how to handle the allocation here? ; may need to return a c-code pair??? ; (string-append " ; )) +; /*bytevector_tag */ , "bytevector" +; /*c_opaque_tag */ , "opaque" +; /*bignum_tag */ , "bignum" +; /*symbol_tag */ , "symbol" (else (error "c->scm unable to convert C object of type " ,type))))))) From cdeeef8b27a69cbb2d6b9a93fefd5e366565ac73 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 4 May 2020 22:45:44 -0400 Subject: [PATCH 31/50] WIP --- libs/cyclone/foreign.sld | 14 ++--- libs/test-foreign.scm | 2 +- scheme/cyclone/cgen.sld | 132 ++++++++++++++++++++------------------- 3 files changed, 74 insertions(+), 74 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 57e97df6..c1f42844 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -9,7 +9,7 @@ (define-library (cyclone foreign) (import (scheme base) - ;(scheme write) ;; TODO: debugging only! + (scheme write) ;; TODO: debugging only! ;(scheme cyclone pretty-print) (scheme cyclone util) ) @@ -34,7 +34,7 @@ ; (if (not (string? arg)) ; (error "c-value" "Invalid argument: string expected, received " arg))) ; (cdr expr)) - `((lambda () (Cyc-foreign-value ,code-arg (quote ,type-arg)))))))) + `((lambda () (Cyc-foreign-value ,code-arg ,(symbol->string type-arg)))))))) (define-syntax c-code (er-macro-transformer @@ -78,7 +78,7 @@ (string-append "symbol_desc(" ,code ")")) ((bytevector) (string-append "(((bytevector_type *)" ,code ")->data)")) - ((opaque + ((opaque) (string-append "opaque_ptr(" ,code ")")) (else (error "scm->c unable to convert scheme object of type " ,type))))))) @@ -98,7 +98,9 @@ (lambda (expr rename compare) (let ((code (cadr expr)) (type (caddr expr))) - `(case ,type + `(case (if (string? ,type) + (string->symbol ,type) + ,type) ((int integer) (cons "" @@ -125,10 +127,6 @@ "make_double(" var ", " ,code ");") (string-append "&" var) ))) - ; TODO: how to handle the allocation here? - ; may need to return a c-code pair??? - ; (string-append " - ; )) ; /*bytevector_tag */ , "bytevector" ; /*c_opaque_tag */ , "opaque" ; /*bignum_tag */ , "bignum" diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index 861de539..6474f440 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -27,7 +27,7 @@ ) ;; Must be top-level -(c-define scm-strlen int "strlen" string) +(c-define scm-strlen "int" "strlen" string) (c-define scm-strlend double "strlen" string) (test-group "foreign lambda" diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index dac68b08..82851910 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -13,6 +13,7 @@ (scheme eval) (scheme inexact) (scheme write) + (cyclone foreign) (scheme cyclone primitives) (scheme cyclone transforms) (scheme cyclone ast) @@ -283,12 +284,12 @@ ;;; Compilation routines. ;; Return generated code that also requests allocation of C variables on stack -(define (c-code/vars str cvars) +(define (c:code/vars str cvars) (list str cvars)) ;; Return generated code with no C variables allocated on the stack -(define (c-code str) (c-code/vars str (list))) +(define (c:code str) (c:code/vars str (list))) ;; Append arg count to a C code pair (define (c:tuple/args cp num-args) @@ -327,12 +328,12 @@ c-allocs)) (define (c:append cp1 cp2) - (c-code/vars + (c:code/vars (string-append (c:body cp1) (c:body cp2)) (append (c:allocs cp1) (c:allocs cp2)))) (define (c:append/prefix prefix cp1 cp2) - (c-code/vars + (c:code/vars (string-append prefix (c:body cp1) (c:body cp2)) (append (c:allocs cp1) (c:allocs cp2)))) @@ -390,7 +391,7 @@ ((const? exp) (c-compile-const exp (alloca? ast-id trace) #f)) ;; TODO: OK to hardcode immutable to false here?? ((prim? exp) ;; TODO: this needs to be more refined, probably w/a lookup table - (c-code (string-append "primitive_" (mangle exp)))) + (c:code (string-append "primitive_" (mangle exp)))) ((ref? exp) (c-compile-ref exp)) ((quote? exp) (c-compile-quote exp (alloca? ast-id trace))) ((if? exp) (c-compile-if exp append-preamble cont ast-id trace cps?)) @@ -436,7 +437,7 @@ (num-args 0) (create-cons (lambda (cvar a b) - (c-code/vars + (c:code/vars (string-append c-make-macro "(" cvar "," (c:body a) "," (c:body b) ");" (c-set-immutable-field cvar use-alloca immutable)) @@ -445,7 +446,7 @@ (lambda (args) (cond ((null? args) - (c-code "NULL")) + (c:code "NULL")) ((not (pair? args)) (c-compile-const args use-alloca immutable)) (else @@ -455,7 +456,7 @@ (c-compile-const (car args) use-alloca immutable) (_c-compile-scalars (cdr args))))) (set! num-args (+ 1 num-args)) - (c-code/vars + (c:code/vars (string-append addr-op cvar-name) (append (c:allocs cell) @@ -484,7 +485,7 @@ (let ((idx-code (c-compile-const (vector-ref exp i) use-alloca immutable))) (loop (+ i 1) - (c-code/vars + (c:code/vars ;; The vector's C variable (c:body code) ;; Allocations @@ -498,7 +499,7 @@ ";")))))))))) (cond ((zero? len) - (c-code/vars + (c:code/vars (string-append addr-op cvar-name) ; Code is just the variable name (list ; Allocate empty vector (string-append @@ -506,7 +507,7 @@ (c-set-immutable-field cvar-name use-alloca immutable))))) (else (let ((code - (c-code/vars + (c:code/vars (string-append addr-op cvar-name) ; Code body is just var name (list ; Allocate the vector (string-append @@ -532,7 +533,7 @@ (let ((byte-val (number->string (bytevector-u8-ref exp i)))) (loop (+ i 1) - (c-code/vars + (c:code/vars ;; The bytevector's C variable (c:body code) ;; Allocations @@ -545,7 +546,7 @@ ";")))))))))) (cond ((zero? len) - (c-code/vars + (c:code/vars (string-append addr-op cvar-name) ; Code is just the variable name (list ; Allocate empty vector (string-append @@ -554,7 +555,7 @@ )))) (else (let ((code - (c-code/vars + (c:code/vars (string-append addr-op cvar-name) ; Code body is just var name (list ; Allocate the vector (string-append @@ -572,7 +573,7 @@ (use-alloca (let ((tmp-name (mangle (gensym 'tmp))) (blen (number->string (string-byte-length exp)))) - (c-code/vars + (c:code/vars (string-append "" cvar-name) ; Code is just the variable name (list ; Allocate integer on the C stack (string-append @@ -595,7 +596,7 @@ use-alloca immutable) ))))) (else - (c-code/vars + (c:code/vars (string-append "&" cvar-name) ; Code is just the variable name (list ; Allocate integer on the C stack (string-append @@ -623,7 +624,7 @@ (define (c-compile-const exp use-alloca immutable) (cond ((null? exp) - (c-code "NULL")) + (c:code "NULL")) ((pair? exp) (c-compile-scalars exp use-alloca immutable)) ((vector? exp) @@ -635,7 +636,7 @@ (num2str (cond (else (number->string exp))))) - (c-code/vars + (c:code/vars (string-append "" cvar-name) ; Code is just the variable name (list ; Allocate pointer on the C stack (string-append @@ -656,14 +657,14 @@ (inum (num2str (imag-part exp))) (addr-op (if use-alloca "" "&")) (c-make-macro (if use-alloca "alloca_complex_num" "make_complex_num"))) - (c-code/vars + (c:code/vars (string-append addr-op cvar-name) ; Code is just the variable name (list ; Allocate on the C stack (string-append c-make-macro "(" cvar-name ", " rnum ", " inum ");"))))) ((and (integer? exp) (exact? exp)) - (c-code (string-append "obj_int2obj(" + (c:code (string-append "obj_int2obj(" (number->string exp) ")"))) ((real? exp) (let ((cvar-name (mangle (gensym 'c))) @@ -676,22 +677,22 @@ (number->string exp)))) (addr-op (if use-alloca "" "&")) (c-make-macro (if use-alloca "alloca_double" "make_double"))) - (c-code/vars + (c:code/vars (string-append addr-op cvar-name) ; Code is just the variable name (list ; Allocate on the C stack (string-append c-make-macro "(" cvar-name ", " num2str ");"))))) ((boolean? exp) - (c-code (string-append + (c:code (string-append (if exp "boolean_t" "boolean_f")))) ((char? exp) - (c-code (string-append "obj_char2obj(" + (c:code (string-append "obj_char2obj(" (number->string (char->integer exp)) ")"))) ((string? exp) (c-compile-string exp use-alloca immutable)) ((symbol? exp) (allocate-symbol exp) - (c-code (string-append "quote_" (mangle exp)))) + (c:code (string-append "quote_" (mangle exp)))) (else (error "unknown constant: " exp)))) @@ -783,7 +784,7 @@ (c-var-assign (lambda (type) (let ((cv-name (mangle (gensym 'c)))) - (c-code/vars + (c:code/vars (string-append (if (or (prim:cont? p) (equal? (prim/c-var-assign p) "object") @@ -830,7 +831,7 @@ ;; the logic ;; (let ((cv-name (mangle (gensym 'c)))) - (c-code/vars + (c:code/vars (if (or (prim:allocates-object? p use-alloca?) (prim->c-func-uses-alloca? p use-alloca?)) cv-name ; Already a pointer @@ -838,7 +839,7 @@ (list (string-append c-func "(" cv-name tdata-comma tdata))))) (else - (c-code/vars + (c:code/vars (string-append c-func "(" tdata tptr-comma tptr) (list tptr-decl)))))) @@ -869,7 +870,7 @@ ;; c-compile-ref : ref-exp -> string (define (c-compile-ref exp) - (c-code + (c:code (if (member exp *global-syms*) (cgen:mangle-global exp) (mangle exp)))) @@ -882,7 +883,7 @@ (lambda (args append-preamble prefix cont) (cond ((not (pair? args)) - (c-code "")) + (c:code "")) (else ;; (trace:debug `(c-compile-args ,(car args))) (let ((cp (c-compile-exp (car args) @@ -929,7 +930,7 @@ cps?)) (num-cargs (c:num-args cgen))) (set-c-call-arity! num-cargs) - (c-code + (c:code (string-append (c:allocs->str (c:allocs cgen)) "return_direct" (number->string num-cargs) @@ -978,7 +979,7 @@ parent-args cgen-lis)))) ;;(trace:info `(loop ,args ,(cadr args) ,cgen-lis ,parent-args)) - (c-code + (c:code (string-append cgen-allocs ; (c:allocs->str (c:allocs cgen)) "\n" @@ -987,17 +988,18 @@ "continue;")))) ((eq? 'Cyc-foreign-code fun) - (c-code/vars + (c:code/vars (string-append "") args)) ((eq? 'Cyc-foreign-value fun) - ;; TODO: take type into account, do not hardcode int - (c-code/vars - (string-append - "obj_int2obj(" (car args) ")") - (list))) + (c->scm (car args) (cadr args)) + ;(c:code/vars + ; (string-append + ; "obj_int2obj(" (car args) ")") + ; (list)) + ) ((prim? fun) (let* ((c-fun @@ -1010,7 +1012,7 @@ (number->string num-args) (if (> num-args 0) "," ""))) (c-args* (if (prim:arg-count? fun) - (c:append (c-code num-args-str) c-args) + (c:append (c:code num-args-str) c-args) c-args))) ;; Emit symbol when mutating global variables, so we can look ;; up the cvar @@ -1029,7 +1031,7 @@ (if (prim/cvar? fun) ;; Args need to go with alloc function - (c-code/vars + (c:code/vars (c:body c-fun) (append (c:allocs c-args*) ; fun alloc depends upon arg allocs @@ -1055,12 +1057,12 @@ (and (prim:udf? fun) (zero? num-args))) c-fun - (c:append c-fun (c-code ", ")))) + (c:append c-fun (c:code ", ")))) c-args*) - (c-code ")"))))) + (c:code ")"))))) ((equal? '%closure-ref fun) - (c-code (apply string-append (list + (c:code (apply string-append (list (c-compile-closure-element-ref ast-id (car args) @@ -1082,7 +1084,7 @@ (num-cargs (c:num-args cargs))) (cond ((not cps?) - (c-code + (c:code (string-append (c:allocs->str (c:allocs cfun) "\n") (c:allocs->str (c:allocs cargs) "\n") @@ -1138,7 +1140,7 @@ (string-append " " p " = " tmp "; ")) params tmp-params)))) ;; (trace:error `(JAE ,fun ,ast-id ,params ,args (c:num-args cargs))) - (c-code/vars + (c:code/vars (string-append (c:allocs->str (c:allocs cfun) "\n") (c:allocs->str (c:allocs cargs) "\n") @@ -1163,7 +1165,7 @@ (let* ((lid (ast:lambda-id wkf)) (c-lambda-fnc-str (string-append "__lambda_" (number->string lid))) (c-lambda-fnc-gc-ret-str (string-append "__lambda_gc_ret_" (number->string lid)))) - (c-code + (c:code (string-append (c:allocs->str (c:allocs cfun) "\n") (c:allocs->str (c:allocs cargs) "\n") @@ -1184,7 +1186,7 @@ ((and wkf fnc) (let* ((lid (ast:lambda-id wkf)) (c-lambda-fnc-str (string-append "__lambda_" (number->string lid)))) - (c-code + (c:code (string-append (c:allocs->str (c:allocs cfun) "\n") (c:allocs->str (c:allocs cargs) "\n") @@ -1197,7 +1199,7 @@ (c:body cargs) ");")))) (else - (c-code + (c:code (string-append (c:allocs->str (c:allocs cfun) "\n") (c:allocs->str (c:allocs cargs) "\n") @@ -1217,7 +1219,7 @@ (num-cargs (c:num-args cargs))) (cond ((not cps?) - (c-code + (c:code (string-append (c:allocs->str (c:allocs cfun) "\n") (c:allocs->str (c:allocs cargs) "\n") @@ -1237,7 +1239,7 @@ (let* ((lid (ast:lambda-id (closure->lam fun))) (c-lambda-fnc-str (string-append "__lambda_" (number->string lid))) (c-lambda-fnc-gc-ret-str (string-append "__lambda_gc_ret_" (number->string lid)))) - (c-code + (c:code (string-append (c:allocs->str (c:allocs cfun) "\n") (c:allocs->str (c:allocs cargs) "\n") @@ -1254,7 +1256,7 @@ ((adbf:well-known fnc) (let* ((lid (ast:lambda-id (closure->lam fun))) (c-lambda-fnc-str (string-append "__lambda_" (number->string lid)))) - (c-code + (c:code (string-append (c:allocs->str (c:allocs cfun) "\n") (c:allocs->str (c:allocs cargs) "\n") @@ -1267,7 +1269,7 @@ (c:body cargs) ");")))) (else - (c-code + (c:code (string-append (c:allocs->str (c:allocs cfun) "\n") (c:allocs->str (c:allocs cargs) "\n") @@ -1284,25 +1286,25 @@ ;; Join expressions; based on c:append (let ((cp1 (if (ref? expr) ;; Ignore lone ref to avoid C warning - (c-code/vars "" '()) + (c:code/vars "" '()) (c-compile-exp expr append-preamble cont ast-id trace cps?))) (cp2 acc)) - (c-code/vars + (c:code/vars (let ((cp1-body (c:body cp1))) (if (zero? (string-length cp1-body)) (c:body cp2) ; Ignore cp1 if necessary (string-append cp1-body ";" (c:body cp2)))) (append (c:allocs cp1) (c:allocs cp2))))) - (c-code "") + (c:code "") args))) exps)) ((equal? 'Cyc-local-set! fun) ;:(trace:error `(JAE DEBUG Cyc-local-set ,exp)) (let ((val-exp (c-compile-exp (caddr exp) append-preamble cont ast-id trace cps?))) - (c-code/vars + (c:code/vars (string-append (mangle (cadr exp)) " = " (c:body val-exp) ";") (c:allocs val-exp))) - ;; (c-code (string-append (mangle (cadr exp)) " = " (mangle (caddr exp)) ";")) + ;; (c:code (string-append (mangle (cadr exp)) " = " (mangle (caddr exp)) ";")) ) ((equal? 'let fun) (let* ((vars/vals (cadr exp)) @@ -1314,14 +1316,14 @@ (let ((cp1 (c-compile-exp (cadr var/val) append-preamble cont ast-id trace cps?)) (cp2 acc)) (set-use-alloca! #f) ; Revert flag - (c-code/vars + (c:code/vars (let ((cp1-body (c:body cp1))) (string-append cp1-body ";" (c:body cp2))) (append (list (string-append "object " (mangle (car var/val)) ";")) (c:allocs cp1) (c:allocs cp2))))) - (c-code "") + (c:code "") vars/vals)) (body-exp (c-compile-exp body append-preamble cont ast-id trace cps?))) @@ -1337,7 +1339,7 @@ (test (compile (if->condition exp))) (then (compile (if->then exp))) (els (compile (if->else exp)))) - (c-code (string-append + (c:code (string-append (c:allocs->str (c:allocs test) " ") "if( (boolean_f != " (c:body test) @@ -1405,7 +1407,7 @@ #f ; inline, so disable CPS on this pass ))) - (c-code/vars "" (list "")))) + (c:code/vars "" (list "")))) (define (c-compile-raw-global-lambda exp append-preamble cont trace . cps?) (let* ((precompiled-sym @@ -1447,14 +1449,14 @@ (define->var exp) #t ; (lambda? body) (let ((cv-name (mangle (gensym 'c)))) - (c-code/vars + (c:code/vars (string-append "&" cv-name) (list (string-append "mclosure0(" cv-name ", (function_type)__lambda_" (number->string lid) ");" cv-name ".num_args = " (number->string num-args) ";"))))) - (c-code/vars "" (list "")))) + (c:code/vars "" (list "")))) ;; Symbol compilation @@ -1655,7 +1657,7 @@ (create-object (lambda () ;; JAE - this is fine, now need to handle other side (actually reading the value without a closure obj ;; (trace:error `(create-object free-vars ,free-vars ,(car free-vars))) - (c-code/vars + (c:code/vars (car free-vars) (list)))) (create-nclosure (lambda () @@ -1713,7 +1715,7 @@ (use-obj-instead-of-closure? (create-object)) (else - (c-code/vars + (c:code/vars (if (and use-alloca? (> (length free-vars) 0)) cv-name @@ -1819,7 +1821,7 @@ "") ; No varargs, skip (c:serialize (c:append - (c-code + (c:code ;; Only trace when entering initial defined function (cond (has-closure? From 8fef2ec1ab94b934db93a82b6d1592d99d7dac49 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 4 May 2020 22:59:51 -0400 Subject: [PATCH 32/50] Fixup c-value to work with new macro --- libs/cyclone/foreign.sld | 2 +- scheme/cyclone/cgen.sld | 10 ++++------ 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index c1f42844..f1c2ae4a 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -9,7 +9,7 @@ (define-library (cyclone foreign) (import (scheme base) - (scheme write) ;; TODO: debugging only! + ;(scheme write) ;; TODO: debugging only! ;(scheme cyclone pretty-print) (scheme cyclone util) ) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 82851910..1777dafa 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -994,12 +994,10 @@ args)) ((eq? 'Cyc-foreign-value fun) - (c->scm (car args) (cadr args)) - ;(c:code/vars - ; (string-append - ; "obj_int2obj(" (car args) ")") - ; (list)) - ) + (let ((kons (c->scm (car args) (cadr args)))) + (c:code/vars + (cdr kons) + (list (car kons))))) ((prim? fun) (let* ((c-fun From 4a6919e153d5ecf70b0d473af90cb7a0309968b7 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 7 May 2020 19:07:07 -0400 Subject: [PATCH 33/50] Added c-define-type --- libs/cyclone/foreign.sld | 28 +++++++++++++++++++++++++++- libs/test-foreign.scm | 4 ++++ 2 files changed, 31 insertions(+), 1 deletion(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index f1c2ae4a..9b562a9f 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -9,7 +9,8 @@ (define-library (cyclone foreign) (import (scheme base) - ;(scheme write) ;; TODO: debugging only! + (scheme eval) + (scheme write) ;; TODO: debugging only! ;(scheme cyclone pretty-print) (scheme cyclone util) ) @@ -20,15 +21,40 @@ c-define c->scm scm->c + c-define-type ) (begin + ;; + ;;(eval `(define *foreign-types* (list))) + + ;; (c-define-type name type (pack (unpack))) + (define-syntax c-define-type + (er-macro-transformer + (lambda (expr rename compare) + (let ((name (cadr expr)) + (type (caddr expr))) + (unless (eval '(with-handler (lambda X #f) *foreign-types*)) + (write "no foreign type table" (current-error-port)) + (newline (current-error-port)) + (eval `(define *foreign-types* (make-hash-table)))) + (eval `(hash-table-set! *foreign-types* (quote ,name) (quote ,type))) + #f)))) (define-syntax c-value (er-macro-transformer (lambda (expr rename compare) (let* ((code-arg (cadr expr)) (type-arg (caddr expr)) + (c-type (eval `(with-handler + (lambda X #f) + (hash-table-ref *foreign-types* (quote ,type-arg)) + ))) ) + (when c-type + (write `(defined c type ,c-type) (current-error-port)) + (newline (current-error-port)) + (set! type-arg c-type)) + ;(for-each ; (lambda (arg) ; (if (not (string? arg)) diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index 6474f440..b66a854b 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -11,8 +11,12 @@ (define *my-global* #f) +(c-define-type my-integer integer) +(c-define-type my-integer2 integer) + (test-group "foreign value" (test 3 (c-value "1 + 2" integer)) + (test 4 (c-value "2 + 2" my-integer)) ) (test-group "foreign code" From ab6ee6c16d0c0316bef9066d43dc54d8bc163125 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sun, 10 May 2020 18:41:04 -0400 Subject: [PATCH 34/50] Allow c-values to support ret-convert from c-define-type --- libs/cyclone/foreign.sld | 14 +++++++++++--- libs/test-foreign.scm | 3 ++- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 9b562a9f..a136356a 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -32,7 +32,7 @@ (er-macro-transformer (lambda (expr rename compare) (let ((name (cadr expr)) - (type (caddr expr))) + (type (cddr expr))) (unless (eval '(with-handler (lambda X #f) *foreign-types*)) (write "no foreign type table" (current-error-port)) (newline (current-error-port)) @@ -49,18 +49,26 @@ (lambda X #f) (hash-table-ref *foreign-types* (quote ,type-arg)) ))) + (c-ret-convert #f) ) (when c-type (write `(defined c type ,c-type) (current-error-port)) (newline (current-error-port)) - (set! type-arg c-type)) + (set! type-arg (car c-type)) + (if (= 3 (length c-type)) + (set! c-ret-convert (caddr c-type)))) ;(for-each ; (lambda (arg) ; (if (not (string? arg)) ; (error "c-value" "Invalid argument: string expected, received " arg))) ; (cdr expr)) - `((lambda () (Cyc-foreign-value ,code-arg ,(symbol->string type-arg)))))))) + + (if c-ret-convert + `((lambda () (,c-ret-convert (Cyc-foreign-value ,code-arg ,(symbol->string type-arg))))) + `((lambda () (Cyc-foreign-value ,code-arg ,(symbol->string type-arg)))) + ) + )))) (define-syntax c-code (er-macro-transformer diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index b66a854b..7a00aa43 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -12,11 +12,12 @@ (define *my-global* #f) (c-define-type my-integer integer) -(c-define-type my-integer2 integer) +(c-define-type my-integer-as-string integer string->number number->string) (test-group "foreign value" (test 3 (c-value "1 + 2" integer)) (test 4 (c-value "2 + 2" my-integer)) + (test "4" (c-value "2 + 2" my-integer-as-string)) ) (test-group "foreign code" From 1c7e03e9d1d9d1b5019d4ae8555f28993d7c32d4 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sun, 10 May 2020 18:44:44 -0400 Subject: [PATCH 35/50] Added TODO items for c-define --- libs/test-foreign.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index 7a00aa43..9628b183 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -32,7 +32,13 @@ ) ;; Must be top-level -(c-define scm-strlen "int" "strlen" string) + +TODO: support custom types (arg and ret) for c-define. + Also need to be able to support arg/ret convert optional type arguments + Would need to generate scheme wrappers to handle these conversions + +(c-define scm-strlen my-integer "strlen" string) +;(c-define scm-strlen "int" "strlen" string) (c-define scm-strlend double "strlen" string) (test-group "foreign lambda" From 9bd5a94ec44932de7646713902f01e12b9382247 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 11 May 2020 17:43:36 -0400 Subject: [PATCH 36/50] WIP --- libs/cyclone/foreign.sld | 24 ++++++++++++++++++++++-- libs/test-foreign.scm | 6 +++--- 2 files changed, 25 insertions(+), 5 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index a136356a..127e14d7 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -173,8 +173,17 @@ (er-macro-transformer (lambda (expr rename compare) (let* ((scm-fnc (cadr expr)) + (scm-fnc-wrapper (gensym 'scm-fnc)) (c-fnc (cadddr expr)) (rv-type (caddr expr)) + (rv-cust-type (eval `(with-handler + (lambda X #f) + (hash-table-ref *foreign-types* (quote ,rv-type)) + ))) + (rv-cust-convert + (if (and rv-cust-type (= 3 (length rv-cust-type))) + (caddr rv-cust-type) + #f)) (arg-types (cddddr expr)) (arg-syms/unbox (map @@ -190,7 +199,9 @@ (c->scm (string-append c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")") - rv-type)) + (if rv-cust-type + (car rv-cust-type) + rv-type))) (return-alloc (car returns)) (return-expr (cdr returns)) (args (string-append @@ -207,7 +218,16 @@ return-alloc "return_closcall1(data, k, " return-expr ");")) ) - `(define-c ,scm-fnc ,args ,body) + (if rv-cust-type + (let ((arg-syms (map (lambda (a) (gensym 'arg)) arg-types))) + `(begin + (define-c ,scm-fnc-wrapper ,args ,body) + (define (,scm-fnc ,@arg-syms) + (,rv-cust-convert TODO: if rv-cust-convert is not #f, + (,scm-fnc-wrapper ,@arg-syms))) + )) + `(define-c ,scm-fnc ,args ,body) + ) )))) ; '(c-define scm-strlen int "strlen" string) ; list diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index 9628b183..42c5a2ad 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -33,9 +33,9 @@ ;; Must be top-level -TODO: support custom types (arg and ret) for c-define. - Also need to be able to support arg/ret convert optional type arguments - Would need to generate scheme wrappers to handle these conversions +;TODO: support custom types (arg and ret) for c-define. +; Also need to be able to support arg/ret convert optional type arguments +; Would need to generate scheme wrappers to handle these conversions (c-define scm-strlen my-integer "strlen" string) ;(c-define scm-strlen "int" "strlen" string) From b6509b442a4fa1a30d20d00306963f91953acbdc Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 11 May 2020 21:28:52 -0400 Subject: [PATCH 37/50] Bug fixes --- libs/cyclone/foreign.sld | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 127e14d7..69c3572e 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -176,10 +176,12 @@ (scm-fnc-wrapper (gensym 'scm-fnc)) (c-fnc (cadddr expr)) (rv-type (caddr expr)) + ;; boolean - Are we returning a custom (user-defined) type? (rv-cust-type (eval `(with-handler (lambda X #f) (hash-table-ref *foreign-types* (quote ,rv-type)) ))) + ;; boolean - Does the custom return type have a conversion function? (rv-cust-convert (if (and rv-cust-type (= 3 (length rv-cust-type))) (caddr rv-cust-type) @@ -218,16 +220,16 @@ return-alloc "return_closcall1(data, k, " return-expr ");")) ) - (if rv-cust-type + (cond + (rv-cust-convert (let ((arg-syms (map (lambda (a) (gensym 'arg)) arg-types))) `(begin (define-c ,scm-fnc-wrapper ,args ,body) (define (,scm-fnc ,@arg-syms) - (,rv-cust-convert TODO: if rv-cust-convert is not #f, - (,scm-fnc-wrapper ,@arg-syms))) - )) - `(define-c ,scm-fnc ,args ,body) - ) + (,rv-cust-convert + (,scm-fnc-wrapper ,@arg-syms)))))) + (else + `(define-c ,scm-fnc ,args ,body))) )))) ; '(c-define scm-strlen int "strlen" string) ; list From fd8cb32e4611b9ef7109b1aa47327e83095a28b9 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 11 May 2020 22:03:07 -0400 Subject: [PATCH 38/50] Added more tests --- libs/test-foreign.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index 42c5a2ad..ad492033 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -38,11 +38,13 @@ ; Would need to generate scheme wrappers to handle these conversions (c-define scm-strlen my-integer "strlen" string) +(c-define scm-strlen-str my-integer-as-string "strlen" string) ;(c-define scm-strlen "int" "strlen" string) (c-define scm-strlend double "strlen" string) (test-group "foreign lambda" (test 15 (scm-strlen "testing 1, 2, 3")) (test 15.0 (scm-strlend "testing 1, 2, 3")) + (test "15" (scm-strlen-str "testing 1, 2, 3")) ) (test-exit) From ec63593324260697c71fb0d447d4e7510476ac8b Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 11 May 2020 22:33:07 -0400 Subject: [PATCH 39/50] Support custom arg types in c-define --- libs/cyclone/foreign.sld | 13 +++++++++++-- libs/test-foreign.scm | 3 +++ 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 69c3572e..4abe9abf 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -190,10 +190,19 @@ (arg-syms/unbox (map (lambda (type) - (let ((var (mangle (gensym 'arg)))) + (let ((var (mangle (gensym 'arg))) + (arg-cust-type (eval `(with-handler + (lambda X #f) + (hash-table-ref *foreign-types* (quote ,type)) + ))) + ) (cons var - (scm->c var type) + (scm->c + var + (if arg-cust-type + (car arg-cust-type) + type)) ;(string-append "string_str(" var ")") ))) arg-types)) diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index ad492033..376f06b6 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -11,6 +11,7 @@ (define *my-global* #f) +(c-define-type my-string string) (c-define-type my-integer integer) (c-define-type my-integer-as-string integer string->number number->string) @@ -41,9 +42,11 @@ (c-define scm-strlen-str my-integer-as-string "strlen" string) ;(c-define scm-strlen "int" "strlen" string) (c-define scm-strlend double "strlen" string) +(c-define scm-strlen2 integer "strlen" my-string) (test-group "foreign lambda" (test 15 (scm-strlen "testing 1, 2, 3")) + (test 15 (scm-strlen2 "testing 1, 2, 3")) (test 15.0 (scm-strlend "testing 1, 2, 3")) (test "15" (scm-strlen-str "testing 1, 2, 3")) ) From a7bdb80964ebad8e197052bfb3b18eddf6421aea Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 11 May 2020 23:02:36 -0400 Subject: [PATCH 40/50] Added TODO --- libs/cyclone/foreign.sld | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 4abe9abf..df1db4ca 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -230,6 +230,8 @@ "return_closcall1(data, k, " return-expr ");")) ) (cond + TODO: need to know if there any custom types for args with an arg-convert function, and need to handle those in case below. + also need to handle case where there are custom arg conversion but not a custom return type conversion (rv-cust-convert (let ((arg-syms (map (lambda (a) (gensym 'arg)) arg-types))) `(begin From 1bd664b81371e274821a9a3dbd6bea5a344514f6 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 May 2020 17:51:47 -0400 Subject: [PATCH 41/50] WIP --- libs/cyclone/foreign.sld | 40 +++++++++++++++++++++++++++++++--------- libs/test-foreign.scm | 3 +++ 2 files changed, 34 insertions(+), 9 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index df1db4ca..d3b9e499 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -187,6 +187,7 @@ (caddr rv-cust-type) #f)) (arg-types (cddddr expr)) + (arg-cust-convert #f) (arg-syms/unbox (map (lambda (type) @@ -200,9 +201,13 @@ var (scm->c var - (if arg-cust-type - (car arg-cust-type) - type)) + (cond + (arg-cust-type + (if (= 3 (length arg-cust-type)) + (set! arg-cust-convert #t)) + (car arg-cust-type)) + (else + type))) ;(string-append "string_str(" var ")") ))) arg-types)) @@ -230,15 +235,32 @@ "return_closcall1(data, k, " return-expr ");")) ) (cond - TODO: need to know if there any custom types for args with an arg-convert function, and need to handle those in case below. - also need to handle case where there are custom arg conversion but not a custom return type conversion - (rv-cust-convert - (let ((arg-syms (map (lambda (a) (gensym 'arg)) arg-types))) + ;TODO: need to know if there any custom types for args with an arg-convert function, and need to handle those in case below. + ; also need to handle case where there are custom arg conversion but not a custom return type conversion + ((or rv-cust-convert arg-cust-convert) + (if (not rv-cust-convert) + (set! rv-cust-convert 'begin)) + (let ((arg-syms + (map + (lambda (type) + (let* ((sym (gensym 'arg)) + (arg-cust-type (eval `(with-handler + (lambda X #f) + (hash-table-ref *foreign-types* (quote ,type))))) + (pass-arg + (if (and arg-cust-type + (= 3 (length arg-cust-type))) + `(,(caddr arg-cust-type) ,sym) + sym)) ) + (cons + sym ;; Arg + pass-arg)));; Passing arg to internal func + arg-types))) `(begin (define-c ,scm-fnc-wrapper ,args ,body) - (define (,scm-fnc ,@arg-syms) + (define (,scm-fnc ,@(map car arg-syms)) (,rv-cust-convert - (,scm-fnc-wrapper ,@arg-syms)))))) + (,scm-fnc-wrapper ,@(map cdr arg-syms))))))) (else `(define-c ,scm-fnc ,args ,body))) )))) diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index 376f06b6..79f2710c 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -14,6 +14,7 @@ (c-define-type my-string string) (c-define-type my-integer integer) (c-define-type my-integer-as-string integer string->number number->string) +(c-define-type string-as-integer string number->string string->number) (test-group "foreign value" (test 3 (c-value "1 + 2" integer)) @@ -43,11 +44,13 @@ ;(c-define scm-strlen "int" "strlen" string) (c-define scm-strlend double "strlen" string) (c-define scm-strlen2 integer "strlen" my-string) +(c-define scm-strlen3 integer "strlen" my-integer-as-string) (test-group "foreign lambda" (test 15 (scm-strlen "testing 1, 2, 3")) (test 15 (scm-strlen2 "testing 1, 2, 3")) (test 15.0 (scm-strlend "testing 1, 2, 3")) (test "15" (scm-strlen-str "testing 1, 2, 3")) + (test 3 (scm-strlen3 255)) ) (test-exit) From d62166d5d7b880591576a4eb492cd3f8e02e98de Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 May 2020 18:12:14 -0400 Subject: [PATCH 42/50] Call proper conversion function --- libs/cyclone/foreign.sld | 6 +++--- libs/test-foreign.scm | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index d3b9e499..15dbcb98 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -203,7 +203,7 @@ var (cond (arg-cust-type - (if (= 3 (length arg-cust-type)) + (if (> (length arg-cust-type) 1) (set! arg-cust-convert #t)) (car arg-cust-type)) (else @@ -249,8 +249,8 @@ (hash-table-ref *foreign-types* (quote ,type))))) (pass-arg (if (and arg-cust-type - (= 3 (length arg-cust-type))) - `(,(caddr arg-cust-type) ,sym) + (> (length arg-cust-type) 1)) + `(,(cadr arg-cust-type) ,sym) sym)) ) (cons sym ;; Arg diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index 79f2710c..f6fbb7d7 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -44,7 +44,7 @@ ;(c-define scm-strlen "int" "strlen" string) (c-define scm-strlend double "strlen" string) (c-define scm-strlen2 integer "strlen" my-string) -(c-define scm-strlen3 integer "strlen" my-integer-as-string) +(c-define scm-strlen3 integer "strlen" string-as-integer) (test-group "foreign lambda" (test 15 (scm-strlen "testing 1, 2, 3")) From 1d57b738617e48db66e7fa57b82bb9b88a73c4b8 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 May 2020 22:18:28 -0400 Subject: [PATCH 43/50] Add c-define-type and refine layout --- docs/api/cyclone/foreign.md | 85 ++++++++++++++++++++++--------------- 1 file changed, 51 insertions(+), 34 deletions(-) diff --git a/docs/api/cyclone/foreign.md b/docs/api/cyclone/foreign.md index 51fd29b7..2f44cff4 100644 --- a/docs/api/cyclone/foreign.md +++ b/docs/api/cyclone/foreign.md @@ -2,6 +2,57 @@ The `(cyclone foreign)` provides a convenient interface for integrating with C code. It is based in concept on the `(chicken foreign)` module from CHICKEN Scheme. Similarly to that module, this library manipulates the C code directly before it is compiled to a native binary. It is not possible to call these forms at runtime. +# Overview + +- [`c-define-type`(#c-define-type) +- [`c-code`](#c-code) +- [`c-value`](#c-value) +- [`c-define`](#c-define) + +## c-define-type + +*Syntax* + + (c-define-type NAME TYPE (ARG-CONVERT (RET-CONVERT))) + +Define a custom type with symbol `NAME` that is an alias of type `TYPE`. It is also possible to specify conversion functions `ARG-CONVERT` and `RET-CONVERT` to convert to/from this custom type. + +EG, to define a type that consists of integers in Scheme and strings in C: + + (c-define-type string-as-integer string number->string string->number) + +## c-code + +*Syntax* + + (c-code CODE ...) + +Insert C code directly into the compiled program. Each `CODE` parameter must be a string containing C code. + +## c-value + +*Syntax* + + (c-value CODE TYPE) + +Generate code that takes the C code specified by the string `CODE` and converts it to a Scheme object of type `TYPE`. + +## c-define + +*Syntax* + + (c-define SCM-FUNC RETURN-TYPE C-FUNC TYPE ...) + +Define a Scheme function `SCM-FUNC` returning an object of type `RETURN-TYPE`. The function will call C function specified by the string `C-FUNC` passed parameters of type specified by any `TYPE` arguments. + +For example, to define a function that calls `strlen`: + + (c-define scm-strlen int "strlen" string) + +Note that these definitions are introduced at the top-level. + +# Type Specifiers + TODO: list of type specifiers built-in types Scheme | C @@ -17,37 +68,3 @@ double | double bignum | mp_int opaque | void * -- [`c-code`](#c-code) -- [`c-value`](#c-value) -- [`c-define`](#c-define) - -# c-code - -*Syntax* - - (c-code CODE ...) - -Insert C code directly into the compiled program. Each `CODE` parameter must be a string containing C code. - -# c-value - -*Syntax* - - (c-value CODE TYPE) - -Generate code that takes the C code specified by the string `CODE` and converts it to a Scheme object of type `TYPE`. - -# c-define - -*Syntax* - - (c-define SCM-FUNC RETURN-TYPE C-FUNC TYPE ...) - -Define a Scheme function `SCM-FUNC` returning an object of type `RETURN-TYPE`. The function will call C function specified by the string `C-FUNC` passed parameters of type specified by any `TYPE` arguments. - -For example, to define a function that calls `strlen`: - - (c-define scm-strlen int "strlen" string) - -Note that these definitions are introduced at the top-level. - From 5b886b19e6cfd173aaa0abc50c9b6d9e47b66216 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 May 2020 22:34:04 -0400 Subject: [PATCH 44/50] Update foreign.md --- docs/api/cyclone/foreign.md | 56 +++++++++++++++++++------------------ 1 file changed, 29 insertions(+), 27 deletions(-) diff --git a/docs/api/cyclone/foreign.md b/docs/api/cyclone/foreign.md index 2f44cff4..ffc7869b 100644 --- a/docs/api/cyclone/foreign.md +++ b/docs/api/cyclone/foreign.md @@ -4,22 +4,10 @@ The `(cyclone foreign)` provides a convenient interface for integrating with C c # Overview -- [`c-define-type`(#c-define-type) - [`c-code`](#c-code) - [`c-value`](#c-value) - [`c-define`](#c-define) - -## c-define-type - -*Syntax* - - (c-define-type NAME TYPE (ARG-CONVERT (RET-CONVERT))) - -Define a custom type with symbol `NAME` that is an alias of type `TYPE`. It is also possible to specify conversion functions `ARG-CONVERT` and `RET-CONVERT` to convert to/from this custom type. - -EG, to define a type that consists of integers in Scheme and strings in C: - - (c-define-type string-as-integer string number->string string->number) +- [`c-define-type`](#c-define-type) ## c-code @@ -51,20 +39,34 @@ For example, to define a function that calls `strlen`: Note that these definitions are introduced at the top-level. +## c-define-type + +*Syntax* + + (c-define-type NAME TYPE (ARG-CONVERT (RET-CONVERT))) + +Define a custom type with symbol `NAME` that is an alias of type `TYPE`. It is also possible to specify conversion functions `ARG-CONVERT` and `RET-CONVERT` to convert to/from this custom type. + +EG, to define a type that consists of integers in Scheme and strings in C: + + (c-define-type string-as-integer string number->string string->number) + + # Type Specifiers -TODO: list of type specifiers -built-in types -Scheme | C -int | int -integer | int -bool | int -char | int -string | char * -symbol | const char * -bytevector | char * -float | double -double | double -bignum | mp_int -opaque | void * +The following built-in specifiers may be used as a `TYPE` for forms in this module. + +Scheme | C +------ | - +`int` | `int` +`integer` | `int` +`bool` | `int` +`char` | `int` +`string` | `char *` +`symbol` | `const char *` +`bytevector` | `char *` +`float` | `double` +`double` | `double` +`bignum` | `mp_int` +`opaque` | `void *` From ca3dfc81141891a1508b41046477f212cfad7bdd Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 May 2020 22:38:25 -0400 Subject: [PATCH 45/50] Link to (cyclone foreign) docs --- docs/API.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/API.md b/docs/API.md index 18b3f6d8..f3dc2273 100644 --- a/docs/API.md +++ b/docs/API.md @@ -57,6 +57,7 @@ Cyclone supports the following [Scheme Requests for Implementation (SRFI)](http: These libraries are provided as Cyclone-specific extensions: - [`cyclone concurrent`](api/cyclone/concurrent.md) - A helper library for writing concurrent code. +- [`cyclone foreign`](api/cyclone/foreign.md) - Provides a convenient interface for integrating with C code. - [`cyclone match`](api/cyclone/match.md) - A hygienic pattern matcher based on Alex Shinn's portable `match.scm`. - [`cyclone test`](api/cyclone/test.md) - A unit testing framework ported from `(chibi test)`. - [`scheme cyclone array-list`](api/scheme/cyclone/array-list.md) From 0034b09468b07e6c61e0ca8c35f322f8ca548d78 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 May 2020 23:07:48 -0400 Subject: [PATCH 46/50] WIP --- libs/cyclone/foreign.sld | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 15dbcb98..1d8dab39 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -10,11 +10,9 @@ (import (scheme base) (scheme eval) - (scheme write) ;; TODO: debugging only! - ;(scheme cyclone pretty-print) (scheme cyclone util) + ;(scheme write) ;; TODO: debugging only! ) - ;(include-c-header "") (export c-code c-value @@ -33,9 +31,14 @@ (lambda (expr rename compare) (let ((name (cadr expr)) (type (cddr expr))) + ;; + ;; Custom foreign types are all stored within the global environment + ;; used by `eval` at compile time. We play a few tricks using exception + ;; handlers to check if variables are defined in that environment. + ;; (unless (eval '(with-handler (lambda X #f) *foreign-types*)) - (write "no foreign type table" (current-error-port)) - (newline (current-error-port)) + ;(write "no foreign type table" (current-error-port)) + ;(newline (current-error-port)) (eval `(define *foreign-types* (make-hash-table)))) (eval `(hash-table-set! *foreign-types* (quote ,name) (quote ,type))) #f)))) @@ -52,8 +55,8 @@ (c-ret-convert #f) ) (when c-type - (write `(defined c type ,c-type) (current-error-port)) - (newline (current-error-port)) + ;(write `(defined c type ,c-type) (current-error-port)) + ;(newline (current-error-port)) (set! type-arg (car c-type)) (if (= 3 (length c-type)) (set! c-ret-convert (caddr c-type)))) @@ -161,6 +164,7 @@ "make_double(" var ", " ,code ");") (string-append "&" var) ))) +TODO: ; /*bytevector_tag */ , "bytevector" ; /*c_opaque_tag */ , "opaque" ; /*bignum_tag */ , "bignum" @@ -168,7 +172,6 @@ (else (error "c->scm unable to convert C object of type " ,type))))))) - ;(pretty-print ( (define-syntax c-define (er-macro-transformer (lambda (expr rename compare) @@ -229,14 +232,13 @@ arg-syms/unbox)) ")")) (body - ;; TODO: need to unbox all args, pass to C function, then box up the result (string-append return-alloc "return_closcall1(data, k, " return-expr ");")) ) (cond - ;TODO: need to know if there any custom types for args with an arg-convert function, and need to handle those in case below. - ; also need to handle case where there are custom arg conversion but not a custom return type conversion + ;; If there are any custom type conversion functions we need to create + ;; a wrapper function in Scheme to perform those conversions ((or rv-cust-convert arg-cust-convert) (if (not rv-cust-convert) (set! rv-cust-convert 'begin)) @@ -261,12 +263,10 @@ (define (,scm-fnc ,@(map car arg-syms)) (,rv-cust-convert (,scm-fnc-wrapper ,@(map cdr arg-syms))))))) + ;; Simpler case, just define the function directly (else `(define-c ,scm-fnc ,args ,body))) )))) - ; '(c-define scm-strlen int "strlen" string) - ; list - ; list)) ) ) From 12ed7e781349764baf03ed94e4102aff331f8bf0 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 13 May 2020 22:29:14 -0400 Subject: [PATCH 47/50] WIP --- libs/cyclone/foreign.sld | 2 +- libs/test-foreign.scm | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 1d8dab39..cbe2ae47 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -161,7 +161,7 @@ (let ((var (mangle (gensym 'var)))) (cons (string-append - "make_double(" var ", " ,code ");") + "make_double(" var ", " ,code ");") TODO: shouldn't this be building a string?? (string-append "&" var) ))) TODO: diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm index f6fbb7d7..4805c71b 100644 --- a/libs/test-foreign.scm +++ b/libs/test-foreign.scm @@ -20,6 +20,7 @@ (test 3 (c-value "1 + 2" integer)) (test 4 (c-value "2 + 2" my-integer)) (test "4" (c-value "2 + 2" my-integer-as-string)) + (test "test" (c-value "\"test\"" string)) ) (test-group "foreign code" From a2a14aec0a4cbb2733161f7efb38585d21d7c31d Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 13 May 2020 23:03:19 -0400 Subject: [PATCH 48/50] c->scm for strings --- libs/cyclone/foreign.sld | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index cbe2ae47..076129af 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -161,10 +161,10 @@ (let ((var (mangle (gensym 'var)))) (cons (string-append - "make_double(" var ", " ,code ");") TODO: shouldn't this be building a string?? + "make_utf8_string(data," var ", " ,code ");") (string-append "&" var) ))) -TODO: +;TODO: ; /*bytevector_tag */ , "bytevector" ; /*c_opaque_tag */ , "opaque" ; /*bignum_tag */ , "bignum" From bb309da886133a1411939ea83968732f05e765ff Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 13 May 2020 23:19:43 -0400 Subject: [PATCH 49/50] Mark TODO item --- libs/cyclone/foreign.sld | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 076129af..06d077fa 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -164,7 +164,7 @@ "make_utf8_string(data," var ", " ,code ");") (string-append "&" var) ))) -;TODO: +TODO: ; /*bytevector_tag */ , "bytevector" ; /*c_opaque_tag */ , "opaque" ; /*bignum_tag */ , "bignum" From 1faf874fff76fb81de60b19b09f3fb340eeb2e36 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 16 May 2020 19:48:21 -0400 Subject: [PATCH 50/50] Add missing C types --- libs/cyclone/foreign.sld | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld index 06d077fa..6831bfc1 100644 --- a/libs/cyclone/foreign.sld +++ b/libs/cyclone/foreign.sld @@ -164,11 +164,21 @@ "make_utf8_string(data," var ", " ,code ");") (string-append "&" var) ))) -TODO: -; /*bytevector_tag */ , "bytevector" -; /*c_opaque_tag */ , "opaque" -; /*bignum_tag */ , "bignum" -; /*symbol_tag */ , "symbol" + ((bytevector) + (let ((var (mangle (gensym 'var)))) + (cons + (string-append + "make_empty_bytevector(data," var ");" + var "->data = " ,code ";") + (string-append "&" var) + ))) + ((opaque) + (let ((var (mangle (gensym 'var)))) + (cons + (string-append + "make_c_opaque(data," var ", " ,code ");") + (string-append "&" var) + ))) (else (error "c->scm unable to convert C object of type " ,type)))))))