idris-lang/Idris2
1
1
Fork 0
mirror of https://github.com/idris-lang/Idris2.git synced 2024-08-17 09:10:33 +03:00
Code Issues Projects Releases Wiki Activity

[ gambit ] fix pack / unpack segfault with gambit scheme

Browse Source
This commit is contained in:
Steve Dunham 2023-11-10 20:39:27 -08:00 committed by G. Allais
parent 6eb66612b1
commit e2ceb97fd8
1 changed files with 9 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
support/gambit/support.scm
View File

@ -2,10 +2,10 @@
;; https://github.com/gambit/gambit/blob/master/gsc/_t-x86.scm#L1106 #L1160 ;; https://github.com/gambit/gambit/blob/master/gsc/_t-x86.scm#L1106 #L1160
(define (blodwen-os) (define (blodwen-os)
(cond (cond
[(memq (cadr (system-type)) '(apple)) "darwin"] ((memq (cadr (system-type)) '(apple)) "darwin")
[(memq (caddr (system-type)) '(linux-gnu)) "unix"] ((memq (caddr (system-type)) '(linux-gnu)) "unix")
[(memq (caddr (system-type)) '(mingw32 mingw64)) "windows"] ((memq (caddr (system-type)) '(mingw32 mingw64)) "windows")
[else "unknown"])) (else "unknown")))
;; TODO Convert to macro ;; TODO Convert to macro
(define (blodwen-read-args desc) (define (blodwen-read-args desc)
@ -16,7 +16,7 @@
(define blodwen-lazy (define blodwen-lazy
(lambda (f) (lambda (f)
(let ([evaluated #f] [res void]) (let ((evaluated #f) (res void))
(lambda () (lambda ()
(if (not evaluated) (if (not evaluated)
(begin (set! evaluated #t) (begin (set! evaluated #t)
@ -132,20 +132,12 @@
(define-macro (cast-string-int x) (define-macro (cast-string-int x)
`(exact-truncate (cast-string-double ,x))) `(exact-truncate (cast-string-double ,x)))
(define (from-idris-list xs)
(if (= (vector-ref xs 0) 0)
'()
(cons (vector-ref xs 1) (from-idris-list (vector-ref xs 2)))))
(define-macro (string-pack xs) (define-macro (string-pack xs)
`(apply string (from-idris-list ,xs))) `(apply string ,xs))
(define (to-idris-list-rev acc xs)
(if (null? xs) (define (string-unpack s) (string->list s))
acc
(to-idris-list-rev (vector 1 (car xs) acc) (cdr xs))))
(define (string-unpack s) (to-idris-list-rev (vector 0) (reverse (string->list s))))
(define-macro (string-concat xs) (define-macro (string-concat xs)
`(apply string-append (from-idris-list ,xs))) `(apply string-append ,xs))
(define-macro (string-cons x y) (define-macro (string-cons x y)
`(string-append (string ,x) ,y)) `(string-append (string ,x) ,y))