From 4f0c262ddc2862d3c3480205607a8e1c66d4faf4 Mon Sep 17 00:00:00 2001 From: Kamil Shakirov Date: Wed, 17 Jun 2020 15:14:54 +0600 Subject: [PATCH 1/4] Add support for OpenBSD and probably for other *BSD operating systems with minor tweaks --- INSTALL.md | 6 ++++++ bootstrap-rkt.sh | 18 ++++++++++++++---- bootstrap.sh | 18 ++++++++++++++---- bootstrap/idris2-boot | 12 +++++++++++- bootstrap/idris2-rktboot | 12 +++++++++++- bootstrap/idris2_app/idris2.rkt | 8 ++++---- bootstrap/idris2_app/idris2.ss | 13 ++++++++----- src/Compiler/Scheme/Chez.idr | 27 +++++++++++++++++++++++---- src/Compiler/Scheme/Racket.idr | 26 ++++++++++++++++++++++---- tests/chez/chez010/run | 14 ++++++++++++-- tests/chez/chez013/run | 14 ++++++++++++-- tests/chez/chez022/run | 14 ++++++++++++-- 12 files changed, 149 insertions(+), 33 deletions(-) diff --git a/INSTALL.md b/INSTALL.md index 78f4311e7..a22cda464 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -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 ----------------- diff --git a/bootstrap-rkt.sh b/bootstrap-rkt.sh index 9ecc0f302..f6e02e3b5 100644 --- a/bootstrap-rkt.sh +++ b/bootstrap-rkt.sh @@ -41,8 +41,18 @@ IDRIS2_BOOT_PATH="${BOOT_PATH_BASE}/prelude${SEP}${BOOT_PATH_BASE}/base${SEP}${B # Otherwise, we get 'git: Bad address' echo ${PREFIX} +case `uname -s` in + OpenBSD|FreeBSD|NetBSD) + MAKE=gmake + ;; + + *) + MAKE=make + ;; +esac + 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} diff --git a/bootstrap.sh b/bootstrap.sh index c2141b1df..83ca85d3e 100644 --- a/bootstrap.sh +++ b/bootstrap.sh @@ -46,8 +46,18 @@ 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} +case `uname -s` in + OpenBSD|FreeBSD|NetBSD) + MAKE=gmake + ;; + + *) + MAKE=make + ;; +esac + +${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} diff --git a/bootstrap/idris2-boot b/bootstrap/idris2-boot index 89b907b10..6e4242835 100755 --- a/bootstrap/idris2-boot +++ b/bootstrap/idris2-boot @@ -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" "$@" diff --git a/bootstrap/idris2-rktboot b/bootstrap/idris2-rktboot index 9f4e28eda..ff922cdd1 100755 --- a/bootstrap/idris2-rktboot +++ b/bootstrap/idris2-rktboot @@ -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" "$@" diff --git a/bootstrap/idris2_app/idris2.rkt b/bootstrap/idris2_app/idris2.rkt index 5518379ec..c3d09aa1a 100755 --- a/bootstrap/idris2_app/idris2.rkt +++ b/bootstrap/idris2_app/idris2.rkt @@ -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)))))))) diff --git a/bootstrap/idris2_app/idris2.ss b/bootstrap/idris2_app/idris2.ss index a31ec8283..0bba4c5a6 100755 --- a/bootstrap/idris2_app/idris2.ss +++ b/bootstrap/idris2_app/idris2.ss @@ -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)))))))) diff --git a/src/Compiler/Scheme/Chez.idr b/src/Compiler/Scheme/Chez.idr index 961a209f5..7525efc41 100644 --- a/src/Compiler/Scheme/Chez.idr +++ b/src/Compiler/Scheme/Chez.idr @@ -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) diff --git a/src/Compiler/Scheme/Racket.idr b/src/Compiler/Scheme/Racket.idr index e0df66119..e5f207d2b 100644 --- a/src/Compiler/Scheme/Racket.idr +++ b/src/Compiler/Scheme/Racket.idr @@ -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 - diff --git a/tests/chez/chez010/run b/tests/chez/chez010/run index 7885df0df..2b7f55e95 100755 --- a/tests/chez/chez010/run +++ b/tests/chez/chez010/run @@ -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 diff --git a/tests/chez/chez013/run b/tests/chez/chez013/run index bfff3ec61..0ce0a1119 100755 --- a/tests/chez/chez013/run +++ b/tests/chez/chez013/run @@ -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 diff --git a/tests/chez/chez022/run b/tests/chez/chez022/run index f15c064a9..d422196d9 100755 --- a/tests/chez/chez022/run +++ b/tests/chez/chez022/run @@ -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 From 4ca80ab7b0979128e2eb2886dbbd401f2af0af92 Mon Sep 17 00:00:00 2001 From: Kamil Shakirov Date: Wed, 17 Jun 2020 15:43:50 +0600 Subject: [PATCH 2/4] Refactor bootstrap scripts --- bootstrap-rkt.sh | 11 ----------- bootstrap.sh | 11 ----------- 2 files changed, 22 deletions(-) diff --git a/bootstrap-rkt.sh b/bootstrap-rkt.sh index f6e02e3b5..e6efc47af 100644 --- a/bootstrap-rkt.sh +++ b/bootstrap-rkt.sh @@ -40,17 +40,6 @@ 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} - -case `uname -s` in - OpenBSD|FreeBSD|NetBSD) - MAKE=gmake - ;; - - *) - MAKE=make - ;; -esac - 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} diff --git a/bootstrap.sh b/bootstrap.sh index 83ca85d3e..110f0e11d 100644 --- a/bootstrap.sh +++ b/bootstrap.sh @@ -46,17 +46,6 @@ 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} - -case `uname -s` in - OpenBSD|FreeBSD|NetBSD) - MAKE=gmake - ;; - - *) - MAKE=make - ;; -esac - ${MAKE} libs SCHEME=${SCHEME} PREFIX=${PREFIX} ${MAKE} install SCHEME=${SCHEME} PREFIX=${PREFIX} ${MAKE} clean IDRIS2_BOOT=${PREFIX}/bin/idris2 From fdb106a787069358c439c9f38c94e08f940c27ba Mon Sep 17 00:00:00 2001 From: Kamil Shakirov Date: Wed, 17 Jun 2020 15:48:18 +0600 Subject: [PATCH 3/4] Pass MAKE variable --- Makefile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Makefile b/Makefile index 819c64dd9..374f63fea 100644 --- a/Makefile +++ b/Makefile @@ -146,6 +146,7 @@ else endif SCHEME=${SCHEME} \ IDRIS2_VERSION=${IDRIS2_VERSION} \ + MAKE=${MAKE} \ sh ./bootstrap.sh # Bootstrapping using racket @@ -160,6 +161,7 @@ else sed -i 's|__PREFIX__|${IDRIS2_CURDIR}/bootstrap|g' bootstrap/idris2_app/idris2-boot.rkt endif IDRIS2_VERSION=${IDRIS2_VERSION} \ + MAKE=${MAKE} \ sh ./bootstrap-rkt.sh bootstrap-test: From 52cdc7a26fdbebd759bb0ee7482994839bbe2933 Mon Sep 17 00:00:00 2001 From: Kamil Shakirov Date: Wed, 17 Jun 2020 18:22:09 +0600 Subject: [PATCH 4/4] Do not supply already exported variables to bootstrap scripts --- Makefile | 5 ----- config.mk | 2 +- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/Makefile b/Makefile index 374f63fea..aab3159ce 100644 --- a/Makefile +++ b/Makefile @@ -144,9 +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} \ - MAKE=${MAKE} \ sh ./bootstrap.sh # Bootstrapping using racket @@ -160,8 +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} \ - MAKE=${MAKE} \ sh ./bootstrap-rkt.sh bootstrap-test: diff --git a/config.mk b/config.mk index 9c7148730..a3f6b83ee 100644 --- a/config.mk +++ b/config.mk @@ -36,7 +36,6 @@ else SHLIB_SUFFIX := .so CFLAGS += -fPIC endif - export OS ifeq ($(OS),bsd) @@ -44,3 +43,4 @@ ifeq ($(OS),bsd) else MAKE := make endif +export MAKE