unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-09-11 02:25:39 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #4864 from unisonweb/fix/jit-cloud-tests

Browse Source 
Some jit fixes for cloud tests
This commit is contained in:
Arya Irani 2024-04-05 16:36:18 -06:00 committed by GitHub
commit 41046d599a
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
12 changed files with 379 additions and 275 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.github/workflows/ci.md vendored
View File

@ -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
View File

@ -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

17
scheme-libs/racket/unison/boot.ss
View File

@ -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)))

286
scheme-libs/racket/unison/bytevector.ss
View File

@ -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)))))
)

55
scheme-libs/racket/unison/concurrent.ss
View File

@ -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)))))
)

95
scheme-libs/racket/unison/core.ss
View File

@ -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)))

98
scheme-libs/racket/unison/data.ss
View File

@ -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))]))

4
scheme-libs/racket/unison/primops-generated.rkt
View File

@ -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)))]))

85
scheme-libs/racket/unison/primops.ss
View File

@ -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)

6
scheme-libs/racket/unison/tcp.rkt
View File

@ -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

2
unison-src/transcripts-manual/gen-racket-libs.md
View File

@ -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

2
unison-src/transcripts-manual/gen-racket-libs.output.md
View File

@ -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.