mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-09-11 21:37:48 +03:00
Merge branch 'master' into custom_conf
This commit is contained in:
Niklas Larsson
GitHub
commit
323ee196ec
@ -7,6 +7,9 @@ The requirements are:
|
||||
* A Scheme compiler; either Chez Scheme (default), or Racket.
|
||||
* `bash`, with `realpath`. On Linux, you probably already have this.
|
||||
On a Mac, you can install this with `brew install coreutils`.
|
||||
On FreeBSD, OpenBSD and NetBSD, you can install `realpath` and `GNU make`
|
||||
using a package manager. For instance, on OpenBSD you can install all of them
|
||||
with `pkg_add coreutuls gmake` command.
|
||||
|
||||
On Windows, it has been reported that installing via `MSYS2` works
|
||||
(https://www.msys2.org/). On Windows older than Windows 8, you may need to
|
||||
@ -19,6 +22,9 @@ by setting the environment variable `IDRIS2_CG=racket` before running `make`.
|
||||
If you install Chez Scheme from source files, building it locally,
|
||||
make sure you run `./configure --threads` to build multithreading support in.
|
||||
|
||||
**NOTE**: On FreeBSD, OpenBSD and NetBSD you need to use `gmake` command instead
|
||||
of `make` in the following steps.
|
||||
|
||||
1: Set the PREFIX
|
||||
-----------------
|
||||
|
||||
|
||||
3
Makefile
3
Makefile
@ -144,8 +144,6 @@ ifeq ($(OS), darwin)
|
||||
else
|
||||
sed -i 's|__PREFIX__|${IDRIS2_CURDIR}/bootstrap|g' bootstrap/idris2_app/idris2-boot.ss
|
||||
endif
|
||||
SCHEME=${SCHEME} \
|
||||
IDRIS2_VERSION=${IDRIS2_VERSION} \
|
||||
sh ./bootstrap.sh
|
||||
|
||||
# Bootstrapping using racket
|
||||
@ -159,7 +157,6 @@ ifeq ($(OS), darwin)
|
||||
else
|
||||
sed -i 's|__PREFIX__|${IDRIS2_CURDIR}/bootstrap|g' bootstrap/idris2_app/idris2-boot.rkt
|
||||
endif
|
||||
IDRIS2_VERSION=${IDRIS2_VERSION} \
|
||||
sh ./bootstrap-rkt.sh
|
||||
|
||||
bootstrap-test:
|
||||
|
||||
@ -40,9 +40,8 @@ IDRIS2_BOOT_PATH="${BOOT_PATH_BASE}/prelude${SEP}${BOOT_PATH_BASE}/base${SEP}${B
|
||||
# PREFIX must be the "clean" build root, without cygpath -m
|
||||
# Otherwise, we get 'git: Bad address'
|
||||
echo ${PREFIX}
|
||||
|
||||
DYLIB_PATH="${PREFIX}/lib"
|
||||
make libs IDRIS2_CG=racket PREFIX=${PREFIX} LD_LIBRARY_PATH=${DYLIB_PATH}
|
||||
make install IDRIS2_CG=racket PREFIX=${PREFIX} LD_LIBRARY_PATH=${DYLIB_PATH}
|
||||
make clean IDRIS2_BOOT=${PREFIX}/bin/idris2 LD_LIBRARY_PATH=${DYLIB_PATH}
|
||||
make all IDRIS2_BOOT=${PREFIX}/bin/idris2 IDRIS2_CG=racket IDRIS2_PATH=${IDRIS2_BOOT_PATH} LD_LIBRARY_PATH=${DYLIB_PATH}
|
||||
${MAKE} libs IDRIS2_CG=racket PREFIX=${PREFIX} LD_LIBRARY_PATH=${DYLIB_PATH}
|
||||
${MAKE} install IDRIS2_CG=racket PREFIX=${PREFIX} LD_LIBRARY_PATH=${DYLIB_PATH}
|
||||
${MAKE} clean IDRIS2_BOOT=${PREFIX}/bin/idris2 LD_LIBRARY_PATH=${DYLIB_PATH}
|
||||
${MAKE} all IDRIS2_BOOT=${PREFIX}/bin/idris2 IDRIS2_CG=racket IDRIS2_PATH=${IDRIS2_BOOT_PATH} LD_LIBRARY_PATH=${DYLIB_PATH}
|
||||
|
||||
@ -46,8 +46,7 @@ IDRIS2_BOOT_PATH="${BOOT_PATH_BASE}/prelude${SEP}${BOOT_PATH_BASE}/base${SEP}${B
|
||||
# PREFIX must be the "clean" build root, without cygpath -m
|
||||
# Otherwise, we get 'git: Bad address'
|
||||
echo ${PREFIX}
|
||||
make libs SCHEME=${SCHEME} PREFIX=${PREFIX}
|
||||
make install SCHEME=${SCHEME} PREFIX=${PREFIX}
|
||||
make clean IDRIS2_BOOT=${PREFIX}/bin/idris2
|
||||
make all IDRIS2_BOOT=${PREFIX}/bin/idris2 SCHEME=${SCHEME} IDRIS2_PATH=${IDRIS2_BOOT_PATH}
|
||||
|
||||
${MAKE} libs SCHEME=${SCHEME} PREFIX=${PREFIX}
|
||||
${MAKE} install SCHEME=${SCHEME} PREFIX=${PREFIX}
|
||||
${MAKE} clean IDRIS2_BOOT=${PREFIX}/bin/idris2
|
||||
${MAKE} all IDRIS2_BOOT=${PREFIX}/bin/idris2 SCHEME=${SCHEME} IDRIS2_PATH=${IDRIS2_BOOT_PATH}
|
||||
|
||||
12
bootstrap/idris2-boot
vendored
12
bootstrap/idris2-boot
vendored
@ -1,5 +1,15 @@
|
||||
#!/bin/sh
|
||||
DIR="`realpath $0`"
|
||||
|
||||
case `uname -s` in
|
||||
OpenBSD|FreeBSD|NetBSD)
|
||||
DIR="`grealpath $0`"
|
||||
;;
|
||||
|
||||
*)
|
||||
DIR="`realpath $0`"
|
||||
;;
|
||||
esac
|
||||
|
||||
export LD_LIBRARY_PATH="$LD_LIBRARY_PATH:`dirname "$DIR"`/"idris2_app""
|
||||
export PATH="`dirname "$DIR"`/"idris2_app":$PATH"
|
||||
${SCHEME} --script "`dirname $DIR`"/"idris2_app/idris2-boot.so" "$@"
|
||||
|
||||
12
bootstrap/idris2-rktboot
vendored
12
bootstrap/idris2-rktboot
vendored
@ -1,5 +1,15 @@
|
||||
#!/bin/sh
|
||||
DIR="`realpath $0`"
|
||||
|
||||
case `uname -s` in
|
||||
OpenBSD|FreeBSD|NetBSD)
|
||||
DIR="`grealpath $0`"
|
||||
;;
|
||||
|
||||
*)
|
||||
DIR="`realpath $0`"
|
||||
;;
|
||||
esac
|
||||
|
||||
export LD_LIBRARY_PATH="$LD_LIBRARY_PATH:`dirname "$DIR"`/"idris2_app""
|
||||
export PATH="`dirname "$DIR"`/"idris2_app":$PATH"
|
||||
"`dirname $DIR`"/"idris2_app/idris2-boot" "$@"
|
||||
|
||||
@ -7325,9 +7325,9 @@
|
||||
(define Racket-Scheme-Compiler-n--8783-872-callback (lambda (arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 arg-9 arg-10 arg-11) (let ((sc0 arg-11)) (case (vector-ref sc0 0) ((10) (let ((e-0 (vector-ref sc0 1))) (let ((e-1 (vector-ref sc0 2))) (Racket-Scheme-Compiler-n--8783-872-callback arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 arg-9 (vector 1 e-0 arg-10) e-1))))(else (let ((args (List-Data-reverse 'erased arg-10))) (lambda (eta-0) (let ((act-24 ((Core-Core-traverse 'erased 'erased (lambda (eta-1) (Racket-Scheme-Compiler-cftySpec arg-4 eta-1)) (List-Data-filter 'erased (lambda (eta-1) (Racket-Scheme-Compiler-n--8783-871-notWorld arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 eta-1)) args)) eta-0))) (let ((sc0 act-24)) (case (vector-ref sc0 0) ((0) (let ((e-2 (vector-ref sc0 1))) (vector 0 e-2))) (else (let ((act-25 ((Racket-Scheme-Compiler-cftySpec arg-4 arg-11) eta-0))) (let ((sc1 act-25)) (case (vector-ref sc1 0) ((0) (let ((e-2 (vector-ref sc1 1))) (vector 0 e-2))) (else (vector 1 (Racket-Scheme-Compiler-n--8783-870-mkFun arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 args arg-11 arg-9)))))))))))))))))
|
||||
(define Racket-Scheme-Compiler-n--8783-869-applyLams (lambda (arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 arg-9 arg-10) (let ((sc0 arg-10)) (case (vector-ref sc0 0) ((0) arg-9) (else (let ((e-2 (vector-ref sc0 1))) (let ((e-3 (vector-ref sc0 2))) (let ((sc1 e-2)) (case (vector-ref sc1 0) ((0) (Racket-Scheme-Compiler-n--8783-869-applyLams arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 (Strings-Prelude-C-43C-43 "(" (Strings-Prelude-C-43C-43 arg-9 " #f)")) e-3)) (else (let ((e-6 (vector-ref sc1 1))) (let ((sc2 e-6)) (let ((e-9 (vector-ref sc2 1))) (let ((e-10 (vector-ref sc2 2))) (Racket-Scheme-Compiler-n--8783-869-applyLams arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 (Strings-Prelude-C-43C-43 "(" (Strings-Prelude-C-43C-43 arg-9 (Strings-Prelude-C-43C-43 " " (Strings-Prelude-C-43C-43 (Racket-Scheme-Compiler-cToRkt e-10 e-9) ")")))) e-3)))))))))))))))
|
||||
(define Racket-Scheme-Compiler-useCC (lambda (arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7) (let ((sc0 arg-5)) (case (vector-ref sc0 0) ((0) (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 arg-4 "No recognised foreign calling convention") eta-0))) (else (let ((e-2 (vector-ref sc0 1))) (let ((e-3 (vector-ref sc0 2))) (Racket-Scheme-Compiler-case--9479-1473 e-2 e-3 arg-7 arg-6 arg-4 arg-3 arg-2 arg-1 arg-0 (Common-Compiler-parseCC e-2)))))))))
|
||||
(define Racket-Scheme-Compiler-startRacketWinSh (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "DIR=\"`realpath \"$0\"`\"" (vector 1 (Strings-Prelude-C-43C-43 "export PATH=\"`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-1 "\":$PATH\"")) (vector 1 (Strings-Prelude-C-43C-43 arg-0 (Strings-Prelude-C-43C-43 "\"" (Strings-Prelude-C-43C-43 arg-2 "\" \"$@\""))) (vector 0 ))))))))
|
||||
(define Racket-Scheme-Compiler-startRacketWinSh (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "" (vector 1 "case `uname -s` in " (vector 1 " OpenBSD|FreeBSD|NetBSD) " (vector 1 " DIR=\"`grealpath $0`\"" (vector 1 " ;; " (vector 1 " " (vector 1 " *) " (vector 1 " DIR=\"`realpath $0`\" " (vector 1 " ;; " (vector 1 "esac " (vector 1 "" (vector 1 (Strings-Prelude-C-43C-43 "export PATH=\"`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-1 "\":$PATH\"")) (vector 1 (Strings-Prelude-C-43C-43 arg-0 (Strings-Prelude-C-43C-43 "\"" (Strings-Prelude-C-43C-43 arg-2 "\" \"$@\""))) (vector 0 ))))))))))))))))))
|
||||
(define Racket-Scheme-Compiler-startRacketCmd (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "@echo off" (vector 1 "set APPDIR=%~dp0" (vector 1 (Strings-Prelude-C-43C-43 "set PATH=%APPDIR%\\" (Strings-Prelude-C-43C-43 arg-1 ";%PATH%")) (vector 1 (Strings-Prelude-C-43C-43 arg-0 (Strings-Prelude-C-43C-43 "\"" (Strings-Prelude-C-43C-43 arg-2 "\" %*"))) (vector 0 ))))))))
|
||||
(define Racket-Scheme-Compiler-startRacket (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "" (vector 1 "DIR=\"`realpath $0`\"" (vector 1 (Strings-Prelude-C-43C-43 "export LD_LIBRARY_PATH=\"$LD_LIBRARY_PATH:`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-1 "\"\"")) (vector 1 (Strings-Prelude-C-43C-43 arg-0 (Strings-Prelude-C-43C-43 "\"`dirname \"$DIR\"`\"/\"" (Strings-Prelude-C-43C-43 arg-2 "\" \"$@\""))) (vector 0 )))))))))
|
||||
(define Racket-Scheme-Compiler-startRacket (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "" (vector 1 "case `uname -s` in " (vector 1 " OpenBSD|FreeBSD|NetBSD) " (vector 1 " DIR=\"`grealpath $0`\"" (vector 1 " ;; " (vector 1 " " (vector 1 " *) " (vector 1 " DIR=\"`realpath $0`\" " (vector 1 " ;; " (vector 1 "esac " (vector 1 "" (vector 1 (Strings-Prelude-C-43C-43 "export LD_LIBRARY_PATH=\"$LD_LIBRARY_PATH:`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-1 "\"\"")) (vector 1 (Strings-Prelude-C-43C-43 arg-0 (Strings-Prelude-C-43C-43 "\"`dirname \"$DIR\"`\"/\"" (Strings-Prelude-C-43C-43 arg-2 "\" \"$@\""))) (vector 0 ))))))))))))))))))
|
||||
(define Racket-Scheme-Compiler-showRacketString (lambda (arg-0) (let ((sc0 arg-0)) (case (vector-ref sc0 0) ((0) (lambda (eta-0) eta-0)) (else (let ((e-2 (vector-ref sc0 1))) (let ((e-3 (vector-ref sc0 2))) (let ((sc1 e-2)) (cond ((equal? sc1 #\") (lambda (eta-0) (Strings-Prelude-C-43C-43 "\\\"" ((Racket-Scheme-Compiler-showRacketString e-3) eta-0))))(else (lambda (eta-0) ((Racket-Scheme-Compiler-showRacketChar e-2) ((Racket-Scheme-Compiler-showRacketString e-3) eta-0)))))))))))))
|
||||
(define Racket-Scheme-Compiler-showRacketChar (lambda (arg-0) (let ((sc0 arg-0)) (cond ((equal? sc0 #\\) (lambda (arg-1) (Strings-Prelude-C-43C-43 "\\\\" arg-1)))(else (Racket-Scheme-Compiler-case--8220-334 arg-0 (Prelude-C-124C-124 (Prelude-C-60_Ord__Char arg-0 (Prelude-chr 32)) (lambda () (Prelude-C-62_Ord__Char arg-0 (Prelude-chr 126))))))))))
|
||||
(define Racket-Scheme-Compiler-schemeCall (lambda (arg-0 arg-1 arg-2 arg-3) (let ((call (Strings-Prelude-C-43C-43 "(" (Strings-Prelude-C-43C-43 arg-1 (Strings-Prelude-C-43C-43 " " (Strings-Prelude-C-43C-43 (Name-Core-showSep " " (Prelude-map_Functor__List 'erased 'erased (lambda (eta-0) (Common-Scheme-Compiler-schName eta-0)) arg-2)) ")")))))) (let ((sc0 arg-3)) (case (vector-ref sc0 0) ((11) (lambda (eta-0) (vector 1 (Common-Scheme-Compiler-mkWorld call))))(else (lambda (eta-0) (vector 1 call))))))))
|
||||
@ -7386,9 +7386,9 @@
|
||||
(define Chez-Scheme-Compiler-n--8803-1177-applyLams (lambda (arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 arg-9) (let ((sc0 arg-9)) (case (vector-ref sc0 0) ((0) arg-8) (else (let ((e-2 (vector-ref sc0 1))) (let ((e-3 (vector-ref sc0 2))) (let ((sc1 e-2)) (case (vector-ref sc1 0) ((0) (Chez-Scheme-Compiler-n--8803-1177-applyLams arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 (Strings-Prelude-C-43C-43 "(" (Strings-Prelude-C-43C-43 arg-8 " #f)")) e-3)) (else (let ((e-6 (vector-ref sc1 1))) (Chez-Scheme-Compiler-n--8803-1177-applyLams arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 (Strings-Prelude-C-43C-43 "(" (Strings-Prelude-C-43C-43 arg-8 (Strings-Prelude-C-43C-43 " " (Strings-Prelude-C-43C-43 e-6 ")")))) e-3))))))))))))
|
||||
(define Chez-Scheme-Compiler-useCC (lambda (arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6) (let ((sc0 arg-4)) (case (vector-ref sc0 0) ((0) (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 arg-3 "No recognised foreign calling convention") eta-0))) (else (let ((e-2 (vector-ref sc0 1))) (let ((e-3 (vector-ref sc0 2))) (Chez-Scheme-Compiler-case--9252-1575 e-2 e-3 arg-6 arg-5 arg-3 arg-2 arg-1 arg-0 (Common-Compiler-parseCC e-2)))))))))
|
||||
(define Chez-Scheme-Compiler-tySpec (lambda (arg-0) (let ((sc0 arg-0)) (case (vector-ref sc0 0) ((5) (let ((e-0 (vector-ref sc0 1))) (let ((e-1 (vector-ref sc0 2))) (let ((e-3 (vector-ref sc0 4))) (let ((sc1 e-1)) (case (vector-ref sc1 0) ((1) (let ((e-4 (vector-ref sc1 1))) (let ((sc2 e-4)) (cond ((equal? sc2 "Int") (let ((sc3 e-3)) (case (vector-ref sc3 0) ((0) (lambda (eta-0) (vector 1 "int")))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0)))))) ((equal? sc2 "String") (let ((sc3 e-3)) (case (vector-ref sc3 0) ((0) (lambda (eta-0) (vector 1 "string")))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0)))))) ((equal? sc2 "Double") (let ((sc3 e-3)) (case (vector-ref sc3 0) ((0) (lambda (eta-0) (vector 1 "double")))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0)))))) ((equal? sc2 "Char") (let ((sc3 e-3)) (case (vector-ref sc3 0) ((0) (lambda (eta-0) (vector 1 "char")))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0))))))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0))))))) ((0) (let ((e-6 (vector-ref sc1 2))) (let ((sc2 e-3)) (case (vector-ref sc2 0) ((1) (let ((e-13 (vector-ref sc2 2))) (let ((sc3 e-13)) (case (vector-ref sc3 0) ((0) (Core-Core-cond 'erased (vector 1 (vector 0 (lambda () (Name-Core-C-61C-61_Eq__Name e-6 (vector 1 "Ptr"))) (lambda () (lambda (eta-0) (vector 1 "void*")))) (vector 1 (vector 0 (lambda () (Name-Core-C-61C-61_Eq__Name e-6 (vector 1 "GCPtr"))) (lambda () (lambda (eta-0) (vector 1 "void*")))) (vector 1 (vector 0 (lambda () (Name-Core-C-61C-61_Eq__Name e-6 (vector 1 "Buffer"))) (lambda () (lambda (eta-0) (vector 1 "u8*")))) (vector 0 )))) (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 e-0 (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (Name-Core-show_Show__Name e-6) " to foreign function"))) eta-0))))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0))))))) ((0) (Core-Core-cond 'erased (vector 1 (vector 0 (lambda () (Name-Core-C-61C-61_Eq__Name e-6 (vector 1 "Unit"))) (lambda () (lambda (eta-0) (vector 1 "void")))) (vector 1 (vector 0 (lambda () (Name-Core-C-61C-61_Eq__Name e-6 (vector 1 "AnyPtr"))) (lambda () (lambda (eta-0) (vector 1 "void*")))) (vector 1 (vector 0 (lambda () (Name-Core-C-61C-61_Eq__Name e-6 (vector 1 "GCAnyPtr"))) (lambda () (lambda (eta-0) (vector 1 "void*")))) (vector 0 )))) (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 e-0 (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (Name-Core-show_Show__Name e-6) " to foreign function"))) eta-0))))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0)))))))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0)))))))))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0)))))))
|
||||
(define Chez-Scheme-Compiler-startChezWinSh (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "DIR=\"`realpath \"$0\"`\"" (vector 1 (Strings-Prelude-C-43C-43 "CHEZ=$(cygpath \"" (Strings-Prelude-C-43C-43 arg-0 "\")")) (vector 1 (Strings-Prelude-C-43C-43 "export PATH=\"`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-1 "\":$PATH\"")) (vector 1 (Strings-Prelude-C-43C-43 "$CHEZ --script \"$(dirname \"$DIR\")/" (Strings-Prelude-C-43C-43 arg-2 "\" \"$@\"")) (vector 0 )))))))))
|
||||
(define Chez-Scheme-Compiler-startChezWinSh (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "" (vector 1 "case `uname -s` in " (vector 1 " OpenBSD|FreeBSD|NetBSD) " (vector 1 " DIR=\"`grealpath $0`\"" (vector 1 " ;; " (vector 1 " " (vector 1 " *) " (vector 1 " DIR=\"`realpath $0`\" " (vector 1 " ;; " (vector 1 "esac " (vector 1 "" (vector 1 (Strings-Prelude-C-43C-43 "CHEZ=$(cygpath \"" (Strings-Prelude-C-43C-43 arg-0 "\")")) (vector 1 (Strings-Prelude-C-43C-43 "export PATH=\"`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-1 "\":$PATH\"")) (vector 1 (Strings-Prelude-C-43C-43 "$CHEZ --script \"$(dirname \"$DIR\")/" (Strings-Prelude-C-43C-43 arg-2 "\" \"$@\"")) (vector 0 )))))))))))))))))))
|
||||
(define Chez-Scheme-Compiler-startChezCmd (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "@echo off" (vector 1 "set APPDIR=%~dp0" (vector 1 (Strings-Prelude-C-43C-43 "set PATH=%APPDIR%\\" (Strings-Prelude-C-43C-43 arg-1 ";%PATH%")) (vector 1 (Strings-Prelude-C-43C-43 "\"" (Strings-Prelude-C-43C-43 arg-0 (Strings-Prelude-C-43C-43 "\" --script \"%APPDIR%/" (Strings-Prelude-C-43C-43 arg-2 "\" %*")))) (vector 0 ))))))))
|
||||
(define Chez-Scheme-Compiler-startChez (lambda (arg-0 arg-1) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "" (vector 1 "DIR=\"`realpath $0`\"" (vector 1 (Strings-Prelude-C-43C-43 "export LD_LIBRARY_PATH=\"$LD_LIBRARY_PATH:`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-0 "\"\"")) (vector 1 (Strings-Prelude-C-43C-43 "\"`dirname \"$DIR\"`\"/\"" (Strings-Prelude-C-43C-43 arg-1 "\" \"$@\"")) (vector 0 )))))))))
|
||||
(define Chez-Scheme-Compiler-startChez (lambda (arg-0 arg-1) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "" (vector 1 "case `uname -s` in " (vector 1 " OpenBSD|FreeBSD|NetBSD) " (vector 1 " DIR=\"`grealpath $0`\"" (vector 1 " ;; " (vector 1 " " (vector 1 " *) " (vector 1 " DIR=\"`realpath $0`\" " (vector 1 " ;; " (vector 1 "esac " (vector 1 "" (vector 1 (Strings-Prelude-C-43C-43 "export LD_LIBRARY_PATH=\"$LD_LIBRARY_PATH:`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-0 "\"\"")) (vector 1 (Strings-Prelude-C-43C-43 "\"`dirname \"$DIR\"`\"/\"" (Strings-Prelude-C-43C-43 arg-1 "\" \"$@\"")) (vector 0 ))))))))))))))))))
|
||||
(define Chez-Scheme-Compiler-showChezString (lambda (arg-0) (let ((sc0 arg-0)) (case (vector-ref sc0 0) ((0) (lambda (eta-0) eta-0)) (else (let ((e-2 (vector-ref sc0 1))) (let ((e-3 (vector-ref sc0 2))) (let ((sc1 e-2)) (cond ((equal? sc1 #\") (lambda (eta-0) (Strings-Prelude-C-43C-43 "\\\"" ((Chez-Scheme-Compiler-showChezString e-3) eta-0))))(else (lambda (eta-0) ((Chez-Scheme-Compiler-showChezChar e-2) ((Chez-Scheme-Compiler-showChezString e-3) eta-0)))))))))))))
|
||||
(define Chez-Scheme-Compiler-showChezChar (lambda (arg-0) (let ((sc0 arg-0)) (cond ((equal? sc0 #\\) (lambda (arg-1) (Strings-Prelude-C-43C-43 "\\\\" arg-1)))(else (Chez-Scheme-Compiler-case--8090-452 arg-0 (Prelude-C-124C-124 (Prelude-C-60_Ord__Char arg-0 (Prelude-chr 32)) (lambda () (Prelude-C-62_Ord__Char arg-0 (Prelude-chr 126))))))))))
|
||||
(define Chez-Scheme-Compiler-schemeCall (lambda (arg-0 arg-1 arg-2 arg-3) (let ((call (Strings-Prelude-C-43C-43 "(" (Strings-Prelude-C-43C-43 arg-1 (Strings-Prelude-C-43C-43 " " (Strings-Prelude-C-43C-43 (Name-Core-showSep " " (Prelude-map_Functor__List 'erased 'erased (lambda (eta-0) (Common-Scheme-Compiler-schName eta-0)) arg-2)) ")")))))) (let ((sc0 arg-3)) (case (vector-ref sc0 0) ((11) (lambda (eta-0) (vector 1 (Common-Scheme-Compiler-mkWorld call))))(else (lambda (eta-0) (vector 1 call))))))))
|
||||
|
||||
@ -10,7 +10,10 @@
|
||||
(let ()
|
||||
(define (blodwen-os)
|
||||
(case (machine-type)
|
||||
[(i3le ti3le a6le ta6le) "unix"]
|
||||
[(i3le ti3le a6le ta6le) "unix"] ; GNU/Linux
|
||||
[(i3ob ti3ob a6ob ta6ob) "unix"] ; OpenBSD
|
||||
[(i3fb ti3fb a6fb ta6fb) "unix"] ; FreeBSD
|
||||
[(i3nb ti3nb a6nb ta6nb) "unix"] ; NetBSD
|
||||
[(i3osx ti3osx a6osx ta6osx) "darwin"]
|
||||
[(i3nt ti3nt a6nt ta6nt) "windows"]
|
||||
[else "unknown"]))
|
||||
@ -7305,9 +7308,9 @@
|
||||
(define Racket-Scheme-Compiler-n--8783-872-callback (lambda (arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 arg-9 arg-10 arg-11) (let ((sc0 arg-11)) (case (vector-ref sc0 0) ((10) (let ((e-0 (vector-ref sc0 1))) (let ((e-1 (vector-ref sc0 2))) (Racket-Scheme-Compiler-n--8783-872-callback arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 arg-9 (vector 1 e-0 arg-10) e-1))))(else (let ((args (List-Data-reverse 'erased arg-10))) (lambda (eta-0) (let ((act-24 ((Core-Core-traverse 'erased 'erased (lambda (eta-1) (Racket-Scheme-Compiler-cftySpec arg-4 eta-1)) (List-Data-filter 'erased (lambda (eta-1) (Racket-Scheme-Compiler-n--8783-871-notWorld arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 eta-1)) args)) eta-0))) (let ((sc0 act-24)) (case (vector-ref sc0 0) ((0) (let ((e-2 (vector-ref sc0 1))) (vector 0 e-2))) (else (let ((act-25 ((Racket-Scheme-Compiler-cftySpec arg-4 arg-11) eta-0))) (let ((sc1 act-25)) (case (vector-ref sc1 0) ((0) (let ((e-2 (vector-ref sc1 1))) (vector 0 e-2))) (else (vector 1 (Racket-Scheme-Compiler-n--8783-870-mkFun arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 args arg-11 arg-9)))))))))))))))))
|
||||
(define Racket-Scheme-Compiler-n--8783-869-applyLams (lambda (arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 arg-9 arg-10) (let ((sc0 arg-10)) (case (vector-ref sc0 0) ((0) arg-9) (else (let ((e-2 (vector-ref sc0 1))) (let ((e-3 (vector-ref sc0 2))) (let ((sc1 e-2)) (case (vector-ref sc1 0) ((0) (Racket-Scheme-Compiler-n--8783-869-applyLams arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 (Strings-Prelude-C-43C-43 "(" (Strings-Prelude-C-43C-43 arg-9 " #f)")) e-3)) (else (let ((e-6 (vector-ref sc1 1))) (let ((sc2 e-6)) (let ((e-9 (vector-ref sc2 1))) (let ((e-10 (vector-ref sc2 2))) (Racket-Scheme-Compiler-n--8783-869-applyLams arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 (Strings-Prelude-C-43C-43 "(" (Strings-Prelude-C-43C-43 arg-9 (Strings-Prelude-C-43C-43 " " (Strings-Prelude-C-43C-43 (Racket-Scheme-Compiler-cToRkt e-10 e-9) ")")))) e-3)))))))))))))))
|
||||
(define Racket-Scheme-Compiler-useCC (lambda (arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7) (let ((sc0 arg-5)) (case (vector-ref sc0 0) ((0) (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 arg-4 "No recognised foreign calling convention") eta-0))) (else (let ((e-2 (vector-ref sc0 1))) (let ((e-3 (vector-ref sc0 2))) (Racket-Scheme-Compiler-case--9479-1473 e-2 e-3 arg-7 arg-6 arg-4 arg-3 arg-2 arg-1 arg-0 (Common-Compiler-parseCC e-2)))))))))
|
||||
(define Racket-Scheme-Compiler-startRacketWinSh (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "DIR=\"`realpath \"$0\"`\"" (vector 1 (Strings-Prelude-C-43C-43 "export PATH=\"`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-1 "\":$PATH\"")) (vector 1 (Strings-Prelude-C-43C-43 arg-0 (Strings-Prelude-C-43C-43 "\"" (Strings-Prelude-C-43C-43 arg-2 "\" \"$@\""))) (vector 0 ))))))))
|
||||
(define Racket-Scheme-Compiler-startRacketWinSh (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "" (vector 1 "case `uname -s` in " (vector 1 " OpenBSD|FreeBSD|NetBSD) " (vector 1 " DIR=\"`grealpath $0`\"" (vector 1 " ;; " (vector 1 " " (vector 1 " *) " (vector 1 " DIR=\"`realpath $0`\" " (vector 1 " ;; " (vector 1 "esac " (vector 1 "" (vector 1 (Strings-Prelude-C-43C-43 "export PATH=\"`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-1 "\":$PATH\"")) (vector 1 (Strings-Prelude-C-43C-43 arg-0 (Strings-Prelude-C-43C-43 "\"" (Strings-Prelude-C-43C-43 arg-2 "\" \"$@\""))) (vector 0 ))))))))))))))))))
|
||||
(define Racket-Scheme-Compiler-startRacketCmd (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "@echo off" (vector 1 "set APPDIR=%~dp0" (vector 1 (Strings-Prelude-C-43C-43 "set PATH=%APPDIR%\\" (Strings-Prelude-C-43C-43 arg-1 ";%PATH%")) (vector 1 (Strings-Prelude-C-43C-43 arg-0 (Strings-Prelude-C-43C-43 "\"" (Strings-Prelude-C-43C-43 arg-2 "\" %*"))) (vector 0 ))))))))
|
||||
(define Racket-Scheme-Compiler-startRacket (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "" (vector 1 "DIR=\"`realpath $0`\"" (vector 1 (Strings-Prelude-C-43C-43 "export LD_LIBRARY_PATH=\"$LD_LIBRARY_PATH:`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-1 "\"\"")) (vector 1 (Strings-Prelude-C-43C-43 arg-0 (Strings-Prelude-C-43C-43 "\"`dirname \"$DIR\"`\"/\"" (Strings-Prelude-C-43C-43 arg-2 "\" \"$@\""))) (vector 0 )))))))))
|
||||
(define Racket-Scheme-Compiler-startRacket (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "" (vector 1 "case `uname -s` in " (vector 1 " OpenBSD|FreeBSD|NetBSD) " (vector 1 " DIR=\"`grealpath $0`\"" (vector 1 " ;; " (vector 1 " " (vector 1 " *) " (vector 1 " DIR=\"`realpath $0`\" " (vector 1 " ;; " (vector 1 "esac " (vector 1 "" (vector 1 (Strings-Prelude-C-43C-43 "export LD_LIBRARY_PATH=\"$LD_LIBRARY_PATH:`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-1 "\"\"")) (vector 1 (Strings-Prelude-C-43C-43 arg-0 (Strings-Prelude-C-43C-43 "\"`dirname \"$DIR\"`\"/\"" (Strings-Prelude-C-43C-43 arg-2 "\" \"$@\""))) (vector 0 ))))))))))))))))))
|
||||
(define Racket-Scheme-Compiler-showRacketString (lambda (arg-0) (let ((sc0 arg-0)) (case (vector-ref sc0 0) ((0) (lambda (eta-0) eta-0)) (else (let ((e-2 (vector-ref sc0 1))) (let ((e-3 (vector-ref sc0 2))) (let ((sc1 e-2)) (cond ((equal? sc1 #\") (lambda (eta-0) (Strings-Prelude-C-43C-43 "\\\"" ((Racket-Scheme-Compiler-showRacketString e-3) eta-0))))(else (lambda (eta-0) ((Racket-Scheme-Compiler-showRacketChar e-2) ((Racket-Scheme-Compiler-showRacketString e-3) eta-0)))))))))))))
|
||||
(define Racket-Scheme-Compiler-showRacketChar (lambda (arg-0) (let ((sc0 arg-0)) (cond ((equal? sc0 #\\) (lambda (arg-1) (Strings-Prelude-C-43C-43 "\\\\" arg-1)))(else (Racket-Scheme-Compiler-case--8220-334 arg-0 (Prelude-C-124C-124 (Prelude-C-60_Ord__Char arg-0 (Prelude-chr 32)) (lambda () (Prelude-C-62_Ord__Char arg-0 (Prelude-chr 126))))))))))
|
||||
(define Racket-Scheme-Compiler-schemeCall (lambda (arg-0 arg-1 arg-2 arg-3) (let ((call (Strings-Prelude-C-43C-43 "(" (Strings-Prelude-C-43C-43 arg-1 (Strings-Prelude-C-43C-43 " " (Strings-Prelude-C-43C-43 (Name-Core-showSep " " (Prelude-map_Functor__List 'erased 'erased (lambda (eta-0) (Common-Scheme-Compiler-schName eta-0)) arg-2)) ")")))))) (let ((sc0 arg-3)) (case (vector-ref sc0 0) ((11) (lambda (eta-0) (vector 1 (Common-Scheme-Compiler-mkWorld call))))(else (lambda (eta-0) (vector 1 call))))))))
|
||||
@ -7366,9 +7369,9 @@
|
||||
(define Chez-Scheme-Compiler-n--8803-1177-applyLams (lambda (arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 arg-8 arg-9) (let ((sc0 arg-9)) (case (vector-ref sc0 0) ((0) arg-8) (else (let ((e-2 (vector-ref sc0 1))) (let ((e-3 (vector-ref sc0 2))) (let ((sc1 e-2)) (case (vector-ref sc1 0) ((0) (Chez-Scheme-Compiler-n--8803-1177-applyLams arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 (Strings-Prelude-C-43C-43 "(" (Strings-Prelude-C-43C-43 arg-8 " #f)")) e-3)) (else (let ((e-6 (vector-ref sc1 1))) (Chez-Scheme-Compiler-n--8803-1177-applyLams arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 arg-7 (Strings-Prelude-C-43C-43 "(" (Strings-Prelude-C-43C-43 arg-8 (Strings-Prelude-C-43C-43 " " (Strings-Prelude-C-43C-43 e-6 ")")))) e-3))))))))))))
|
||||
(define Chez-Scheme-Compiler-useCC (lambda (arg-0 arg-1 arg-2 arg-3 arg-4 arg-5 arg-6) (let ((sc0 arg-4)) (case (vector-ref sc0 0) ((0) (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 arg-3 "No recognised foreign calling convention") eta-0))) (else (let ((e-2 (vector-ref sc0 1))) (let ((e-3 (vector-ref sc0 2))) (Chez-Scheme-Compiler-case--9252-1575 e-2 e-3 arg-6 arg-5 arg-3 arg-2 arg-1 arg-0 (Common-Compiler-parseCC e-2)))))))))
|
||||
(define Chez-Scheme-Compiler-tySpec (lambda (arg-0) (let ((sc0 arg-0)) (case (vector-ref sc0 0) ((5) (let ((e-0 (vector-ref sc0 1))) (let ((e-1 (vector-ref sc0 2))) (let ((e-3 (vector-ref sc0 4))) (let ((sc1 e-1)) (case (vector-ref sc1 0) ((1) (let ((e-4 (vector-ref sc1 1))) (let ((sc2 e-4)) (cond ((equal? sc2 "Int") (let ((sc3 e-3)) (case (vector-ref sc3 0) ((0) (lambda (eta-0) (vector 1 "int")))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0)))))) ((equal? sc2 "String") (let ((sc3 e-3)) (case (vector-ref sc3 0) ((0) (lambda (eta-0) (vector 1 "string")))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0)))))) ((equal? sc2 "Double") (let ((sc3 e-3)) (case (vector-ref sc3 0) ((0) (lambda (eta-0) (vector 1 "double")))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0)))))) ((equal? sc2 "Char") (let ((sc3 e-3)) (case (vector-ref sc3 0) ((0) (lambda (eta-0) (vector 1 "char")))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0))))))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0))))))) ((0) (let ((e-6 (vector-ref sc1 2))) (let ((sc2 e-3)) (case (vector-ref sc2 0) ((1) (let ((e-13 (vector-ref sc2 2))) (let ((sc3 e-13)) (case (vector-ref sc3 0) ((0) (Core-Core-cond 'erased (vector 1 (vector 0 (lambda () (Name-Core-C-61C-61_Eq__Name e-6 (vector 1 "Ptr"))) (lambda () (lambda (eta-0) (vector 1 "void*")))) (vector 1 (vector 0 (lambda () (Name-Core-C-61C-61_Eq__Name e-6 (vector 1 "GCPtr"))) (lambda () (lambda (eta-0) (vector 1 "void*")))) (vector 1 (vector 0 (lambda () (Name-Core-C-61C-61_Eq__Name e-6 (vector 1 "Buffer"))) (lambda () (lambda (eta-0) (vector 1 "u8*")))) (vector 0 )))) (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 e-0 (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (Name-Core-show_Show__Name e-6) " to foreign function"))) eta-0))))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0))))))) ((0) (Core-Core-cond 'erased (vector 1 (vector 0 (lambda () (Name-Core-C-61C-61_Eq__Name e-6 (vector 1 "Unit"))) (lambda () (lambda (eta-0) (vector 1 "void")))) (vector 1 (vector 0 (lambda () (Name-Core-C-61C-61_Eq__Name e-6 (vector 1 "AnyPtr"))) (lambda () (lambda (eta-0) (vector 1 "void*")))) (vector 1 (vector 0 (lambda () (Name-Core-C-61C-61_Eq__Name e-6 (vector 1 "GCAnyPtr"))) (lambda () (lambda (eta-0) (vector 1 "void*")))) (vector 0 )))) (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 e-0 (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (Name-Core-show_Show__Name e-6) " to foreign function"))) eta-0))))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0)))))))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0)))))))))(else (lambda (eta-0) (Core-Core-throw_Catchable__Core_Error 'erased (vector 47 (NamedCExp-CompileExpr-Core-getFC arg-0) (Strings-Prelude-C-43C-43 "Can't pass argument of type " (Strings-Prelude-C-43C-43 (CompileExpr-Core-show_Show__NamedCExp arg-0) " to foreign function"))) eta-0)))))))
|
||||
(define Chez-Scheme-Compiler-startChezWinSh (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "DIR=\"`realpath \"$0\"`\"" (vector 1 (Strings-Prelude-C-43C-43 "CHEZ=$(cygpath \"" (Strings-Prelude-C-43C-43 arg-0 "\")")) (vector 1 (Strings-Prelude-C-43C-43 "export PATH=\"`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-1 "\":$PATH\"")) (vector 1 (Strings-Prelude-C-43C-43 "$CHEZ --script \"$(dirname \"$DIR\")/" (Strings-Prelude-C-43C-43 arg-2 "\" \"$@\"")) (vector 0 )))))))))
|
||||
(define Chez-Scheme-Compiler-startChezWinSh (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "" (vector 1 "case `uname -s` in " (vector 1 " OpenBSD|FreeBSD|NetBSD) " (vector 1 " DIR=\"`grealpath $0`\"" (vector 1 " ;; " (vector 1 " " (vector 1 " *) " (vector 1 " DIR=\"`realpath $0`\" " (vector 1 " ;; " (vector 1 "esac " (vector 1 "" (vector 1 (Strings-Prelude-C-43C-43 "CHEZ=$(cygpath \"" (Strings-Prelude-C-43C-43 arg-0 "\")")) (vector 1 (Strings-Prelude-C-43C-43 "export PATH=\"`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-1 "\":$PATH\"")) (vector 1 (Strings-Prelude-C-43C-43 "$CHEZ --script \"$(dirname \"$DIR\")/" (Strings-Prelude-C-43C-43 arg-2 "\" \"$@\"")) (vector 0 )))))))))))))))))))
|
||||
(define Chez-Scheme-Compiler-startChezCmd (lambda (arg-0 arg-1 arg-2) (Strings-Data-unlines (vector 1 "@echo off" (vector 1 "set APPDIR=%~dp0" (vector 1 (Strings-Prelude-C-43C-43 "set PATH=%APPDIR%\\" (Strings-Prelude-C-43C-43 arg-1 ";%PATH%")) (vector 1 (Strings-Prelude-C-43C-43 "\"" (Strings-Prelude-C-43C-43 arg-0 (Strings-Prelude-C-43C-43 "\" --script \"%APPDIR%/" (Strings-Prelude-C-43C-43 arg-2 "\" %*")))) (vector 0 ))))))))
|
||||
(define Chez-Scheme-Compiler-startChez (lambda (arg-0 arg-1) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "" (vector 1 "DIR=\"`realpath $0`\"" (vector 1 (Strings-Prelude-C-43C-43 "export LD_LIBRARY_PATH=\"$LD_LIBRARY_PATH:`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-0 "\"\"")) (vector 1 (Strings-Prelude-C-43C-43 "\"`dirname \"$DIR\"`\"/\"" (Strings-Prelude-C-43C-43 arg-1 "\" \"$@\"")) (vector 0 )))))))))
|
||||
(define Chez-Scheme-Compiler-startChez (lambda (arg-0 arg-1) (Strings-Data-unlines (vector 1 "#!/bin/sh" (vector 1 "" (vector 1 "case `uname -s` in " (vector 1 " OpenBSD|FreeBSD|NetBSD) " (vector 1 " DIR=\"`grealpath $0`\"" (vector 1 " ;; " (vector 1 " " (vector 1 " *) " (vector 1 " DIR=\"`realpath $0`\" " (vector 1 " ;; " (vector 1 "esac " (vector 1 "" (vector 1 (Strings-Prelude-C-43C-43 "export LD_LIBRARY_PATH=\"$LD_LIBRARY_PATH:`dirname \"$DIR\"`/\"" (Strings-Prelude-C-43C-43 arg-0 "\"\"")) (vector 1 (Strings-Prelude-C-43C-43 "\"`dirname \"$DIR\"`\"/\"" (Strings-Prelude-C-43C-43 arg-1 "\" \"$@\"")) (vector 0 ))))))))))))))))))
|
||||
(define Chez-Scheme-Compiler-showChezString (lambda (arg-0) (let ((sc0 arg-0)) (case (vector-ref sc0 0) ((0) (lambda (eta-0) eta-0)) (else (let ((e-2 (vector-ref sc0 1))) (let ((e-3 (vector-ref sc0 2))) (let ((sc1 e-2)) (cond ((equal? sc1 #\") (lambda (eta-0) (Strings-Prelude-C-43C-43 "\\\"" ((Chez-Scheme-Compiler-showChezString e-3) eta-0))))(else (lambda (eta-0) ((Chez-Scheme-Compiler-showChezChar e-2) ((Chez-Scheme-Compiler-showChezString e-3) eta-0)))))))))))))
|
||||
(define Chez-Scheme-Compiler-showChezChar (lambda (arg-0) (let ((sc0 arg-0)) (cond ((equal? sc0 #\\) (lambda (arg-1) (Strings-Prelude-C-43C-43 "\\\\" arg-1)))(else (Chez-Scheme-Compiler-case--8090-452 arg-0 (Prelude-C-124C-124 (Prelude-C-60_Ord__Char arg-0 (Prelude-chr 32)) (lambda () (Prelude-C-62_Ord__Char arg-0 (Prelude-chr 126))))))))))
|
||||
(define Chez-Scheme-Compiler-schemeCall (lambda (arg-0 arg-1 arg-2 arg-3) (let ((call (Strings-Prelude-C-43C-43 "(" (Strings-Prelude-C-43C-43 arg-1 (Strings-Prelude-C-43C-43 " " (Strings-Prelude-C-43C-43 (Name-Core-showSep " " (Prelude-map_Functor__List 'erased 'erased (lambda (eta-0) (Common-Scheme-Compiler-schName eta-0)) arg-2)) ")")))))) (let ((sc0 arg-3)) (case (vector-ref sc0 0) ((11) (lambda (eta-0) (vector 1 (Common-Scheme-Compiler-mkWorld call))))(else (lambda (eta-0) (vector 1 call))))))))
|
||||
|
||||
@ -36,7 +36,6 @@ else
|
||||
SHLIB_SUFFIX := .so
|
||||
CFLAGS += -fPIC
|
||||
endif
|
||||
|
||||
export OS
|
||||
|
||||
ifeq ($(OS),bsd)
|
||||
@ -44,6 +43,7 @@ ifeq ($(OS),bsd)
|
||||
else
|
||||
MAKE := make
|
||||
endif
|
||||
export MAKE
|
||||
|
||||
# Add a custom.mk file to override any of the configurations
|
||||
-include custom.mk
|
||||
|
||||
@ -75,7 +75,7 @@ schHeader chez libs
|
||||
"(case (machine-type)\n" ++
|
||||
" [(i3le ti3le a6le ta6le) (load-shared-object \"libc.so.6\")]\n" ++
|
||||
" [(i3osx ti3osx a6osx ta6osx) (load-shared-object \"libc.dylib\")]\n" ++
|
||||
" [(i3nt ti3nt a6nt ta6nt) (load-shared-object \"msvcrt.dll\")" ++
|
||||
" [(i3nt ti3nt a6nt ta6nt) (load-shared-object \"msvcrt.dll\")" ++
|
||||
" (load-shared-object \"ws2_32.dll\")]\n" ++
|
||||
" [else (load-shared-object \"libc.so\")])\n\n" ++
|
||||
showSep "\n" (map (\x => "(load-shared-object \"" ++ escapeString x ++ "\")") libs) ++ "\n\n" ++
|
||||
@ -341,7 +341,16 @@ startChez : String -> String -> String
|
||||
startChez appdir target = unlines
|
||||
[ "#!/bin/sh"
|
||||
, ""
|
||||
, "DIR=\"`realpath $0`\""
|
||||
, "case `uname -s` in "
|
||||
, " OpenBSD|FreeBSD|NetBSD) "
|
||||
, " DIR=\"`grealpath $0`\""
|
||||
, " ;; "
|
||||
, " "
|
||||
, " *) "
|
||||
, " DIR=\"`realpath $0`\" "
|
||||
, " ;; "
|
||||
, "esac "
|
||||
, ""
|
||||
, "export LD_LIBRARY_PATH=\"$LD_LIBRARY_PATH:`dirname \"$DIR\"`/\"" ++ appdir ++ "\"\""
|
||||
, "\"`dirname \"$DIR\"`\"/\"" ++ target ++ "\" \"$@\""
|
||||
]
|
||||
@ -357,7 +366,17 @@ startChezCmd chez appdir target = unlines
|
||||
startChezWinSh : String -> String -> String -> String
|
||||
startChezWinSh chez appdir target = unlines
|
||||
[ "#!/bin/sh"
|
||||
, "DIR=\"`realpath \"$0\"`\""
|
||||
, ""
|
||||
, "case `uname -s` in "
|
||||
, " OpenBSD|FreeBSD|NetBSD) "
|
||||
, " DIR=\"`grealpath $0`\""
|
||||
, " ;; "
|
||||
, " "
|
||||
, " *) "
|
||||
, " DIR=\"`realpath $0`\" "
|
||||
, " ;; "
|
||||
, "esac "
|
||||
, ""
|
||||
, "CHEZ=$(cygpath \"" ++ chez ++"\")"
|
||||
, "export PATH=\"`dirname \"$DIR\"`/\"" ++ appdir ++ "\":$PATH\""
|
||||
, "$CHEZ --script \"$(dirname \"$DIR\")/" ++ target ++ "\" \"$@\""
|
||||
@ -440,7 +459,7 @@ compileExpr makeitso c execDir tm outfile
|
||||
logTime "Make SO" $ when makeitso $ compileToSO chez appDirGen outSsAbs
|
||||
let outShRel = execDir </> outfile
|
||||
if isWindows
|
||||
then makeShWindows chez outShRel appDirRel (if makeitso then outSoFile else outSsFile)
|
||||
then makeShWindows chez outShRel appDirRel (if makeitso then outSoFile else outSsFile)
|
||||
else makeSh outShRel appDirRel (if makeitso then outSoFile else outSsFile)
|
||||
coreLift $ chmodRaw outShRel 0o755
|
||||
pure (Just outShRel)
|
||||
|
||||
@ -314,7 +314,16 @@ startRacket : String -> String -> String -> String
|
||||
startRacket racket appdir target = unlines
|
||||
[ "#!/bin/sh"
|
||||
, ""
|
||||
, "DIR=\"`realpath $0`\""
|
||||
, "case `uname -s` in "
|
||||
, " OpenBSD|FreeBSD|NetBSD) "
|
||||
, " DIR=\"`grealpath $0`\""
|
||||
, " ;; "
|
||||
, " "
|
||||
, " *) "
|
||||
, " DIR=\"`realpath $0`\" "
|
||||
, " ;; "
|
||||
, "esac "
|
||||
, ""
|
||||
, "export LD_LIBRARY_PATH=\"$LD_LIBRARY_PATH:`dirname \"$DIR\"`/\"" ++ appdir ++ "\"\""
|
||||
, racket ++ "\"`dirname \"$DIR\"`\"/\"" ++ target ++ "\" \"$@\""
|
||||
]
|
||||
@ -330,7 +339,17 @@ startRacketCmd racket appdir target = unlines
|
||||
startRacketWinSh : String -> String -> String -> String
|
||||
startRacketWinSh racket appdir target = unlines
|
||||
[ "#!/bin/sh"
|
||||
, "DIR=\"`realpath \"$0\"`\""
|
||||
, ""
|
||||
, "case `uname -s` in "
|
||||
, " OpenBSD|FreeBSD|NetBSD) "
|
||||
, " DIR=\"`grealpath $0`\""
|
||||
, " ;; "
|
||||
, " "
|
||||
, " *) "
|
||||
, " DIR=\"`realpath $0`\" "
|
||||
, " ;; "
|
||||
, "esac "
|
||||
, ""
|
||||
, "export PATH=\"`dirname \"$DIR\"`/\"" ++ appdir ++ "\":$PATH\""
|
||||
, racket ++ "\"" ++ target ++ "\" \"$@\""
|
||||
]
|
||||
@ -384,7 +403,7 @@ compileExpr mkexec c execDir tm outfile
|
||||
coreLift $ mkdirAll appDirGen
|
||||
Just cwd <- coreLift currentDir
|
||||
| Nothing => throw (InternalError "Can't get current directory")
|
||||
|
||||
|
||||
let ext = if isWindows then ".exe" else ""
|
||||
let outRktFile = appDirRel </> outfile <.> "rkt"
|
||||
let outBinFile = appDirRel </> outfile <.> ext
|
||||
@ -424,4 +443,3 @@ executeExpr c execDir tm
|
||||
export
|
||||
codegenRacket : Codegen
|
||||
codegenRacket = MkCG (compileExpr True) executeExpr
|
||||
|
||||
|
||||
@ -1,4 +1,14 @@
|
||||
make all > /dev/null
|
||||
case `uname -s` in
|
||||
OpenBSD|FreeBSD|NetBSD)
|
||||
MAKE=gmake
|
||||
;;
|
||||
|
||||
*)
|
||||
MAKE=make
|
||||
;;
|
||||
esac
|
||||
|
||||
${MAKE} all > /dev/null
|
||||
$1 --no-banner CB.idr < input
|
||||
rm -rf build
|
||||
make clean > /dev/null
|
||||
${MAKE} clean > /dev/null
|
||||
|
||||
@ -1,4 +1,14 @@
|
||||
make all > /dev/null
|
||||
case `uname -s` in
|
||||
OpenBSD|FreeBSD|NetBSD)
|
||||
MAKE=gmake
|
||||
;;
|
||||
|
||||
*)
|
||||
MAKE=make
|
||||
;;
|
||||
esac
|
||||
|
||||
${MAKE} all > /dev/null
|
||||
$1 --no-banner Struct.idr < input
|
||||
rm -rf build
|
||||
make clean > /dev/null
|
||||
${MAKE} clean > /dev/null
|
||||
|
||||
@ -1,4 +1,14 @@
|
||||
make all > /dev/null
|
||||
case `uname -s` in
|
||||
OpenBSD|FreeBSD|NetBSD)
|
||||
MAKE=gmake
|
||||
;;
|
||||
|
||||
*)
|
||||
MAKE=make
|
||||
;;
|
||||
esac
|
||||
|
||||
${MAKE} all > /dev/null
|
||||
$1 --no-banner usealloc.idr < input
|
||||
rm -rf build
|
||||
make clean > /dev/null
|
||||
${MAKE} clean > /dev/null
|
||||
|
||||
Loading…
Reference in New Issue
Block a user