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

Exception and debugging related work

Browse Source 
Makes various internal values print more nicely, which makes debugging
more tractable. Links now print as base32hex strings like they would in
ucm. Functions inside unison structures print as their hash if possible.
Also, short hashes are printed in most cases, rather than the full hash.

Had to shuffle around some bytevector stuff to make the above work.

Pulled `tryEval` completely into primops, and made it directly do an
exception request, rather than implementing the TFRC pseudo instruction.
This requires a share bump, as does a fix to the `Failure` data info.

Some of the exception/failure related internal functions were wrapping
the last argument in Any when they shouldn't have, causing errors for
code expecting a single wrapper.
This commit is contained in:
Dan Doel 2024-04-05 13:00:45 -04:00
parent 80fc452dd8
commit 3cb89e42b3
11 changed files with 374 additions and 274 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?)
@ -496,8 +455,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)
@ -531,9 +488,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

@ -95,12 +95,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)
@ -152,6 +156,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)
@ -203,6 +210,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)
@ -243,9 +253,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]
@ -395,9 +453,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.
@ -456,3 +514,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)

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.