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

[ fix #2279 ] Racket bootstrap unsafe-fx

Browse Source
This commit is contained in:
Ben Hormann 2022-01-30 12:20:00 +13:00 committed by G. Allais
parent ac9e03d7e3
commit ca5f1f1938
2 changed files with 2 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bootstrap/idris2_app/idris2.rkt generated
View File

@ -7336,7 +7336,7 @@
(define CompilerC-45SchemeC-45Racket-showRacketString (lambda (arg-0) (lambda (clam-0) (if (null? arg-0) clam-0 (let ((e-2 (car arg-0))) (let ((e-3 (cdr arg-0))) (cond ((equal? e-2 #\") (PreludeC-45TypesC-45String-C-43C-43 "\\\"" ((CompilerC-45SchemeC-45Racket-showRacketString e-3) clam-0)))(else ((CompilerC-45SchemeC-45Racket-showRacketChar e-2) ((CompilerC-45SchemeC-45Racket-showRacketString e-3) clam-0))))))))))
(define CompilerC-45SchemeC-45Racket-showRacketChar (lambda (arg-0) (lambda (clam-0) (cond ((equal? arg-0 #\\) (PreludeC-45TypesC-45String-C-43C-43 "\\\\" clam-0))(else (let ((sc0 (let ((sc1 (PreludeC-45EqOrd-u--C-60_Ord_Char arg-0 (PreludeC-45Types-chr 32)))) (cond ((equal? sc1 1) 1) (else (PreludeC-45EqOrd-u--C-62_Ord_Char arg-0 (PreludeC-45Types-chr (blodwen-toSignedInt 126 63)))))))) (cond ((equal? sc0 1) (PreludeC-45TypesC-45String-C-43C-43 (PreludeC-45TypesC-45String-C-43C-43 "\\u" (LibrariesC-45UtilsC-45Hex-leftPad #\0 (+ 1 (+ 1 (+ 1 (+ 1 0)))) (LibrariesC-45UtilsC-45Hex-asHex (PreludeC-45Cast-u--cast_Cast_Char_Bits64 arg-0)))) clam-0)) (else (PreludeC-45Types-strCons arg-0 clam-0)))))))))
(define CompilerC-45SchemeC-45Racket-schemeCall (lambda (arg-0 arg-1 arg-2 arg-3) (let ((u--call (PreludeC-45TypesC-45String-C-43C-43 "(" (PreludeC-45TypesC-45String-C-43C-43 arg-1 (PreludeC-45TypesC-45String-C-43C-43 " " (PreludeC-45TypesC-45String-C-43C-43 (CoreC-45NameC-45Namespace-showSep " " (PreludeC-45Types-u--map_Functor_List (lambda (eta-0) (CompilerC-45SchemeC-45Common-schName eta-0)) arg-2)) ")")))))) (lambda (clam-0) (case (vector-ref arg-3 0) ((20) (vector 1 (CompilerC-45SchemeC-45Common-mkWorld u--call)))(else (vector 1 u--call)))))))
(define CompilerC-45SchemeC-45Racket-schHeader (lambda (arg-0 arg-1) (PreludeC-45TypesC-45String-C-43C-43 "#lang racket/base\u000a" (PreludeC-45TypesC-45String-C-43C-43 "; " (PreludeC-45TypesC-45String-C-43C-43 (CompilerC-45Generated-generatedString "Racket") (PreludeC-45TypesC-45String-C-43C-43 "\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require racket/async-channel)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require racket/future)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require racket/math)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require racket/system)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require rnrs/bytevectors-6)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require rnrs/io/ports-6)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require srfi/19)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require ffi/unsafe ffi/unsafe/define)\u000a" (PreludeC-45TypesC-45String-C-43C-43 (cond ((equal? arg-0 1) "(require profile)\u000a") (else "")) (PreludeC-45TypesC-45String-C-43C-43 "(require racket/flonum)\u000a" (PreludeC-45TypesC-45String-C-43C-43 arg-1 "(let ()\u000a")))))))))))))))))
(define CompilerC-45SchemeC-45Racket-schHeader (lambda (arg-0 arg-1) (PreludeC-45TypesC-45String-C-43C-43 "#lang racket/base\u000a" (PreludeC-45TypesC-45String-C-43C-43 "; " (PreludeC-45TypesC-45String-C-43C-43 (CompilerC-45Generated-generatedString "Racket") (PreludeC-45TypesC-45String-C-43C-43 "\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require racket/async-channel)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require racket/future)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require racket/math)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require racket/system)\u000a(require racket/unsafe/ops)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require rnrs/bytevectors-6)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require rnrs/io/ports-6)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require srfi/19)\u000a" (PreludeC-45TypesC-45String-C-43C-43 "(require ffi/unsafe ffi/unsafe/define)\u000a" (PreludeC-45TypesC-45String-C-43C-43 (cond ((equal? arg-0 1) "(require profile)\u000a") (else "")) (PreludeC-45TypesC-45String-C-43C-43 "(require racket/flonum)\u000a" (PreludeC-45TypesC-45String-C-43C-43 arg-1 "(let ()\u000a")))))))))))))))))
(define CompilerC-45SchemeC-45Racket-schFooter(blodwen-lazy (lambda () ") (collect-garbage)")))
(define CompilerC-45SchemeC-45Racket-schFgnDef (lambda (arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7) (case (vector-ref arg-7 0) ((2) (let ((e-0 (vector-ref arg-7 1))) (let ((e-1 (vector-ref arg-7 2))) (let ((e-2 (vector-ref arg-7 3))) (let ((u--argns (CompilerC-45SchemeC-45Racket-mkArgs 0 e-1))) (let ((u--allargns (PreludeC-45Types-u--map_Functor_List (lambda (eta-0) (Builtin-fst eta-0)) u--argns))) (let ((u--useargns (PreludeC-45Types-u--map_Functor_List (lambda (eta-0) (Builtin-fst eta-0)) (DataC-45List-filter (lambda (eta-0) (Builtin-snd eta-0)) u--argns)))) (lambda (eta-0) (let ((act-24 (CoreC-45Core-traverseC-39 (lambda (eta-1) (CompilerC-45SchemeC-45Racket-mkStruct arg-3 eta-1)) e-1 '() eta-0))) (case (vector-ref act-24 0) ((0) (let ((e-3 (vector-ref act-24 1))) (vector 0 e-3))) (else (let ((e-5 (vector-ref act-24 1))) (let ((act-25 ((CompilerC-45SchemeC-45Racket-mkStruct arg-3 e-2) eta-0))) (case (vector-ref act-25 0) ((0) (let ((e-3 (vector-ref act-25 1))) (vector 0 e-3))) (else (let ((e-6 (vector-ref act-25 1))) (let ((act-26 ((CompilerC-45SchemeC-45Racket-useCC arg-0 arg-1 arg-2 arg-4 arg-5 e-0 (DataC-45List-u--zip_Zippable_List u--useargns e-1) e-2) eta-0))) (case (vector-ref act-26 0) ((0) (let ((e-3 (vector-ref act-26 1))) (vector 0 e-3))) (else (let ((e-7 (vector-ref act-26 1))) (let ((e-4 (car e-7))) (let ((e-3 (cdr e-7))) (let ((act-27 (let ((act-27 (unbox arg-1))) (vector 1 act-27)))) (case (vector-ref act-27 0) ((0) (let ((e-8 (vector-ref act-27 1))) (vector 0 e-8))) (else (let ((e-8 (vector-ref act-27 1))) (let ((act-28 (CoreC-45Context-u--full_HasNames_Name (let ((e-39 (vector-ref e-8 0))) e-39) arg-6 eta-0))) (case (vector-ref act-28 0) ((0) (let ((e-9 (vector-ref act-28 1))) (vector 0 e-9))) (else (let ((e-9 (vector-ref act-28 1))) (vector 1 (cons (PreludeC-45TypesC-45String-C-43C-43 (PreludeC-45Interfaces-concat (csegen-67) e-5) (PreludeC-45TypesC-45String-C-43C-43 e-6 e-4)) (PreludeC-45TypesC-45String-C-43C-43 "(define " (PreludeC-45TypesC-45String-C-43C-43 (CompilerC-45SchemeC-45Common-schName e-9) (PreludeC-45TypesC-45String-C-43C-43 " (lambda (" (PreludeC-45TypesC-45String-C-43C-43 (CoreC-45NameC-45Namespace-showSep " " (PreludeC-45Types-u--map_Functor_List (lambda (eta-1) (CompilerC-45SchemeC-45Common-schName eta-1)) u--allargns)) (PreludeC-45TypesC-45String-C-43C-43 ") " (PreludeC-45TypesC-45String-C-43C-43 e-3 "))\u000a"))))))))))))))))))))))))))))))))))))))(else (lambda (eta-0) (vector 1 (cons "" "")))))))
(define CompilerC-45SchemeC-45Racket-rktToC (lambda (arg-0 arg-1) (case (vector-ref arg-0 0) ((13) (PreludeC-45TypesC-45String-C-43C-43 "(char->integer " (PreludeC-45TypesC-45String-C-43C-43 arg-1 ")")))(else arg-1))))

2
support/gambit/support.scm
View File

@ -59,7 +59,7 @@
; To match Chez
(define (add1 x) (+ x 1))
(define (sub1 x) (- x 1))
(define (fxsub1 x) (fx- x 1))
(define (fxadd1 x) (fx+ x 1))
(define (fxsub1 x) (fx- x 1))
(define (integer->bits8 x) (bitwise-and x #xff))