mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
Merge pull request #4864 from unisonweb/fix/jit-cloud-tests
Some jit fixes for cloud tests
This commit is contained in:
commit
41046d599a
2
.github/workflows/ci.md
vendored
2
.github/workflows/ci.md
vendored
@ -9,7 +9,7 @@ At a high level, the CI process is:
|
||||
Some version numbers that are used during CI:
|
||||
- `ormolu_version: "0.5.0.1"`
|
||||
- `racket_version: "8.7"`
|
||||
- `jit_version: "@unison/internal/releases/0.0.11"`
|
||||
- `jit_version: "@unison/internal/releases/0.0.14"`
|
||||
|
||||
Some cached directories:
|
||||
- `ucm_local_bin` a temp path for caching a built `ucm`
|
||||
|
2
.github/workflows/ci.yaml
vendored
2
.github/workflows/ci.yaml
vendored
@ -21,7 +21,7 @@ env:
|
||||
ormolu_version: "0.5.2.0"
|
||||
racket_version: "8.7"
|
||||
ucm_local_bin: "ucm-local-bin"
|
||||
jit_version: "@unison/internal/releases/0.0.13"
|
||||
jit_version: "@unison/internal/releases/0.0.14"
|
||||
jit_src_scheme: "unison-jit-src/scheme-libs/racket"
|
||||
jit_dist: "unison-jit-dist"
|
||||
jit_generator_os: ubuntu-20.04
|
||||
|
@ -81,6 +81,7 @@
|
||||
exn:bug?
|
||||
exn:bug->exception
|
||||
exception->string
|
||||
raise-unison-exception
|
||||
|
||||
request
|
||||
request-case
|
||||
@ -565,7 +566,10 @@
|
||||
[0 (f)
|
||||
(control ref-exception:typelink k
|
||||
(let ([disp (describe-value f)])
|
||||
(raise (make-exn:bug "builtin.bug" disp))))]]))
|
||||
(raise
|
||||
(make-exn:bug
|
||||
(string->chunked-string "builtin.bug")
|
||||
disp))))]]))
|
||||
|
||||
(begin-encourage-inline
|
||||
(define mask64 #xffffffffffffffff)
|
||||
@ -594,3 +598,14 @@
|
||||
(if (and (fixnum? n) (exact-nonnegative-integer? n)) n
|
||||
(modulo n bit64))))
|
||||
|
||||
(define (raise-unison-exception ty msg val)
|
||||
(request
|
||||
ref-exception:typelink
|
||||
0
|
||||
(ref-failure-failure ty msg (unison-any-any val))))
|
||||
|
||||
(define (exn:bug->exception b)
|
||||
(raise-unison-exception
|
||||
ref-runtimefailure:typelink
|
||||
(exn:bug-msg b)
|
||||
(exn:bug-val b)))
|
||||
|
@ -5,129 +5,191 @@
|
||||
; implements all the functions we'd want. This library exports the
|
||||
; desired functionality on top of an unsafe in-place freeze
|
||||
; re-exported from the (unison core) module.
|
||||
#!r6rs
|
||||
(library (unison bytevector)
|
||||
(export
|
||||
freeze-bytevector!
|
||||
ibytevector-drop
|
||||
ibytevector-take
|
||||
ibytevector-append
|
||||
bytevector-u8-ref
|
||||
bytevector-u16-ref
|
||||
bytevector-u24-ref
|
||||
bytevector-u32-ref
|
||||
bytevector-u40-ref
|
||||
bytevector-u48-ref
|
||||
bytevector-u56-ref
|
||||
bytevector-u64-ref
|
||||
u8-list->ibytevector
|
||||
b32d
|
||||
b32hd
|
||||
base32-string->ibytevector)
|
||||
#lang racket/base
|
||||
|
||||
(import (rnrs)
|
||||
(unison core))
|
||||
(provide
|
||||
freeze-bytevector!
|
||||
ibytevector-drop
|
||||
ibytevector-take
|
||||
ibytevector-append
|
||||
bytevector-u8-ref
|
||||
bytevector-u16-ref
|
||||
bytevector-u24-ref
|
||||
bytevector-u32-ref
|
||||
bytevector-u40-ref
|
||||
bytevector-u48-ref
|
||||
bytevector-u56-ref
|
||||
bytevector-u64-ref
|
||||
u8-list->ibytevector
|
||||
bytevector->base32-string
|
||||
base32-string->ibytevector)
|
||||
|
||||
(define (ibytevector-drop n bs)
|
||||
(let* ([l (bytevector-length bs)]
|
||||
[k (max 0 (- l n))]
|
||||
[br (make-bytevector k)])
|
||||
(bytevector-copy! bs n br 0 k)
|
||||
(freeze-bytevector! br)))
|
||||
(require
|
||||
racket
|
||||
racket/fixnum
|
||||
(only-in racket/unsafe/ops
|
||||
unsafe-bytes->immutable-bytes!)
|
||||
(only-in rnrs
|
||||
div
|
||||
mod
|
||||
div-and-mod
|
||||
bytevector-u8-ref
|
||||
bytevector-u16-ref
|
||||
bytevector-u32-ref
|
||||
bytevector-u64-ref))
|
||||
|
||||
(define (ibytevector-take n bs)
|
||||
(let* ([sz (min n (bytevector-length bs))]
|
||||
[br (make-bytevector sz)])
|
||||
(bytevector-copy! bs 0 br 0 sz)
|
||||
(freeze-bytevector! br)))
|
||||
(define freeze-bytevector! unsafe-bytes->immutable-bytes!)
|
||||
|
||||
(define (ibytevector-append l r)
|
||||
(freeze-bytevector! (bytevector-append l r)))
|
||||
(define (ibytevector-drop n bs)
|
||||
(let* ([l (bytes-length bs)]
|
||||
[k (max 0 (- l n))]
|
||||
[br (make-bytes k)])
|
||||
(bytes-copy! br 0 bs n k)
|
||||
(unsafe-bytes->immutable-bytes! br)))
|
||||
|
||||
(define (u8-list->ibytevector l)
|
||||
(freeze-bytevector! (u8-list->bytevector l)))
|
||||
(define (ibytevector-take n bs)
|
||||
(let* ([sz (min n (bytes-length bs))]
|
||||
[br (make-bytes sz)])
|
||||
(bytes-copy br 0 bs 0 sz)
|
||||
(unsafe-bytes->immutable-bytes! br)))
|
||||
|
||||
(define (bytevector-u24-ref bs n end)
|
||||
(let ([v16 (bytevector-u16-ref bs n end)]
|
||||
[v8 (bytevector-u8-ref bs (+ n 2))])
|
||||
(case end
|
||||
[big (fxior v8 (fxarithmetic-shift-left v16 8))]
|
||||
[little (fxior v16 (fxarithmetic-shift-left v8 16))])))
|
||||
(define (ibytevector-append l r)
|
||||
(unsafe-bytes->immutable-bytes! (bytes-append l r)))
|
||||
|
||||
(define (bytevector-u40-ref bs n end)
|
||||
(let ([v32 (bytevector-u32-ref bs n end)]
|
||||
[v8 (bytevector-u8-ref bs (+ n 4))])
|
||||
(case end
|
||||
[big (fxior v8 (fxarithmetic-shift-left v32 8))]
|
||||
[small (fxior v32 (fxarithmetic-shift-left v8 32))])))
|
||||
(define (u8-list->ibytevector l)
|
||||
(unsafe-bytes->immutable-bytes! (list->bytes l)))
|
||||
|
||||
(define (bytevector-u48-ref bs n end)
|
||||
(let ([v32 (bytevector-u32-ref bs n end)]
|
||||
[v16 (bytevector-u16-ref bs (+ n 4) end)])
|
||||
(case end
|
||||
[big (fxior v16 (fxarithmetic-shift-left v32 8))]
|
||||
[small (fxior v32 (fxarithmetic-shift-left v16 32))])))
|
||||
(define (bytevector-u24-ref bs n end)
|
||||
(let ([v16 (bytevector-u16-ref bs n end)]
|
||||
[v8 (bytevector-u8-ref bs (+ n 2))])
|
||||
(case end
|
||||
[(big) (fxior v8 (fxlshift v16 8))]
|
||||
[(little) (fxior v16 (fxlshift v8 16))])))
|
||||
|
||||
(define (bytevector-u56-ref bs n end)
|
||||
(let ([v32 (bytevector-u32-ref bs n end)]
|
||||
[v16 (bytevector-u16-ref bs (+ n 4) end)]
|
||||
[v8 (bytevector-u8-ref bs (+ n 6))])
|
||||
(case end
|
||||
[big (fxior v8
|
||||
(fxarithmetic-shift-left v16 8)
|
||||
(fxarithmetic-shift-left v32 24))]
|
||||
[small (fxior v32
|
||||
(fxarithmetic-shift-left v16 32)
|
||||
(fxarithmetic-shift-left v8 48))])))
|
||||
(define (bytevector-u40-ref bs n end)
|
||||
(let ([v32 (bytevector-u32-ref bs n end)]
|
||||
[v8 (bytevector-u8-ref bs (+ n 4))])
|
||||
(case end
|
||||
[(big) (fxior v8 (fxlshift v32 8))]
|
||||
[(small) (fxior v32 (fxlshift v8 32))])))
|
||||
|
||||
(define (b32d c)
|
||||
(let ([n (char->integer c)])
|
||||
(define (bytevector-u48-ref bs n end)
|
||||
(let ([v32 (bytevector-u32-ref bs n end)]
|
||||
[v16 (bytevector-u16-ref bs (+ n 4) end)])
|
||||
(case end
|
||||
[(big) (fxior v16 (fxlshift v32 8))]
|
||||
[(small) (fxior v32 (fxlshift v16 32))])))
|
||||
|
||||
(define (bytevector-u56-ref bs n end)
|
||||
(let ([v32 (bytevector-u32-ref bs n end)]
|
||||
[v16 (bytevector-u16-ref bs (+ n 4) end)]
|
||||
[v8 (bytevector-u8-ref bs (+ n 6))])
|
||||
(case end
|
||||
[(big) (fxior v8
|
||||
(fxlshift v16 8)
|
||||
(fxlshift v32 24))]
|
||||
[(small) (fxior v32
|
||||
(fxlshift v16 32)
|
||||
(fxlshift v8 48))])))
|
||||
|
||||
(define (b32d c)
|
||||
(let ([n (char->integer c)])
|
||||
(cond
|
||||
[(and (<= 65 n) (<= n 90)) (- n 65)]
|
||||
[(and (<= 97 n) (<= n 122)) (- n 97)]
|
||||
[(and (<= 50 n) (<= n 55)) (- n 24)])))
|
||||
|
||||
(define (b32hd c)
|
||||
(let ([n (char->integer c)])
|
||||
(cond
|
||||
[(and (<= 48 n) (<= n 57)) (- n 48)]
|
||||
[(and (<= 65 n) (<= n 86)) (- n 65)]
|
||||
[(and (<= 97 n) (<= n 118)) (- n 97)])))
|
||||
|
||||
(define (base32-string->ibytevector str #:alphabet [alphabet 'standard])
|
||||
(define decode
|
||||
(match alphabet
|
||||
[hex b32hd]
|
||||
[standard b32d]))
|
||||
|
||||
(define (main ilen)
|
||||
(let* ([olen (div (* ilen 5) 8)]
|
||||
[out (make-bytes olen)])
|
||||
|
||||
(define (fill n k o)
|
||||
(when (>= k 0)
|
||||
(let ([m (fxand n 255)])
|
||||
(bytes-set! out (+ o k) m)
|
||||
(fill (fxrshift n 8) (- k 1) o))))
|
||||
|
||||
(define (fixup i)
|
||||
(if (= i 0) (values 0 -1)
|
||||
(let* ([chars (+ 1 (mod (- i 1) 8))])
|
||||
(div-and-mod (* 5 chars) 8))))
|
||||
|
||||
(let rec ([acc 0] [i 0] [o 0])
|
||||
(cond
|
||||
[(>= i ilen)
|
||||
(let-values ([(k n) (fixup i)])
|
||||
(fill (fxrshift acc n) (- k 1) o)
|
||||
(unsafe-bytes->immutable-bytes! out))]
|
||||
[(and (> i 0) (= 0 (mod i 8)))
|
||||
(fill acc 4 o)
|
||||
(rec (decode (string-ref str i)) (+ i 1) (+ o 5))]
|
||||
[else
|
||||
(let ([sacc (fxlshift acc 5)]
|
||||
[bits (decode (string-ref str i))])
|
||||
(rec (fxior sacc bits) (+ i 1) o))]))))
|
||||
|
||||
(let search ([i (- (string-length str) 1)])
|
||||
(if (and (>= i 0) (eq? (string-ref str i) #\=))
|
||||
(search (- i 1))
|
||||
(main (+ i 1)))))
|
||||
|
||||
; code should convert 5-bit numbers to the corresponding character
|
||||
(define (bytevector->base32-string bs #:alphabet [alphabet 'standard])
|
||||
(define code
|
||||
(match alphabet
|
||||
[hex b32h]
|
||||
[standard b32]))
|
||||
|
||||
(let* ([ilen (bytes-length bs)]
|
||||
[olen (* 8 (div (+ ilen 4) 5))]
|
||||
[out (make-string olen #\=)])
|
||||
|
||||
(define (fill n k o)
|
||||
(if (>= k 0)
|
||||
(let ([m (fxand n 31)])
|
||||
(string-set! out (+ o k) (code m))
|
||||
(fill (fxrshift n 5) (- k 1) o))
|
||||
#f))
|
||||
|
||||
(define (fixup i)
|
||||
(if (= i 0) (values 0 -1)
|
||||
(let ([bys (+ 1 (mod (- i 1) 5))])
|
||||
(let-values ([(d m) (div-and-mod (* 8 bys) 5)])
|
||||
(if (= m 0) (values m (- d 1))
|
||||
(values (- 5 m) d))))))
|
||||
|
||||
(let rec ([acc 0] [i 0] [o 0])
|
||||
(cond
|
||||
[(and (<= 65 n) (<= n 90)) (- n 65)]
|
||||
[(and (<= 97 n) (<= n 122)) (- n 97)]
|
||||
[(and (<= 50 n) (<= n 55)) (- n 24)])))
|
||||
[(>= i ilen)
|
||||
(let-values ([(n k) (fixup i)])
|
||||
(fill (fxlshift acc n) k o)
|
||||
out)]
|
||||
[(and (> i 0) (= 0 (mod i 5)))
|
||||
(fill acc 7 o)
|
||||
(rec (bytes-ref bs i) (+ i 1) (+ o 8))]
|
||||
[else
|
||||
(let ([sacc (fxlshift acc 8)]
|
||||
[by (bytes-ref bs i)])
|
||||
(rec (fxior sacc by) (+ i 1) o))]))))
|
||||
|
||||
(define (b32hd c)
|
||||
(let ([n (char->integer c)])
|
||||
(cond
|
||||
[(and (<= 48 n) (<= n 57)) (- n 48)]
|
||||
[(and (<= 65 n) (<= n 86)) (- n 65)]
|
||||
[(and (<= 97 n) (<= n 118)) (- n 97)])))
|
||||
; 65 = #\A
|
||||
; 24 = #\2 - 26
|
||||
(define (b32 n) (integer->char (+ n (if (< n 26) 65 24))))
|
||||
|
||||
(define (base32-string->ibytevector decode str)
|
||||
(define (main ilen)
|
||||
(let* ([olen (div (* ilen 5) 8)]
|
||||
[out (make-bytevector olen)])
|
||||
; 48 = #\0
|
||||
; 87 = #\a - 10
|
||||
(define (b32h n) (integer->char (+ n (if (< n 10) 48 87))))
|
||||
|
||||
(define (fill n k o)
|
||||
(if (>= k 0)
|
||||
(let ([m (fxand n 255)])
|
||||
(bytevector-u8-set! out (+ o k) m)
|
||||
(fill (fxarithmetic-shift-right n 8) (- k 1) o))))
|
||||
|
||||
(define (fixup i)
|
||||
(if (= i 0) (values 0 -1)
|
||||
(let ([chars (+ 1 (mod (- i 1) 8))])
|
||||
(div-and-mod (* 5 chars) 8))))
|
||||
|
||||
(let rec ([acc 0] [i 0] [o 0])
|
||||
(cond
|
||||
[(>= i ilen)
|
||||
(let-values ([(k n) (fixup i)])
|
||||
(fill (fxarithmetic-shift-right acc n) (- k 1) o)
|
||||
(freeze-bytevector! out))]
|
||||
[(and (> i 0) (= 0 (mod i 8)))
|
||||
(fill acc 4 o)
|
||||
(rec (decode (string-ref str i)) (+ i 1) (+ o 5))]
|
||||
[else
|
||||
(let ([sacc (fxarithmetic-shift-left acc 5)]
|
||||
[bits (decode (string-ref str i))])
|
||||
(rec (fxior sacc bits) (+ i 1) o))]))))
|
||||
|
||||
(let search ([i (- (string-length str) 1)])
|
||||
(if (and (>= i 0) (eq? (string-ref str i) #\=))
|
||||
(search (- i 1))
|
||||
(main (+ i 1)))))
|
||||
|
||||
|
||||
)
|
||||
|
@ -12,8 +12,7 @@
|
||||
promise-try-read
|
||||
fork
|
||||
kill
|
||||
sleep
|
||||
try-eval)
|
||||
sleep)
|
||||
|
||||
(import (rnrs)
|
||||
(rnrs records syntactic)
|
||||
@ -37,13 +36,7 @@
|
||||
sleep
|
||||
printf
|
||||
with-handlers
|
||||
exn:break?
|
||||
exn:fail?
|
||||
exn:fail:read?
|
||||
exn:fail:filesystem?
|
||||
exn:fail:network?
|
||||
exn:fail:contract:divide-by-zero?
|
||||
exn:fail:contract:non-fixnum-result?)
|
||||
exn:break?)
|
||||
(box ref-new)
|
||||
(unbox ref-read)
|
||||
(set-box! ref-write)
|
||||
@ -96,46 +89,4 @@
|
||||
(define (kill threadId)
|
||||
(break-thread threadId)
|
||||
(right unit))
|
||||
|
||||
(define (exn:io? e)
|
||||
(or (exn:fail:read? e)
|
||||
(exn:fail:filesystem? e)
|
||||
(exn:fail:network? e)))
|
||||
|
||||
(define (exn:arith? e)
|
||||
(or (exn:fail:contract:divide-by-zero? e)
|
||||
(exn:fail:contract:non-fixnum-result? e)))
|
||||
|
||||
(define (try-eval thunk)
|
||||
(with-handlers
|
||||
([exn:break?
|
||||
(lambda (e)
|
||||
(exception
|
||||
ref-threadkilledfailure:typelink
|
||||
(string->chunked-string "thread killed")
|
||||
ref-unit-unit))]
|
||||
[exn:io?
|
||||
(lambda (e)
|
||||
(exception
|
||||
ref-iofailure:typelink
|
||||
(exception->string e) ref-unit-unit))]
|
||||
[exn:arith?
|
||||
(lambda (e)
|
||||
(exception
|
||||
ref-arithfailure:typelink
|
||||
(exception->string e)
|
||||
ref-unit-unit))]
|
||||
[exn:bug? (lambda (e) (exn:bug->exception e))]
|
||||
[exn:fail?
|
||||
(lambda (e)
|
||||
(exception
|
||||
ref-runtimefailure:typelink
|
||||
(exception->string e)
|
||||
ref-unit-unit))]
|
||||
[(lambda (x) #t)
|
||||
(lambda (e)
|
||||
(exception
|
||||
ref-miscfailure:typelink
|
||||
(exception->string e)
|
||||
ref-unit-unit))])
|
||||
(right (thunk)))))
|
||||
)
|
||||
|
@ -20,10 +20,7 @@
|
||||
|
||||
exception->string
|
||||
|
||||
exn:bug
|
||||
make-exn:bug
|
||||
exn:bug?
|
||||
exn:bug->exception
|
||||
(struct-out exn:bug)
|
||||
|
||||
let-marks
|
||||
ref-mark
|
||||
@ -46,15 +43,10 @@
|
||||
decode-value
|
||||
describe-value
|
||||
|
||||
bytevector->base32-string
|
||||
b32
|
||||
b32h
|
||||
|
||||
bytevector->string/utf-8
|
||||
string->bytevector/utf-8)
|
||||
|
||||
(require
|
||||
racket/base
|
||||
(rename-in (only-in racket
|
||||
current-inexact-milliseconds
|
||||
directory-list
|
||||
@ -73,6 +65,7 @@
|
||||
path->string
|
||||
match
|
||||
match*
|
||||
string-append*
|
||||
for/fold)
|
||||
(string-copy! racket-string-copy!)
|
||||
(bytes-append bytevector-append)
|
||||
@ -83,6 +76,7 @@
|
||||
racket/exn
|
||||
(only-in racket/fixnum fl->fx fx- fxand fxlshift fxrshift fxior)
|
||||
racket/unsafe/ops
|
||||
unison/bytevector
|
||||
unison/data
|
||||
unison/data-info
|
||||
unison/chunked-seq)
|
||||
@ -108,48 +102,6 @@
|
||||
(string-set! out (+ o 1) (b16 c1))
|
||||
(rec (+ i 1) (+ o 2)))]))))
|
||||
|
||||
; code should convert 5-bit numbers to the corresponding character
|
||||
(define (bytevector->base32-string code bs)
|
||||
(let* ([ilen (bytes-length bs)]
|
||||
[olen (* 8 (div (+ ilen 4) 5))]
|
||||
[out (make-string olen #\=)])
|
||||
|
||||
(define (fill n k o)
|
||||
(if (>= k 0)
|
||||
(let ([m (fxand n 31)])
|
||||
(string-set! out (+ o k) (code m))
|
||||
(fill (fxrshift n 5) (- k 1) o))
|
||||
#f))
|
||||
|
||||
(define (fixup i)
|
||||
(if (= i 0) (values 0 -1)
|
||||
(let ([bys (+ 1 (mod (- i 1) 5))])
|
||||
(let-values ([(d m) (div-and-mod (* 8 bys) 5)])
|
||||
(if (= m 0) (values m (- d 1))
|
||||
(values (- 5 m) d))))))
|
||||
|
||||
(let rec ([acc 0] [i 0] [o 0])
|
||||
(cond
|
||||
[(>= i ilen)
|
||||
(let-values ([(n k) (fixup i)])
|
||||
(fill (fxlshift acc n) k o)
|
||||
out)]
|
||||
[(and (> i 0) (= 0 (mod i 5)))
|
||||
(fill acc 7 o)
|
||||
(rec (bytes-ref bs i) (+ i 1) (+ o 8))]
|
||||
[else
|
||||
(let ([sacc (fxlshift acc 8)]
|
||||
[by (bytes-ref bs i)])
|
||||
(rec (fxior sacc by) (+ i 1) o))]))))
|
||||
|
||||
; 65 = #\A
|
||||
; 24 = #\2 - 26
|
||||
(define (b32 n) (integer->char (+ n (if (< n 26) 65 24))))
|
||||
|
||||
; 48 = #\0
|
||||
; 87 = #\a - 10
|
||||
(define (b32h n) (integer->char (+ n (if (< n 10) 48 87))))
|
||||
|
||||
|
||||
(define (describe-list op cl l)
|
||||
(let rec ([pre (string op)] [post (string op cl)] [cur l])
|
||||
@ -164,7 +116,7 @@
|
||||
(define (describe-list-br l) (describe-list #\{ #\} l))
|
||||
|
||||
(define (describe-hash h)
|
||||
(substring (bytevector->base32-string b32h h) 0 8))
|
||||
(substring (bytevector->base32-string h #:alphabet 'hex) 0 8))
|
||||
|
||||
(define (describe-derived h i)
|
||||
(let ([th (describe-hash h)]
|
||||
@ -183,7 +135,7 @@
|
||||
[(unison-termlink-derived hash i) (describe-derived hash i)]))
|
||||
|
||||
(define (describe-bytes bs)
|
||||
(let* ([s (bytevector->base32-string b32h bs)]
|
||||
(let* ([s (bytevector->base32-string bs #:alphabet 'hex)]
|
||||
[l (string-length s)]
|
||||
[sfx (if (<= l 10) "" "...")])
|
||||
(string-append "32x" (substring s 0 10) sfx)))
|
||||
@ -216,6 +168,9 @@
|
||||
[else
|
||||
(format-non-tuple (cons tup acc))])))
|
||||
|
||||
(define (describe-applied f args)
|
||||
(string-append f " "))
|
||||
|
||||
(define (describe-value x)
|
||||
(match x
|
||||
[(unison-sum t fs)
|
||||
@ -229,22 +184,26 @@
|
||||
(let ([tt (number->string t)]
|
||||
[rt (describe-ref r)]
|
||||
[vs (describe-list-br fs)])
|
||||
(string-append "Data " rt " " tt " " vs))]
|
||||
(string-append "{Data " rt " " tt " " vs "}"))]
|
||||
[(unison-pure v)
|
||||
(string-append "Pure " (describe-list-br (list v)))]
|
||||
[(unison-termlink-con r t)
|
||||
(let ([rt (describe-ref r)]
|
||||
[tt (number->string t)])
|
||||
(string-append "{Con " r " " t "}"))]
|
||||
[(unison-termlink-builtin name) (string-append "##" name)]
|
||||
[(unison-termlink-derived hash i) (describe-derived hash i)]
|
||||
[(unison-typelink-builtin nm)
|
||||
(string-append "##" nm)]
|
||||
[(unison-typelink-derived hs i) (describe-derived hs i)]
|
||||
[(? unison-termlink?) (termlink->string x #t)]
|
||||
[(? unison-typelink?) (typelink->string x #t)]
|
||||
[(unison-quote v)
|
||||
(string-append "{Value " (describe-value v) "}")]
|
||||
[(unison-code v)
|
||||
(string-append "Code (" (describe-value v) ")")]
|
||||
(string-append "{Code " (describe-value v) "}")]
|
||||
[(unison-closure code env)
|
||||
(define dc
|
||||
(termlink->string (lookup-function-link code) #t))
|
||||
(define (f v)
|
||||
(string-append " " (describe-value v)))
|
||||
|
||||
(string-append* dc (map f env))]
|
||||
[(? procedure?)
|
||||
(string-append
|
||||
"ref"
|
||||
(termlink->string (lookup-function-link x) #t))]
|
||||
[(? chunked-list?)
|
||||
(describe-list-sq (vector->list (chunked-list->vector x)))]
|
||||
[(? chunked-string?)
|
||||
@ -503,8 +462,6 @@
|
||||
([c (in-chunked-string-chunks s)])
|
||||
(f acc (string->chunked-string (m c)))))
|
||||
|
||||
(define freeze-bytevector! unsafe-bytes->immutable-bytes!)
|
||||
|
||||
(define freeze-vector! unsafe-vector*->immutable-vector!)
|
||||
|
||||
(define (freeze-subvector src off len)
|
||||
@ -538,9 +495,3 @@
|
||||
#:methods gen:custom-write
|
||||
[(define write-proc write-exn:bug)])
|
||||
|
||||
|
||||
(define (exn:bug->exception b)
|
||||
(exception
|
||||
ref-runtimefailure:typelink
|
||||
(exn:bug-msg b)
|
||||
(exn:bug-val b)))
|
||||
|
@ -96,12 +96,16 @@
|
||||
builtin-tls.signedcert:typelink
|
||||
builtin-tls.version:typelink
|
||||
|
||||
unison-tuple->list)
|
||||
unison-tuple->list
|
||||
|
||||
typelink->string
|
||||
termlink->string)
|
||||
|
||||
(require
|
||||
racket
|
||||
racket/fixnum
|
||||
(only-in "vector-trie.rkt" ->fx/wraparound))
|
||||
(only-in "vector-trie.rkt" ->fx/wraparound)
|
||||
unison/bytevector)
|
||||
|
||||
(struct unison-data
|
||||
(ref tag fields)
|
||||
@ -153,6 +157,9 @@
|
||||
(struct unison-termlink ()
|
||||
#:transparent
|
||||
#:reflection-name 'termlink
|
||||
#:methods gen:custom-write
|
||||
[(define (write-proc tl port mode)
|
||||
(write-string (termlink->string tl #t) port))]
|
||||
#:property prop:equal+hash
|
||||
(let ()
|
||||
(define (equal-proc lnl lnr rec)
|
||||
@ -204,6 +211,9 @@
|
||||
(struct unison-typelink ()
|
||||
#:transparent
|
||||
#:reflection-name 'typelink
|
||||
#:methods gen:custom-write
|
||||
[(define (write-proc tl port mode)
|
||||
(write-string (typelink->string tl #t) port))]
|
||||
#:property prop:equal+hash
|
||||
(let ()
|
||||
(define (equal-proc lnl lnr rec)
|
||||
@ -244,9 +254,57 @@
|
||||
(struct unison-code (rep))
|
||||
(struct unison-quote (val))
|
||||
|
||||
(define (write-procedure f port mode)
|
||||
(cond
|
||||
[(hash-has-key? function-associations f)
|
||||
(define tl (lookup-function-link f))
|
||||
(write-string (termlink->string tl #t) port)]
|
||||
[else
|
||||
(case mode
|
||||
[(#f) (display f port)]
|
||||
[(#t) (write f port)]
|
||||
[else (print f port mode)])]))
|
||||
|
||||
(define (write-sequence s port mode)
|
||||
(define rec
|
||||
(case mode
|
||||
[(#f) display]
|
||||
[(#t) write]
|
||||
[else (lambda (e port) (print e port mode))]))
|
||||
|
||||
(write-string "'(" port)
|
||||
|
||||
(define first #t)
|
||||
|
||||
(for ([e s])
|
||||
(unless first
|
||||
(write-string " " port)
|
||||
(set! first #f))
|
||||
|
||||
(if (procedure? e)
|
||||
(write-procedure e port mode)
|
||||
(rec e port)))
|
||||
(write-string ")" port))
|
||||
|
||||
(struct unison-closure
|
||||
(code env)
|
||||
#:transparent
|
||||
#:methods gen:custom-write
|
||||
[(define (write-proc clo port mode)
|
||||
(define code-tl
|
||||
(lookup-function-link (unison-closure-code clo)))
|
||||
|
||||
(define rec
|
||||
(case mode
|
||||
[(#t) write]
|
||||
[(#f) display]
|
||||
[else (lambda (v port) (print v port mode))]))
|
||||
|
||||
(write-string "(unison-closure " port)
|
||||
(write-procedure (unison-closure-code clo) port mode)
|
||||
(write-string " " port)
|
||||
(write-sequence (unison-closure-env clo) port mode)
|
||||
(write-string ")" port))]
|
||||
#:property prop:procedure
|
||||
(case-lambda
|
||||
[(clo) clo]
|
||||
@ -416,9 +474,9 @@
|
||||
(define (failure typeLink msg any)
|
||||
(sum 0 typeLink msg any))
|
||||
|
||||
; Type -> Text -> a ->{Exception} b
|
||||
; Type -> Text -> a -> (type, text, a) + b
|
||||
(define (exception typeLink msg a)
|
||||
(failure typeLink msg (unison-any-any a)))
|
||||
(failure typeLink msg a))
|
||||
|
||||
; A counter for internally numbering declared data, so that the
|
||||
; entire reference doesn't need to be stored in every data record.
|
||||
@ -477,3 +535,35 @@
|
||||
(cons (car fs) (unison-tuple->list (cadr fs)))]
|
||||
[else
|
||||
(raise "unison-tuple->list: unexpected value")])))
|
||||
|
||||
(define (hash-string hs)
|
||||
(string-append
|
||||
"#"
|
||||
(bytevector->base32-string hs #:alphabet 'hex)))
|
||||
|
||||
(define (ix-string i)
|
||||
(if (= i 0)
|
||||
""
|
||||
(string-append "." (number->string i))))
|
||||
|
||||
(define (typelink->string ln [short #f])
|
||||
(define (clip s) (if short (substring s 0 8) s))
|
||||
|
||||
(match ln
|
||||
[(unison-typelink-builtin name)
|
||||
(string-append "##" name)]
|
||||
[(unison-typelink-derived hs i)
|
||||
(string-append (clip (hash-string hs)) (ix-string i))]))
|
||||
|
||||
(define (termlink->string ln [short #f])
|
||||
(define (clip s) (if short (substring s 0 8) s))
|
||||
|
||||
(match ln
|
||||
[(unison-termlink-builtin name)
|
||||
(string-append "##" name)]
|
||||
[(unison-termlink-derived hs i)
|
||||
(string-append (clip (hash-string hs)) (ix-string i))]
|
||||
[(unison-termlink-con rf t)
|
||||
(string-append
|
||||
(typelink->string rf short) "#" (number->string t))]))
|
||||
|
||||
|
@ -9,7 +9,7 @@
|
||||
racket/vector
|
||||
unison/boot
|
||||
unison/boot-generated
|
||||
(only-in unison/core bytevector->base32-string b32h)
|
||||
(only-in unison/bytevector bytevector->base32-string)
|
||||
unison/data
|
||||
unison/data-info
|
||||
unison/chunked-seq
|
||||
@ -220,7 +220,7 @@
|
||||
[(unison-termlink-builtin name)
|
||||
(string-append "builtin-" name)]
|
||||
[(unison-termlink-derived bs i)
|
||||
(let ([hs (bytevector->base32-string b32h bs)]
|
||||
(let ([hs (bytevector->base32-string bs #:alphabet 'hex)]
|
||||
[po (if (= i 0) "" (string-append "." (number->string i)))])
|
||||
(string->symbol
|
||||
(string-append "ref-" (substring hs 0 8) po)))]))
|
||||
|
@ -140,6 +140,8 @@
|
||||
builtin-Bytes.indexOf:termlink
|
||||
builtin-IO.randomBytes
|
||||
builtin-IO.randomBytes:termlink
|
||||
builtin-IO.tryEval
|
||||
builtin-IO.tryEval:termlink
|
||||
|
||||
builtin-Scope.bytearrayOf
|
||||
builtin-Scope.bytearrayOf:termlink
|
||||
@ -388,7 +390,6 @@
|
||||
unison-FOp-IO.delay.impl.v3
|
||||
unison-POp-FORK
|
||||
unison-FOp-IO.kill.impl.v3
|
||||
unison-POp-TFRC
|
||||
|
||||
unison-FOp-Handle.toText
|
||||
unison-FOp-Socket.toText
|
||||
@ -602,7 +603,14 @@
|
||||
vector-copy!
|
||||
bytes-copy!
|
||||
sub1
|
||||
add1)
|
||||
add1
|
||||
exn:break?
|
||||
exn:fail?
|
||||
exn:fail:read?
|
||||
exn:fail:filesystem?
|
||||
exn:fail:network?
|
||||
exn:fail:contract:divide-by-zero?
|
||||
exn:fail:contract:non-fixnum-result?)
|
||||
(car icar) (cdr icdr))
|
||||
(only (racket string)
|
||||
string-contains?
|
||||
@ -618,6 +626,8 @@
|
||||
clamp-integer
|
||||
clamp-natural
|
||||
wrap-natural
|
||||
exn:bug->exception
|
||||
raise-unison-exception
|
||||
bit64
|
||||
bit63
|
||||
nbit63)
|
||||
@ -698,6 +708,7 @@
|
||||
(define-builtin-link Text.!=)
|
||||
(define-builtin-link Bytes.indexOf)
|
||||
(define-builtin-link IO.randomBytes)
|
||||
(define-builtin-link IO.tryEval)
|
||||
(define-builtin-link List.splitLeft)
|
||||
(define-builtin-link List.splitRight)
|
||||
(define-builtin-link Value.toBuiltin)
|
||||
@ -827,34 +838,10 @@
|
||||
(define-unison (builtin-Scope.bytearrayOf i n)
|
||||
(make-bytevector n i))
|
||||
|
||||
(define (hash-string hs)
|
||||
(string-append "#" (bytevector->base32-string b32h hs)))
|
||||
|
||||
(define (ix-string i)
|
||||
(if (= i 0)
|
||||
""
|
||||
(string-append "." (number->string i))))
|
||||
|
||||
(define (typelink->string ln)
|
||||
(match ln
|
||||
[(unison-typelink-builtin name)
|
||||
(string-append "##" name)]
|
||||
[(unison-typelink-derived hs i)
|
||||
(string-append (hash-string hs) (ix-string i))]))
|
||||
|
||||
(define-builtin-link Link.Type.toText)
|
||||
(define-unison (builtin-Link.Type.toText ln)
|
||||
(string->chunked-string (typelink->string ln)))
|
||||
|
||||
(define (termlink->string ln)
|
||||
(match ln
|
||||
[(unison-termlink-builtin name)
|
||||
(string-append "##" name)]
|
||||
[(unison-termlink-derived hs i)
|
||||
(string-append (hash-string hs) (ix-string i))]
|
||||
[(unison-termlink-con rf t)
|
||||
(string-append (typelink->string rf) "#" (number->string t))]))
|
||||
|
||||
(define-builtin-link Link.Term.toText)
|
||||
(define-unison (builtin-Link.Term.toText ln)
|
||||
(string->chunked-string (termlink->string ln)))
|
||||
@ -1343,7 +1330,6 @@
|
||||
(define unison-FOp-ImmutableArray.size vector-length)
|
||||
|
||||
(define (unison-POp-FORK thunk) (fork thunk))
|
||||
(define (unison-POp-TFRC thunk) (try-eval thunk))
|
||||
(define (unison-FOp-IO.delay.impl.v3 micros) (sleep micros))
|
||||
(define (unison-FOp-IO.kill.impl.v3 threadId) (kill threadId))
|
||||
(define (unison-FOp-Scope.ref a) (ref-new a))
|
||||
@ -1358,6 +1344,50 @@
|
||||
(define (unison-FOp-Promise.tryRead promise) (promise-try-read promise))
|
||||
(define (unison-FOp-Promise.write promise a) (promise-write promise a)))
|
||||
|
||||
|
||||
(define (exn:io? e)
|
||||
(or (exn:fail:read? e)
|
||||
(exn:fail:filesystem? e)
|
||||
(exn:fail:network? e)))
|
||||
|
||||
(define (exn:arith? e)
|
||||
(or (exn:fail:contract:divide-by-zero? e)
|
||||
(exn:fail:contract:non-fixnum-result? e)))
|
||||
|
||||
(define-unison (builtin-IO.tryEval thunk)
|
||||
(with-handlers
|
||||
([exn:break?
|
||||
(lambda (e)
|
||||
(raise-unison-exception
|
||||
ref-threadkilledfailure:typelink
|
||||
(string->chunked-string "thread killed")
|
||||
ref-unit-unit))]
|
||||
[exn:io?
|
||||
(lambda (e)
|
||||
(raise-unison-exception
|
||||
ref-iofailure:typelink
|
||||
(exception->string e)
|
||||
ref-unit-unit))]
|
||||
[exn:arith?
|
||||
(lambda (e)
|
||||
(raise-unison-exception
|
||||
ref-arithfailure:typelink
|
||||
(exception->string e)
|
||||
ref-unit-unit))]
|
||||
[exn:bug? (lambda (e) (exn:bug->exception e))]
|
||||
[exn:fail?
|
||||
(lambda (e)
|
||||
(raise-unison-exception
|
||||
ref-runtimefailure:typelink
|
||||
(exception->string e)
|
||||
ref-unit-unit))]
|
||||
[(lambda (x) #t)
|
||||
(lambda (e)
|
||||
(raise-unison-exception
|
||||
ref-miscfailure:typelink
|
||||
(exception->string e)
|
||||
ref-unit-unit))])
|
||||
(thunk ref-unit-unit)))
|
||||
|
||||
(declare-builtin-link builtin-Float.*)
|
||||
(declare-builtin-link builtin-Float.fromRepresentation)
|
||||
@ -1417,6 +1447,7 @@
|
||||
(declare-builtin-link builtin-Text.!=)
|
||||
(declare-builtin-link builtin-Bytes.indexOf)
|
||||
(declare-builtin-link builtin-IO.randomBytes)
|
||||
(declare-builtin-link builtin-IO.tryEval)
|
||||
(declare-builtin-link builtin-List.splitLeft)
|
||||
(declare-builtin-link builtin-List.splitRight)
|
||||
(declare-builtin-link builtin-Value.toBuiltin)
|
||||
|
@ -122,7 +122,11 @@
|
||||
ref-miscfailure:typelink
|
||||
(string->chunked-string "Unknown exception")
|
||||
ref-unit-unit))] ]
|
||||
(let ([listener (tcp-listen (string->number port ) 4 #f (if (equal? 0 hostname) #f hostname))])
|
||||
(let ([listener (tcp-listen
|
||||
(string->number port)
|
||||
4
|
||||
#t
|
||||
(if (equal? 0 hostname) #f hostname))])
|
||||
(right listener))))))
|
||||
|
||||
; NOTE: This is a no-op because racket's public TCP stack doesn't have separate operations for
|
||||
|
@ -5,7 +5,7 @@ Next, we'll download the jit project and generate a few Racket files from it.
|
||||
|
||||
```ucm
|
||||
.> project.create-empty jit-setup
|
||||
jit-setup/main> pull @unison/internal/releases/0.0.13 lib.jit
|
||||
jit-setup/main> pull @unison/internal/releases/0.0.14 lib.jit
|
||||
```
|
||||
|
||||
```unison
|
||||
|
@ -20,7 +20,7 @@ Next, we'll download the jit project and generate a few Racket files from it.
|
||||
|
||||
🎉 🥳 Happy coding!
|
||||
|
||||
jit-setup/main> pull @unison/internal/releases/0.0.13 lib.jit
|
||||
jit-setup/main> pull @unison/internal/releases/0.0.14 lib.jit
|
||||
|
||||
Downloaded 15053 entities.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user