mirror of
https://github.com/unisonweb/unison.git
synced 2024-10-26 02:55:19 +03:00
A few fixes/tweaks
- Changes the naming convention for builtin types/data to avoid clashes between builtins and pregenerated data types. For instance, both had a Value type in scheme, because of the in-unison representation. Instead of just `unison-`, now either `builtin-` or `ref-` prefixes are used. - Fixes several places where invalid values were being used in exceptions. Raw scheme values were being returned that do not correspond to unison values, and this was causing problems with reflection. - Fixes some code loading operations returning in-unison `Reference` values instead of term link values. Parts of these are implemented in unison, so both types are in play, and need to be correctly mediated.
This commit is contained in:
Dan Doel
parent
98bf7d1286
commit
702318a6e4
@ -54,7 +54,7 @@
|
||||
(let ([bs (grab-bytes)])
|
||||
(match (builtin-Value.deserialize (bytes->chunked-bytes bs))
|
||||
[(unison-data _ t (list q))
|
||||
(= t unison-either-right:tag)
|
||||
(= t ref-either-right:tag)
|
||||
(apply
|
||||
values
|
||||
(unison-tuple->list (reify-value (unison-quote-val q))))]
|
||||
@ -67,7 +67,7 @@
|
||||
(define (do-evaluate)
|
||||
(let-values ([(code main-ref) (decode-input)])
|
||||
(add-runtime-code 'unison-main code)
|
||||
(handle [unison-exception:typelink] top-exn-handler
|
||||
(handle [ref-exception:typelink] top-exn-handler
|
||||
((termlink->proc main-ref))
|
||||
(data 'unit 0))))
|
||||
|
||||
|
||||
@ -13,38 +13,39 @@
|
||||
#!racket/base
|
||||
(provide
|
||||
(all-from-out unison/data-info)
|
||||
unison-any:typelink
|
||||
unison-boolean:typelink
|
||||
unison-bytes:typelink
|
||||
unison-char:typelink
|
||||
unison-float:typelink
|
||||
unison-int:typelink
|
||||
unison-nat:typelink
|
||||
unison-text:typelink
|
||||
unison-code:typelink
|
||||
unison-mvar:typelink
|
||||
unison-pattern:typelink
|
||||
unison-promise:typelink
|
||||
unison-sequence:typelink
|
||||
unison-socket:typelink
|
||||
unison-tls:typelink
|
||||
unison-timespec:typelink
|
||||
unison-threadid:typelink
|
||||
builtin-any:typelink
|
||||
builtin-boolean:typelink
|
||||
builtin-bytes:typelink
|
||||
builtin-char:typelink
|
||||
builtin-float:typelink
|
||||
builtin-int:typelink
|
||||
builtin-nat:typelink
|
||||
builtin-text:typelink
|
||||
builtin-code:typelink
|
||||
builtin-mvar:typelink
|
||||
builtin-pattern:typelink
|
||||
builtin-promise:typelink
|
||||
builtin-sequence:typelink
|
||||
builtin-socket:typelink
|
||||
builtin-tls:typelink
|
||||
builtin-timespec:typelink
|
||||
builtin-threadid:typelink
|
||||
builtin-value:typelink
|
||||
|
||||
unison-crypto.hashalgorithm:typelink
|
||||
unison-char.class:typelink
|
||||
unison-immutablearray:typelink
|
||||
unison-immutablebytearray:typelink
|
||||
unison-mutablearray:typelink
|
||||
unison-mutablebytearray:typelink
|
||||
unison-processhandle:typelink
|
||||
unison-ref.ticket:typelink
|
||||
unison-tls.cipher:typelink
|
||||
unison-tls.clientconfig:typelink
|
||||
unison-tls.privatekey:typelink
|
||||
unison-tls.serverconfig:typelink
|
||||
unison-tls.signedcert:typelink
|
||||
unison-tls.version:typelink
|
||||
builtin-crypto.hashalgorithm:typelink
|
||||
builtin-char.class:typelink
|
||||
builtin-immutablearray:typelink
|
||||
builtin-immutablebytearray:typelink
|
||||
builtin-mutablearray:typelink
|
||||
builtin-mutablebytearray:typelink
|
||||
builtin-processhandle:typelink
|
||||
builtin-ref.ticket:typelink
|
||||
builtin-tls.cipher:typelink
|
||||
builtin-tls.clientconfig:typelink
|
||||
builtin-tls.privatekey:typelink
|
||||
builtin-tls.serverconfig:typelink
|
||||
builtin-tls.signedcert:typelink
|
||||
builtin-tls.version:typelink
|
||||
|
||||
bytevector
|
||||
bytes
|
||||
@ -495,60 +496,57 @@
|
||||
(define (reference->termlink rf)
|
||||
(match rf
|
||||
[(unison-data _ t (list nm))
|
||||
#:when (= t unison-reference-builtin:tag)
|
||||
#:when (= t ref-reference-builtin:tag)
|
||||
(unison-termlink-builtin (chunked-string->string nm))]
|
||||
[(unison-data _ t (list id))
|
||||
#:when (= t unison-reference-derived:tag)
|
||||
#:when (= t ref-reference-derived:tag)
|
||||
(match id
|
||||
[(unison-data _ t (list rf i))
|
||||
#:when (= t unison-id-id:tag)
|
||||
#:when (= t ref-id-id:tag)
|
||||
(unison-termlink-derived rf i)])]))
|
||||
|
||||
(define (referent->termlink rn)
|
||||
(match rn
|
||||
[(unison-data _ t (list rf i))
|
||||
#:when (= t unison-referent-con:tag)
|
||||
#:when (= t ref-referent-con:tag)
|
||||
(unison-termlink-con (reference->typelink rf) i)]
|
||||
[(unison-data _ t (list rf))
|
||||
#:when (= t unison-referent-def:tag)
|
||||
#:when (= t ref-referent-def:tag)
|
||||
(reference->termlink rf)]))
|
||||
|
||||
(define (reference->typelink rf)
|
||||
(match rf
|
||||
[(unison-data _ t (list nm))
|
||||
#:when (= t unison-reference-builtin:tag)
|
||||
#:when (= t ref-reference-builtin:tag)
|
||||
(unison-typelink-builtin (chunked-string->string nm))]
|
||||
[(unison-data _ t (list id))
|
||||
#:when (= t unison-reference-derived:tag)
|
||||
#:when (= t ref-reference-derived:tag)
|
||||
(match id
|
||||
[(unison-data _ t (list rf i))
|
||||
#:when (= t unison-id-id:tag)
|
||||
#:when (= t ref-id-id:tag)
|
||||
(unison-typelink-derived rf i)])]))
|
||||
|
||||
(define (typelink->reference tl)
|
||||
(match tl
|
||||
[(unison-typelink-builtin nm)
|
||||
(unison-reference-builtin (string->chunked-string nm))]
|
||||
(ref-reference-builtin (string->chunked-string nm))]
|
||||
[(unison-typelink-derived hs i)
|
||||
(unison-reference-derived
|
||||
(unison-id-id hs i))]))
|
||||
(ref-reference-derived (ref-id-id hs i))]))
|
||||
|
||||
(define (termlink->referent tl)
|
||||
(match tl
|
||||
[(unison-termlink-builtin nm)
|
||||
(unison-referent-def
|
||||
(unison-reference-builtin nm))]
|
||||
(ref-referent-def
|
||||
(ref-reference-builtin nm))]
|
||||
[(unison-termlink-derived rf i)
|
||||
(unison-referent-def
|
||||
(unison-reference-derived
|
||||
(unison-id-id rf i)))]
|
||||
(ref-referent-def
|
||||
(ref-reference-derived
|
||||
(ref-id-id rf i)))]
|
||||
[(unison-termlink-con tyl i)
|
||||
(unison-referent-con
|
||||
(typelink->reference tyl)
|
||||
i)]))
|
||||
(ref-referent-con (typelink->reference tyl) i)]))
|
||||
|
||||
(define (list->unison-tuple l)
|
||||
(foldr unison-tuple-pair unison-unit-unit l))
|
||||
(foldr ref-tuple-pair ref-unit-unit l))
|
||||
|
||||
(define (unison-tuple . l) (list->unison-tuple l))
|
||||
|
||||
@ -564,13 +562,13 @@
|
||||
[pure (x)
|
||||
(match x
|
||||
[(unison-data r 0 (list))
|
||||
(eq? r unison-unit:typelink)
|
||||
(eq? r ref-unit:typelink)
|
||||
(display "")]
|
||||
[else
|
||||
(display (describe-value x))])]
|
||||
[unison-exception:typelink
|
||||
[ref-exception:typelink
|
||||
[0 (f)
|
||||
(control unison-exception:typelink k
|
||||
(control ref-exception:typelink k
|
||||
(let ([disp (describe-value f)])
|
||||
(raise (make-exn:bug "builtin.bug" disp))))]]))
|
||||
|
||||
|
||||
@ -112,31 +112,31 @@
|
||||
([exn:break?
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-threadkilledfailure:typelink
|
||||
ref-threadkilledfailure:typelink
|
||||
(string->chunked-string "thread killed")
|
||||
()))]
|
||||
ref-unit-unit))]
|
||||
[exn:io?
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-iofailure:typelink
|
||||
(exception->string e) ()))]
|
||||
ref-iofailure:typelink
|
||||
(exception->string e) ref-unit-unit))]
|
||||
[exn:arith?
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-arithfailure:typelink
|
||||
ref-arithfailure:typelink
|
||||
(exception->string e)
|
||||
()))]
|
||||
ref-unit-unit))]
|
||||
[exn:bug? (lambda (e) (exn:bug->exception e))]
|
||||
[exn:fail?
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-runtimefailure:typelink
|
||||
ref-runtimefailure:typelink
|
||||
(exception->string e)
|
||||
()))]
|
||||
ref-unit-unit))]
|
||||
[(lambda (x) #t)
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-miscfailure:typelink
|
||||
ref-miscfailure:typelink
|
||||
(string->chunked-string "unknown exception")
|
||||
e))])
|
||||
ref-unit-unit))])
|
||||
(right (thunk)))))
|
||||
|
||||
@ -385,6 +385,6 @@
|
||||
#:constructor-name make-exn:bug)
|
||||
(define (exn:bug->exception b)
|
||||
(exception
|
||||
unison-runtimefailure:typelink
|
||||
ref-runtimefailure:typelink
|
||||
(exn:bug-msg b)
|
||||
(exn:bug-a b)))
|
||||
|
||||
@ -53,47 +53,47 @@
|
||||
failure
|
||||
exception
|
||||
|
||||
unison-any:typelink
|
||||
builtin-any:typelink
|
||||
unison-any-any:tag
|
||||
unison-any-any
|
||||
|
||||
unison-boolean:typelink
|
||||
builtin-boolean:typelink
|
||||
unison-boolean-true:tag
|
||||
unison-boolean-false:tag
|
||||
unison-boolean-true
|
||||
unison-boolean-false
|
||||
|
||||
unison-bytes:typelink
|
||||
unison-char:typelink
|
||||
unison-float:typelink
|
||||
unison-int:typelink
|
||||
unison-nat:typelink
|
||||
unison-text:typelink
|
||||
unison-code:typelink
|
||||
unison-mvar:typelink
|
||||
unison-pattern:typelink
|
||||
unison-promise:typelink
|
||||
unison-sequence:typelink
|
||||
unison-socket:typelink
|
||||
unison-tls:typelink
|
||||
unison-timespec:typelink
|
||||
unison-threadid:typelink
|
||||
; unison-value:typelink
|
||||
builtin-bytes:typelink
|
||||
builtin-char:typelink
|
||||
builtin-float:typelink
|
||||
builtin-int:typelink
|
||||
builtin-nat:typelink
|
||||
builtin-text:typelink
|
||||
builtin-code:typelink
|
||||
builtin-mvar:typelink
|
||||
builtin-pattern:typelink
|
||||
builtin-promise:typelink
|
||||
builtin-sequence:typelink
|
||||
builtin-socket:typelink
|
||||
builtin-tls:typelink
|
||||
builtin-timespec:typelink
|
||||
builtin-threadid:typelink
|
||||
builtin-value:typelink
|
||||
|
||||
unison-crypto.hashalgorithm:typelink
|
||||
unison-char.class:typelink
|
||||
unison-immutablearray:typelink
|
||||
unison-immutablebytearray:typelink
|
||||
unison-mutablearray:typelink
|
||||
unison-mutablebytearray:typelink
|
||||
unison-processhandle:typelink
|
||||
unison-ref.ticket:typelink
|
||||
unison-tls.cipher:typelink
|
||||
unison-tls.clientconfig:typelink
|
||||
unison-tls.privatekey:typelink
|
||||
unison-tls.serverconfig:typelink
|
||||
unison-tls.signedcert:typelink
|
||||
unison-tls.version:typelink
|
||||
builtin-crypto.hashalgorithm:typelink
|
||||
builtin-char.class:typelink
|
||||
builtin-immutablearray:typelink
|
||||
builtin-immutablebytearray:typelink
|
||||
builtin-mutablearray:typelink
|
||||
builtin-mutablebytearray:typelink
|
||||
builtin-processhandle:typelink
|
||||
builtin-ref.ticket:typelink
|
||||
builtin-tls.cipher:typelink
|
||||
builtin-tls.clientconfig:typelink
|
||||
builtin-tls.privatekey:typelink
|
||||
builtin-tls.serverconfig:typelink
|
||||
builtin-tls.signedcert:typelink
|
||||
builtin-tls.version:typelink
|
||||
|
||||
unison-tuple->list)
|
||||
|
||||
@ -332,63 +332,63 @@
|
||||
(define (either-get either) (car (unison-sum-fields either)))
|
||||
|
||||
; a -> Any
|
||||
(define unison-any:typelink (unison-typelink-builtin "Any"))
|
||||
(define builtin-any:typelink (unison-typelink-builtin "Any"))
|
||||
(define unison-any-any:tag 0)
|
||||
(define (unison-any-any x)
|
||||
(data unison-any:typelink unison-any-any:tag x))
|
||||
(data builtin-any:typelink unison-any-any:tag x))
|
||||
|
||||
(define unison-boolean:typelink (unison-typelink-builtin "Boolean"))
|
||||
(define builtin-boolean:typelink (unison-typelink-builtin "Boolean"))
|
||||
(define unison-boolean-true:tag 1)
|
||||
(define unison-boolean-false:tag 0)
|
||||
(define unison-boolean-true
|
||||
(data unison-boolean:typelink unison-boolean-true:tag))
|
||||
(data builtin-boolean:typelink unison-boolean-true:tag))
|
||||
(define unison-boolean-false
|
||||
(data unison-boolean:typelink unison-boolean-false:tag))
|
||||
(data builtin-boolean:typelink unison-boolean-false:tag))
|
||||
|
||||
(define unison-bytes:typelink (unison-typelink-builtin "Bytes"))
|
||||
(define unison-char:typelink (unison-typelink-builtin "Char"))
|
||||
(define unison-code:typelink (unison-typelink-builtin "Code"))
|
||||
(define unison-float:typelink (unison-typelink-builtin "Float"))
|
||||
(define unison-int:typelink (unison-typelink-builtin "Int"))
|
||||
(define unison-mvar:typelink (unison-typelink-builtin "MVar"))
|
||||
(define unison-nat:typelink (unison-typelink-builtin "Nat"))
|
||||
(define unison-pattern:typelink (unison-typelink-builtin "Pattern"))
|
||||
(define unison-promise:typelink (unison-typelink-builtin "Promise"))
|
||||
(define unison-sequence:typelink (unison-typelink-builtin "Sequence"))
|
||||
(define unison-socket:typelink (unison-typelink-builtin "Socket"))
|
||||
(define unison-text:typelink (unison-typelink-builtin "Text"))
|
||||
(define unison-tls:typelink (unison-typelink-builtin "Tls"))
|
||||
(define unison-timespec:typelink (unison-typelink-builtin "TimeSpec"))
|
||||
(define unison-threadid:typelink (unison-typelink-builtin "ThreadId"))
|
||||
; (define unison-value:typelink (unison-typelink-builtin "Value"))
|
||||
(define builtin-bytes:typelink (unison-typelink-builtin "Bytes"))
|
||||
(define builtin-char:typelink (unison-typelink-builtin "Char"))
|
||||
(define builtin-code:typelink (unison-typelink-builtin "Code"))
|
||||
(define builtin-float:typelink (unison-typelink-builtin "Float"))
|
||||
(define builtin-int:typelink (unison-typelink-builtin "Int"))
|
||||
(define builtin-mvar:typelink (unison-typelink-builtin "MVar"))
|
||||
(define builtin-nat:typelink (unison-typelink-builtin "Nat"))
|
||||
(define builtin-pattern:typelink (unison-typelink-builtin "Pattern"))
|
||||
(define builtin-promise:typelink (unison-typelink-builtin "Promise"))
|
||||
(define builtin-sequence:typelink (unison-typelink-builtin "Sequence"))
|
||||
(define builtin-socket:typelink (unison-typelink-builtin "Socket"))
|
||||
(define builtin-text:typelink (unison-typelink-builtin "Text"))
|
||||
(define builtin-tls:typelink (unison-typelink-builtin "Tls"))
|
||||
(define builtin-timespec:typelink (unison-typelink-builtin "TimeSpec"))
|
||||
(define builtin-threadid:typelink (unison-typelink-builtin "ThreadId"))
|
||||
(define builtin-value:typelink (unison-typelink-builtin "Value"))
|
||||
|
||||
(define unison-crypto.hashalgorithm:typelink
|
||||
(define builtin-crypto.hashalgorithm:typelink
|
||||
(unison-typelink-builtin "crypto.HashAlgorithm"))
|
||||
(define unison-char.class:typelink
|
||||
(define builtin-char.class:typelink
|
||||
(unison-typelink-builtin "Char.Class"))
|
||||
(define unison-immutablearray:typelink
|
||||
(define builtin-immutablearray:typelink
|
||||
(unison-typelink-builtin "ImmutableArray"))
|
||||
(define unison-immutablebytearray:typelink
|
||||
(define builtin-immutablebytearray:typelink
|
||||
(unison-typelink-builtin "ImmutableByteArray"))
|
||||
(define unison-mutablearray:typelink
|
||||
(define builtin-mutablearray:typelink
|
||||
(unison-typelink-builtin "MutableArray"))
|
||||
(define unison-mutablebytearray:typelink
|
||||
(define builtin-mutablebytearray:typelink
|
||||
(unison-typelink-builtin "MutableArray"))
|
||||
(define unison-processhandle:typelink
|
||||
(define builtin-processhandle:typelink
|
||||
(unison-typelink-builtin "ProcessHandle"))
|
||||
(define unison-ref.ticket:typelink
|
||||
(define builtin-ref.ticket:typelink
|
||||
(unison-typelink-builtin "Ref.Ticket"))
|
||||
(define unison-tls.cipher:typelink
|
||||
(define builtin-tls.cipher:typelink
|
||||
(unison-typelink-builtin "Tls.Cipher"))
|
||||
(define unison-tls.clientconfig:typelink
|
||||
(define builtin-tls.clientconfig:typelink
|
||||
(unison-typelink-builtin "Tls.ClientConfig"))
|
||||
(define unison-tls.privatekey:typelink
|
||||
(define builtin-tls.privatekey:typelink
|
||||
(unison-typelink-builtin "Tls.PrivateKey"))
|
||||
(define unison-tls.serverconfig:typelink
|
||||
(define builtin-tls.serverconfig:typelink
|
||||
(unison-typelink-builtin "Tls.ServerConfig"))
|
||||
(define unison-tls.signedcert:typelink
|
||||
(define builtin-tls.signedcert:typelink
|
||||
(unison-typelink-builtin "Tls.SignedCert"))
|
||||
(define unison-tls.version:typelink
|
||||
(define builtin-tls.version:typelink
|
||||
(unison-typelink-builtin "Tls.Version"))
|
||||
|
||||
; Type -> Text -> Any -> Failure
|
||||
|
||||
@ -43,87 +43,103 @@
|
||||
|
||||
; typeLink msg any
|
||||
(define (Exception typeLink message payload)
|
||||
(let* ([x7 (unison-any-any payload)]
|
||||
[x8 (unison-failure-failure typeLink message x7)])
|
||||
(unison-either-left x8)))
|
||||
(let* ([a (unison-any-any payload)]
|
||||
[msg (string->chunked-string message)]
|
||||
[f (ref-failure-failure typeLink msg a)])
|
||||
(ref-either-left f)))
|
||||
|
||||
(define-unison (isFileOpen.impl.v3 port)
|
||||
(unison-either-right (not (port-closed? port))))
|
||||
(ref-either-right (not (port-closed? port))))
|
||||
|
||||
(define-unison (ready.impl.v1 port)
|
||||
(if (byte-ready? port)
|
||||
(unison-either-right #t)
|
||||
(ref-either-right #t)
|
||||
(if (port-eof? port)
|
||||
(Exception unison-iofailure:typelink "EOF" port)
|
||||
(unison-either-right #f))))
|
||||
(Exception ref-iofailure:typelink "EOF" port)
|
||||
(ref-either-right #f))))
|
||||
|
||||
(define-unison (getCurrentDirectory.impl.v3 unit)
|
||||
(unison-either-right
|
||||
(ref-either-right
|
||||
(string->chunked-string (path->string (current-directory)))))
|
||||
|
||||
(define-unison (isSeekable.impl.v3 handle)
|
||||
(unison-either-right
|
||||
(ref-either-right
|
||||
(port-has-set-port-position!? handle)))
|
||||
|
||||
(define-unison (handlePosition.impl.v3 handle)
|
||||
(unison-either-right (port-position handle)))
|
||||
(ref-either-right (port-position handle)))
|
||||
|
||||
(define-unison (seekHandle.impl.v3 handle mode amount)
|
||||
(data-case mode
|
||||
(0 ()
|
||||
(set-port-position! handle amount)
|
||||
(unison-either-right none))
|
||||
(ref-either-right none))
|
||||
(1 ()
|
||||
(let ([current (port-position handle)])
|
||||
(set-port-position! handle (+ current amount))
|
||||
(unison-either-right none)))
|
||||
(ref-either-right none)))
|
||||
(2 ()
|
||||
(Exception unison-iofailure:typelink "SeekFromEnd not supported" 0))))
|
||||
(Exception
|
||||
ref-iofailure:typelink
|
||||
"SeekFromEnd not supported"
|
||||
0))))
|
||||
|
||||
(define-unison (getLine.impl.v1 handle)
|
||||
(let* ([line (read-line handle)])
|
||||
(if (eof-object? line)
|
||||
(unison-either-right (string->chunked-string ""))
|
||||
(unison-either-right (string->chunked-string line))
|
||||
(ref-either-right (string->chunked-string ""))
|
||||
(ref-either-right (string->chunked-string line))
|
||||
)))
|
||||
|
||||
(define-unison (getChar.impl.v1 handle)
|
||||
(let* ([char (read-char handle)])
|
||||
(if (eof-object? char)
|
||||
(Exception unison-iofailure:typelink "End of file reached")
|
||||
(unison-either-right char))))
|
||||
(Exception
|
||||
ref-iofailure:typelink
|
||||
"End of file reached"
|
||||
ref-unit-unit)
|
||||
(ref-either-right char))))
|
||||
|
||||
(define-unison (getSomeBytes.impl.v1 handle bytes)
|
||||
(let* ([buffer (make-bytes bytes)]
|
||||
[line (read-bytes-avail! buffer handle)])
|
||||
(if (eof-object? line)
|
||||
(unison-either-right (bytes->chunked-bytes #""))
|
||||
(unison-either-right (bytes->chunked-bytes buffer))
|
||||
(ref-either-right (bytes->chunked-bytes #""))
|
||||
(ref-either-right (bytes->chunked-bytes buffer))
|
||||
)))
|
||||
|
||||
(define-unison (getBuffering.impl.v3 handle)
|
||||
(case (file-stream-buffer-mode handle)
|
||||
[(none) (unison-either-right unison-buffermode-no-buffering)]
|
||||
[(line) (unison-either-right
|
||||
unison-buffermode-line-buffering)]
|
||||
[(block) (unison-either-right
|
||||
unison-buffermode-block-buffering)]
|
||||
[(#f) (Exception unison-iofailure:typelink "Unable to determine buffering mode of handle" '())]
|
||||
[else (Exception unison-iofailure:typelink "Unexpected response from file-stream-buffer-mode" '())]))
|
||||
[(none) (ref-either-right ref-buffermode-no-buffering)]
|
||||
[(line) (ref-either-right
|
||||
ref-buffermode-line-buffering)]
|
||||
[(block) (ref-either-right
|
||||
ref-buffermode-block-buffering)]
|
||||
[(#f) (Exception
|
||||
ref-iofailure:typelink
|
||||
"Unable to determine buffering mode of handle"
|
||||
ref-unit-unit)]
|
||||
[else (Exception
|
||||
ref-iofailure:typelink
|
||||
"Unexpected response from file-stream-buffer-mode"
|
||||
ref-unit-unit)]))
|
||||
|
||||
(define-unison (setBuffering.impl.v3 handle mode)
|
||||
(data-case mode
|
||||
(0 ()
|
||||
(file-stream-buffer-mode handle 'none)
|
||||
(unison-either-right none))
|
||||
(ref-either-right none))
|
||||
(1 ()
|
||||
(file-stream-buffer-mode handle 'line)
|
||||
(unison-either-right none))
|
||||
(ref-either-right none))
|
||||
(2 ()
|
||||
(file-stream-buffer-mode handle 'block)
|
||||
(unison-either-right none))
|
||||
(ref-either-right none))
|
||||
(3 (size)
|
||||
(Exception unison-iofailure:typelink "Sized block buffering not supported" '()))))
|
||||
(Exception
|
||||
ref-iofailure:typelink
|
||||
"Sized block buffering not supported"
|
||||
ref-unit-unit))))
|
||||
|
||||
(define (with-buffer-mode port mode)
|
||||
(file-stream-buffer-mode port mode)
|
||||
@ -141,8 +157,11 @@
|
||||
|
||||
(define-unison (getEcho.impl.v1 handle)
|
||||
(if (eq? handle stdin)
|
||||
(unison-either-right (get-stdin-echo))
|
||||
(Exception unison-iofailure:typelink "getEcho only supported on stdin" '())))
|
||||
(ref-either-right (get-stdin-echo))
|
||||
(Exception
|
||||
ref-iofailure:typelink
|
||||
"getEcho only supported on stdin"
|
||||
ref-unit-unit)))
|
||||
|
||||
(define-unison (setEcho.impl.v1 handle echo)
|
||||
(if (eq? handle stdin)
|
||||
@ -150,23 +169,29 @@
|
||||
(if echo
|
||||
(system "stty echo")
|
||||
(system "stty -echo"))
|
||||
(unison-either-right none))
|
||||
(Exception unison-iofailure:typelink "setEcho only supported on stdin" '())))
|
||||
(ref-either-right none))
|
||||
(Exception
|
||||
ref-iofailure:typelink
|
||||
"setEcho only supported on stdin"
|
||||
ref-unit-unit)))
|
||||
|
||||
(define (get-stdin-echo)
|
||||
(let ([current (with-output-to-string (lambda () (system "stty -a")))])
|
||||
(string-contains? current " echo ")))
|
||||
|
||||
(define-unison (getArgs.impl.v1 unit)
|
||||
(unison-either-right
|
||||
(ref-either-right
|
||||
(vector->chunked-list
|
||||
(vector-map string->chunked-string (current-command-line-arguments)))))
|
||||
|
||||
(define-unison (getEnv.impl.v1 key)
|
||||
(let ([value (environment-variables-ref (current-environment-variables) (string->bytes/utf-8 (chunked-string->string key)))])
|
||||
(if (false? value)
|
||||
(Exception unison-iofailure:typelink "environmental variable not found" key)
|
||||
(unison-either-right
|
||||
(Exception
|
||||
ref-iofailure:typelink
|
||||
"environmental variable not found"
|
||||
key)
|
||||
(ref-either-right
|
||||
(string->chunked-string (bytes->string/utf-8 value))))))
|
||||
|
||||
;; From https://github.com/sorawee/shlex/blob/5de06500e8c831cfc8dffb99d57a76decc02c569/main.rkt (MIT License)
|
||||
|
||||
@ -46,20 +46,26 @@
|
||||
(with-handlers
|
||||
[[exn:fail:filesystem?
|
||||
(lambda (e)
|
||||
(exception unison-iofailure:typelink (exception->string e) '()))]]
|
||||
(exception
|
||||
ref-iofailure:typelink
|
||||
(exception->string e)
|
||||
ref-unit-unit))]]
|
||||
(right (file-size (chunked-string->string path)))))
|
||||
|
||||
(define (getFileTimestamp.impl.v3 path)
|
||||
(with-handlers
|
||||
[[exn:fail:filesystem?
|
||||
(lambda (e)
|
||||
(exception unison-iofailure:typelink (exception->string e) '()))]]
|
||||
(exception
|
||||
ref-iofailure:typelink
|
||||
(exception->string e)
|
||||
ref-unit-unit))]]
|
||||
(right (file-or-directory-modify-seconds (chunked-string->string path)))))
|
||||
|
||||
; in haskell, it's not just file but also directory
|
||||
(define-unison (fileExists.impl.v3 path)
|
||||
(let ([path-string (chunked-string->string path)])
|
||||
(unison-either-right
|
||||
(ref-either-right
|
||||
(or
|
||||
(file-exists? path-string)
|
||||
(directory-exists? path-string)))))
|
||||
@ -73,10 +79,10 @@
|
||||
|
||||
(define-unison (setCurrentDirectory.impl.v3 path)
|
||||
(current-directory (chunked-string->string path))
|
||||
(unison-either-right none))
|
||||
(ref-either-right none))
|
||||
|
||||
(define-unison (createTempDirectory.impl.v3 prefix)
|
||||
(unison-either-right
|
||||
(ref-either-right
|
||||
(string->chunked-string
|
||||
(path->string
|
||||
(make-temporary-directory*
|
||||
@ -85,31 +91,31 @@
|
||||
|
||||
(define-unison (createDirectory.impl.v3 file)
|
||||
(make-directory (chunked-string->string file))
|
||||
(unison-either-right none))
|
||||
(ref-either-right none))
|
||||
|
||||
(define-unison (removeDirectory.impl.v3 file)
|
||||
(delete-directory/files (chunked-string->string file))
|
||||
(unison-either-right none))
|
||||
(ref-either-right none))
|
||||
|
||||
(define-unison (isDirectory.impl.v3 path)
|
||||
(unison-either-right
|
||||
(ref-either-right
|
||||
(directory-exists? (chunked-string->string path))))
|
||||
|
||||
(define-unison (renameDirectory.impl.v3 old new)
|
||||
(rename-file-or-directory (chunked-string->string old)
|
||||
(chunked-string->string new))
|
||||
(unison-either-right none))
|
||||
(ref-either-right none))
|
||||
|
||||
(define-unison (renameFile.impl.v3 old new)
|
||||
(rename-file-or-directory (chunked-string->string old)
|
||||
(chunked-string->string new))
|
||||
(unison-either-right none))
|
||||
(ref-either-right none))
|
||||
|
||||
(define-unison (systemTime.impl.v3 unit)
|
||||
(unison-either-right (current-seconds)))
|
||||
(ref-either-right (current-seconds)))
|
||||
|
||||
(define-unison (systemTimeMicroseconds.impl.v3 unit)
|
||||
(unison-either-right (inexact->exact (* 1000 (current-inexact-milliseconds)))))
|
||||
(ref-either-right (inexact->exact (* 1000 (current-inexact-milliseconds)))))
|
||||
|
||||
(define (threadCPUTime.v1)
|
||||
(right (current-process-milliseconds (current-thread))))
|
||||
|
||||
@ -83,10 +83,10 @@
|
||||
(define (decode-term tm)
|
||||
(match tm
|
||||
[(unison-data _ t (list tms))
|
||||
#:when (= t unison-schemeterm-sexpr:tag)
|
||||
#:when (= t ref-schemeterm-sexpr:tag)
|
||||
(map decode-term (chunked-list->list tms))]
|
||||
[(unison-data _ t (list as h tms))
|
||||
#:when (= t unison-schemeterm-handle:tag)
|
||||
#:when (= t ref-schemeterm-handle:tag)
|
||||
`(handle
|
||||
,(map
|
||||
(lambda (tx) (text->linkname tx))
|
||||
@ -94,27 +94,27 @@
|
||||
,(text->ident h)
|
||||
,@(map decode-term (chunked-list->list tms)))]
|
||||
[(unison-data _ t (list hd sc cs))
|
||||
#:when (= t unison-schemeterm-cases:tag)
|
||||
#:when (= t ref-schemeterm-cases:tag)
|
||||
(assemble-cases
|
||||
(text->ident hd)
|
||||
(decode-term sc)
|
||||
(map decode-term (chunked-list->list cs)))]
|
||||
[(unison-data _ t (list hd bs bd))
|
||||
#:when (= t unison-schemeterm-binds:tag)
|
||||
#:when (= t ref-schemeterm-binds:tag)
|
||||
`(,(text->ident hd)
|
||||
,(map decode-binding (chunked-list->list bs))
|
||||
,(decode-term bd))]
|
||||
[(unison-data _ t (list tx))
|
||||
#:when (= t unison-schemeterm-ident:tag)
|
||||
#:when (= t ref-schemeterm-ident:tag)
|
||||
(text->ident tx)]
|
||||
[(unison-data _ t (list tx))
|
||||
#:when (= t unison-schemeterm-string:tag)
|
||||
#:when (= t ref-schemeterm-string:tag)
|
||||
(chunked-string->string tx)]
|
||||
[(unison-data _ t (list tx))
|
||||
#:when (= t unison-schemeterm-symbol:tag)
|
||||
#:when (= t ref-schemeterm-symbol:tag)
|
||||
`(quote ,(text->ident tx))]
|
||||
[(unison-data _ t (list ns))
|
||||
#:when (= t unison-schemeterm-bytevec:tag)
|
||||
#:when (= t ref-schemeterm-bytevec:tag)
|
||||
(list->bytes (chunked-list->list ns))]
|
||||
[else
|
||||
(raise (format "decode-term: unimplemented case: ~a" tm))]))
|
||||
@ -131,13 +131,13 @@
|
||||
(define (decode-syntax dfn)
|
||||
(match dfn
|
||||
[(unison-data _ t (list nm vs bd))
|
||||
#:when (= t unison-schemedefn-define:tag)
|
||||
#:when (= t ref-schemedefn-define:tag)
|
||||
(let ([head (map text->ident
|
||||
(cons nm (chunked-list->list vs)))]
|
||||
[body (decode-term bd)])
|
||||
(list 'define-unison head body))]
|
||||
[(unison-data _ t (list nm bd))
|
||||
#:when (= t unison-schemedefn-alias:tag)
|
||||
#:when (= t ref-schemedefn-alias:tag)
|
||||
(list 'define (text->ident nm) (decode-term bd))]
|
||||
[else
|
||||
(raise (format "decode-syntax: unimplemented case: ~a" dfn))]))
|
||||
@ -167,10 +167,10 @@
|
||||
(define (decode-ref rf)
|
||||
(match rf
|
||||
[(unison-data r t (list name))
|
||||
#:when (= t unison-reference-builtin:tag)
|
||||
#:when (= t ref-reference-builtin:tag)
|
||||
(sum 0 (chunked-string->string name))]
|
||||
[(unison-data r t (list id))
|
||||
#:when (= t unison-reference-derived:tag)
|
||||
#:when (= t ref-reference-derived:tag)
|
||||
(data-case id
|
||||
[0 (bs i) (sum 1 bs i)])]))
|
||||
|
||||
@ -200,7 +200,7 @@
|
||||
[(_)
|
||||
#`(lambda (gr)
|
||||
(data-case (group-ref-ident gr)
|
||||
[#,unison-schemeterm-ident:tag (name) name]
|
||||
[#,ref-schemeterm-ident:tag (name) name]
|
||||
[else
|
||||
(raise
|
||||
(format
|
||||
@ -242,10 +242,10 @@
|
||||
(define (termlink->reference rn)
|
||||
(match rn
|
||||
[(unison-termlink-builtin name)
|
||||
(unison-reference-builtin
|
||||
(ref-reference-builtin
|
||||
(string->chunked-string name))]
|
||||
[(unison-termlink-derived bs i)
|
||||
(unison-reference-derived (unison-id-id bs i))]
|
||||
(ref-reference-derived (ref-id-id bs i))]
|
||||
[else (raise "termlink->reference: con case")]))
|
||||
|
||||
(define (group-reference gr)
|
||||
@ -260,19 +260,19 @@
|
||||
(define runtime-module-map (make-hash))
|
||||
|
||||
(define (reflect-derived bs i)
|
||||
(data unison-reference:typelink unison-reference-derived:tag
|
||||
(data unison-id:typelink unison-id-id:tag bs i)))
|
||||
(data ref-reference:typelink ref-reference-derived:tag
|
||||
(data ref-id:typelink ref-id-id:tag bs i)))
|
||||
|
||||
(define (function->groupref f)
|
||||
(match (lookup-function-link f)
|
||||
[(unison-termlink-derived h i)
|
||||
(unison-groupref-group
|
||||
(unison-reference-derived
|
||||
(unison-id-id h i))
|
||||
(ref-groupref-group
|
||||
(ref-reference-derived
|
||||
(ref-id-id h i))
|
||||
0)]
|
||||
[(unison-termlink-builtin name)
|
||||
(unison-groupref-group
|
||||
(unison-reference-builtin (string->chunked-string name))
|
||||
(ref-groupref-group
|
||||
(ref-reference-builtin (string->chunked-string name))
|
||||
0)]
|
||||
[else (raise "function->groupref: con case")]))
|
||||
|
||||
@ -280,19 +280,19 @@
|
||||
(match vl
|
||||
[(unison-data _ t (list l))
|
||||
(cond
|
||||
[(= t unison-vlit-bytes:tag) l]
|
||||
[(= t unison-vlit-char:tag) l]
|
||||
[(= t unison-vlit-bytearray:tag) l]
|
||||
[(= t unison-vlit-text:tag) l]
|
||||
[(= t unison-vlit-termlink:tag) (referent->termlink l)]
|
||||
[(= t unison-vlit-typelink:tag) (reference->typelink l)]
|
||||
[(= t unison-vlit-float:tag) l]
|
||||
[(= t unison-vlit-pos:tag) l]
|
||||
[(= t unison-vlit-neg:tag) (- l)]
|
||||
[(= t unison-vlit-quote:tag) (unison-quote l)]
|
||||
[(= t unison-vlit-code:tag) (unison-code l)]
|
||||
[(= t unison-vlit-array:tag) (vector-map reify-value l)]
|
||||
[(= t unison-vlit-seq:tag)
|
||||
[(= t ref-vlit-bytes:tag) l]
|
||||
[(= t ref-vlit-char:tag) l]
|
||||
[(= t ref-vlit-bytearray:tag) l]
|
||||
[(= t ref-vlit-text:tag) l]
|
||||
[(= t ref-vlit-termlink:tag) (referent->termlink l)]
|
||||
[(= t ref-vlit-typelink:tag) (reference->typelink l)]
|
||||
[(= t ref-vlit-float:tag) l]
|
||||
[(= t ref-vlit-pos:tag) l]
|
||||
[(= t ref-vlit-neg:tag) (- l)]
|
||||
[(= t ref-vlit-quote:tag) (unison-quote l)]
|
||||
[(= t ref-vlit-code:tag) (unison-code l)]
|
||||
[(= t ref-vlit-array:tag) (vector-map reify-value l)]
|
||||
[(= t ref-vlit-seq:tag)
|
||||
; TODO: better map over chunked list
|
||||
(vector->chunked-list
|
||||
(vector-map reify-value (chunked-list->vector l)))]
|
||||
@ -302,19 +302,19 @@
|
||||
(define (reify-value v)
|
||||
(match v
|
||||
[(unison-data _ t (list rf rt bs0))
|
||||
#:when (= t unison-value-data:tag)
|
||||
#:when (= t ref-value-data:tag)
|
||||
(let ([bs (map reify-value (chunked-list->list bs0))])
|
||||
(make-data (reference->typelink rf) rt bs))]
|
||||
[(unison-data _ t (list gr bs0))
|
||||
#:when (= t unison-value-partial:tag)
|
||||
#:when (= t ref-value-partial:tag)
|
||||
(let ([bs (map reify-value (chunked-list->list bs0))]
|
||||
[proc (resolve-proc gr)])
|
||||
(apply proc bs))]
|
||||
[(unison-data _ t (list vl))
|
||||
#:when (= t unison-value-vlit:tag)
|
||||
#:when (= t ref-value-vlit:tag)
|
||||
(reify-vlit vl)]
|
||||
[(unison-data _ t (list bs0 k))
|
||||
#:when (= t unison-value-cont:tag)
|
||||
#:when (= t ref-value-cont:tag)
|
||||
(raise "reify-value: unimplemented cont case")]
|
||||
[(unison-data r t fs)
|
||||
(raise "reify-value: unimplemented data case")]
|
||||
@ -324,75 +324,75 @@
|
||||
(define (reflect-typelink tl)
|
||||
(match tl
|
||||
[(unison-typelink-builtin name)
|
||||
(unison-reference-builtin
|
||||
(ref-reference-builtin
|
||||
(string->chunked-string name))]
|
||||
[(unison-typelink-derived h i)
|
||||
(unison-reference-derived (unison-id-id h i))]))
|
||||
(ref-reference-derived (ref-id-id h i))]))
|
||||
|
||||
(define (reflect-termlink tl)
|
||||
(match tl
|
||||
[(unison-termlink-con r i)
|
||||
(unison-referent-con (reflect-typelink r) i)]
|
||||
(ref-referent-con (reflect-typelink r) i)]
|
||||
[(unison-termlink-builtin name)
|
||||
(unison-referent-def
|
||||
(unison-reference-builtin
|
||||
(ref-referent-def
|
||||
(ref-reference-builtin
|
||||
(string->chunked-string name)))]
|
||||
[(unison-termlink-derived h i)
|
||||
(unison-referent-def
|
||||
(unison-reference-derived
|
||||
(unison-id-id h i)))]))
|
||||
(ref-referent-def
|
||||
(ref-reference-derived
|
||||
(ref-id-id h i)))]))
|
||||
|
||||
(define (number-reference n)
|
||||
(cond
|
||||
[(exact-nonnegative-integer? n)
|
||||
(unison-reference-builtin (string->chunked-string "Nat"))]
|
||||
(ref-reference-builtin (string->chunked-string "Nat"))]
|
||||
[(exact-integer? n)
|
||||
(unison-reference-builtin (string->chunked-string "Int"))]
|
||||
(ref-reference-builtin (string->chunked-string "Int"))]
|
||||
[else
|
||||
(unison-reference-builtin (string->chunked-string "Float"))]))
|
||||
(ref-reference-builtin (string->chunked-string "Float"))]))
|
||||
|
||||
(define (reflect-value v)
|
||||
(match v
|
||||
[(? exact-nonnegative-integer?)
|
||||
(unison-value-vlit (unison-vlit-pos v))]
|
||||
(ref-value-vlit (ref-vlit-pos v))]
|
||||
[(? exact-integer?)
|
||||
(unison-value-vlit (unison-vlit-neg (- v)))]
|
||||
(ref-value-vlit (ref-vlit-neg (- v)))]
|
||||
[(? inexact-real?)
|
||||
(unison-value-vlit (unison-vlit-float v))]
|
||||
(ref-value-vlit (ref-vlit-float v))]
|
||||
[(? char?)
|
||||
(unison-value-vlit (unison-vlit-char v))]
|
||||
(ref-value-vlit (ref-vlit-char v))]
|
||||
[(? chunked-bytes?)
|
||||
(unison-value-vlit (unison-vlit-bytes v))]
|
||||
(ref-value-vlit (ref-vlit-bytes v))]
|
||||
[(? bytes?)
|
||||
(unison-value-vlit (unison-vlit-bytearray v))]
|
||||
(ref-value-vlit (ref-vlit-bytearray v))]
|
||||
[(? vector?)
|
||||
(unison-value-vlit
|
||||
(unison-vlit-array
|
||||
(ref-value-vlit
|
||||
(ref-vlit-array
|
||||
(vector-map reflect-value v)))]
|
||||
[(? chunked-string?)
|
||||
(unison-value-vlit (unison-vlit-text v))]
|
||||
(ref-value-vlit (ref-vlit-text v))]
|
||||
; TODO: better map over chunked lists
|
||||
[(? chunked-list?)
|
||||
(unison-value-vlit
|
||||
(unison-vlit-seq
|
||||
(ref-value-vlit
|
||||
(ref-vlit-seq
|
||||
(list->chunked-list
|
||||
(map reflect-value (chunked-list->list v)))))]
|
||||
[(? unison-termlink?)
|
||||
(unison-value-vlit (unison-vlit-termlink (reflect-termlink v)))]
|
||||
(ref-value-vlit (ref-vlit-termlink (reflect-termlink v)))]
|
||||
[(? unison-typelink?)
|
||||
(unison-value-vlit (unison-vlit-typelink (reflect-typelink v)))]
|
||||
[(unison-code sg) (unison-value-vlit (unison-vlit-code sg))]
|
||||
[(unison-quote q) (unison-value-vlit (unison-vlit-quote q))]
|
||||
(ref-value-vlit (ref-vlit-typelink (reflect-typelink v)))]
|
||||
[(unison-code sg) (ref-value-vlit (ref-vlit-code sg))]
|
||||
[(unison-quote q) (ref-value-vlit (ref-vlit-quote q))]
|
||||
[(unison-closure f as)
|
||||
(unison-value-partial
|
||||
(ref-value-partial
|
||||
(function->groupref f)
|
||||
(list->chunked-list (map reflect-value as)))]
|
||||
[(? procedure?)
|
||||
(unison-value-partial
|
||||
(ref-value-partial
|
||||
(function->groupref v)
|
||||
empty-chunked-list)]
|
||||
[(unison-data rf t fs)
|
||||
(unison-value-data
|
||||
(ref-value-data
|
||||
(reflect-typelink rf)
|
||||
t
|
||||
(list->chunked-list (map reflect-value fs)))]))
|
||||
@ -428,8 +428,8 @@
|
||||
|
||||
#:result
|
||||
(if (null? unkn)
|
||||
(unison-either-right (list->chunked-list sdbx))
|
||||
(unison-either-left (list->chunked-list unkn))))
|
||||
(ref-either-right (list->chunked-list sdbx))
|
||||
(ref-either-left (list->chunked-list unkn))))
|
||||
|
||||
([r (in-chunked-list (value-term-dependencies v))])
|
||||
|
||||
@ -593,7 +593,7 @@
|
||||
|
||||
,@sdefs
|
||||
|
||||
(handle [unison-exception:typelink] top-exn-handler
|
||||
(handle [ref-exception:typelink] top-exn-handler
|
||||
(,pname #f)))))
|
||||
|
||||
(define (build-runtime-module mname tylinks tmlinks defs)
|
||||
@ -655,7 +655,9 @@
|
||||
(add-module-associations tmlinks mname)
|
||||
(add-runtime-module mname tylinks tmlinks sdefs)
|
||||
#f)]
|
||||
[else (list->chunked-list rdeps)]))]
|
||||
[else
|
||||
(list->chunked-list
|
||||
(map reference->termlink rdeps))]))]
|
||||
[else #f])))
|
||||
|
||||
(define (unison-POp-CACH dfns0)
|
||||
@ -671,14 +673,16 @@
|
||||
[fdeps (filter need-dependency? (chunked-list->list deps))])
|
||||
(if (null? fdeps)
|
||||
(sum 1 (reify-value val))
|
||||
(sum 0 (list->chunked-list fdeps)))))
|
||||
(sum 0
|
||||
(list->chunked-list
|
||||
(map reference->termlink fdeps))))))
|
||||
|
||||
(define (unison-POp-LKUP tl) (lookup-code tl))
|
||||
|
||||
(define-unison (builtin-Code.lookup tl)
|
||||
(match (lookup-code tl)
|
||||
[(unison-sum 0 (list)) unison-optional-none]
|
||||
[(unison-sum 1 (list co)) (unison-optional-some co)]))
|
||||
[(unison-sum 0 (list)) ref-optional-none]
|
||||
[(unison-sum 1 (list co)) (ref-optional-some co)]))
|
||||
|
||||
(define-unison (builtin-validateSandboxed ok v)
|
||||
(let ([l (sandbox-scheme-value (chunked-list->list ok) v)])
|
||||
|
||||
@ -24,13 +24,6 @@
|
||||
#!r6rs
|
||||
(library (unison primops)
|
||||
(export
|
||||
builtin-Any:typelink
|
||||
builtin-Char:typelink
|
||||
builtin-Float:typelink
|
||||
builtin-Int:typelink
|
||||
builtin-Nat:typelink
|
||||
builtin-Text:typelink
|
||||
|
||||
builtin-Float.*
|
||||
builtin-Float.*:termlink
|
||||
builtin-Float.>=
|
||||
@ -645,13 +638,6 @@
|
||||
(unison concurrent)
|
||||
(racket random))
|
||||
|
||||
(define builtin-Any:typelink unison-any:typelink)
|
||||
(define builtin-Char:typelink unison-char:typelink)
|
||||
(define builtin-Float:typelink unison-float:typelink)
|
||||
(define builtin-Int:typelink unison-int:typelink)
|
||||
(define builtin-Nat:typelink unison-nat:typelink)
|
||||
(define builtin-Text:typelink unison-text:typelink)
|
||||
|
||||
(define-builtin-link Float.*)
|
||||
(define-builtin-link Float.fromRepresentation)
|
||||
(define-builtin-link Float.toRepresentation)
|
||||
@ -780,13 +766,13 @@
|
||||
|
||||
(define-unison (builtin-List.splitLeft n s)
|
||||
(match (unison-POp-SPLL n s)
|
||||
[(unison-sum 0 fs) unison-seqview-empty]
|
||||
[(unison-sum 1 (list l r)) (unison-seqview-elem l r)]))
|
||||
[(unison-sum 0 fs) ref-seqview-empty]
|
||||
[(unison-sum 1 (list l r)) (ref-seqview-elem l r)]))
|
||||
|
||||
(define-unison (builtin-List.splitRight n s)
|
||||
(match (unison-POp-SPLR n s)
|
||||
[(unison-sum 0 fs) unison-seqview-empty]
|
||||
[(unison-sum 1 (list l r)) (unison-seqview-elem l r)]))
|
||||
[(unison-sum 0 fs) ref-seqview-empty]
|
||||
[(unison-sum 1 (list l r)) (ref-seqview-elem l r)]))
|
||||
|
||||
(define-unison (builtin-Float.> x y) (fl> x y))
|
||||
(define-unison (builtin-Float.< x y) (fl< x y))
|
||||
@ -896,7 +882,7 @@
|
||||
(define (reify-exn thunk)
|
||||
(guard
|
||||
(e [else
|
||||
(sum 0 '() (exception->string e) e)])
|
||||
(sum 0 '() (exception->string e) ref-unit-unit)])
|
||||
(thunk)))
|
||||
|
||||
; Core implemented primops, upon which primops-in-unison can be built.
|
||||
@ -977,8 +963,8 @@
|
||||
|
||||
(define (->optional v)
|
||||
(if v
|
||||
(unison-optional-some v)
|
||||
unison-optional-none))
|
||||
(ref-optional-some v)
|
||||
ref-optional-none))
|
||||
|
||||
(define-unison (builtin-Text.indexOf n h)
|
||||
(->optional (chunked-string-index-of h n)))
|
||||
@ -1130,7 +1116,7 @@
|
||||
([exn:fail:contract?
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-iofailure:typelink
|
||||
ref-iofailure:typelink
|
||||
(string->chunked-string
|
||||
(string-append
|
||||
"Invalid UTF-8 stream: "
|
||||
@ -1143,7 +1129,7 @@
|
||||
(bytes->chunked-bytes (string->bytes/utf-8 (chunked-string->string s))))
|
||||
|
||||
(define-unison (builtin-IO.isFileEOF.impl.v3 p)
|
||||
(unison-either-right (port-eof? p)))
|
||||
(ref-either-right (port-eof? p)))
|
||||
|
||||
(define (unison-FOp-IO.closeFile.impl.v3 h)
|
||||
(if (input-port? h)
|
||||
|
||||
@ -30,21 +30,22 @@
|
||||
[[exn:fail:network?
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-iofailure:typelink
|
||||
(exception->string e) '()))]
|
||||
ref-iofailure:typelink
|
||||
(exception->string e)
|
||||
ref-unit-unit))]
|
||||
[exn:fail:contract?
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-miscfailure:typelink
|
||||
ref-miscfailure:typelink
|
||||
(exception->string e)
|
||||
'()))]
|
||||
ref-unit-unit))]
|
||||
[(lambda _ #t)
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-miscfailure:typelink
|
||||
ref-miscfailure:typelink
|
||||
(chunked-string->string
|
||||
(format "Unknown exception ~a" (exn->string e)))
|
||||
e))]]
|
||||
ref-unit-unit))]]
|
||||
(fn)))
|
||||
|
||||
(define (closeSocket.impl.v3 socket)
|
||||
@ -66,9 +67,9 @@
|
||||
(define (socketSend.impl.v3 socket data) ; socket bytes -> ()
|
||||
(if (not (socket-pair? socket))
|
||||
(exception
|
||||
unison-iofailure:typelink
|
||||
"Cannot send on a server socket"
|
||||
'())
|
||||
ref-iofailure:typelink
|
||||
(string->chunked-string "Cannot send on a server socket")
|
||||
ref-unit-unit)
|
||||
(begin
|
||||
(write-bytes (chunked-bytes->bytes data) (socket-pair-output socket))
|
||||
(flush-output (socket-pair-output socket))
|
||||
@ -77,8 +78,8 @@
|
||||
(define (socketReceive.impl.v3 socket amt) ; socket int -> bytes
|
||||
(if (not (socket-pair? socket))
|
||||
(exception
|
||||
unison-iofailure:typelink
|
||||
"Cannot receive on a server socket")
|
||||
ref-iofailure:typelink
|
||||
(string->chunked-string "Cannot receive on a server socket"))
|
||||
(handle-errors
|
||||
(lambda ()
|
||||
(begin
|
||||
@ -106,20 +107,21 @@
|
||||
[[exn:fail:network?
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-iofailure:typelink
|
||||
(exception->string e) '()))]
|
||||
ref-iofailure:typelink
|
||||
(exception->string e)
|
||||
ref-unit-unit))]
|
||||
[exn:fail:contract?
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-iofailure:typelink
|
||||
ref-iofailure:typelink
|
||||
(exception->string e)
|
||||
'()))]
|
||||
ref-unit-unit))]
|
||||
[(lambda _ #t)
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-miscfailure:typelink
|
||||
ref-miscfailure:typelink
|
||||
(string->chunked-string "Unknown exception")
|
||||
e))] ]
|
||||
ref-unit-unit))] ]
|
||||
(let ([listener (tcp-listen (string->number port ) 4 #f (if (equal? 0 hostname) #f hostname))])
|
||||
(right listener))))))
|
||||
|
||||
@ -135,9 +137,9 @@
|
||||
(define (socketAccept.impl.v3 listener)
|
||||
(if (socket-pair? listener)
|
||||
(exception
|
||||
unison-iofailure:typelink
|
||||
ref-iofailure:typelink
|
||||
(string->chunked-string "Cannot accept on a non-server socket")
|
||||
'())
|
||||
ref-unit-unit)
|
||||
(begin
|
||||
(let-values ([(input output) (tcp-accept listener)])
|
||||
(right (socket-pair input output))))))
|
||||
|
||||
@ -63,8 +63,9 @@
|
||||
(if (= 1 (length certs))
|
||||
(right bytes)
|
||||
(exception
|
||||
unison-tlsfailure:typelink
|
||||
(string->chunked-string "nope") certs)))) ; TODO passing certs is wrong, should either be converted to chunked-list or removed
|
||||
ref-tlsfailure:typelink
|
||||
(string->chunked-string "nope")
|
||||
bytes))))
|
||||
|
||||
; We don't actually "decode" certificates, we just validate them
|
||||
(define (encodeCert bytes) bytes)
|
||||
@ -119,35 +120,36 @@
|
||||
[[exn:fail:network?
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-iofailure:typelink
|
||||
(exception->string e) '()))]
|
||||
ref-iofailure:typelink
|
||||
(exception->string e)
|
||||
ref-unit-unit))]
|
||||
[exn:fail:contract?
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-miscfailure:typelink
|
||||
ref-miscfailure:typelink
|
||||
(exception->string e)
|
||||
'()))]
|
||||
ref-unit-unit))]
|
||||
[(lambda err
|
||||
(string-contains? (exn->string err) "not valid for hostname"))
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-tlsfailure:typelink
|
||||
ref-tlsfailure:typelink
|
||||
(string->chunked-string "NameMismatch")
|
||||
'()))]
|
||||
ref-unit-unit))]
|
||||
[(lambda err
|
||||
(string-contains? (exn->string err) "certificate verify failed"))
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-tlsfailure:typelink
|
||||
ref-tlsfailure:typelink
|
||||
(string->chunked-string "certificate verify failed")
|
||||
'()))]
|
||||
ref-unit-unit))]
|
||||
[(lambda _ #t)
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-miscfailure:typelink
|
||||
ref-miscfailure:typelink
|
||||
(string->chunked-string
|
||||
(format "Unknown exception ~a" (exn->string e)))
|
||||
e))]]
|
||||
ref-unit-unit))]]
|
||||
(fn)))
|
||||
|
||||
(define (newClient.impl.v3 config socket)
|
||||
|
||||
@ -110,7 +110,7 @@
|
||||
[[exn:fail?
|
||||
(lambda (e)
|
||||
(exception
|
||||
unison-miscfailure:typelink
|
||||
ref-miscfailure:typelink
|
||||
(exception->string e)
|
||||
'()))]]
|
||||
(right
|
||||
|
||||
@ -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.12 lib.jit
|
||||
jit-setup/main> pull @unison/internal/releases/0.0.13 lib.jit
|
||||
```
|
||||
|
||||
```unison
|
||||
|
||||
@ -20,9 +20,9 @@ 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.12 lib.jit
|
||||
jit-setup/main> pull @unison/internal/releases/0.0.13 lib.jit
|
||||
|
||||
Downloaded 15048 entities.
|
||||
Downloaded 15053 entities.
|
||||
|
||||
✅
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user