Changeset 34025 in project for release/5


Ignore:
Timestamp:
04/24/17 11:05:18 (2 years ago)
Author:
felix
Message:

updated eggs with .egg files and changes from git repo, dropped .meta + .setup files, broke everything

Location:
release/5
Files:
10 added
26 deleted
12 edited

Legend:

Unmodified
Added
Removed
  • release/5/bind/trunk/bind-foreign-transformer.scm

    r29019 r34025  
    1 (require-library matchable)
    2 (import matchable)
    3 
    41;; bind-foreign-lambda* and its cousins are functions that are similar to
    52;; foreign-lambda*, but where the C body is a lisp-like language instead of
     
    2118      (('* args ...)  (conc (intersperse (map xpr->str args) "*")))
    2219      (('+ args ...)  (conc (intersperse (map xpr->str args) "+")))
    23       (('-> struct x) (conc (xpr->str struct) "->" (xpr->str x)))
    2420      (('= var x)     (conc (xpr->str var) " = " (xpr->str x)))
    2521      (('deref x)     (conc "*" (xpr->str x)))
     
    2824      ((? symbol? a) (symbol->string a))
    2925      ((? number? a) (number->string a))
    30       (else (error "invalid c-exp" cexp))))
     26      (else ;; matching ('-> struct x) doesn't seem to work...
     27        (if (and (eq? '-> (car cexp)) (= 3 (length cexp)))
     28            (conc (xpr->str (cadr cexp)) "->" (xpr->str (caddr cexp)))
     29            (error "invalid c-exp" cexp)))))
    3130  (match cexp
    3231    (('stmt statements ...) (apply conc (map (lambda (s) (conc s ";\n")) (map cexp->string statements))))
  • release/5/bind/trunk/bind-translator.scm

    r31455 r34025  
    1616                         set-bind-options set-renaming
    1717                         no-c-syntax-checks
     18                         debugging-chicken
    1819                         test-debug-flag
    1920                         ;; export default foreign-transfomer:
     
    2122
    2223(import scheme chicken)
    23 (use extras data-structures files ports silex srfi-13 srfi-1 utils regex matchable)
    24 
    25 (define-syntax (tok x r c)
    26   `(,(r 'cons) ,(cadr x) yyline))
     24(import (chicken data-structures))
     25(import (chicken pathname))
     26(import srfi-1)
     27(import (chicken irregex))
     28(import matchable)
     29(import (chicken format))
     30(import (chicken pretty-print))
     31
     32(define-syntax tok
     33  (er-macro-transformer
     34    (lambda (x r c)
     35      `(,(r 'cons) ,(cadr x) yyline))))
    2736
    2837(include "c.l.scm")
     
    6069(define foreign-transformer bind-foreign-lambda*)
    6170
     71;; terrible hack follows ...
     72
    6273;; unless this is running in the compiler, create stubs for some API procedures
    63 (unless (or (memq #:compiling ##sys#features) (memq #:compiler-extension ##sys#features))
    64   (set! chicken.compiler.support#register-foreign-type! void)
    65   (set! chicken.compiler.support#lookup-foreign-type void)
    66   (set! chicken.compiler.support#debugging-chicken '()))
     74(define compiler-ext (or (memq #:compiling ##sys#features) (memq #:compiler-extension ##sys#features)))
     75
     76(define register-foreign-type!
     77  (if compiler-ext
     78      (##sys#slot 'chicken.compiler.support#register-foreign-type! 0)
     79      void))
     80
     81(define lookup-foreign-type
     82  (if compiler-ext
     83      (##sys#slot 'chicken.compiler.support#lookup-foreign-type 0)
     84      void))
     85
     86(define debugging-chicken
     87  (if compiler-ext
     88      (##sys#slot 'chicken.compiler.support#debugging-chicken 0)
     89      '()))
     90
     91;; ... end of terrible hack
    6792
    6893(define (test-debug-flag sym)
    69   (memq sym chicken.compiler.support#debugging-chicken))
     94  (memq sym debugging-chicken))
    7095
    7196(define (parsing-error arg1 . more)
     
    10961121      (downcase-string
    10971122       (string-translate
    1098         (string-substitute "([a-z])([A-Z])" "\\1-\\2" (car m) #t)
     1123        (irregex-replace/all "([a-z])([A-Z])" (car m)
     1124                             (lambda (m)
     1125                               (string-append (irregex-match-substring m 1)
     1126                                              "-"
     1127                                              (irregex-match-substring m 2))))
    10991128        "_" "-") ) ) ) )
    11001129
     
    11101139       (let ([stname (->symbol tname)] )
    11111140         (set! declared-types (cons stname declared-types))
    1112          (chicken.compiler.support#register-foreign-type! stname stype) ; will be overwritten later
     1141         (register-foreign-type! stname stype) ; will be overwritten later
    11131142         `(,(r 'begin)
    11141143           (,(r 'foreign-declare)
     
    11671196      [else
    11681197       (cond [(and (symbol? type)
    1169                    (chicken.compiler.support#lookup-foreign-type type))
     1198                   (lookup-foreign-type type))
    11701199              => (lambda (t)
    11711200                   (foreign-type-declaration (if (vector? t) (vector-ref t 0) t) target)) ]
     
    12171246                   (lambda (rx repl str)
    12181247                     (if (procedure? repl)
    1219                          (let ([m (string-match rx str)])
     1248                         (let ([m (irregex-match rx str)])
    12201249                           (if m (repl m) str) )
    1221                          (string-substitute rx repl str #t) ) )
     1250                         (irregex-replace/all rx str repl) ) )
    12221251                   (->string str)
    12231252                   name-substitution-rxs
     
    13201349      (('template . _) '<pointer>)
    13211350      [(? symbol?)
    1322        (let ([a (chicken.compiler.support#lookup-foreign-type ftype)])
     1351       (let ([a (lookup-foreign-type ftype)])
    13231352         (if a
    13241353             (rec (if (vector? a) (vector-ref a 0) a))
  • release/5/bind/trunk/bind.scm

    r26848 r34025  
    1515(import scheme chicken foreign)
    1616
    17 (import-for-syntax bind-translator srfi-1 srfi-13 utils)
    18 
    1917(begin-for-syntax
    20  (require-library bind-translator))
     18  (import bind-translator)
     19  (import srfi-1)
     20  (import srfi-13))
    2121
    2222(define-syntax bind
     
    4141    (read-all fname)))
    4242
    43 (define-syntax (bind-file x r c)
    44   `(,(r 'bind) ,@(map bind:read-file (cdr x))))
     43(define-syntax bind-file
     44  (er-macro-transformer
     45    (lambda (x r c)
     46      `(,(r 'bind) ,@(map bind:read-file (cdr x))))))
    4547
    46 (define-syntax (bind-file* x r c)
    47   `(,(r 'bind*) ,@(map bind:read-file (cdr x))))
     48(define-syntax bind-file*
     49  (er-macro-transformer
     50    (lambda (x r c)
     51      `(,(r 'bind*) ,@(map bind:read-file (cdr x))))))
    4852
    4953(define-syntax bind-include-path
     
    5256    `(,(r 'void) ) ) )
    5357
    54 (define-syntax (bind-type x r c)
    55   (parse-type-declaration (cdr x) r))
     58(define-syntax bind-type
     59  (er-macro-transformer
     60    (lambda (x r c)
     61      (parse-type-declaration (cdr x) r))))
    5662
    57 (define-syntax (bind-opaque-type x r c)
    58   (parse-opaque-type-declaration (cdr x) r))
     63(define-syntax bind-opaque-type
     64  (er-macro-transformer
     65    (lambda (x r c)
     66      (parse-opaque-type-declaration (cdr x) r))))
    5967
    60 (define-syntax (bind-options x r c)
    61   (apply set-bind-options (strip-syntax (cdr x)))
    62   `(,(r 'void)))
     68(define-syntax bind-options
     69  (er-macro-transformer
     70    (lambda (x r c)
     71      (apply set-bind-options (strip-syntax (cdr x)))
     72      `(,(r 'void)))))
    6373
    64 (define-syntax (bind-rename x r c)
    65   (if (= 2 (length (cdr x)))
    66       (apply set-renaming (strip-syntax (cdr x)))
    67       (syntax-error 'bind-rename "bad number of arguments" x))
    68   `(,(r 'void)))
     74(define-syntax bind-rename
     75  (er-macro-transformer
     76    (lambda (x r c)
     77      (if (= 2 (length (cdr x)))
     78          (apply set-renaming (strip-syntax (cdr x)))
     79          (syntax-error 'bind-rename "bad number of arguments" x))
     80      `(,(r 'void)))))
    6981
    70 (define-syntax (bind-rename/pattern x r c)
    71   (if (= 2 (length (cdr x)))
    72       (apply set-renaming (append (strip-syntax (cdr x)) '(regex: #t)))
    73       (syntax-error 'bind-rename "bad number of arguments" x))
    74   `(,(r 'void)))
     82(define-syntax bind-rename/pattern
     83  (er-macro-transformer
     84    (lambda (x r c)
     85      (if (= 2 (length (cdr x)))
     86          (apply set-renaming (append (strip-syntax (cdr x)) '(regex: #t)))
     87          (syntax-error 'bind-rename "bad number of arguments" x))
     88      `(,(r 'void)))))
    7589
    7690)
  • release/5/bind/trunk/chicken-bind.scm

    r31455 r34025  
    22
    33
    4 (require-extension srfi-1 utils bind-translator extras regex)
     4(import scheme chicken)
     5(import srfi-1)
     6(import bind-translator)
    57
    68(define (usage #!optional (status 0))
     
    3638              (rest (cdr args)))
    3739          (cond ((string=? "-debug" arg)
    38                  (set! chicken.compiler.support#debugging-chicken '(C X))
     40                 (set! debugging-chicken '(C X))
    3941                 (loop rest))
    4042                ((string=? "-export-constants" arg)
     
    6062                ((or (string=? "-rename-regex" arg) (string=? "-rename" arg))
    6163                 (unless (pair? rest) (usage 1))
    62                  (let ((m (string-match "([^:]+):(.+)" (cadr args))))
     64                 (let ((m (irregex-match "([^:]+):(.+)" (cadr args))))
    6365                   (if m
    6466                       (set-renaming (cadr m) (caddr m) regex: (string=? "-rename-regex" arg))
  • release/5/bind/trunk/tests/cplusplus-test.scm

    r22282 r34025  
    1 (use bind coops extras)
    2 (use cplusplus-object)
     1(import bind coops cplusplus-object)
     2(import (chicken pretty-print))
    33
    44(bind* #<<EOF
  • release/5/bind/trunk/tests/foreign-transformer-test.scm

    r29020 r34025  
    11;;; Test for foreign-transform
    22;;; May also be useful as an example of how to use it.
    3 (use bind test srfi-4)
     3(import bind test srfi-4)
     4(import (chicken pretty-print))
    45
    5 (import-for-syntax bind-translator)
    6 (import-for-syntax matchable)
     6(begin-for-syntax
     7  (import bind-translator matchable)
     8  (import (chicken pretty-print))
     9  (import (chicken data-structures))
     10  (import srfi-1))
    711
    812(begin-for-syntax
  • release/5/bind/trunk/tests/run.scm

    r29019 r34025  
    22
    33
    4 (use setup-api)
     4(import (chicken format)
     5        (chicken pathname)
     6        (chicken process))
    57
    6 (run (csc tests.scm -debug F -c++))
    7 (run (./tests))
     8(define prefix (pathname-directory (car (argv))))
     9(define csc (make-pathname prefix "csc"))  ; hack
    810
    9 (run (csc cplusplus-test.scm -debug F -c++))
    10 (run (./cplusplus-test))
     11(system* (format "~s tests.scm -k -debug F -c++" csc))
     12(system* "./tests")
    1113
    12 (run (csc foreign-transformer-test.scm -debug F))
    13 (run (./foreign-transformer-test))
     14(system* (format "~s -k cplusplus-test.scm -debug F -c++" csc))
     15(system* "./cplusplus-test")
     16
     17(system* (format "~s -k foreign-transformer-test.scm -debug F" csc))
     18(system* "./foreign-transformer-test")
  • release/5/bind/trunk/tests/tests.scm

    r22282 r34025  
    1 (use coops extras regex)
     1(import coops)
    22(import bind foreign)
    33
     
    6565
    6666(bind-rename "foo" "bar")
    67 (bind-rename/pattern "(.+)_(.+)_(.+)" "\\2")
    6867
    6968(bind-options
     
    7372
    7473(bind* "int foo(___inout double *d) { return (int)*d; }")
    75 (bind* "int32_t one_two_three(___inout double *d) { return (int)*d; }")
     74(bind* "int32_t two(___inout double *d) { return (int)*d; }")
    7675
    7776(assert (equal? '(22 22.3) (receive (bar 22.3))))
  • release/5/object-evict/trunk/object-evict.scm

    r33443 r34025  
    1111  (import scheme srfi-12 srfi-69 (chicken fixnum)
    1212          (only (chicken memory) align-to-word allocate free)
    13           ;; TODO: remove "chicken"!  optional should not be needed!
    14           (only chicken when unless void) )
     13          (only chicken when unless void optional) )
    1514
    1615(define (object-evicted? x) (##core#inline "C_permanentp" x))
  • release/5/queues/trunk/queues.egg

    r33682 r34025  
    55 (category data)
    66 (license "Public Domain")
    7  (doc-from-wiki)
    8  (authors "Andrew Wilcox, ported to CHICKEN by felix")
    9  (version "1.0")
    10  (components (extension queues)))
     7 (author "Andrew Wilcox, ported to CHICKEN by felix")
     8 (components (extension queues (types-file))))
  • release/5/srfi-13/trunk/srfi-13.egg

    r33720 r34025  
    77 (dependencies srfi-14)
    88 (test-dependencies test)
    9  (components (extension srfi-13)))
     9 (components (extension srfi-13 (types-file))))
  • release/5/srfi-14/trunk/srfi-14.egg

    r33720 r34025  
    55 (category data)
    66 (license "BSD")
    7  (components (extension srfi-14)))
     7 (components (extension srfi-14 (types-file))))
Note: See TracChangeset for help on using the changeset viewer.