diff --git a/.github/workflows/ci.md b/.github/workflows/ci.md index 4f0de29bf9..e23874d7ac 100644 --- a/.github/workflows/ci.md +++ b/.github/workflows/ci.md @@ -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.17"` +- `jit_version: "@unison/internal/releases/0.0.18"` Some cached directories: - `ucm_local_bin` a temp path for caching a built `ucm` diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 8a5e089ce4..51f1f720f3 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -14,7 +14,7 @@ on: env: ormolu_version: 0.5.2.0 ucm_local_bin: ucm-local-bin - jit_version: "@unison/internal/releases/0.0.17" + jit_version: "@unison/internal/releases/0.0.18" jit_src_scheme: unison-jit-src/scheme-libs/racket jit_dist: unison-jit-dist jit_generator_os: ubuntu-20.04 diff --git a/scheme-libs/racket/unison/arithmetic.rkt b/scheme-libs/racket/unison/arithmetic.rkt index d9a63d9eb5..a50364eb55 100644 --- a/scheme-libs/racket/unison/arithmetic.rkt +++ b/scheme-libs/racket/unison/arithmetic.rkt @@ -1,70 +1,103 @@ #!racket/base (provide - (prefix-out - builtin- - (combine-out - Nat.toFloat - Nat.increment - Nat.+ - Nat.drop - Float.* - Float.fromRepresentation - Float.toRepresentation - Float.ceiling - Int.+ - Int.- - Int./ - Int.increment - Int.negate - Int.fromRepresentation - Int.toRepresentation - Int.signum - ))) + builtin-Nat.+ + builtin-Nat.+:termlink + builtin-Nat.toFloat + builtin-Nat.toFloat:termlink + builtin-Nat.increment + builtin-Nat.increment:termlink + builtin-Nat.drop + builtin-Nat.drop:termlink + builtin-Float.* + builtin-Float.*:termlink + builtin-Float.fromRepresentation + builtin-Float.fromRepresentation:termlink + builtin-Float.toRepresentation + builtin-Float.toRepresentation:termlink + builtin-Float.ceiling + builtin-Float.ceiling:termlink + builtin-Int.+ + builtin-Int.+:termlink + builtin-Int.- + builtin-Int.-:termlink + builtin-Int./ + builtin-Int./:termlink + builtin-Int.increment + builtin-Int.increment:termlink + builtin-Int.negate + builtin-Int.negate:termlink + builtin-Int.fromRepresentation + builtin-Int.fromRepresentation:termlink + builtin-Int.toRepresentation + builtin-Int.toRepresentation:termlink + builtin-Int.signum + builtin-Int.signum:termlink) (require racket racket/fixnum racket/flonum racket/performance-hint + unison/data unison/boot) (begin-encourage-inline - (define-unison (Nat.+ m n) (clamp-natural (+ m n))) - (define-unison (Nat.drop m n) (max 0 (- m n))) + (define-unison-builtin + (builtin-Nat.+ m n) + (clamp-natural (+ m n))) - (define-unison (Nat.increment n) (clamp-natural (add1 n))) - (define-unison (Int.increment i) (clamp-integer (add1 i))) - (define-unison (Int.negate i) (if (> i nbit63) (- i) i)) - (define-unison (Int.+ i j) (clamp-integer (+ i j))) - (define-unison (Int.- i j) (clamp-integer (- i j))) - (define-unison (Int./ i j) (floor (/ i j))) - (define-unison (Int.signum i) (sgn i)) - (define-unison (Float.* x y) (fl* x y)) + (define-unison-builtin + (builtin-Nat.drop m n) + (max 0 (- m n))) - (define-unison (Nat.toFloat n) (->fl n)) + (define-unison-builtin + (builtin-Nat.increment n) + (clamp-natural (add1 n))) + (define-unison-builtin + (builtin-Int.increment i) (clamp-integer (add1 i))) + (define-unison-builtin + (builtin-Int.negate i) (if (> i nbit63) (- i) i)) + (define-unison-builtin + (builtin-Int.+ i j) (clamp-integer (+ i j))) + (define-unison-builtin + (builtin-Int.- i j) (clamp-integer (- i j))) + (define-unison-builtin + (builtin-Int./ i j) (floor (/ i j))) + (define-unison-builtin + (builtin-Int.signum i) (sgn i)) + (define-unison-builtin + (builtin-Float.* x y) (fl* x y)) - (define-unison (Float.ceiling f) + (define-unison-builtin + (builtin-Nat.toFloat n) (->fl n)) + + (define-unison-builtin + (builtin-Float.ceiling f) (clamp-integer (fl->exact-integer (ceiling f)))) ; If someone can suggest a better mechanism for these, ; that would be appreciated. - (define-unison (Float.toRepresentation fl) + (define-unison-builtin + (builtin-Float.toRepresentation fl) (integer-bytes->integer (real->floating-point-bytes fl 8 #t) ; big endian #f ; unsigned #t)) ; big endian - (define-unison (Float.fromRepresentation n) + (define-unison-builtin + (builtin-Float.fromRepresentation n) (floating-point-bytes->real (integer->integer-bytes n 8 #f #t) ; unsigned, big endian #t)) ; big endian - (define-unison (Int.toRepresentation i) + (define-unison-builtin + (builtin-Int.toRepresentation i) (integer-bytes->integer (integer->integer-bytes i 8 #t #t) ; signed, big endian #f #t)) ; unsigned, big endian - (define-unison (Int.fromRepresentation n) + (define-unison-builtin + (builtin-Int.fromRepresentation n) (integer-bytes->integer (integer->integer-bytes n 8 #f #t) ; unsigned, big endian #t #t)) ; signed, big endian diff --git a/scheme-libs/racket/unison/boot.ss b/scheme-libs/racket/unison/boot.ss index 67d390f9cf..ed8b0f7d35 100644 --- a/scheme-libs/racket/unison/boot.ss +++ b/scheme-libs/racket/unison/boot.ss @@ -55,6 +55,7 @@ bytes control define-unison + define-unison-builtin handle name data @@ -116,14 +117,16 @@ (require (for-syntax racket/set - (only-in racket partition flatten)) + (only-in racket partition flatten split-at) + (only-in racket/string string-prefix?) + (only-in racket/syntax format-id)) (rename-in (except-in racket false true unit any) [make-continuation-prompt-tag make-prompt]) ; (for (only (compatibility mlist) mlist->list list->mlist) expand) ; (for (only (racket base) quasisyntax/loc) expand) ; (for-syntax (only-in unison/core syntax->list)) - (only-in racket/control prompt0-at control0-at) + (only-in racket/control control0-at) racket/performance-hint unison/core unison/data @@ -151,115 +154,301 @@ (syntax-rules () [(with-name name e) (let ([name e]) name)])) -; function definition with slow/fast path. Slow path allows for -; under/overapplication. Fast path is exact application. +; Our definition macro needs to generate multiple entry points for the +; defined procedures, so this is a function for making up names for +; those based on the original. +(define-for-syntax (adjust-symbol name post) + (string->symbol + (string-append + (symbol->string name) + ":" + post))) + +(define-for-syntax (adjust-name name post) + (datum->syntax name (adjust-symbol (syntax->datum name) post) name)) + +; Helper function. Turns a list of syntax objects into a +; list-syntax object. +(define-for-syntax (list->syntax l) #`(#,@l)) + +; These are auxiliary functions for manipulating a unison definition +; into a form amenable for the right runtime behavior. This involves +; multiple separate definitions: ; -; The intent is for the scheme compiler to be able to recognize and -; optimize static, fast path calls itself, while still supporting -; unison-like automatic partial application and such. -(define-syntax (define-unison x) - (define (fast-path-symbol name) - (string->symbol - (string-append - (symbol->string name) - ":fast-path"))) - - (define (fast-path-name name) - (datum->syntax name (fast-path-symbol (syntax->datum name)))) - - ; Helper function. Turns a list of syntax objects into a - ; list-syntax object. - (define (list->syntax l) #`(#,@l)) - ; Builds partial application cases for unison functions. - ; It seems most efficient to have a case for each posible - ; under-application. - (define (build-partials name formals) - (let rec ([us formals] [acc '()]) - (syntax-case us () - [() (list->syntax (cons #`[() #,name] acc))] - [(a ... z) - (rec #'(a ...) - (cons - #`[(a ... z) - (with-name - #,(datum->syntax name (syntax->datum name)) - (partial-app #,name a ... z))] - acc))]))) - - ; Given an overall function name, a fast path name, and a list of - ; arguments, builds the case-lambda body of a unison function that - ; enables applying to arbitrary numbers of arguments. - (define (func-cases name name:fast args) - (syntax-case args () - [() (quasisyntax/loc x - (case-lambda - [() (#,name:fast)] - [r (apply (#,name:fast) r)]))] - [(a ... z) - (quasisyntax/loc x - (case-lambda - #,@(build-partials name #'(a ...)) - [(a ... z) (#,name:fast a ... z)] - [(a ... z . r) (apply (#,name:fast a ... z) r)]))])) - - (syntax-case x () - [(define-unison (name a ...) e ...) - (let ([fname (fast-path-name #'name)]) - (with-syntax ([name:fast fname] - [fast (syntax/loc x (lambda (a ...) e ...))] - [slow (func-cases #'name fname #'(a ...))]) - (syntax/loc x - (define-values (name:fast name) (values fast slow)))))])) +; 1. an :impl definition is generated containing the actual code body +; 2. a :fast definition, which takes exactly the number of arguments +; as the original, but checks if stack information needs to be +; stored for continuation serialization. +; 3. a :slow path which implements under/over application to unison +; definitions, so they act like curried functions, not scheme +; procedures +; 4. a macro that implements the actual occurrences, and directly +; calls the fast path for static calls with exactly the right +; number of arguments +; +; Additionally, arguments are threaded through the internal +; definitions that indicate whether an ability handler is in place +; that could potentially result in the continuation being serialized. +; If so, then calls write additional information to the continuation +; for that serialization. This isn't cheap for tight loops, so we +; attempt to avoid this as much as possible (conditioning the +; annotation on a flag checkseems to cause no performance loss). + + +; This builds the core definition for a unison definition. It is just +; a lambda expression with the original code, but with an additional +; keyword argument for threading purity information. +(define-for-syntax (make-impl name:impl:stx arg:stx body:stx) + (with-syntax ([name:impl name:impl:stx] + [args arg:stx] + [body body:stx]) + (syntax/loc body:stx + (define (name:impl #:pure pure? . args) . body)))) + +(define frame-contents (gensym)) + +; Builds the wrapper definition, 'fast path,' which just tests the +; purity, writes the stack information if necessary, and calls the +; implementation. If #:force-pure is specified, the fast path just +; directly calls the implementation procedure. This should allow +; tight loops to still perform well if we can detect that they +; (hereditarily) cannot make ability requests, even in contexts +; where a handler is present. +(define-for-syntax + (make-fast-path + #:force-pure force-pure? + loc ; original location + name:fast:stx name:impl:stx + arg:stx) + + (with-syntax ([name:impl name:impl:stx] + [name:fast name:fast:stx] + [args arg:stx]) + (if force-pure? + (syntax/loc loc + (define name:fast name:impl)) + + (syntax/loc loc + (define (name:fast #:pure pure? . args) + (if pure? + (name:impl #:pure pure? . args) + (with-continuation-mark + frame-contents + (vector . args) + (name:impl #:pure pure? . args)))))))) + +; Slow path -- unnecessary +; (define-for-syntax (make-slow-path loc name argstx) +; (with-syntax ([name:slow (adjust-symbol name "slow")] +; [n (length (syntax->list argstx))]) +; (syntax/loc loc +; (define (name:slow #:pure pure? . as) +; (define k (length as)) +; (cond +; [(< k n) (unison-closure n name:slow as)] +; [(= k n) (apply name:fast #:pure pure? as)] +; [(> k n) +; (define-values (h t) (split-at as n)) +; (apply +; (apply name:fast #:pure pure? h) +; #:pure pure? +; t)]))))) + +; This definition builds a macro that defines the behavior of actual +; occurences of the definition names. It has the following behavior: +; +; 1. Exactly saturated occurences directly call the fast path +; 2. Undersaturated or unapplied occurrences become closure +; construction +; 3. Oversaturated occurrences become an appropriate nested +; application +; +; Because of point 2, all function values end up represented as +; unison-closure objects, so a slow path procedure is no longer +; necessary; it is handled by the prop:procedure of the closure +; structure. This should also make various universal operations easier +; to handle, because we can just test for unison-closures, instead of +; having to deal with raw procedures. +(define-for-syntax + (make-callsite-macro + #:internal internal? + loc ; original location + name:stx name:fast:stx + arity:val) + (with-syntax ([name name:stx] + [name:fast name:fast:stx] + [arity arity:val]) + (cond + [internal? + (syntax/loc loc + (define-syntax (name stx) + (syntax-case stx () + [(_ #:by-name _ . bs) + (syntax/loc stx + (unison-closure arity name:fast (list . bs)))] + [(_ . bs) + (let ([k (length (syntax->list #'bs))]) + (cond + [(= arity k) ; saturated + (syntax/loc stx + (name:fast #:pure #t . bs))] + [(> arity k) ; undersaturated + (syntax/loc stx + (unison-closure arity name:fast (list . bs)))] + [(< arity k) ; oversaturated + (define-values (h t) + (split-at (syntax->list #'bs) arity)) + + (quasisyntax/loc stx + ((name:fast #:pure #t #,@h) #,@t))]))] + [_ (syntax/loc stx + (unison-closure arity name:fast (list)))])))] + [else + (syntax/loc loc + (define-syntax (name stx) + (syntax-case stx () + [(_ #:by-name _ . bs) + (syntax/loc stx + (unison-closure arity name:fast (list . bs)))] + [(_ . bs) + (let ([k (length (syntax->list #'bs))]) + + ; todo: purity + + ; capture local pure? + (with-syntax ([pure? (format-id stx "pure?")]) + (cond + [(= arity k) ; saturated + (syntax/loc stx + (name:fast #:pure pure? . bs))] + [(> arity k) + (syntax/loc stx + (unison-closure n name:fast (list . bs)))] + [(< arity k) ; oversaturated + (define-values (h t) + (split-at (syntax->list #'bs) arity)) + + ; TODO: pending argument frame + (quasisyntax/loc stx + ((name:fast #:pure pure? #,@h) + #:pure pure? + #,@t))])))] + ; non-applied occurrence; partial ap immediately + [_ (syntax/loc stx + (unison-closure arity name:fast (list)))])))]))) + +(define-for-syntax + (link-decl no-link-decl? loc name:stx name:fast:stx name:impl:stx) + (if no-link-decl? + #'() + (let ([name:link:stx (adjust-name name:stx "termlink")]) + (with-syntax + ([name:fast name:fast:stx] + [name:impl name:impl:stx] + [name:link name:link:stx]) + (syntax/loc loc + ((declare-function-link name:fast name:link) + (declare-function-link name:impl name:link))))))) + +(define-for-syntax (process-hints hs) + (for/fold ([internal? #f] + [force-pure? #t] + [gen-link? #f] + [no-link-decl? #f]) + ([h hs]) + (values + (or internal? (eq? h 'internal)) + (or force-pure? (eq? h 'force-pure) (eq? h 'internal)) + (or gen-link? (eq? h 'gen-link)) + (or no-link-decl? (eq? h 'no-link-decl))))) + +(define-for-syntax + (make-link-def gen-link? loc name:stx name:link:stx) + + (define (chop s) + (if (string-prefix? s "builtin-") + (substring s 8) + s)) + + (define name:txt + (chop + (symbol->string + (syntax->datum name:stx)))) + + (cond + [gen-link? + (with-syntax ([name:link name:link:stx]) + (quasisyntax/loc loc + ((define name:link + (unison-termlink-builtin #,name:txt)))))] + [else #'()])) + +(define-for-syntax + (expand-define-unison + #:hints hints + loc name:stx arg:stx expr:stx) + + (define-values + (internal? force-pure? gen-link? no-link-decl?) + (process-hints hints)) + + (let ([name:fast:stx (adjust-name name:stx "fast")] + [name:impl:stx (adjust-name name:stx "impl")] + [name:link:stx (adjust-name name:stx "termlink")] + [arity (length (syntax->list arg:stx))]) + (with-syntax + ([(link ...) (make-link-def gen-link? loc name:stx name:link:stx)] + [fast (make-fast-path + #:force-pure force-pure? + loc name:fast:stx name:impl:stx arg:stx)] + [impl (make-impl name:impl:stx arg:stx expr:stx)] + [call (make-callsite-macro + #:internal internal? + loc name:stx name:fast:stx arity)] + [(decls ...) + (link-decl no-link-decl? loc name:stx name:fast:stx name:impl:stx)]) + (syntax/loc loc + (begin link ... impl fast call decls ...))))) + +; Function definition supporting various unison features, like +; partial application and continuation serialization. See above for +; details. +; +; `#:internal #t` indicates that the definition is for builtin +; functions. These should always be built in a way that does not +; annotate the stack, because they don't make relevant ability +; requests. This is important for performance and some correct +; behavior (i.e. they may occur in non-unison contexts where a +; `pure?` indicator is not being threaded). +(define-syntax (define-unison stx) + (syntax-case stx () + [(define-unison #:hints hs (name . args) . exprs) + (expand-define-unison + #:hints (syntax->datum #'hs) + stx #'name #'args #'exprs)] + [(define-unison (name . args) . exprs) + (expand-define-unison + #:hints '[internal] + stx #'name #'args #'exprs)])) + +(define-syntax (define-unison-builtin stx) + (syntax-case stx () + [(define-unison-builtin . rest) + (syntax/loc stx + (define-unison #:hints [internal gen-link] . rest))])) ; call-by-name bindings -(define-syntax name - (lambda (stx) - (syntax-case stx () - ((name ([v (f . args)] ...) body ...) - (with-syntax ([(lam ...) - (map (lambda (body) - (quasisyntax/loc stx - (lambda r #,body))) - (syntax->list #'[(apply f (append (list . args) r)) ...]))]) - #`(let ([v lam] ...) - body ...)))))) +(define-syntax (name stx) + (syntax-case stx () + [(name ([v (f . args)] ...) body ...) + (syntax/loc stx + (let ([v (f #:by-name #t . args)] ...) body ...))])) ; Wrapper that more closely matches `handle` constructs -; -; Note: this uses the prompt _twice_ to achieve the sort of dynamic -; scoping we want. First we push an outer delimiter, then install -; the continuation marks corresponding to the handled abilities -; (which tells which propt to use for that ability and which -; functions to use for each request). Then we re-delimit by the same -; prompt. -; -; If we just used one delimiter, we'd have a problem. If we pushed -; the marks _after_ the delimiter, then the continuation captured -; when handling would contain those marks, and would effectively -; retain the handler for requests within the continuation. If the -; marks were outside the prompt, we'd be in a similar situation, -; except where the handler would be automatically handling requests -; within its own implementation (although, in both these cases we'd -; get control errors, because we would be using the _function_ part -; of the handler without the necessary delimiters existing on the -; continuation). Both of these situations are wrong for _shallow_ -; handlers. -; -; Instead, what we need to be able to do is capture the continuation -; _up to_ the marks, then _discard_ the marks, and this is what the -; multiple delimiters accomplish. There might be more efficient ways -; to accomplish this with some specialized mark functions, but I'm -; uncertain of what pitfalls there are with regard to that (whehter -; they work might depend on exact frame structure of the -; metacontinuation). (define-syntax handle (syntax-rules () [(handle [r ...] h e ...) - (let ([p (make-prompt)]) - (prompt0-at p - (let ([v (let-marks (list r ...) (cons p h) - (prompt0-at p e ...))]) - (h (make-pure v)))))])) + (call-with-handler (list r ...) h (lambda () e ...))])) ; wrapper that more closely matches ability requests (define-syntax request diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 2049e23b37..a929ad77c8 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -66,17 +66,17 @@ [cas! (lambda () (unsafe-struct*-cas! promise 2 value (some new-value)))] [awake-readers (lambda () (semaphore-post (promise-semaphore promise)))]) (cond - [(some? value) false] + [(some? value) sum-false] [else - (let ([ok (parameterize-break #f (if (cas!) (awake-readers) false))]) - (if ok true (loop)))])))) + (let ([ok (parameterize-break #f (if (cas!) (awake-readers) sum-false))]) + (if ok sum-true (loop)))])))) (define (ref-cas ref ticket value) - (if (box-cas! ref ticket value) true false)) + (if (box-cas! ref ticket value) sum-true sum-false)) (define (sleep n) (sleep-secs (/ n 1000000)) - (right unit)) + (right sum-unit)) ;; Swallows uncaught breaks/thread kills rather than logging them to ;; match the behaviour of the Haskell runtime @@ -88,5 +88,5 @@ (define (kill threadId) (break-thread threadId) - (right unit)) + (right sum-unit)) ) diff --git a/scheme-libs/racket/unison/core.ss b/scheme-libs/racket/unison/core.ss index a273938150..0985c20464 100644 --- a/scheme-libs/racket/unison/core.ss +++ b/scheme-libs/racket/unison/core.ss @@ -23,6 +23,7 @@ (struct-out exn:bug) let-marks + call-with-marks ref-mark chunked-string-foldMap-chunks @@ -192,7 +193,9 @@ (string-append "{Value " (describe-value v) "}")] [(unison-code v) (string-append "{Code " (describe-value v) "}")] - [(unison-closure code env) + [(unison-cont-reflected fs) "{Continuation}"] + [(unison-cont-wrapped _) "{Continuation}"] + [(unison-closure _ code env) (define dc (termlink->string (lookup-function-link code) #t)) (define (f v) @@ -437,13 +440,6 @@ ; [() '()] ; [(x . xs) (cons #'x (syntax->list #'xs))])) -(define (call-with-marks rs v f) - (cond - [(null? rs) (f)] - [else - (with-continuation-mark (car rs) v - (call-with-marks (cdr rs) v f))])) - (define-syntax let-marks (syntax-rules () [(let-marks ks bn e ...) diff --git a/scheme-libs/racket/unison/data.ss b/scheme-libs/racket/unison/data.ss index 7ab75d6d5b..a110be41f2 100644 --- a/scheme-libs/racket/unison/data.ss +++ b/scheme-libs/racket/unison/data.ss @@ -12,6 +12,12 @@ have-code? (struct-out unison-data) + (struct-out unison-continuation) + (struct-out unison-cont-wrapped) + (struct-out unison-cont-reflected) + (struct-out unison-frame) + (struct-out unison-frame-push) + (struct-out unison-frame-mark) (struct-out unison-sum) (struct-out unison-pure) (struct-out unison-request) @@ -27,6 +33,9 @@ (struct-out unison-quote) (struct-out unison-timespec) + call-with-handler + call-with-marks + define-builtin-link declare-builtin-link @@ -45,9 +54,9 @@ left? either-get either-get - unit - false - true + sum-unit + sum-false + sum-true bool char ord @@ -100,12 +109,15 @@ builtin-tls.version:typelink unison-tuple->list + unison-pair->cons typelink->string termlink->string) (require - racket + (rename-in racket + [make-continuation-prompt-tag make-prompt]) + (only-in racket/control prompt0-at control0-at) racket/fixnum (only-in "vector-trie.rkt" ->fx/wraparound) unison/bytevector) @@ -290,13 +302,10 @@ (write-string ")" port)) (struct unison-closure - (code env) + (arity 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] @@ -308,12 +317,31 @@ (write-string " " port) (write-sequence (unison-closure-env clo) port mode) (write-string ")" port))] + + ; This has essentially becomes the slow path for unison function + ; application. The definition macro immediately creates a closure + ; for any statically under-saturated call or unapplied occurrence. + ; This means that there is never a bare unison function being passed + ; as a value. So, we can define the slow path here once and for all. #:property prop:procedure - (case-lambda - [(clo) clo] - [(clo . rest) - (apply (unison-closure-code clo) - (append (unison-closure-env clo) rest))])) + (lambda (clo #:pure [pure? #f] #:by-name [by-name? #f] . rest) + (define arity (unison-closure-arity clo)) + (define old-env (unison-closure-env clo)) + (define code (unison-closure-code clo)) + + (define new-env (append old-env rest)) + (define k (length rest)) + (define l (length new-env)) + (cond + [(or by-name? (> arity l)) + (struct-copy unison-closure clo [env new-env])] + [(= arity l) ; saturated + (apply code #:pure pure? new-env)] + [(= k 0) clo] ; special case, 0-applying undersaturated + [(< arity l) + ; TODO: pending arg annotation if no pure? + (define-values (now pending) (split-at new-env arity)) + (apply (apply code #:pure pure? now) #:pure pure? pending)]))) (struct unison-timespec (sec nsec) #:transparent @@ -335,6 +363,115 @@ (list equal-proc (hash-proc 3) (hash-proc 5)))) +; This is the base struct for continuation representations. It has +; two possibilities seen below. +(struct unison-continuation () #:transparent) + +; This is a wrapper that allows for a struct representation of all +; continuations involved in unison. I.E. instead of just passing +; around a raw racket continuation, we wrap it in a box for easier +; identification. +(struct unison-cont-wrapped unison-continuation (cont) + ; Use the wrapped continuation for procedure calls. Continuations + ; will always be called via the jumpCont wrapper which exactly + ; applies them to one argument. + #:property prop:procedure 0) + +; Basic mechanism for installing handlers, defined here so that it +; can be used in the implementation of reflected continuations. +; +; Note: this uses the prompt _twice_ to achieve the sort of dynamic +; scoping we want. First we push an outer delimiter, then install +; the continuation marks corresponding to the handled abilities +; (which tells which propt to use for that ability and which +; functions to use for each request). Then we re-delimit by the same +; prompt. +; +; If we just used one delimiter, we'd have a problem. If we pushed +; the marks _after_ the delimiter, then the continuation captured +; when handling would contain those marks, and would effectively +; retain the handler for requests within the continuation. If the +; marks were outside the prompt, we'd be in a similar situation, +; except where the handler would be automatically handling requests +; within its own implementation (although, in both these cases we'd +; get control errors, because we would be using the _function_ part +; of the handler without the necessary delimiters existing on the +; continuation). Both of these situations are wrong for _shallow_ +; handlers. +; +; Instead, what we need to be able to do is capture the continuation +; _up to_ the marks, then _discard_ the marks, and this is what the +; multiple delimiters accomplish. There might be more efficient ways +; to accomplish this with some specialized mark functions, but I'm +; uncertain of what pitfalls there are with regard to that (whehter +; they work might depend on exact frame structure of the +; metacontinuation). +(define (call-with-handler rs h f) + (let ([p (make-prompt)]) + (prompt0-at p + (let ([v (call-with-marks rs (cons p h) + (lambda () (prompt0-at p (f))))]) + (h (make-pure v)))))) + +(define (call-with-marks rs v f) + (cond + [(null? rs) (f)] + [else + (with-continuation-mark (car rs) v + (call-with-marks (cdr rs) v f))])) + +; Version of the above for re-installing a handlers in the serialized +; format. In that case, there is an association list of links and +; handlers, rather than a single handler (although the separate +; handlers are likely duplicates). +(define (call-with-assoc-marks p hs f) + (match hs + ['() (f)] + [(cons (cons r h) rest) + (with-continuation-mark r (cons p h) + (call-with-assoc-marks rest f))])) + +(define (call-with-handler-assocs hs f) + (let ([p (make-prompt)]) + (prompt0-at p + (call-with-assoc-marks p hs + (lambda () (prompt0-at p (f))))))) + +(define (repush frames v) + (match frames + ['() v] + [(cons (unison-frame-mark as tls hs) frames) + ; handler frame; as are pending arguments, tls are typelinks + ; for handled abilities; hs are associations from links to + ; handler values. + ; + ; todo: args + (call-with-handler-assocs hs + (lambda () (repush frames v)))] + [(cons (unison-frame-push ls as rt) rest) + (displayln (list ls as rt)) + (raise "repush push: not implemented yet")])) + +; This is a *reflected* representation of continuations amenable +; to serialization. Most continuations won't be in this format, +; because it's foolish to eagerly parse the racket continuation if +; it's just going to be applied. But, a continuation that we've +; gotten from serialization will be in this format. +; +; `frames` should be a list of the below `unison-frame` structs. +(struct unison-cont-reflected unison-continuation (frames) + #:property prop:procedure + (lambda (cont v) (repush (unison-cont-reflected-frames cont) v))) + +; Stack frames for reflected continuations +(struct unison-frame () #:transparent) + +(struct unison-frame-push unison-frame + (locals args return-to)) + +(struct unison-frame-mark unison-frame + (args abilities handlers)) + (define-syntax (define-builtin-link stx) (syntax-case stx () [(_ name) @@ -344,9 +481,11 @@ [dname (datum->syntax stx (string->symbol (string-append - "builtin-" txt ":termlink")))]) - #`(define #,dname - (unison-termlink-builtin #,(datum->syntax stx txt))))])) + "builtin-" txt ":termlink")) + #'name)]) + (quasisyntax/loc stx + (define #,dname + (unison-termlink-builtin #,(datum->syntax stx txt)))))])) (define-syntax (declare-builtin-link stx) (syntax-case stx () @@ -357,7 +496,8 @@ [dname (datum->syntax stx (string->symbol (string-append txt ":termlink")))]) - #`(declare-function-link name #,dname))])) + (quasisyntax/loc stx + (declare-function-link name #,dname)))])) (define (partial-app f . args) (unison-closure f args)) @@ -382,11 +522,11 @@ ; # works as well ; Unit -(define unit (sum 0)) +(define sum-unit (sum 0)) ; Booleans are represented as numbers -(define false 0) -(define true 1) +(define sum-false 0) +(define sum-true 1) (define (bool b) (if b 1 0)) @@ -542,6 +682,13 @@ [else (raise "unison-tuple->list: unexpected value")]))) +(define (unison-pair->cons t) + (match t + [(unison-data _ _ (list x (unison-data _ _ (list y _)))) + (cons x y)] + [else + (raise "unison-pair->cons: unexpected value")])) + (define (hash-string hs) (string-append "#" diff --git a/scheme-libs/racket/unison/io-handles.rkt b/scheme-libs/racket/unison/io-handles.rkt index 9f5c1bdc6f..575d247163 100644 --- a/scheme-libs/racket/unison/io-handles.rkt +++ b/scheme-libs/racket/unison/io-handles.rkt @@ -3,7 +3,7 @@ rnrs/io/ports-6 (only-in rnrs standard-error-port standard-input-port standard-output-port vector-map) (only-in racket empty? with-output-to-string system/exit-code system false?) - (only-in unison/boot data-case define-unison) + (only-in unison/boot data-case define-unison-builtin) unison/data unison/chunked-seq unison/data @@ -15,26 +15,39 @@ (provide unison-FOp-IO.stdHandle unison-FOp-IO.openFile.impl.v3 - (prefix-out - builtin-IO. - (combine-out - seekHandle.impl.v3 - getLine.impl.v1 - getSomeBytes.impl.v1 - getBuffering.impl.v3 - setBuffering.impl.v3 - getEcho.impl.v1 - setEcho.impl.v1 - getArgs.impl.v1 - getEnv.impl.v1 - getChar.impl.v1 - isFileOpen.impl.v3 - isSeekable.impl.v3 - handlePosition.impl.v3 - process.call - getCurrentDirectory.impl.v3 - ready.impl.v1 - )) + + builtin-IO.seekHandle.impl.v3 + builtin-IO.seekHandle.impl.v3:termlink + builtin-IO.getLine.impl.v1 + builtin-IO.getLine.impl.v1:termlink + builtin-IO.getSomeBytes.impl.v1 + builtin-IO.getSomeBytes.impl.v1:termlink + builtin-IO.getBuffering.impl.v3 + builtin-IO.getBuffering.impl.v3:termlink + builtin-IO.setBuffering.impl.v3 + builtin-IO.setBuffering.impl.v3:termlink + builtin-IO.getEcho.impl.v1 + builtin-IO.getEcho.impl.v1:termlink + builtin-IO.setEcho.impl.v1 + builtin-IO.setEcho.impl.v1:termlink + builtin-IO.getArgs.impl.v1 + builtin-IO.getArgs.impl.v1:termlink + builtin-IO.getEnv.impl.v1 + builtin-IO.getEnv.impl.v1:termlink + builtin-IO.getChar.impl.v1 + builtin-IO.getChar.impl.v1:termlink + builtin-IO.isFileOpen.impl.v3 + builtin-IO.isFileOpen.impl.v3:termlink + builtin-IO.isSeekable.impl.v3 + builtin-IO.isSeekable.impl.v3:termlink + builtin-IO.handlePosition.impl.v3 + builtin-IO.handlePosition.impl.v3:termlink + builtin-IO.process.call + builtin-IO.process.call:termlink + builtin-IO.getCurrentDirectory.impl.v3 + builtin-IO.getCurrentDirectory.impl.v3:termlink + builtin-IO.ready.impl.v1 + builtin-IO.ready.impl.v1:termlink ; Still to implement: ; handlePosition.impl.v3 @@ -49,28 +62,34 @@ [f (ref-failure-failure typeLink msg a)]) (ref-either-left f))) -(define-unison (isFileOpen.impl.v3 port) +(define-unison-builtin + (builtin-IO.isFileOpen.impl.v3 port) (ref-either-right (not (port-closed? port)))) -(define-unison (ready.impl.v1 port) +(define-unison-builtin + (builtin-IO.ready.impl.v1 port) (if (byte-ready? port) (ref-either-right #t) (if (port-eof? port) (Exception ref-iofailure:typelink "EOF" port) (ref-either-right #f)))) -(define-unison (getCurrentDirectory.impl.v3 unit) +(define-unison-builtin + (builtin-IO.getCurrentDirectory.impl.v3 unit) (ref-either-right (string->chunked-string (path->string (current-directory))))) -(define-unison (isSeekable.impl.v3 handle) +(define-unison-builtin + (builtin-IO.isSeekable.impl.v3 handle) (ref-either-right (port-has-set-port-position!? handle))) -(define-unison (handlePosition.impl.v3 handle) +(define-unison-builtin + (builtin-IO.handlePosition.impl.v3 handle) (ref-either-right (port-position handle))) -(define-unison (seekHandle.impl.v3 handle mode amount) +(define-unison-builtin + (builtin-IO.seekHandle.impl.v3 handle mode amount) (data-case mode (0 () (set-port-position! handle amount) @@ -85,14 +104,16 @@ "SeekFromEnd not supported" 0)))) -(define-unison (getLine.impl.v1 handle) +(define-unison-builtin + (builtin-IO.getLine.impl.v1 handle) (let* ([line (read-line handle)]) (if (eof-object? line) (ref-either-right (string->chunked-string "")) (ref-either-right (string->chunked-string line)) ))) -(define-unison (getChar.impl.v1 handle) +(define-unison-builtin + (builtin-IO.getChar.impl.v1 handle) (let* ([char (read-char handle)]) (if (eof-object? char) (Exception @@ -101,7 +122,8 @@ ref-unit-unit) (ref-either-right char)))) -(define-unison (getSomeBytes.impl.v1 handle nbytes) +(define-unison-builtin + (builtin-IO.getSomeBytes.impl.v1 handle nbytes) (let* ([buffer (make-bytes nbytes)] [line (read-bytes-avail! buffer handle)]) (cond @@ -119,7 +141,8 @@ (subbytes buffer 0 line) buffer)))]))) -(define-unison (getBuffering.impl.v3 handle) +(define-unison-builtin + (builtin-IO.getBuffering.impl.v3 handle) (case (file-stream-buffer-mode handle) [(none) (ref-either-right ref-buffermode-no-buffering)] [(line) (ref-either-right @@ -135,7 +158,8 @@ "Unexpected response from file-stream-buffer-mode" ref-unit-unit)])) -(define-unison (setBuffering.impl.v3 handle mode) +(define-unison-builtin + (builtin-IO.setBuffering.impl.v3 handle mode) (data-case mode (0 () (file-stream-buffer-mode handle 'none) @@ -166,7 +190,8 @@ [(1) stdout] [(2) stderr])) -(define-unison (getEcho.impl.v1 handle) +(define-unison-builtin + (builtin-IO.getEcho.impl.v1 handle) (if (eq? handle stdin) (ref-either-right (get-stdin-echo)) (Exception @@ -174,7 +199,8 @@ "getEcho only supported on stdin" ref-unit-unit))) -(define-unison (setEcho.impl.v1 handle echo) +(define-unison-builtin + (builtin-IO.setEcho.impl.v1 handle echo) (if (eq? handle stdin) (begin (if echo @@ -190,12 +216,14 @@ (let ([current (with-output-to-string (lambda () (system "stty -a")))]) (string-contains? current " echo "))) -(define-unison (getArgs.impl.v1 unit) +(define-unison-builtin + (builtin-IO.getArgs.impl.v1 unit) (ref-either-right (vector->chunked-list (vector-map string->chunked-string (current-command-line-arguments))))) -(define-unison (getEnv.impl.v1 key) +(define-unison-builtin + (builtin-IO.getEnv.impl.v1 key) (let ([value (environment-variables-ref (current-environment-variables) (string->bytes/utf-8 (chunked-string->string key)))]) (if (false? value) (Exception @@ -224,7 +252,8 @@ s) "''")) -(define-unison (process.call command arguments) +(define-unison-builtin + (builtin-IO.process.call command arguments) (system/exit-code (string-join (cons (chunked-string->string command) diff --git a/scheme-libs/racket/unison/io.rkt b/scheme-libs/racket/unison/io.rkt index bc94c53149..ae99bd1978 100644 --- a/scheme-libs/racket/unison/io.rkt +++ b/scheme-libs/racket/unison/io.rkt @@ -9,7 +9,7 @@ date-dst? date-time-zone-offset date*-time-zone-name) - (only-in unison/boot data-case define-unison) + (only-in unison/boot data-case define-unison-builtin) (only-in rnrs/arithmetic/flonums-6 flmod)) @@ -33,20 +33,29 @@ getTempDirectory.impl.v3 removeFile.impl.v3 getFileSize.impl.v3)) - (prefix-out - builtin-IO. - (combine-out - fileExists.impl.v3 - renameFile.impl.v3 - createDirectory.impl.v3 - removeDirectory.impl.v3 - directoryContents.impl.v3 - setCurrentDirectory.impl.v3 - renameDirectory.impl.v3 - isDirectory.impl.v3 - systemTime.impl.v3 - systemTimeMicroseconds.impl.v3 - createTempDirectory.impl.v3))) + + builtin-IO.fileExists.impl.v3 + builtin-IO.fileExists.impl.v3:termlink + builtin-IO.renameFile.impl.v3 + builtin-IO.renameFile.impl.v3:termlink + builtin-IO.createDirectory.impl.v3 + builtin-IO.createDirectory.impl.v3:termlink + builtin-IO.removeDirectory.impl.v3 + builtin-IO.removeDirectory.impl.v3:termlink + builtin-IO.directoryContents.impl.v3 + builtin-IO.directoryContents.impl.v3:termlink + builtin-IO.setCurrentDirectory.impl.v3 + builtin-IO.setCurrentDirectory.impl.v3:termlink + builtin-IO.renameDirectory.impl.v3 + builtin-IO.renameDirectory.impl.v3:termlink + builtin-IO.isDirectory.impl.v3 + builtin-IO.isDirectory.impl.v3:termlink + builtin-IO.systemTime.impl.v3 + builtin-IO.systemTime.impl.v3:termlink + builtin-IO.systemTimeMicroseconds.impl.v3 + builtin-IO.systemTimeMicroseconds.impl.v3:termlink + builtin-IO.createTempDirectory.impl.v3 + builtin-IO.createTempDirectory.impl.v3:termlink) (define (failure-result ty msg vl) (ref-either-left @@ -76,7 +85,8 @@ (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) +(define-unison-builtin + (builtin-IO.fileExists.impl.v3 path) (let ([path-string (chunked-string->string path)]) (ref-either-right (or @@ -90,11 +100,13 @@ (define (getTempDirectory.impl.v3) (right (string->chunked-string (path->string (find-system-path 'temp-dir))))) -(define-unison (setCurrentDirectory.impl.v3 path) +(define-unison-builtin + (builtin-IO.setCurrentDirectory.impl.v3 path) (current-directory (chunked-string->string path)) (ref-either-right none)) -(define-unison (directoryContents.impl.v3 path) +(define-unison-builtin + (builtin-IO.directoryContents.impl.v3 path) (with-handlers [[exn:fail:filesystem? (lambda (e) @@ -112,7 +124,8 @@ (list* "." ".." dirss)))))))) -(define-unison (createTempDirectory.impl.v3 prefix) +(define-unison-builtin + (builtin-IO.createTempDirectory.impl.v3 prefix) (ref-either-right (string->chunked-string (path->string @@ -120,35 +133,43 @@ (string->bytes/utf-8 (chunked-string->string prefix)) #""))))) -(define-unison (createDirectory.impl.v3 file) +(define-unison-builtin + (builtin-IO.createDirectory.impl.v3 file) (make-directory (chunked-string->string file)) (ref-either-right none)) -(define-unison (removeDirectory.impl.v3 file) +(define-unison-builtin + (builtin-IO.removeDirectory.impl.v3 file) (delete-directory/files (chunked-string->string file)) (ref-either-right none)) -(define-unison (isDirectory.impl.v3 path) +(define-unison-builtin + (builtin-IO.isDirectory.impl.v3 path) (ref-either-right (directory-exists? (chunked-string->string path)))) -(define-unison (renameDirectory.impl.v3 old new) +(define-unison-builtin + (builtin-IO.renameDirectory.impl.v3 old new) (rename-file-or-directory (chunked-string->string old) (chunked-string->string new)) (ref-either-right none)) -(define-unison (renameFile.impl.v3 old new) +(define-unison-builtin + (builtin-IO.renameFile.impl.v3 old new) (rename-file-or-directory (chunked-string->string old) (chunked-string->string new)) (ref-either-right none)) -(define-unison (systemTime.impl.v3 unit) +(define-unison-builtin + (builtin-IO.systemTime.impl.v3 unit) (ref-either-right (current-seconds))) -(define-unison (systemTimeMicroseconds.impl.v3 unit) +(define-unison-builtin + (builtin-IO.systemTimeMicroseconds.impl.v3 unit) (ref-either-right (inexact->exact (* 1000 (current-inexact-milliseconds))))) -(define-unison (builtin-Clock.internals.systemTimeZone.v1 secs) +(define-unison-builtin + (builtin-Clock.internals.systemTimeZone.v1 secs) (let* ([d (seconds->date secs)]) (list->unison-tuple (list diff --git a/scheme-libs/racket/unison/math.rkt b/scheme-libs/racket/unison/math.rkt index 2e34a49987..654ac6944d 100644 --- a/scheme-libs/racket/unison/math.rkt +++ b/scheme-libs/racket/unison/math.rkt @@ -7,24 +7,39 @@ clamp-integer clamp-natural data-case - define-unison + define-unison-builtin nbit63)) (provide - builtin-Float.exp - builtin-Float.log - builtin-Float.max - builtin-Float.min - builtin-Float.tan - builtin-Float.tanh - builtin-Float.logBase - builtin-Int.* - builtin-Int.pow - builtin-Int.trailingZeros - builtin-Nat.trailingZeros - builtin-Int.popCount - builtin-Nat.popCount - builtin-Float.pow + builtin-Float.exp + builtin-Float.exp:termlink + builtin-Float.log + builtin-Float.log:termlink + builtin-Float.max + builtin-Float.max:termlink + builtin-Float.min + builtin-Float.min:termlink + builtin-Float.tan + builtin-Float.tan:termlink + builtin-Float.tanh + builtin-Float.tanh:termlink + builtin-Float.logBase + builtin-Float.logBase:termlink + builtin-Int.* + builtin-Int.*:termlink + builtin-Int.pow + builtin-Int.pow:termlink + builtin-Int.trailingZeros + builtin-Int.trailingZeros:termlink + builtin-Nat.trailingZeros + builtin-Nat.trailingZeros:termlink + builtin-Int.popCount + builtin-Int.popCount:termlink + builtin-Nat.popCount + builtin-Nat.popCount:termlink + builtin-Float.pow + builtin-Float.pow:termlink + (prefix-out unison-POp- (combine-out ABSF @@ -71,21 +86,50 @@ SINF ITOF))) -(define-unison (builtin-Float.logBase base num) (log num base)) +(define-unison-builtin + (builtin-Float.logBase base num) + (log num base)) (define (LOGB base num) (log num base)) -(define-unison (builtin-Float.exp n) (exp n)) -(define-unison (builtin-Float.log n) (log n)) -(define-unison (builtin-Float.max n m) (max n m)) -(define-unison (builtin-Float.min n m) (min n m)) -(define-unison (builtin-Float.tan n) (tan n)) -(define-unison (builtin-Float.tanh n) (tanh n)) -(define-unison (builtin-Int.* n m) (clamp-integer (* n m))) -(define-unison (builtin-Int.pow n m) (clamp-integer (expt n m))) -(define-unison (builtin-Int.trailingZeros n) (TZRO n)) -(define-unison (builtin-Nat.trailingZeros n) (TZRO n)) -(define-unison (builtin-Nat.popCount n) (POPC n)) -(define-unison (builtin-Int.popCount n) (POPC n)) -(define-unison (builtin-Float.pow n m) (expt n m)) + +(define-unison-builtin + (builtin-Float.exp n) (exp n)) + +(define-unison-builtin + (builtin-Float.log n) (log n)) + +(define-unison-builtin + (builtin-Float.max n m) (max n m)) + +(define-unison-builtin + (builtin-Float.min n m) (min n m)) + +(define-unison-builtin + (builtin-Float.tan n) (tan n)) + +(define-unison-builtin + (builtin-Float.tanh n) (tanh n)) + +(define-unison-builtin + (builtin-Int.* n m) (clamp-integer (* n m))) + +(define-unison-builtin + (builtin-Int.pow n m) (clamp-integer (expt n m))) + +(define-unison-builtin + (builtin-Int.trailingZeros n) (TZRO n)) + +(define-unison-builtin + (builtin-Nat.trailingZeros n) (TZRO n)) + +(define-unison-builtin + (builtin-Nat.popCount n) (POPC n)) + +(define-unison-builtin + (builtin-Int.popCount n) (POPC n)) + +(define-unison-builtin + (builtin-Float.pow n m) (expt n m)) + (define (EXPF n) (exp n)) (define ABSF abs) (define ACOS acos) diff --git a/scheme-libs/racket/unison/primops-generated.rkt b/scheme-libs/racket/unison/primops-generated.rkt index 0e9b462ff6..105d3ec205 100644 --- a/scheme-libs/racket/unison/primops-generated.rkt +++ b/scheme-libs/racket/unison/primops-generated.rkt @@ -31,9 +31,11 @@ builtin-sandboxLinks builtin-sandboxLinks:termlink + builtin-Code.dependencies:termlink builtin-Code.deserialize:termlink builtin-Code.serialize:termlink builtin-Code.validateLinks:termlink + builtin-Value.dependencies:termlink builtin-Value.deserialize:termlink builtin-Value.serialize:termlink builtin-crypto.hash:termlink @@ -54,21 +56,15 @@ build-runtime-module termlink->proc) -(define-builtin-link Value.value) -(define-builtin-link Value.reflect) -(define-builtin-link Code.isMissing) -(define-builtin-link Code.lookup) - +(define-builtin-link Code.dependencies) (define-builtin-link Code.deserialize) (define-builtin-link Code.serialize) (define-builtin-link Code.validateLinks) +(define-builtin-link Value.dependencies) (define-builtin-link Value.deserialize) (define-builtin-link Value.serialize) (define-builtin-link crypto.hash) (define-builtin-link crypto.hmac) -(define-builtin-link validateSandboxed) -(define-builtin-link Value.validateSandboxed) -(define-builtin-link sandboxLinks) (define (chunked-list->list cl) (vector->list (chunked-list->vector cl))) @@ -129,14 +125,33 @@ (raise (format "decode-binding: unimplemented case: ~a" bn))])) +(define (decode-hints hs) + (define (hint->sym t) + (cond + [(= t ref-defnhint-internal:tag) 'internal] + [(= t ref-defnhint-genlink:tag) 'gen-link] + [(= t ref-defnhint-nolinkdecl:tag) 'no-link-decl])) + + (for/fold ([def 'define-unison] [out '()]) ([h hs]) + (match h + [(unison-data _ t (list)) + #:when (= t ref-defnhint-builtin:tag) + (values 'define-unison-builtin out)] + [(unison-data _ t (list)) + (values def (cons (hint->sym t) out))]))) + (define (decode-syntax dfn) (match dfn - [(unison-data _ t (list nm vs bd)) + [(unison-data _ t (list nm hs vs bd)) #: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))] + (let-values + ([(head) (map text->ident + (cons nm (chunked-list->list vs)))] + [(def hints) (decode-hints (chunked-list->list hs))] + [(body) (decode-term bd)]) + (if (null? hints) + (list def head body) + (list def '#:hints hints head body)))] [(unison-data _ t (list nm bd)) #:when (= t ref-schemedefn-alias:tag) (list 'define (text->ident nm) (decode-term bd))] @@ -195,20 +210,17 @@ (describe-value tl)))] [1 (rf) rf])) -(define-syntax make-group-ref-decoder - (lambda (stx) - (syntax-case stx () - [(_) - #`(lambda (gr) - (data-case (group-ref-ident gr) - [#,ref-schemeterm-ident:tag (name) name] - [else - (raise - (format - "decode-group-ref: unimplemented data case: ~a" - (describe-value gr)))]))]))) - -(define decode-group-ref (make-group-ref-decoder)) +(define (decode-group-ref gr0) + (match (group-ref-ident gr0) + [(unison-data _ t (list name)) + #:when (= t ref-schemeterm-ident:tag) + name] + [else + (raise + (format + "decode-group-ref: unimplemented data case: ~a" + (describe-value gr0)))])) + (define (group-ref-sym gr) (string->symbol (chunked-string->string @@ -301,6 +313,70 @@ [else (raise (format "decode-vlit: unimplemented case: !a" vl))])])) +(define (reify-handlers hs) + (for/list ([h (chunked-list->list hs)]) + (match (unison-pair->cons h) + [(cons r h) + (cons (reference->typelink r) + (reify-value h))]))) + +(define (reflect-handlers hs) + (list->chunked-list + (for/list ([h hs]) + (match h + [(cons r h) + (unison-tuple + (typelink->reference r) + (reflect-value h))])))) + +(define (reify-groupref gr0) + (match gr0 + [(unison-data _ t (list r i)) + #:when (= t ref-groupref-group:tag) + (cons (reference->typelink r) i)])) + +(define (reflect-groupref rt) + (match rt + [(cons l i) + (ref-groupref-group (typelink->reference l) i)])) + +(define (parse-continuation orig k0 vs0) + (let rec ([k k0] [vs vs0] [frames '()]) + (match k + [(unison-data _ t (list)) + #:when (= t ref-cont-empty:tag) + (unison-cont-reflected (reverse frames))] + [(unison-data _ t (list l a gr0 k)) + #:when (= t ref-cont-push:tag) + (cond + [(>= (length vs) (+ l a)) + (let*-values + ([(locals int) (split-at vs l)] + [(args rest) (split-at int a)] + [(gr) (reify-groupref gr0)] + [(fm) (unison-frame-push locals args gr)]) + (rec k rest (cons fm frames)))] + [else + (raise + (make-exn:bug + "reify-value: malformed continuation" + orig))])] + [(unison-data _ t (list a rs0 de0 k)) + #:when (= t ref-cont-mark:tag) + (cond + [(>= (length vs) a) + (let*-values + ([(args rest) (split-at vs a)] + [(rs) (map reference->termlink (chunked-list->list rs0))] + [(hs) (reify-handlers de0)] + [(fm) (unison-frame-mark args rs hs)]) + (rec k rest (cons fm frames)))] + [else + (raise + (make-exn:bug + "reify-value: malformed continuation" + orig))])]))) + (define (reify-value v) (match v [(unison-data _ t (list rf rt bs0)) @@ -327,16 +403,14 @@ #:when (= t ref-value-partial:tag) (let ([bs (map reify-value (chunked-list->list bs0))] [proc (resolve-proc gr)]) - (apply proc bs))] + (struct-copy unison-closure proc [env bs]))] [(unison-data _ t (list vl)) #:when (= t ref-value-vlit:tag) (reify-vlit vl)] - [(unison-data _ t (list bs0 k)) + [(unison-data _ t (list vs0 k)) #:when (= t ref-value-cont:tag) - (raise - (make-exn:bug - "reify-value: unimplemented cont case" - ref-unit-unit))] + (parse-continuation v k + (map reify-value (chunked-list->list vs0)))] [(unison-data r t fs) (raise (make-exn:bug @@ -413,14 +487,34 @@ (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-cont-reflected frames0) + (for/foldr ([k ref-cont-empty] + [vs '()] + #:result + (ref-value-cont + (list->chunked-list (map reflect-value vs)) + k)) + ([frame frames0]) + (match frame + [(unison-frame-push locals args return-to) + (values + (ref-cont-push + (length locals) + (length args) + (reflect-groupref return-to) + k) + (append locals args vs))] + [(unison-frame-mark args refs hs) + (values + (ref-cont-mark + (length args) + (map typelink->reference refs) + (reflect-handlers hs)) + (append args vs))]))] + [(unison-closure arity f as) (ref-value-partial (function->groupref f) (list->chunked-list (map reflect-value as)))] - [(? procedure?) - (ref-value-partial - (function->groupref v) - empty-chunked-list)] [(unison-data rf t fs) (ref-value-data (reflect-typelink rf) @@ -438,7 +532,7 @@ [(? chunked-list?) (for/fold ([acc '()]) ([e (in-chunked-list v)]) (append (sandbox-value ok e) acc))] - [(unison-closure f as) + [(unison-closure arity f as) (for/fold ([acc (sandbox-proc ok f)]) ([a (in-list as)]) (append (sandbox-scheme-value ok a) acc))] [(? procedure?) (sandbox-proc ok v)] @@ -474,11 +568,11 @@ [(unison-quote v) (sandbox-value ok v)])) ; replacment for Value.unsafeValue : a -> Value -(define-unison +(define-unison-builtin (builtin-Value.reflect v) (reflect-value v)) -(define-unison +(define-unison-builtin (builtin-Value.value v) (let ([rv (reflect-value v)]) (unison-quote rv))) @@ -706,23 +800,23 @@ (define (unison-POp-LKUP tl) (lookup-code tl)) -(define-unison (builtin-Code.lookup tl) +(define-unison-builtin (builtin-Code.lookup tl) (match (lookup-code tl) [(unison-sum 0 (list)) ref-optional-none] [(unison-sum 1 (list co)) (ref-optional-some co)])) -(define-unison (builtin-validateSandboxed ok v) +(define-unison-builtin (builtin-validateSandboxed ok v) (let ([l (sandbox-scheme-value (chunked-list->list ok) v)]) (null? l))) -(define-unison (builtin-sandboxLinks tl) (check-sandbox tl)) +(define-unison-builtin (builtin-sandboxLinks tl) (check-sandbox tl)) -(define-unison (builtin-Code.isMissing tl) +(define-unison-builtin (builtin-Code.isMissing tl) (cond [(unison-termlink-builtin? tl) #f] [(unison-termlink-con? tl) #f] [(have-code? tl) #t] [else #f])) -(define-unison (builtin-Value.validateSandboxed ok v) +(define-unison-builtin (builtin-Value.validateSandboxed ok v) (sandbox-quoted (chunked-list->list ok) v)) diff --git a/scheme-libs/racket/unison/primops.ss b/scheme-libs/racket/unison/primops.ss index 225b68acdb..712727499f 100644 --- a/scheme-libs/racket/unison/primops.ss +++ b/scheme-libs/racket/unison/primops.ss @@ -21,1499 +21,1476 @@ ; Unison.Runtime.Builtin, so the POp/FOp implementation must ; take/return arguments that match what is expected in those wrappers. -#!r6rs -(library (unison primops) - (export - builtin-Float.* - builtin-Float.*:termlink - builtin-Float.>= - builtin-Float.>=:termlink - builtin-Float.<= - builtin-Float.<=:termlink - builtin-Float.> - builtin-Float.>:termlink - builtin-Float.< - builtin-Float.<:termlink - builtin-Float.== - builtin-Float.==:termlink - builtin-Float.fromRepresentation - builtin-Float.fromRepresentation:termlink - builtin-Float.toRepresentation - builtin-Float.toRepresentation:termlink - builtin-Float.ceiling - builtin-Float.ceiling:termlink - builtin-Float.exp - builtin-Float.exp:termlink - builtin-Float.log - builtin-Float.log:termlink - builtin-Float.max - builtin-Float.max:termlink - builtin-Float.min - builtin-Float.min:termlink - builtin-Float.tan - builtin-Float.tan:termlink - builtin-Float.tanh - builtin-Float.tanh:termlink - builtin-Float.logBase - builtin-Float.logBase:termlink - builtin-Float.pow - builtin-Float.pow:termlink - builtin-Int.pow - builtin-Int.pow:termlink - builtin-Int.* - builtin-Int.*:termlink - builtin-Int.+ - builtin-Int.+:termlink - builtin-Int.- - builtin-Int.-:termlink - builtin-Int./ - builtin-Int./:termlink - builtin-Int.increment - builtin-Int.increment:termlink - builtin-Int.negate - builtin-Int.negate:termlink - builtin-Int.fromRepresentation - builtin-Int.fromRepresentation:termlink - builtin-Int.toRepresentation - builtin-Int.toRepresentation:termlink - builtin-Int.signum - builtin-Int.signum:termlink - builtin-Int.trailingZeros - builtin-Int.trailingZeros:termlink - builtin-Int.popCount - builtin-Int.popCount:termlink - builtin-Int.isEven - builtin-Int.isEven:termlink - builtin-Int.isOdd - builtin-Int.isOdd:termlink - builtin-Int.== - builtin-Int.==:termlink - builtin-Int.< - builtin-Int.<:termlink - builtin-Int.<= - builtin-Int.<=:termlink - builtin-Int.> - builtin-Int.>:termlink - builtin-Int.>= - builtin-Int.>=:termlink - builtin-Nat.+ - builtin-Nat.+:termlink - builtin-Nat.drop - builtin-Nat.drop:termlink - builtin-Nat.== - builtin-Nat.==:termlink - builtin-Nat.< - builtin-Nat.<:termlink - builtin-Nat.<= - builtin-Nat.<=:termlink - builtin-Nat.> - builtin-Nat.>:termlink - builtin-Nat.>= - builtin-Nat.>=:termlink - builtin-Nat.isEven - builtin-Nat.isEven:termlink - builtin-Nat.isOdd - builtin-Nat.isOdd:termlink - builtin-Nat.increment - builtin-Nat.increment:termlink - builtin-Nat.popCount - builtin-Nat.popCount:termlink - builtin-Nat.toFloat - builtin-Nat.toFloat:termlink - builtin-Nat.trailingZeros - builtin-Nat.trailingZeros:termlink - builtin-Text.indexOf - builtin-Text.indexOf:termlink - builtin-Text.== - builtin-Text.==:termlink - builtin-Text.!= - builtin-Text.!=:termlink - builtin-Text.<= - builtin-Text.<=:termlink - builtin-Text.>= - builtin-Text.>=:termlink - builtin-Text.< - builtin-Text.<:termlink - builtin-Text.> - builtin-Text.>:termlink - builtin-Bytes.indexOf - 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 - - builtin-Universal.== - builtin-Universal.==:termlink - builtin-Universal.> - builtin-Universal.>:termlink - builtin-Universal.>= - builtin-Universal.>=:termlink - builtin-Universal.< - builtin-Universal.<:termlink - builtin-Universal.<= - builtin-Universal.<=:termlink - builtin-Universal.compare - builtin-Universal.compare:termlink - builtin-Universal.murmurHash:termlink - - builtin-unsafe.coerceAbilities - builtin-unsafe.coerceAbilities:termlink - - builtin-List.splitLeft - builtin-List.splitLeft:termlink - builtin-List.splitRight - builtin-List.splitRight:termlink - - builtin-Link.Term.toText - builtin-Link.Term.toText:termlink - - builtin-Value.toBuiltin - builtin-Value.toBuiltin:termlink - builtin-Value.fromBuiltin - builtin-Value.fromBuiltin:termlink - builtin-Code.fromGroup - builtin-Code.fromGroup:termlink - builtin-Code.toGroup - builtin-Code.toGroup:termlink - builtin-TermLink.fromReferent - builtin-TermLink.fromReferent:termlink - builtin-TermLink.toReferent - builtin-TermLink.toReferent:termlink - builtin-TypeLink.toReference - builtin-TypeLink.toReference:termlink - - builtin-IO.UDP.clientSocket.impl.v1 - builtin-IO.UDP.clientSocket.impl.v1:termlink - builtin-IO.UDP.UDPSocket.recv.impl.v1 - builtin-IO.UDP.UDPSocket.recv.impl.v1:termlink - builtin-IO.UDP.UDPSocket.send.impl.v1 - builtin-IO.UDP.UDPSocket.send.impl.v1:termlink - builtin-IO.UDP.UDPSocket.close.impl.v1 - builtin-IO.UDP.UDPSocket.close.impl.v1:termlink - builtin-IO.UDP.ListenSocket.close.impl.v1 - builtin-IO.UDP.ListenSocket.close.impl.v1:termlink - builtin-IO.UDP.UDPSocket.toText.impl.v1 - builtin-IO.UDP.UDPSocket.toText.impl.v1:termlink - builtin-IO.UDP.serverSocket.impl.v1 - builtin-IO.UDP.serverSocket.impl.v1:termlink - builtin-IO.UDP.ListenSocket.toText.impl.v1 - builtin-IO.UDP.ListenSocket.toText.impl.v1:termlink - builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 - builtin-IO.UDP.ListenSocket.recvFrom.impl.v1:termlink - builtin-IO.UDP.ClientSockAddr.toText.v1 - builtin-IO.UDP.ClientSockAddr.toText.v1:termlink - builtin-IO.UDP.ListenSocket.sendTo.impl.v1 - builtin-IO.UDP.ListenSocket.sendTo.impl.v1:termlink - - unison-FOp-internal.dataTag - unison-FOp-Char.toText - ; unison-FOp-Code.dependencies - ; unison-FOp-Code.serialize - unison-FOp-IO.closeFile.impl.v3 - unison-FOp-IO.openFile.impl.v3 - ; unison-FOp-IO.isFileEOF.impl.v3 - unison-FOp-IO.putBytes.impl.v3 - unison-FOp-IO.getBytes.impl.v3 - builtin-IO.seekHandle.impl.v3 - builtin-IO.seekHandle.impl.v3:termlink - builtin-IO.getLine.impl.v1 - builtin-IO.getLine.impl.v1:termlink - builtin-IO.getSomeBytes.impl.v1 - builtin-IO.getSomeBytes.impl.v1:termlink - builtin-IO.setBuffering.impl.v3 - builtin-IO.setBuffering.impl.v3:termlink - builtin-IO.getBuffering.impl.v3 - builtin-IO.getBuffering.impl.v3:termlink - builtin-IO.setEcho.impl.v1 - builtin-IO.setEcho.impl.v1:termlink - builtin-IO.isFileOpen.impl.v3 - builtin-IO.isFileOpen.impl.v3:termlink - builtin-IO.ready.impl.v1 - builtin-IO.ready.impl.v1:termlink - builtin-IO.process.call - builtin-IO.process.call:termlink - builtin-IO.getEcho.impl.v1 - builtin-IO.getEcho.impl.v1:termlink - builtin-IO.getArgs.impl.v1 - builtin-IO.getArgs.impl.v1:termlink - builtin-IO.getEnv.impl.v1 - builtin-IO.getEnv.impl.v1:termlink - builtin-IO.getChar.impl.v1 - builtin-IO.getChar.impl.v1:termlink - builtin-IO.getCurrentDirectory.impl.v3 - builtin-IO.getCurrentDirectory.impl.v3:termlink - builtin-IO.removeDirectory.impl.v3 - builtin-IO.removeDirectory.impl.v3:termlink - builtin-IO.renameFile.impl.v3 - builtin-IO.renameFile.impl.v3:termlink - builtin-IO.createTempDirectory.impl.v3 - builtin-IO.createTempDirectory.impl.v3:termlink - builtin-IO.createDirectory.impl.v3 - builtin-IO.createDirectory.impl.v3:termlink - builtin-IO.setCurrentDirectory.impl.v3 - builtin-IO.setCurrentDirectory.impl.v3:termlink - builtin-IO.renameDirectory.impl.v3 - builtin-IO.renameDirectory.impl.v3:termlink - builtin-IO.isDirectory.impl.v3 - builtin-IO.isDirectory.impl.v3:termlink - builtin-IO.isSeekable.impl.v3 - builtin-IO.isSeekable.impl.v3:termlink - builtin-IO.handlePosition.impl.v3 - builtin-IO.handlePosition.impl.v3:termlink - builtin-IO.systemTime.impl.v3 - builtin-IO.systemTime.impl.v3:termlink - builtin-IO.systemTimeMicroseconds.impl.v3 - builtin-IO.systemTimeMicroseconds.impl.v3:termlink - - builtin-Char.Class.is - builtin-Char.Class.is:termlink - builtin-Pattern.captureAs - builtin-Pattern.captureAs:termlink - builtin-Pattern.many.corrected - builtin-Pattern.many.corrected:termlink - builtin-Pattern.isMatch - builtin-Pattern.isMatch:termlink - builtin-IO.fileExists.impl.v3 - builtin-IO.fileExists.impl.v3:termlink - builtin-IO.isFileEOF.impl.v3 - builtin-IO.isFileEOF.impl.v3:termlink - - unison-FOp-IO.getFileSize.impl.v3 - unison-FOp-IO.getFileTimestamp.impl.v3 - ; unison-FOp-IO.fileExists.impl.v3 - unison-FOp-IO.removeFile.impl.v3 - unison-FOp-IO.getTempDirectory.impl.v3 - unison-FOp-Text.fromUtf8.impl.v3 - unison-FOp-Text.repeat - unison-FOp-Text.reverse - unison-FOp-Text.toUtf8 - unison-FOp-Text.toLowercase - unison-FOp-Text.toUppercase - unison-FOp-Pattern.run - unison-FOp-Pattern.isMatch - unison-FOp-Pattern.many - unison-FOp-Pattern.capture - unison-FOp-Pattern.join - unison-FOp-Pattern.or - unison-FOp-Pattern.replicate - unison-FOp-Text.patterns.digit - unison-FOp-Text.patterns.letter - unison-FOp-Text.patterns.punctuation - unison-FOp-Text.patterns.charIn - unison-FOp-Text.patterns.notCharIn - unison-FOp-Text.patterns.anyChar - unison-FOp-Text.patterns.space - unison-FOp-Text.patterns.charRange - unison-FOp-Text.patterns.notCharRange - unison-FOp-Text.patterns.literal - unison-FOp-Text.patterns.eof - unison-FOp-Text.patterns.char - unison-FOp-Char.Class.is - unison-FOp-Char.Class.any - unison-FOp-Char.Class.alphanumeric - unison-FOp-Char.Class.upper - unison-FOp-Char.Class.lower - unison-FOp-Char.Class.number - unison-FOp-Char.Class.punctuation - unison-FOp-Char.Class.symbol - unison-FOp-Char.Class.letter - unison-FOp-Char.Class.whitespace - unison-FOp-Char.Class.control - unison-FOp-Char.Class.printable - unison-FOp-Char.Class.mark - unison-FOp-Char.Class.separator - unison-FOp-Char.Class.or - unison-FOp-Char.Class.range - unison-FOp-Char.Class.anyOf - unison-FOp-Char.Class.and - unison-FOp-Char.Class.not - unison-FOp-Clock.internals.nsec.v1 - unison-FOp-Clock.internals.sec.v1 - unison-FOp-Clock.internals.threadCPUTime.v1 - unison-FOp-Clock.internals.processCPUTime.v1 - unison-FOp-Clock.internals.realtime.v1 - unison-FOp-Clock.internals.monotonic.v1 - builtin-Clock.internals.systemTimeZone.v1 - builtin-Clock.internals.systemTimeZone.v1:termlink - - - ; unison-FOp-Value.serialize - unison-FOp-IO.stdHandle - unison-FOp-IO.getArgs.impl.v1 - - builtin-IO.directoryContents.impl.v3 - builtin-IO.directoryContents.impl.v3:termlink - unison-FOp-IO.systemTimeMicroseconds.v1 - - unison-FOp-ImmutableArray.copyTo! - unison-FOp-ImmutableArray.read - - unison-FOp-MutableArray.copyTo! - unison-FOp-MutableArray.freeze! - unison-FOp-MutableArray.freeze - unison-FOp-MutableArray.read - unison-FOp-MutableArray.write - - unison-FOp-MutableArray.size - unison-FOp-ImmutableArray.size - - unison-FOp-MutableByteArray.size - unison-FOp-ImmutableByteArray.size - - unison-FOp-MutableByteArray.length - unison-FOp-ImmutableByteArray.length - - unison-FOp-ImmutableByteArray.copyTo! - unison-FOp-ImmutableByteArray.read8 - unison-FOp-ImmutableByteArray.read16be - unison-FOp-ImmutableByteArray.read24be - unison-FOp-ImmutableByteArray.read32be - unison-FOp-ImmutableByteArray.read40be - unison-FOp-ImmutableByteArray.read48be - unison-FOp-ImmutableByteArray.read56be - unison-FOp-ImmutableByteArray.read64be - - unison-FOp-MutableByteArray.copyTo! - unison-FOp-MutableByteArray.freeze! - unison-FOp-MutableByteArray.write8 - unison-FOp-MutableByteArray.write16be - unison-FOp-MutableByteArray.write32be - unison-FOp-MutableByteArray.write64be - unison-FOp-MutableByteArray.read8 - unison-FOp-MutableByteArray.read16be - unison-FOp-MutableByteArray.read24be - unison-FOp-MutableByteArray.read32be - unison-FOp-MutableByteArray.read40be - unison-FOp-MutableByteArray.read64be - - unison-FOp-Scope.bytearray - unison-FOp-Scope.bytearrayOf - unison-FOp-Scope.array - unison-FOp-Scope.arrayOf - unison-FOp-Scope.ref - - unison-FOp-IO.bytearray - unison-FOp-IO.bytearrayOf - unison-FOp-IO.array - unison-FOp-IO.arrayOf - - unison-FOp-IO.ref - unison-FOp-Ref.read - unison-FOp-Ref.write - unison-FOp-Ref.readForCas - unison-FOp-Ref.Ticket.read - unison-FOp-Ref.cas - - unison-FOp-Promise.new - unison-FOp-Promise.read - unison-FOp-Promise.tryRead - unison-FOp-Promise.write - - unison-FOp-IO.delay.impl.v3 - unison-POp-FORK - unison-FOp-IO.kill.impl.v3 - - unison-FOp-Handle.toText - unison-FOp-Socket.toText - unison-FOp-ThreadId.toText - - unison-POp-ABSF - unison-POp-ACOS - unison-POp-ACSH - unison-POp-ADDF - unison-POp-ASIN - unison-POp-ASNH - unison-POp-ATAN - unison-POp-ATN2 - unison-POp-ATNH - unison-POp-CEIL - unison-POp-FLOR - unison-POp-COSF - unison-POp-COSH - unison-POp-DIVF - unison-POp-DIVI - unison-POp-EQLF - unison-POp-EQLI - unison-POp-SUBF - unison-POp-SUBI - unison-POp-SGNI - unison-POp-LEQF - unison-POp-SINF - unison-POp-SINH - unison-POp-TRNF - unison-POp-RNDF - unison-POp-SQRT - unison-POp-TANH - unison-POp-TANF - unison-POp-TZRO - unison-POp-POPC - unison-POp-ITOF - - unison-POp-ADDN - unison-POp-ANDN - unison-POp-BLDS - unison-POp-CATS - unison-POp-CATT - unison-POp-CATB - unison-POp-CMPU - unison-POp-COMN - unison-POp-CONS - unison-POp-DBTX - unison-POp-DECI - unison-POp-INCI - unison-POp-DECN - unison-POp-INCN - unison-POp-DIVN - unison-POp-DRPB - unison-POp-DRPS - unison-POp-DRPT - unison-POp-EQLN - unison-POp-EQLT - unison-POp-EXPF - unison-POp-LEQT - unison-POp-EQLU - unison-POp-EROR - unison-POp-FTOT - unison-POp-IDXB - unison-POp-IDXS - unison-POp-IORN - unison-POp-ITOT - unison-POp-LEQN - ; unison-POp-LKUP - unison-POp-LZRO - unison-POp-MULN - unison-POp-MODN - unison-POp-NTOT - unison-POp-PAKT - unison-POp-SHLI - unison-POp-SHLN - unison-POp-SHRI - unison-POp-SHRN - unison-POp-SIZS - unison-POp-SIZT - unison-POp-SIZB - unison-POp-SNOC - unison-POp-SUBN - unison-POp-SUBI - unison-POp-TAKS - unison-POp-TAKT - unison-POp-TAKB - unison-POp-TRCE - unison-POp-PRNT - unison-POp-TTON - unison-POp-TTOI - unison-POp-TTOF - unison-POp-UPKT - unison-POp-XORN - unison-POp-VALU - unison-POp-VWLS - unison-POp-UCNS - unison-POp-USNC - unison-POp-FLTB - unison-POp-MAXF - unison-POp-MINF - unison-POp-MULF - unison-POp-MULI - unison-POp-NEGI - unison-POp-NTOF - unison-POp-POWF - unison-POp-POWI - unison-POp-POWN - - unison-POp-UPKB - unison-POp-PAKB - unison-POp-ADDI - unison-POp-MULI - unison-POp-MODI - unison-POp-LEQI - unison-POp-LOGB - unison-POp-LOGF - unison-POp-POWN - unison-POp-VWRS - unison-POp-SPLL - unison-POp-SPLR - - unison-FOp-Bytes.gzip.compress - unison-FOp-Bytes.gzip.decompress - unison-FOp-Bytes.zlib.compress - unison-FOp-Bytes.zlib.decompress - unison-FOp-Bytes.toBase16 - unison-FOp-Bytes.toBase32 - unison-FOp-Bytes.toBase64 - unison-FOp-Bytes.toBase64UrlUnpadded - unison-FOp-Bytes.fromBase16 - unison-FOp-Bytes.fromBase32 - unison-FOp-Bytes.fromBase64 - unison-FOp-Bytes.fromBase64UrlUnpadded - unison-FOp-Bytes.encodeNat16be - unison-FOp-Bytes.encodeNat16le - unison-FOp-Bytes.encodeNat32be - unison-FOp-Bytes.encodeNat32le - unison-FOp-Bytes.encodeNat64be - unison-FOp-Bytes.encodeNat64le - unison-FOp-Bytes.decodeNat16be - unison-FOp-Bytes.decodeNat16le - unison-FOp-Bytes.decodeNat32be - unison-FOp-Bytes.decodeNat32le - unison-FOp-Bytes.decodeNat64be - unison-FOp-Bytes.decodeNat64le - - unison-FOp-crypto.hashBytes - unison-FOp-crypto.hmacBytes - unison-FOp-crypto.HashAlgorithm.Md5 - unison-FOp-crypto.HashAlgorithm.Sha1 - unison-FOp-crypto.HashAlgorithm.Sha2_256 - unison-FOp-crypto.HashAlgorithm.Sha2_512 - unison-FOp-crypto.HashAlgorithm.Sha3_256 - unison-FOp-crypto.HashAlgorithm.Sha3_512 - unison-FOp-crypto.HashAlgorithm.Blake2s_256 - unison-FOp-crypto.HashAlgorithm.Blake2b_256 - unison-FOp-crypto.HashAlgorithm.Blake2b_512 - - unison-FOp-IO.clientSocket.impl.v3 - unison-FOp-IO.closeSocket.impl.v3 - unison-FOp-IO.socketReceive.impl.v3 - unison-FOp-IO.socketSend.impl.v3 - unison-FOp-IO.socketPort.impl.v3 - unison-FOp-IO.serverSocket.impl.v3 - unison-FOp-IO.socketAccept.impl.v3 - unison-FOp-IO.listen.impl.v3 - unison-FOp-Tls.ClientConfig.default - unison-FOp-Tls.ClientConfig.certificates.set - unison-FOp-Tls.decodeCert.impl.v3 - unison-FOp-Tls.encodeCert - unison-FOp-Tls.newServer.impl.v3 - unison-FOp-Tls.decodePrivateKey - unison-FOp-Tls.encodePrivateKey - unison-FOp-Tls.ServerConfig.default - unison-FOp-Tls.handshake.impl.v3 - unison-FOp-Tls.newClient.impl.v3 - unison-FOp-Tls.receive.impl.v3 - unison-FOp-Tls.send.impl.v3 - unison-FOp-Tls.terminate.impl.v3 - - ; fake builtins - builtin-murmurHashBytes) - - (import (rnrs) - (only (srfi :13) string-reverse) - (racket performance-hint) - (only (racket flonum) - fl< - fl> - fl<= - fl>= - fl=) - (rename - (only (racket) - car - cdr - exact-integer? - exact-nonnegative-integer? - foldl - integer-length - bytes->string/utf-8 - string->bytes/utf-8 - exn:fail:contract? - file-stream-buffer-mode - with-handlers - match - modulo - quotient - regexp-match-positions - sequence-ref - vector-copy! - bytes-copy! - sub1 - 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? - string-replace) - (unison arithmetic) - (unison bytevector) - (unison core) - (only (unison boot) - define-unison - referent->termlink - termlink->referent - typelink->reference - clamp-integer - clamp-natural - wrap-natural - exn:bug->exception - raise-unison-exception - bit64 - bit63 - nbit63) - (unison data) - (unison data-info) - (unison math) - (unison chunked-seq) - (unison chunked-bytes) - (unison string-search) - (unison bytes-nat) - (unison pattern) - (unison crypto) - (unison io) - (unison io-handles) - (unison murmurhash) - (unison tls) - (unison tcp) - (unison udp) - (unison gzip) - (unison zlib) - (unison concurrent) - (racket random)) - - (define-builtin-link Float.*) - (define-builtin-link Float.fromRepresentation) - (define-builtin-link Float.toRepresentation) - (define-builtin-link Float.ceiling) - (define-builtin-link Float.exp) - (define-builtin-link Float.log) - (define-builtin-link Float.max) - (define-builtin-link Float.min) - (define-builtin-link Float.tan) - (define-builtin-link Float.tanh) - (define-builtin-link Float.logBase) - (define-builtin-link Float.pow) - (define-builtin-link Float.>) - (define-builtin-link Float.<) - (define-builtin-link Float.>=) - (define-builtin-link Float.<=) - (define-builtin-link Float.==) - (define-builtin-link Int.pow) - (define-builtin-link Int.*) - (define-builtin-link Int.+) - (define-builtin-link Int.-) - (define-builtin-link Int./) - (define-builtin-link Int.>) - (define-builtin-link Int.<) - (define-builtin-link Int.>=) - (define-builtin-link Int.<=) - (define-builtin-link Int.==) - (define-builtin-link Int.isEven) - (define-builtin-link Int.isOdd) - (define-builtin-link Int.increment) - (define-builtin-link Int.negate) - (define-builtin-link Int.fromRepresentation) - (define-builtin-link Int.toRepresentation) - (define-builtin-link Int.signum) - (define-builtin-link Int.trailingZeros) - (define-builtin-link Int.popCount) - (define-builtin-link Nat.increment) - (define-builtin-link Nat.popCount) - (define-builtin-link Nat.toFloat) - (define-builtin-link Nat.trailingZeros) - (define-builtin-link Nat.+) - (define-builtin-link Nat.>) - (define-builtin-link Nat.<) - (define-builtin-link Nat.>=) - (define-builtin-link Nat.<=) - (define-builtin-link Nat.==) - (define-builtin-link Nat.drop) - (define-builtin-link Nat.isEven) - (define-builtin-link Nat.isOdd) - (define-builtin-link Text.indexOf) - (define-builtin-link Text.>) - (define-builtin-link Text.<) - (define-builtin-link Text.>=) - (define-builtin-link Text.<=) - (define-builtin-link Text.==) - (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) - (define-builtin-link Value.fromBuiltin) - (define-builtin-link Code.fromGroup) - (define-builtin-link Code.toGroup) - (define-builtin-link TermLink.fromReferent) - (define-builtin-link TermLink.toReferent) - (define-builtin-link TypeLink.toReference) - (define-builtin-link IO.seekHandle.impl.v3) - (define-builtin-link IO.getLine.impl.v1) - (define-builtin-link IO.getSomeBytes.impl.v1) - (define-builtin-link IO.setBuffering.impl.v3) - (define-builtin-link IO.getBuffering.impl.v3) - (define-builtin-link IO.setEcho.impl.v1) - (define-builtin-link IO.isFileOpen.impl.v3) - (define-builtin-link IO.ready.impl.v1) - (define-builtin-link IO.process.call) - (define-builtin-link IO.getEcho.impl.v1) - (define-builtin-link IO.getArgs.impl.v1) - (define-builtin-link IO.getEnv.impl.v1) - (define-builtin-link IO.getChar.impl.v1) - (define-builtin-link IO.getCurrentDirectory.impl.v3) - (define-builtin-link IO.directoryContents.impl.v3) - (define-builtin-link IO.removeDirectory.impl.v3) - (define-builtin-link IO.renameFile.impl.v3) - (define-builtin-link IO.createTempDirectory.impl.v3) - (define-builtin-link IO.createDirectory.impl.v3) - (define-builtin-link IO.setCurrentDirectory.impl.v3) - (define-builtin-link IO.renameDirectory.impl.v3) - (define-builtin-link IO.fileExists.impl.v3) - (define-builtin-link IO.isDirectory.impl.v3) - (define-builtin-link IO.isFileEOF.impl.v3) - (define-builtin-link IO.isSeekable.impl.v3) - (define-builtin-link IO.handlePosition.impl.v3) - (define-builtin-link IO.systemTime.impl.v3) - (define-builtin-link IO.systemTimeMicroseconds.impl.v3) - (define-builtin-link Universal.==) - (define-builtin-link Universal.>) - (define-builtin-link Universal.<) - (define-builtin-link Universal.>=) - (define-builtin-link Universal.<=) - (define-builtin-link Universal.compare) - (define-builtin-link Universal.murmurHash) - (define-builtin-link Pattern.captureAs) - (define-builtin-link Pattern.many.corrected) - (define-builtin-link Pattern.isMatch) - (define-builtin-link Char.Class.is) - (define-builtin-link Scope.bytearrayOf) - (define-builtin-link unsafe.coerceAbilities) - (define-builtin-link Clock.internals.systemTimeZone.v1) - +#lang racket/base +(provide + builtin-Float.* + builtin-Float.*:termlink + builtin-Float.>= + builtin-Float.>=:termlink + builtin-Float.<= + builtin-Float.<=:termlink + builtin-Float.> + builtin-Float.>:termlink + builtin-Float.< + builtin-Float.<:termlink + builtin-Float.== + builtin-Float.==:termlink + builtin-Float.fromRepresentation + builtin-Float.fromRepresentation:termlink + builtin-Float.toRepresentation + builtin-Float.toRepresentation:termlink + builtin-Float.ceiling + builtin-Float.ceiling:termlink + builtin-Float.exp + builtin-Float.exp:termlink + builtin-Float.log + builtin-Float.log:termlink + builtin-Float.max + builtin-Float.max:termlink + builtin-Float.min + builtin-Float.min:termlink + builtin-Float.tan + builtin-Float.tan:termlink + builtin-Float.tanh + builtin-Float.tanh:termlink + builtin-Float.logBase + builtin-Float.logBase:termlink + builtin-Float.pow + builtin-Float.pow:termlink + builtin-Int.pow + builtin-Int.pow:termlink + builtin-Int.* + builtin-Int.*:termlink + builtin-Int.+ + builtin-Int.+:termlink + builtin-Int.- + builtin-Int.-:termlink + builtin-Int./ + builtin-Int./:termlink + builtin-Int.increment + builtin-Int.increment:termlink + builtin-Int.negate + builtin-Int.negate:termlink + builtin-Int.fromRepresentation + builtin-Int.fromRepresentation:termlink + builtin-Int.toRepresentation + builtin-Int.toRepresentation:termlink + builtin-Int.signum + builtin-Int.signum:termlink + builtin-Int.trailingZeros + builtin-Int.trailingZeros:termlink + builtin-Int.popCount + builtin-Int.popCount:termlink + builtin-Int.isEven + builtin-Int.isEven:termlink + builtin-Int.isOdd + builtin-Int.isOdd:termlink + builtin-Int.== + builtin-Int.==:termlink + builtin-Int.< + builtin-Int.<:termlink + builtin-Int.<= + builtin-Int.<=:termlink + builtin-Int.> + builtin-Int.>:termlink + builtin-Int.>= + builtin-Int.>=:termlink + builtin-Nat.+ + builtin-Nat.+:termlink + builtin-Nat.drop + builtin-Nat.drop:termlink + builtin-Nat.== + builtin-Nat.==:termlink + builtin-Nat.< + builtin-Nat.<:termlink + builtin-Nat.<= + builtin-Nat.<=:termlink + builtin-Nat.> + builtin-Nat.>:termlink + builtin-Nat.>= + builtin-Nat.>=:termlink + builtin-Nat.isEven + builtin-Nat.isEven:termlink + builtin-Nat.isOdd + builtin-Nat.isOdd:termlink + builtin-Nat.increment + builtin-Nat.increment:termlink + builtin-Nat.popCount + builtin-Nat.popCount:termlink + builtin-Nat.toFloat + builtin-Nat.toFloat:termlink + builtin-Nat.trailingZeros + builtin-Nat.trailingZeros:termlink + builtin-Text.indexOf + builtin-Text.indexOf:termlink + builtin-Text.== + builtin-Text.==:termlink + builtin-Text.!= + builtin-Text.!=:termlink + builtin-Text.<= + builtin-Text.<=:termlink + builtin-Text.>= + builtin-Text.>=:termlink + builtin-Text.< + builtin-Text.<:termlink + builtin-Text.> + builtin-Text.>:termlink + builtin-Bytes.indexOf + 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 + + builtin-Universal.== + builtin-Universal.==:termlink + builtin-Universal.> + builtin-Universal.>:termlink + builtin-Universal.>= + builtin-Universal.>=:termlink + builtin-Universal.< + builtin-Universal.<:termlink + builtin-Universal.<= + builtin-Universal.<=:termlink + builtin-Universal.compare + builtin-Universal.compare:termlink + builtin-Universal.murmurHash:termlink + + builtin-unsafe.coerceAbilities + builtin-unsafe.coerceAbilities:termlink + + builtin-List.splitLeft + builtin-List.splitLeft:termlink + builtin-List.splitRight + builtin-List.splitRight:termlink + + builtin-Link.Term.toText + builtin-Link.Term.toText:termlink + + builtin-Value.toBuiltin + builtin-Value.toBuiltin:termlink + builtin-Value.fromBuiltin + builtin-Value.fromBuiltin:termlink + builtin-Code.fromGroup + builtin-Code.fromGroup:termlink + builtin-Code.toGroup + builtin-Code.toGroup:termlink + builtin-TermLink.fromReferent + builtin-TermLink.fromReferent:termlink + builtin-TermLink.toReferent + builtin-TermLink.toReferent:termlink + builtin-TypeLink.toReference + builtin-TypeLink.toReference:termlink + + builtin-IO.UDP.clientSocket.impl.v1 + builtin-IO.UDP.clientSocket.impl.v1:termlink + builtin-IO.UDP.UDPSocket.recv.impl.v1 + builtin-IO.UDP.UDPSocket.recv.impl.v1:termlink + builtin-IO.UDP.UDPSocket.send.impl.v1 + builtin-IO.UDP.UDPSocket.send.impl.v1:termlink + builtin-IO.UDP.UDPSocket.close.impl.v1 + builtin-IO.UDP.UDPSocket.close.impl.v1:termlink + builtin-IO.UDP.ListenSocket.close.impl.v1 + builtin-IO.UDP.ListenSocket.close.impl.v1:termlink + builtin-IO.UDP.UDPSocket.toText.impl.v1 + builtin-IO.UDP.UDPSocket.toText.impl.v1:termlink + builtin-IO.UDP.serverSocket.impl.v1 + builtin-IO.UDP.serverSocket.impl.v1:termlink + builtin-IO.UDP.ListenSocket.toText.impl.v1 + builtin-IO.UDP.ListenSocket.toText.impl.v1:termlink + builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 + builtin-IO.UDP.ListenSocket.recvFrom.impl.v1:termlink + builtin-IO.UDP.ClientSockAddr.toText.v1 + builtin-IO.UDP.ClientSockAddr.toText.v1:termlink + builtin-IO.UDP.ListenSocket.sendTo.impl.v1 + builtin-IO.UDP.ListenSocket.sendTo.impl.v1:termlink + + unison-FOp-internal.dataTag + unison-FOp-Char.toText + ; unison-FOp-Code.dependencies + ; unison-FOp-Code.serialize + unison-FOp-IO.closeFile.impl.v3 + unison-FOp-IO.openFile.impl.v3 + ; unison-FOp-IO.isFileEOF.impl.v3 + unison-FOp-IO.putBytes.impl.v3 + unison-FOp-IO.getBytes.impl.v3 + builtin-IO.seekHandle.impl.v3 + builtin-IO.seekHandle.impl.v3:termlink + builtin-IO.getLine.impl.v1 + builtin-IO.getLine.impl.v1:termlink + builtin-IO.getSomeBytes.impl.v1 + builtin-IO.getSomeBytes.impl.v1:termlink + builtin-IO.setBuffering.impl.v3 + builtin-IO.setBuffering.impl.v3:termlink + builtin-IO.getBuffering.impl.v3 + builtin-IO.getBuffering.impl.v3:termlink + builtin-IO.setEcho.impl.v1 + builtin-IO.setEcho.impl.v1:termlink + builtin-IO.isFileOpen.impl.v3 + builtin-IO.isFileOpen.impl.v3:termlink + builtin-IO.ready.impl.v1 + builtin-IO.ready.impl.v1:termlink + builtin-IO.process.call + builtin-IO.process.call:termlink + builtin-IO.getEcho.impl.v1 + builtin-IO.getEcho.impl.v1:termlink + builtin-IO.getArgs.impl.v1 + builtin-IO.getArgs.impl.v1:termlink + builtin-IO.getEnv.impl.v1 + builtin-IO.getEnv.impl.v1:termlink + builtin-IO.getChar.impl.v1 + builtin-IO.getChar.impl.v1:termlink + builtin-IO.getCurrentDirectory.impl.v3 + builtin-IO.getCurrentDirectory.impl.v3:termlink + builtin-IO.removeDirectory.impl.v3 + builtin-IO.removeDirectory.impl.v3:termlink + builtin-IO.renameFile.impl.v3 + builtin-IO.renameFile.impl.v3:termlink + builtin-IO.createTempDirectory.impl.v3 + builtin-IO.createTempDirectory.impl.v3:termlink + builtin-IO.createDirectory.impl.v3 + builtin-IO.createDirectory.impl.v3:termlink + builtin-IO.setCurrentDirectory.impl.v3 + builtin-IO.setCurrentDirectory.impl.v3:termlink + builtin-IO.renameDirectory.impl.v3 + builtin-IO.renameDirectory.impl.v3:termlink + builtin-IO.isDirectory.impl.v3 + builtin-IO.isDirectory.impl.v3:termlink + builtin-IO.isSeekable.impl.v3 + builtin-IO.isSeekable.impl.v3:termlink + builtin-IO.handlePosition.impl.v3 + builtin-IO.handlePosition.impl.v3:termlink + builtin-IO.systemTime.impl.v3 + builtin-IO.systemTime.impl.v3:termlink + builtin-IO.systemTimeMicroseconds.impl.v3 + builtin-IO.systemTimeMicroseconds.impl.v3:termlink + + builtin-Char.Class.is + builtin-Char.Class.is:termlink + builtin-Pattern.captureAs + builtin-Pattern.captureAs:termlink + builtin-Pattern.many.corrected + builtin-Pattern.many.corrected:termlink + builtin-Pattern.isMatch + builtin-Pattern.isMatch:termlink + builtin-IO.fileExists.impl.v3 + builtin-IO.fileExists.impl.v3:termlink + builtin-IO.isFileEOF.impl.v3 + builtin-IO.isFileEOF.impl.v3:termlink + + unison-FOp-IO.getFileSize.impl.v3 + unison-FOp-IO.getFileTimestamp.impl.v3 + ; unison-FOp-IO.fileExists.impl.v3 + unison-FOp-IO.removeFile.impl.v3 + unison-FOp-IO.getTempDirectory.impl.v3 + unison-FOp-Text.fromUtf8.impl.v3 + unison-FOp-Text.repeat + unison-FOp-Text.reverse + unison-FOp-Text.toUtf8 + unison-FOp-Text.toLowercase + unison-FOp-Text.toUppercase + unison-FOp-Pattern.run + unison-FOp-Pattern.isMatch + unison-FOp-Pattern.many + unison-FOp-Pattern.capture + unison-FOp-Pattern.join + unison-FOp-Pattern.or + unison-FOp-Pattern.replicate + unison-FOp-Text.patterns.digit + unison-FOp-Text.patterns.letter + unison-FOp-Text.patterns.punctuation + unison-FOp-Text.patterns.charIn + unison-FOp-Text.patterns.notCharIn + unison-FOp-Text.patterns.anyChar + unison-FOp-Text.patterns.space + unison-FOp-Text.patterns.charRange + unison-FOp-Text.patterns.notCharRange + unison-FOp-Text.patterns.literal + unison-FOp-Text.patterns.eof + unison-FOp-Text.patterns.char + unison-FOp-Char.Class.is + unison-FOp-Char.Class.any + unison-FOp-Char.Class.alphanumeric + unison-FOp-Char.Class.upper + unison-FOp-Char.Class.lower + unison-FOp-Char.Class.number + unison-FOp-Char.Class.punctuation + unison-FOp-Char.Class.symbol + unison-FOp-Char.Class.letter + unison-FOp-Char.Class.whitespace + unison-FOp-Char.Class.control + unison-FOp-Char.Class.printable + unison-FOp-Char.Class.mark + unison-FOp-Char.Class.separator + unison-FOp-Char.Class.or + unison-FOp-Char.Class.range + unison-FOp-Char.Class.anyOf + unison-FOp-Char.Class.and + unison-FOp-Char.Class.not + unison-FOp-Clock.internals.nsec.v1 + unison-FOp-Clock.internals.sec.v1 + unison-FOp-Clock.internals.threadCPUTime.v1 + unison-FOp-Clock.internals.processCPUTime.v1 + unison-FOp-Clock.internals.realtime.v1 + unison-FOp-Clock.internals.monotonic.v1 + builtin-Clock.internals.systemTimeZone.v1 + builtin-Clock.internals.systemTimeZone.v1:termlink + + + ; unison-FOp-Value.serialize + unison-FOp-IO.stdHandle + unison-FOp-IO.getArgs.impl.v1 + + builtin-IO.directoryContents.impl.v3 + builtin-IO.directoryContents.impl.v3:termlink + unison-FOp-IO.systemTimeMicroseconds.v1 + + unison-FOp-ImmutableArray.copyTo! + unison-FOp-ImmutableArray.read + + unison-FOp-MutableArray.copyTo! + unison-FOp-MutableArray.freeze! + unison-FOp-MutableArray.freeze + unison-FOp-MutableArray.read + unison-FOp-MutableArray.write + + unison-FOp-MutableArray.size + unison-FOp-ImmutableArray.size + + unison-FOp-MutableByteArray.size + unison-FOp-ImmutableByteArray.size + + unison-FOp-MutableByteArray.length + unison-FOp-ImmutableByteArray.length + + unison-FOp-ImmutableByteArray.copyTo! + unison-FOp-ImmutableByteArray.read8 + unison-FOp-ImmutableByteArray.read16be + unison-FOp-ImmutableByteArray.read24be + unison-FOp-ImmutableByteArray.read32be + unison-FOp-ImmutableByteArray.read40be + unison-FOp-ImmutableByteArray.read48be + unison-FOp-ImmutableByteArray.read56be + unison-FOp-ImmutableByteArray.read64be + + unison-FOp-MutableByteArray.copyTo! + unison-FOp-MutableByteArray.freeze! + unison-FOp-MutableByteArray.write8 + unison-FOp-MutableByteArray.write16be + unison-FOp-MutableByteArray.write32be + unison-FOp-MutableByteArray.write64be + unison-FOp-MutableByteArray.read8 + unison-FOp-MutableByteArray.read16be + unison-FOp-MutableByteArray.read24be + unison-FOp-MutableByteArray.read32be + unison-FOp-MutableByteArray.read40be + unison-FOp-MutableByteArray.read64be + + unison-FOp-Scope.bytearray + unison-FOp-Scope.bytearrayOf + unison-FOp-Scope.array + unison-FOp-Scope.arrayOf + unison-FOp-Scope.ref + + unison-FOp-IO.bytearray + unison-FOp-IO.bytearrayOf + unison-FOp-IO.array + unison-FOp-IO.arrayOf + + unison-FOp-IO.ref + unison-FOp-Ref.read + unison-FOp-Ref.write + unison-FOp-Ref.readForCas + unison-FOp-Ref.Ticket.read + unison-FOp-Ref.cas + + unison-FOp-Promise.new + unison-FOp-Promise.read + unison-FOp-Promise.tryRead + unison-FOp-Promise.write + + unison-FOp-IO.delay.impl.v3 + unison-POp-FORK + unison-FOp-IO.kill.impl.v3 + + unison-FOp-Handle.toText + unison-FOp-Socket.toText + unison-FOp-ThreadId.toText + + unison-POp-ABSF + unison-POp-ACOS + unison-POp-ACSH + unison-POp-ADDF + unison-POp-ASIN + unison-POp-ASNH + unison-POp-ATAN + unison-POp-ATN2 + unison-POp-ATNH + unison-POp-CEIL + unison-POp-FLOR + unison-POp-COSF + unison-POp-COSH + unison-POp-DIVF + unison-POp-DIVI + unison-POp-EQLF + unison-POp-EQLI + unison-POp-SUBF + unison-POp-SUBI + unison-POp-SGNI + unison-POp-LEQF + unison-POp-SINF + unison-POp-SINH + unison-POp-TRNF + unison-POp-RNDF + unison-POp-SQRT + unison-POp-TANH + unison-POp-TANF + unison-POp-TZRO + unison-POp-POPC + unison-POp-ITOF + + unison-POp-ADDN + unison-POp-ANDN + unison-POp-BLDS + unison-POp-CATS + unison-POp-CATT + unison-POp-CATB + unison-POp-CMPU + unison-POp-COMN + unison-POp-CONS + unison-POp-DBTX + unison-POp-DECI + unison-POp-INCI + unison-POp-DECN + unison-POp-INCN + unison-POp-DIVN + unison-POp-DRPB + unison-POp-DRPS + unison-POp-DRPT + unison-POp-EQLN + unison-POp-EQLT + unison-POp-EXPF + unison-POp-LEQT + unison-POp-EQLU + unison-POp-EROR + unison-POp-FTOT + unison-POp-IDXB + unison-POp-IDXS + unison-POp-IORN + unison-POp-ITOT + unison-POp-LEQN + ; unison-POp-LKUP + unison-POp-LZRO + unison-POp-MULN + unison-POp-MODN + unison-POp-NTOT + unison-POp-PAKT + unison-POp-SHLI + unison-POp-SHLN + unison-POp-SHRI + unison-POp-SHRN + unison-POp-SIZS + unison-POp-SIZT + unison-POp-SIZB + unison-POp-SNOC + unison-POp-SUBN + unison-POp-SUBI + unison-POp-TAKS + unison-POp-TAKT + unison-POp-TAKB + unison-POp-TRCE + unison-POp-PRNT + unison-POp-TTON + unison-POp-TTOI + unison-POp-TTOF + unison-POp-UPKT + unison-POp-XORN + unison-POp-VALU + unison-POp-VWLS + unison-POp-UCNS + unison-POp-USNC + unison-POp-FLTB + unison-POp-MAXF + unison-POp-MINF + unison-POp-MULF + unison-POp-MULI + unison-POp-NEGI + unison-POp-NTOF + unison-POp-POWF + unison-POp-POWI + unison-POp-POWN + + unison-POp-UPKB + unison-POp-PAKB + unison-POp-ADDI + unison-POp-MULI + unison-POp-MODI + unison-POp-LEQI + unison-POp-LOGB + unison-POp-LOGF + unison-POp-POWN + unison-POp-VWRS + unison-POp-SPLL + unison-POp-SPLR + + unison-FOp-Bytes.gzip.compress + unison-FOp-Bytes.gzip.decompress + unison-FOp-Bytes.zlib.compress + unison-FOp-Bytes.zlib.decompress + unison-FOp-Bytes.toBase16 + unison-FOp-Bytes.toBase32 + unison-FOp-Bytes.toBase64 + unison-FOp-Bytes.toBase64UrlUnpadded + unison-FOp-Bytes.fromBase16 + unison-FOp-Bytes.fromBase32 + unison-FOp-Bytes.fromBase64 + unison-FOp-Bytes.fromBase64UrlUnpadded + unison-FOp-Bytes.encodeNat16be + unison-FOp-Bytes.encodeNat16le + unison-FOp-Bytes.encodeNat32be + unison-FOp-Bytes.encodeNat32le + unison-FOp-Bytes.encodeNat64be + unison-FOp-Bytes.encodeNat64le + unison-FOp-Bytes.decodeNat16be + unison-FOp-Bytes.decodeNat16le + unison-FOp-Bytes.decodeNat32be + unison-FOp-Bytes.decodeNat32le + unison-FOp-Bytes.decodeNat64be + unison-FOp-Bytes.decodeNat64le + + unison-FOp-crypto.hashBytes + unison-FOp-crypto.hmacBytes + unison-FOp-crypto.HashAlgorithm.Md5 + unison-FOp-crypto.HashAlgorithm.Sha1 + unison-FOp-crypto.HashAlgorithm.Sha2_256 + unison-FOp-crypto.HashAlgorithm.Sha2_512 + unison-FOp-crypto.HashAlgorithm.Sha3_256 + unison-FOp-crypto.HashAlgorithm.Sha3_512 + unison-FOp-crypto.HashAlgorithm.Blake2s_256 + unison-FOp-crypto.HashAlgorithm.Blake2b_256 + unison-FOp-crypto.HashAlgorithm.Blake2b_512 + + unison-FOp-IO.clientSocket.impl.v3 + unison-FOp-IO.closeSocket.impl.v3 + unison-FOp-IO.socketReceive.impl.v3 + unison-FOp-IO.socketSend.impl.v3 + unison-FOp-IO.socketPort.impl.v3 + unison-FOp-IO.serverSocket.impl.v3 + unison-FOp-IO.socketAccept.impl.v3 + unison-FOp-IO.listen.impl.v3 + unison-FOp-Tls.ClientConfig.default + unison-FOp-Tls.ClientConfig.certificates.set + unison-FOp-Tls.decodeCert.impl.v3 + unison-FOp-Tls.encodeCert + unison-FOp-Tls.newServer.impl.v3 + unison-FOp-Tls.decodePrivateKey + unison-FOp-Tls.encodePrivateKey + unison-FOp-Tls.ServerConfig.default + unison-FOp-Tls.handshake.impl.v3 + unison-FOp-Tls.newClient.impl.v3 + unison-FOp-Tls.receive.impl.v3 + unison-FOp-Tls.send.impl.v3 + unison-FOp-Tls.terminate.impl.v3 + + ; fake builtins + builtin-murmurHashBytes) + +(require + (except-in racket + eof + sleep) + + (only-in srfi/13 string-reverse) + rnrs/bytevectors-6 + + racket/performance-hint + + (only-in racket/flonum + fl< + fl> + fl<= + fl>= + fl=) + + (only-in racket/string + string-contains? + string-replace) + + unison/arithmetic + unison/bytevector + unison/core + + (only-in unison/boot + define-unison-builtin + referent->termlink + termlink->referent + typelink->reference + clamp-integer + clamp-natural + wrap-natural + exn:bug->exception + raise-unison-exception + bit64 + bit63 + nbit63) + + unison/data + unison/data-info + unison/math + unison/chunked-seq + unison/chunked-bytes + unison/string-search + unison/bytes-nat + unison/pattern + unison/crypto + unison/io + unison/io-handles + unison/murmurhash + unison/tls + unison/tcp + unison/udp + unison/gzip + unison/zlib + unison/concurrent + racket/random) + +; (define-builtin-link Float.*) +; (define-builtin-link Float.fromRepresentation) +; (define-builtin-link Float.toRepresentation) +; (define-builtin-link Float.ceiling) +; (define-builtin-link Float.exp) +; (define-builtin-link Float.log) +; (define-builtin-link Float.max) +; (define-builtin-link Float.min) +; (define-builtin-link Float.tan) +; (define-builtin-link Float.tanh) +; (define-builtin-link Float.logBase) +; (define-builtin-link Float.pow) +; (define-builtin-link Float.>) +; (define-builtin-link Float.<) +; (define-builtin-link Float.>=) +; (define-builtin-link Float.<=) +; (define-builtin-link Float.==) +; (define-builtin-link Int.pow) +; (define-builtin-link Int.*) +; (define-builtin-link Int.+) +; (define-builtin-link Int.-) +; (define-builtin-link Int./) +; (define-builtin-link Int.>) +; (define-builtin-link Int.<) +; (define-builtin-link Int.>=) +; (define-builtin-link Int.<=) +; (define-builtin-link Int.==) +; (define-builtin-link Int.isEven) +; (define-builtin-link Int.isOdd) +; (define-builtin-link Int.increment) +; (define-builtin-link Int.negate) +; (define-builtin-link Int.fromRepresentation) +; (define-builtin-link Int.toRepresentation) +; (define-builtin-link Int.signum) +; (define-builtin-link Int.trailingZeros) +; (define-builtin-link Int.popCount) +; (define-builtin-link Nat.increment) +; (define-builtin-link Nat.popCount) +; (define-builtin-link Nat.toFloat) +; (define-builtin-link Nat.trailingZeros) +; (define-builtin-link Nat.+) +; (define-builtin-link Nat.>) +; (define-builtin-link Nat.<) +; (define-builtin-link Nat.>=) +; (define-builtin-link Nat.<=) +; (define-builtin-link Nat.==) +; (define-builtin-link Nat.drop) +; (define-builtin-link Nat.isEven) +; (define-builtin-link Nat.isOdd) +; (define-builtin-link Text.indexOf) +; (define-builtin-link Text.>) +; (define-builtin-link Text.<) +; (define-builtin-link Text.>=) +; (define-builtin-link Text.<=) +; (define-builtin-link Text.==) +; (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) +; (define-builtin-link Value.fromBuiltin) +; (define-builtin-link Code.fromGroup) +; (define-builtin-link Code.toGroup) +; (define-builtin-link TermLink.fromReferent) +; (define-builtin-link TermLink.toReferent) +; (define-builtin-link TypeLink.toReference) +; (define-builtin-link IO.seekHandle.impl.v3) +; (define-builtin-link IO.getLine.impl.v1) +; (define-builtin-link IO.getSomeBytes.impl.v1) +; (define-builtin-link IO.setBuffering.impl.v3) +; (define-builtin-link IO.getBuffering.impl.v3) +; (define-builtin-link IO.setEcho.impl.v1) +; (define-builtin-link IO.isFileOpen.impl.v3) +; (define-builtin-link IO.ready.impl.v1) +; (define-builtin-link IO.process.call) +; (define-builtin-link IO.getEcho.impl.v1) +; (define-builtin-link IO.getArgs.impl.v1) +; (define-builtin-link IO.getEnv.impl.v1) +; (define-builtin-link IO.getChar.impl.v1) +; (define-builtin-link IO.getCurrentDirectory.impl.v3) +; (define-builtin-link IO.directoryContents.impl.v3) +; (define-builtin-link IO.removeDirectory.impl.v3) +; (define-builtin-link IO.renameFile.impl.v3) +; (define-builtin-link IO.createTempDirectory.impl.v3) +; (define-builtin-link IO.createDirectory.impl.v3) +; (define-builtin-link IO.setCurrentDirectory.impl.v3) +; (define-builtin-link IO.renameDirectory.impl.v3) +; (define-builtin-link IO.fileExists.impl.v3) +; (define-builtin-link IO.isDirectory.impl.v3) +; (define-builtin-link IO.isFileEOF.impl.v3) +; (define-builtin-link IO.isSeekable.impl.v3) +; (define-builtin-link IO.handlePosition.impl.v3) +; (define-builtin-link IO.systemTime.impl.v3) +; (define-builtin-link IO.systemTimeMicroseconds.impl.v3) +; (define-builtin-link Universal.==) +; (define-builtin-link Universal.>) +; (define-builtin-link Universal.<) +; (define-builtin-link Universal.>=) +; (define-builtin-link Universal.<=) +; (define-builtin-link Universal.compare) +(define-builtin-link Universal.murmurHash) +; (define-builtin-link Pattern.captureAs) +; (define-builtin-link Pattern.many.corrected) +; (define-builtin-link Pattern.isMatch) +; (define-builtin-link Char.Class.is) +; (define-builtin-link Scope.bytearrayOf) +; (define-builtin-link unsafe.coerceAbilities) +(define-builtin-link Clock.internals.systemTimeZone.v1) + +(begin-encourage-inline + (define-unison-builtin (builtin-Value.toBuiltin v) (unison-quote v)) + (define-unison-builtin (builtin-Value.fromBuiltin v) + (unison-quote-val v)) + (define-unison-builtin (builtin-Code.fromGroup sg) (unison-code sg)) + (define-unison-builtin (builtin-Code.toGroup co) + (unison-code-rep co)) + (define-unison-builtin (builtin-TermLink.fromReferent rf) + (referent->termlink rf)) + (define-unison-builtin (builtin-TermLink.toReferent tl) + (termlink->referent tl)) + (define-unison-builtin (builtin-TypeLink.toReference tl) + (typelink->reference tl)) + (define-unison-builtin (builtin-murmurHashBytes bs) + (murmurhash-bytes (chunked-bytes->bytes bs))) + + (define-unison-builtin (builtin-IO.randomBytes n) + (bytes->chunked-bytes (crypto-random-bytes n))) + + (define-unison-builtin (builtin-List.splitLeft n s) + (match (unison-POp-SPLL n s) + [(unison-sum 0 fs) ref-seqview-empty] + [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) + + (define-unison-builtin (builtin-List.splitRight n s) + (match (unison-POp-SPLR n s) + [(unison-sum 0 fs) ref-seqview-empty] + [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) + + (define-unison-builtin (builtin-Float.> x y) (fl> x y)) + (define-unison-builtin (builtin-Float.< x y) (fl< x y)) + (define-unison-builtin (builtin-Float.>= x y) (fl>= x y)) + (define-unison-builtin (builtin-Float.<= x y) (fl<= x y)) + (define-unison-builtin (builtin-Float.== x y) (fl= x y)) + + (define-unison-builtin (builtin-Int.> x y) (> x y)) + (define-unison-builtin (builtin-Int.< x y) (< x y)) + (define-unison-builtin (builtin-Int.>= x y) (>= x y)) + (define-unison-builtin (builtin-Int.<= x y) (<= x y)) + (define-unison-builtin (builtin-Int.== x y) (= x y)) + (define-unison-builtin (builtin-Int.isEven x) (even? x)) + (define-unison-builtin (builtin-Int.isOdd x) (odd? x)) + + (define-unison-builtin (builtin-Nat.> x y) (> x y)) + (define-unison-builtin (builtin-Nat.< x y) (< x y)) + (define-unison-builtin (builtin-Nat.>= x y) (>= x y)) + (define-unison-builtin (builtin-Nat.<= x y) (<= x y)) (begin-encourage-inline - (define-unison (builtin-Value.toBuiltin v) (unison-quote v)) - (define-unison (builtin-Value.fromBuiltin v) - (unison-quote-val v)) - (define-unison (builtin-Code.fromGroup sg) (unison-code sg)) - (define-unison (builtin-Code.toGroup co) - (unison-code-rep co)) - (define-unison (builtin-TermLink.fromReferent rf) - (referent->termlink rf)) - (define-unison (builtin-TermLink.toReferent tl) - (termlink->referent tl)) - (define-unison (builtin-TypeLink.toReference tl) - (typelink->reference tl)) - (define-unison (builtin-murmurHashBytes bs) - (murmurhash-bytes (chunked-bytes->bytes bs))) - - (define-unison (builtin-IO.randomBytes n) - (bytes->chunked-bytes (crypto-random-bytes n))) - - (define-unison (builtin-List.splitLeft n s) - (match (unison-POp-SPLL n s) - [(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) 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)) - (define-unison (builtin-Float.>= x y) (fl>= x y)) - (define-unison (builtin-Float.<= x y) (fl<= x y)) - (define-unison (builtin-Float.== x y) (fl= x y)) - - (define-unison (builtin-Int.> x y) (> x y)) - (define-unison (builtin-Int.< x y) (< x y)) - (define-unison (builtin-Int.>= x y) (>= x y)) - (define-unison (builtin-Int.<= x y) (<= x y)) - (define-unison (builtin-Int.== x y) (= x y)) - (define-unison (builtin-Int.isEven x) (even? x)) - (define-unison (builtin-Int.isOdd x) (odd? x)) - - (define-unison (builtin-Nat.> x y) (> x y)) - (define-unison (builtin-Nat.< x y) (< x y)) - (define-unison (builtin-Nat.>= x y) (>= x y)) - (define-unison (builtin-Nat.<= x y) (<= x y)) - (begin-encourage-inline - (define-unison (builtin-Nat.== x y) (= x y))) - - (define-unison (builtin-Nat.isEven x) (even? x)) - (define-unison (builtin-Nat.isOdd x) (odd? x)) - - ; Note: chunked-string x y) - (not (chunked-string= x y) (chunked-string x y) - (case (universal-compare x y) [(>) #t] [else #f])) - (define-unison (builtin-Universal.< x y) - (case (universal-compare x y) [(<) #t] [else #f])) - (define-unison (builtin-Universal.<= x y) - (case (universal-compare x y) [(>) #f] [else #t])) - (define-unison (builtin-Universal.>= x y) - (case (universal-compare x y) [(<) #f] [else #t])) - (define-unison (builtin-Universal.compare x y) - (case (universal-compare x y) - [(>) 1] [(<) -1] [else 0])) - - (define-unison (builtin-Scope.bytearrayOf i n) - (make-bytevector n i)) - - (define-builtin-link Link.Type.toText) - (define-unison (builtin-Link.Type.toText ln) - (string->chunked-string (typelink->string ln))) - - (define-builtin-link Link.Term.toText) - (define-unison (builtin-Link.Term.toText ln) - (string->chunked-string (termlink->string ln))) - - (define-unison (builtin-Char.Class.is cc c) - (pattern-match? cc (string->chunked-string (string c)))) - - (define-unison (builtin-Pattern.captureAs c p) - (capture-as c p)) - - (define-unison (builtin-Pattern.many.corrected p) (many p)) - - (define-unison (builtin-Pattern.isMatch p s) - (pattern-match? p s)) - - (define-unison (builtin-unsafe.coerceAbilities f) f) - - (define (unison-POp-UPKB bs) - (build-chunked-list - (chunked-bytes-length bs) - (lambda (i) (chunked-bytes-ref bs i)))) - - (define (unison-POp-ADDI i j) (clamp-integer (+ i j))) - (define (unison-POp-MULI i j) (clamp-integer (* i j))) - (define (unison-POp-MODI i j) (clamp-integer (modulo i j))) - (define (unison-POp-LEQI a b) (bool (<= a b))) - (define (unison-POp-POWN m n) (clamp-natural (expt m n))) - (define unison-POp-LOGF log) - - (define (reify-exn thunk) - (guard - (e [else - (sum 0 '() (exception->string e) ref-unit-unit)]) - (thunk))) - - ; Core implemented primops, upon which primops-in-unison can be built. - (define (unison-POp-ADDN m n) (clamp-natural (+ m n))) - (define (unison-POp-ANDN m n) (bitwise-and m n)) - (define unison-POp-BLDS - (lambda args-list - (fold-right (lambda (e l) (chunked-list-add-first l e)) empty-chunked-list args-list))) - (define (unison-POp-CATS l r) (chunked-list-append l r)) - (define (unison-POp-CATT l r) (chunked-string-append l r)) - (define (unison-POp-CATB l r) (chunked-bytes-append l r)) - (define (unison-POp-CMPU l r) (ord (universal-compare l r))) - (define (unison-POp-COMN n) (wrap-natural (bitwise-not n))) - (define (unison-POp-CONS x xs) (chunked-list-add-first xs x)) - (define (unison-POp-DECI n) (clamp-integer (sub1 n))) - (define (unison-POp-INCI n) (clamp-integer (add1 n))) - (define (unison-POp-DECN n) (wrap-natural (sub1 n))) - (define (unison-POp-INCN n) (clamp-natural (add1 n))) - (define (unison-POp-DIVN m n) (quotient m n)) - (define (unison-POp-DRPB n bs) (chunked-bytes-drop bs n)) - (define (unison-POp-DRPS n l) (chunked-list-drop l n)) - (define (unison-POp-DRPT n t) (chunked-string-drop t n)) - (define (unison-POp-EQLN m n) (bool (= m n))) - (define (unison-POp-EQLT s t) (bool (equal? s t))) - (define (unison-POp-LEQT s t) (bool (chunked-stringstring fnm)]) - (put-string p snm) - (put-string p ": ") - (display (describe-value x) p) - (raise (make-exn:bug snm x)))) - (define (unison-POp-FTOT f) - (define base (number->string f)) - (define dotted - (if (string-contains? base ".") - base - (string-replace base "e" ".0e"))) - (string->chunked-string - (string-replace dotted "+" ""))) - (define (unison-POp-IDXB n bs) - (guard (x [else none]) - (some (chunked-bytes-ref bs n)))) - (define (unison-POp-IDXS n l) - (guard (x [else none]) - (some (chunked-list-ref l n)))) - (define (unison-POp-IORN m n) (bitwise-ior m n)) - (define (unison-POp-ITOT n) - (string->chunked-string (number->string n))) - (define (unison-POp-LEQN m n) (bool (fx<=? m n))) - (define (unison-POp-LZRO m) (- 64 (integer-length m))) - (define (unison-POp-MULN m n) (clamp-natural (* m n))) - (define (unison-POp-MODN m n) (modulo m n)) - (define (unison-POp-NTOT n) (string->chunked-string (number->string n))) - (define (unison-POp-PAKB l) - (build-chunked-bytes - (chunked-list-length l) - (lambda (i) (chunked-list-ref l i)))) - (define (unison-POp-PAKT l) - (build-chunked-string - (chunked-list-length l) - (lambda (i) (chunked-list-ref l i)))) - (define (unison-POp-SHLI i k) - (clamp-integer (bitwise-arithmetic-shift-left i k))) - (define (unison-POp-SHLN n k) - (clamp-natural (bitwise-arithmetic-shift-left n k))) - (define (unison-POp-SHRI i k) (bitwise-arithmetic-shift-right i k)) - (define (unison-POp-SHRN n k) (bitwise-arithmetic-shift-right n k)) - (define (unison-POp-SIZS l) (chunked-list-length l)) - (define (unison-POp-SIZT t) (chunked-string-length t)) - (define (unison-POp-SIZB b) (chunked-bytes-length b)) - (define (unison-POp-SNOC xs x) (chunked-list-add-last xs x)) - (define (unison-POp-SUBN m n) (clamp-integer (- m n))) - (define (unison-POp-SUBI m n) (clamp-integer (- m n))) - (define (unison-POp-TAKS n s) (chunked-list-take s n)) - (define (unison-POp-TAKT n t) (chunked-string-take t n)) - (define (unison-POp-TAKB n t) (chunked-bytes-take t n)) - - (define (->optional v) - (if v - (ref-optional-some v) - ref-optional-none)) - - (define-unison (builtin-Text.indexOf n h) - (->optional (chunked-string-index-of h n))) - (define-unison (builtin-Bytes.indexOf n h) - (->optional (chunked-bytes-index-of h n))) - - ;; TODO currently only runs in low-level tracing support - (define (unison-POp-DBTX x) - (sum 1 (string->chunked-string (describe-value x)))) - - (define (unison-FOp-Handle.toText h) - (string->chunked-string (describe-value h))) - (define (unison-FOp-Socket.toText s) - (string->chunked-string (describe-value s))) - (define (unison-FOp-ThreadId.toText tid) - (string->chunked-string (describe-value tid))) - - (define (unison-POp-TRCE s x) - (display "trace: ") - (display (chunked-string->string s)) - (newline) - (display (describe-value x)) - (newline)) - (define (unison-POp-PRNT s) - (display (chunked-string->string s)) - (newline)) - (define (unison-POp-TTON s) - (let ([mn (string->number (chunked-string->string s))]) - (if (and (exact-nonnegative-integer? mn) (< mn bit64)) - (some mn) - none))) - (define (unison-POp-TTOI s) - (let ([mn (string->number (chunked-string->string s))]) - (if (and (exact-integer? mn) (>= mn nbit63) (< mn bit63)) - (some mn) - none))) - (define (unison-POp-TTOF s) - (let ([mn (string->number (chunked-string->string s))]) - (if mn (some mn) none))) - (define (unison-POp-UPKT s) - (build-chunked-list - (chunked-string-length s) - (lambda (i) (chunked-string-ref s i)))) - (define (unison-POp-VWLS l) - (if (chunked-list-empty? l) - (sum 0) - (let-values ([(t h) (chunked-list-pop-first l)]) - (sum 1 h t)))) - (define (unison-POp-VWRS l) - (if (chunked-list-empty? l) - (sum 0) - (let-values ([(t h) (chunked-list-pop-last l)]) - (sum 1 t h)))) - (define (unison-POp-SPLL i s) - (if (< (chunked-list-length s) i) - (sum 0) - (let-values ([(l r) (chunked-list-split-at s i)]) - (sum 1 l r)))) - (define (unison-POp-SPLR i s) ; TODO write test that stresses this - (let ([len (chunked-list-length s) ]) - (if (< len i) - (sum 0) - (let-values ([(l r) (chunked-list-split-at s (- len i))]) - (sum 1 l r))))) - - (define (unison-POp-UCNS s) - (if (chunked-string-empty? s) - (sum 0) - (let-values ([(t h) (chunked-string-pop-first s)]) - (sum 1 (char h) t)))) - - (define (unison-POp-USNC s) - (if (chunked-string-empty? s) - (sum 0) - (let-values ([(t h) (chunked-string-pop-last s)]) - (sum 1 t (char h))))) - - ;; TODO flatten operation on Bytes is a no-op for now (and possibly ever) - (define (unison-POp-FLTB b) b) - - (define (unison-POp-XORN m n) (bitwise-xor m n)) - (define (unison-POp-VALU c) (decode-value c)) - - (define (unison-FOp-ImmutableByteArray.read16be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u16-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read24be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u24-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read32be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u32-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read40be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u40-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read48be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u48-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read56be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u56-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read64be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u64-ref bs n 'big))))) - - (define unison-FOp-internal.dataTag unison-data-tag) - - (define (unison-FOp-IO.getBytes.impl.v3 p n) - (reify-exn - (lambda () - (right - (bytes->chunked-bytes - (get-bytevector-n p n)))))) - - (define (unison-FOp-IO.putBytes.impl.v3 p bs) - (begin - (put-bytevector p (chunked-bytes->bytes bs)) - (flush-output-port p) - (sum 1 #f))) - - (define (unison-FOp-Char.toText c) (string->chunked-string (string (integer->char c)))) - - (define (unison-FOp-IO.getArgs.impl.v1) - (sum 1 (cdr (command-line)))) - - (define unison-FOp-IO.systemTimeMicroseconds.v1 current-microseconds) - - ;; TODO should we convert Bytes -> Text directly without the intermediate conversions? - (define (unison-FOp-Text.fromUtf8.impl.v3 b) - (with-handlers - ([exn:fail:contract? - (lambda (e) - (exception - ref-iofailure:typelink - (string->chunked-string - (string-append - "Invalid UTF-8 stream: " - (describe-value b))) - (exception->string e)))]) - (right (string->chunked-string (bytes->string/utf-8 (chunked-bytes->bytes b)))))) - - ;; TODO should we convert Text -> Bytes directly without the intermediate conversions? - (define (unison-FOp-Text.toUtf8 s) - (bytes->chunked-bytes (string->bytes/utf-8 (chunked-string->string s)))) - - (define-unison (builtin-IO.isFileEOF.impl.v3 p) - (ref-either-right (port-eof? p))) - - (define (unison-FOp-IO.closeFile.impl.v3 h) - (if (input-port? h) - (close-input-port h) - (close-output-port h)) - (right none)) - - (define (unison-FOp-Text.repeat n t) - (let loop ([cnt 0] - [acc empty-chunked-string]) - (if (= cnt n) - acc - (loop (+ cnt 1) (chunked-string-append acc t))))) - - (define (unison-FOp-Text.reverse s) - (chunked-string-foldMap-chunks - s - string-reverse - (lambda (acc c) (chunked-string-append c acc)))) - - (define (unison-FOp-Text.toLowercase s) - (chunked-string-foldMap-chunks s string-downcase chunked-string-append)) - - (define (unison-FOp-Text.toUppercase s) - (chunked-string-foldMap-chunks s string-upcase chunked-string-append)) - - (define (unison-FOp-Pattern.run p s) - (let* ([r (pattern-match p s)]) - (if r (sum 1 (icdr r) (icar r)) (sum 0)))) - - (define (unison-FOp-Pattern.isMatch p s) (bool (pattern-match? p s))) - (define (unison-FOp-Pattern.many p) (many p)) - (define (unison-FOp-Pattern.capture p) (capture p)) - (define (unison-FOp-Pattern.join ps) - (join* ps)) - (define (unison-FOp-Pattern.or p1 p2) (choice p1 p2)) - (define (unison-FOp-Pattern.replicate n m p) (replicate p n m)) - - (define (unison-FOp-Text.patterns.digit) digit) - (define (unison-FOp-Text.patterns.letter) letter) - (define (unison-FOp-Text.patterns.punctuation) punctuation) - (define (unison-FOp-Text.patterns.charIn cs) (chars cs)) - (define (unison-FOp-Text.patterns.notCharIn cs) (not-chars cs)) - (define (unison-FOp-Text.patterns.anyChar) any-char) - (define (unison-FOp-Text.patterns.space) space) - (define (unison-FOp-Text.patterns.charRange a z) (char-range (integer->char a) (integer->char z))) - (define (unison-FOp-Text.patterns.notCharRange a z) (not-char-range (integer->char a) (integer->char z))) - (define (unison-FOp-Text.patterns.literal s) (literal s)) - (define (unison-FOp-Text.patterns.eof) eof) - (define (unison-FOp-Text.patterns.char cc) cc) - (define (unison-FOp-Char.Class.is cc c) - (unison-FOp-Pattern.isMatch cc (unison-FOp-Char.toText c))) - (define (unison-FOp-Char.Class.any) (unison-FOp-Text.patterns.anyChar)) - (define (unison-FOp-Char.Class.punctuation) - (unison-FOp-Text.patterns.punctuation)) - (define (unison-FOp-Char.Class.letter) (unison-FOp-Text.patterns.letter)) - (define (unison-FOp-Char.Class.alphanumeric) alphanumeric) - (define (unison-FOp-Char.Class.upper) upper) - (define (unison-FOp-Char.Class.lower) lower) - (define (unison-FOp-Char.Class.number) number) - (define (unison-FOp-Char.Class.symbol) symbol) - (define (unison-FOp-Char.Class.whitespace) space) - (define (unison-FOp-Char.Class.control) control) - (define (unison-FOp-Char.Class.printable) printable) - (define (unison-FOp-Char.Class.mark) mark) - (define (unison-FOp-Char.Class.separator) separator) - (define (unison-FOp-Char.Class.or p1 p2) (char-class-or p1 p2)) - (define (unison-FOp-Char.Class.range a z) - (unison-FOp-Text.patterns.charRange a z)) - (define (unison-FOp-Char.Class.anyOf cs) (unison-FOp-Text.patterns.charIn cs)) - (define (unison-FOp-Char.Class.and cc1 cc2) (char-class-and cc1 cc2)) - (define (unison-FOp-Char.Class.not cc) (char-class-not cc)) - - (define (catch-array thunk) - (reify-exn thunk)) - - (define (unison-FOp-ImmutableArray.read vec i) - (catch-array - (lambda () - (sum 1 (vector-ref vec i))))) - - (define (unison-FOp-ImmutableArray.copyTo! dst doff src soff n) - (catch-array - (lambda () - (vector-copy! dst doff src soff n) - (sum 1)))) - - (define (unison-FOp-MutableArray.copyTo! dst doff src soff l) - (catch-array - (lambda () - (vector-copy! dst doff src soff l) - (sum 1)))) - - (define unison-FOp-MutableArray.freeze! freeze-vector!) - - (define unison-FOp-MutableArray.freeze freeze-subvector) - - (define (unison-FOp-MutableArray.read src i) - (catch-array - (lambda () - (sum 1 (vector-ref src i))))) - - (define (unison-FOp-MutableArray.write dst i x) - (catch-array - (lambda () - (vector-set! dst i x) - (sum 1)))) - - (define (unison-FOp-ImmutableByteArray.copyTo! dst doff src soff n) - (catch-array - (lambda () - (bytes-copy! dst doff src soff n) - (sum 1)))) - - (define (unison-FOp-ImmutableByteArray.read8 arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u8-ref arr i))))) - - (define (unison-FOp-MutableByteArray.copyTo! dst doff src soff l) - (catch-array - (lambda () - (bytes-copy! dst doff src soff l) - (sum 1)))) - - (define unison-FOp-MutableByteArray.freeze! freeze-bytevector!) - - (define (unison-FOp-MutableByteArray.write8 arr i b) - (catch-array - (lambda () - (bytevector-u8-set! arr i b) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.write16be arr i b) - (catch-array - (lambda () - (bytevector-u16-set! arr i b 'big) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.write32be arr i b) - (catch-array - (lambda () - (bytevector-u32-set! arr i b 'big) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.write64be arr i b) - (catch-array - (lambda () - (bytevector-u64-set! arr i b 'big) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.read8 arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u8-ref arr i))))) - - (define (unison-FOp-MutableByteArray.read16be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u16-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read24be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u24-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read32be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u32-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read40be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u40-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read64be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u64-ref arr i 'big))))) - - (define (unison-FOp-Scope.bytearray n) (make-bytevector n)) - (define (unison-FOp-IO.bytearray n) (make-bytevector n)) - - (define (unison-FOp-Scope.array n) (make-vector n)) - (define (unison-FOp-IO.array n) (make-vector n)) - - (define (unison-FOp-Scope.bytearrayOf b n) (make-bytevector n b)) - (define (unison-FOp-IO.bytearrayOf b n) (make-bytevector n b)) - - (define (unison-FOp-Scope.arrayOf v n) (make-vector n v)) - (define (unison-FOp-IO.arrayOf v n) (make-vector n v)) - - (define unison-FOp-MutableByteArray.length bytevector-length) - (define unison-FOp-ImmutableByteArray.length bytevector-length) - (define unison-FOp-MutableByteArray.size bytevector-length) - (define unison-FOp-ImmutableByteArray.size bytevector-length) - (define unison-FOp-MutableArray.size vector-length) - (define unison-FOp-ImmutableArray.size vector-length) - - (define (unison-POp-FORK thunk) (fork 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)) - (define (unison-FOp-IO.ref a) (ref-new a)) - (define (unison-FOp-Ref.read ref) (ref-read ref)) - (define (unison-FOp-Ref.write ref a) (ref-write ref a)) - (define (unison-FOp-Ref.readForCas ref) (ref-read ref)) - (define (unison-FOp-Ref.Ticket.read ticket) ticket) - (define (unison-FOp-Ref.cas ref ticket value) (ref-cas ref ticket value)) - (define (unison-FOp-Promise.new) (promise-new)) - (define (unison-FOp-Promise.read promise) (promise-read promise)) - (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) + (define-unison-builtin (builtin-Nat.== x y) (= x y))) + + (define-unison-builtin (builtin-Nat.isEven x) (even? x)) + (define-unison-builtin (builtin-Nat.isOdd x) (odd? x)) + + ; Note: chunked-string x y) + (not (chunked-string= x y) (chunked-string x y) + (case (universal-compare x y) [(>) #t] [else #f])) + (define-unison-builtin (builtin-Universal.< x y) + (case (universal-compare x y) [(<) #t] [else #f])) + (define-unison-builtin (builtin-Universal.<= x y) + (case (universal-compare x y) [(>) #f] [else #t])) + (define-unison-builtin (builtin-Universal.>= x y) + (case (universal-compare x y) [(<) #f] [else #t])) + (define-unison-builtin (builtin-Universal.compare x y) + (case (universal-compare x y) + [(>) 1] [(<) -1] [else 0])) + + (define-unison-builtin (builtin-Scope.bytearrayOf i n) + (make-bytes n i)) + + ; (define-builtin-link Link.Type.toText) + (define-unison-builtin (builtin-Link.Type.toText ln) + (string->chunked-string (typelink->string ln))) + + ; (define-builtin-link Link.Term.toText) + (define-unison-builtin (builtin-Link.Term.toText ln) + (string->chunked-string (termlink->string ln))) + + (define-unison-builtin (builtin-Char.Class.is cc c) + (pattern-match? cc (string->chunked-string (string c)))) + + (define-unison-builtin (builtin-Pattern.captureAs c p) + (capture-as c p)) + + (define-unison-builtin (builtin-Pattern.many.corrected p) (many p)) + + (define-unison-builtin (builtin-Pattern.isMatch p s) + (pattern-match? p s)) + + (define-unison-builtin (builtin-unsafe.coerceAbilities f) f) + + (define (unison-POp-UPKB bs) + (build-chunked-list + (chunked-bytes-length bs) + (lambda (i) (chunked-bytes-ref bs i)))) + + (define (unison-POp-ADDI i j) (clamp-integer (+ i j))) + (define (unison-POp-MULI i j) (clamp-integer (* i j))) + (define (unison-POp-MODI i j) (clamp-integer (modulo i j))) + (define (unison-POp-LEQI a b) (bool (<= a b))) + (define (unison-POp-POWN m n) (clamp-natural (expt m n))) + (define unison-POp-LOGF log) + + (define (reify-exn 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? + ([exn:fail:contract? (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) + (sum 0 '() (exception->string e) ref-unit-unit))]) + (thunk))) + + ; Core implemented primops, upon which primops-in-unison can be built. + (define (unison-POp-ADDN m n) (clamp-natural (+ m n))) + (define (unison-POp-ANDN m n) (bitwise-and m n)) + (define unison-POp-BLDS + (lambda args-list + (foldr (lambda (e l) (chunked-list-add-first l e)) empty-chunked-list args-list))) + (define (unison-POp-CATS l r) (chunked-list-append l r)) + (define (unison-POp-CATT l r) (chunked-string-append l r)) + (define (unison-POp-CATB l r) (chunked-bytes-append l r)) + (define (unison-POp-CMPU l r) (ord (universal-compare l r))) + (define (unison-POp-COMN n) (wrap-natural (bitwise-not n))) + (define (unison-POp-CONS x xs) (chunked-list-add-first xs x)) + (define (unison-POp-DECI n) (clamp-integer (sub1 n))) + (define (unison-POp-INCI n) (clamp-integer (add1 n))) + (define (unison-POp-DECN n) (wrap-natural (sub1 n))) + (define (unison-POp-INCN n) (clamp-natural (add1 n))) + (define (unison-POp-DIVN m n) (quotient m n)) + (define (unison-POp-DRPB n bs) (chunked-bytes-drop bs n)) + (define (unison-POp-DRPS n l) (chunked-list-drop l n)) + (define (unison-POp-DRPT n t) (chunked-string-drop t n)) + (define (unison-POp-EQLN m n) (bool (= m n))) + (define (unison-POp-EQLT s t) (bool (equal? s t))) + (define (unison-POp-LEQT s t) (bool (chunked-stringstring fnm)]) + (raise (make-exn:bug snm x)))) + (define (unison-POp-FTOT f) + (define base (number->string f)) + (define dotted + (if (string-contains? base ".") + base + (string-replace base "e" ".0e"))) + (string->chunked-string + (string-replace dotted "+" ""))) + (define (unison-POp-IDXB n bs) + (with-handlers + ([exn:fail:contract? (lambda (e) none)]) + (some (chunked-bytes-ref bs n)))) + (define (unison-POp-IDXS n l) + (with-handlers + ([exn:fail:contract? (lambda (x) none)]) + (some (chunked-list-ref l n)))) + (define (unison-POp-IORN m n) (bitwise-ior m n)) + (define (unison-POp-ITOT n) + (string->chunked-string (number->string n))) + (define (unison-POp-LEQN m n) (bool (<= m n))) + (define (unison-POp-LZRO m) (- 64 (integer-length m))) + (define (unison-POp-MULN m n) (clamp-natural (* m n))) + (define (unison-POp-MODN m n) (modulo m n)) + (define (unison-POp-NTOT n) (string->chunked-string (number->string n))) + (define (unison-POp-PAKB l) + (build-chunked-bytes + (chunked-list-length l) + (lambda (i) (chunked-list-ref l i)))) + (define (unison-POp-PAKT l) + (build-chunked-string + (chunked-list-length l) + (lambda (i) (chunked-list-ref l i)))) + (define (unison-POp-SHLI i k) + (clamp-integer (arithmetic-shift i k))) + (define (unison-POp-SHLN n k) + (clamp-natural (arithmetic-shift n k))) + (define (unison-POp-SHRI i k) (arithmetic-shift i (- k))) + (define (unison-POp-SHRN n k) (arithmetic-shift n (- k))) + (define (unison-POp-SIZS l) (chunked-list-length l)) + (define (unison-POp-SIZT t) (chunked-string-length t)) + (define (unison-POp-SIZB b) (chunked-bytes-length b)) + (define (unison-POp-SNOC xs x) (chunked-list-add-last xs x)) + (define (unison-POp-SUBN m n) (clamp-integer (- m n))) + (define (unison-POp-SUBI m n) (clamp-integer (- m n))) + (define (unison-POp-TAKS n s) (chunked-list-take s n)) + (define (unison-POp-TAKT n t) (chunked-string-take t n)) + (define (unison-POp-TAKB n t) (chunked-bytes-take t n)) + + (define (->optional v) + (if v + (ref-optional-some v) + ref-optional-none)) + + (define-unison-builtin (builtin-Text.indexOf n h) + (->optional (chunked-string-index-of h n))) + (define-unison-builtin (builtin-Bytes.indexOf n h) + (->optional (chunked-bytes-index-of h n))) + + ;; TODO currently only runs in low-level tracing support + (define (unison-POp-DBTX x) + (sum 1 (string->chunked-string (describe-value x)))) + + (define (unison-FOp-Handle.toText h) + (string->chunked-string (describe-value h))) + (define (unison-FOp-Socket.toText s) + (string->chunked-string (describe-value s))) + (define (unison-FOp-ThreadId.toText tid) + (string->chunked-string (describe-value tid))) + + (define (unison-POp-TRCE s x) + (display "trace: ") + (display (chunked-string->string s)) + (newline) + (display (describe-value x)) + (newline)) + (define (unison-POp-PRNT s) + (display (chunked-string->string s)) + (newline)) + (define (unison-POp-TTON s) + (let ([mn (string->number (chunked-string->string s))]) + (if (and (exact-nonnegative-integer? mn) (< mn bit64)) + (some mn) + none))) + (define (unison-POp-TTOI s) + (let ([mn (string->number (chunked-string->string s))]) + (if (and (exact-integer? mn) (>= mn nbit63) (< mn bit63)) + (some mn) + none))) + (define (unison-POp-TTOF s) + (let ([mn (string->number (chunked-string->string s))]) + (if mn (some mn) none))) + (define (unison-POp-UPKT s) + (build-chunked-list + (chunked-string-length s) + (lambda (i) (chunked-string-ref s i)))) + (define (unison-POp-VWLS l) + (if (chunked-list-empty? l) + (sum 0) + (let-values ([(t h) (chunked-list-pop-first l)]) + (sum 1 h t)))) + (define (unison-POp-VWRS l) + (if (chunked-list-empty? l) + (sum 0) + (let-values ([(t h) (chunked-list-pop-last l)]) + (sum 1 t h)))) + (define (unison-POp-SPLL i s) + (if (< (chunked-list-length s) i) + (sum 0) + (let-values ([(l r) (chunked-list-split-at s i)]) + (sum 1 l r)))) + (define (unison-POp-SPLR i s) ; TODO write test that stresses this + (let ([len (chunked-list-length s) ]) + (if (< len i) + (sum 0) + (let-values ([(l r) (chunked-list-split-at s (- len i))]) + (sum 1 l r))))) + + (define (unison-POp-UCNS s) + (if (chunked-string-empty? s) + (sum 0) + (let-values ([(t h) (chunked-string-pop-first s)]) + (sum 1 (char h) t)))) + + (define (unison-POp-USNC s) + (if (chunked-string-empty? s) + (sum 0) + (let-values ([(t h) (chunked-string-pop-last s)]) + (sum 1 t (char h))))) + + ;; TODO flatten operation on Bytes is a no-op for now (and possibly ever) + (define (unison-POp-FLTB b) b) + + (define (unison-POp-XORN m n) (bitwise-xor m n)) + (define (unison-POp-VALU c) (decode-value c)) + + (define (unison-FOp-ImmutableByteArray.read16be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u16-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read24be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u24-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read32be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u32-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read40be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u40-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read48be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u48-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read56be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u56-ref bs n 'big))))) + + (define (unison-FOp-ImmutableByteArray.read64be bs n) + (reify-exn + (lambda () + (sum 1 (bytevector-u64-ref bs n 'big))))) + + (define unison-FOp-internal.dataTag unison-data-tag) + + (define (unison-FOp-IO.getBytes.impl.v3 p n) + (reify-exn + (lambda () + (right + (bytes->chunked-bytes + (read-bytes n p)))))) + + (define (unison-FOp-IO.putBytes.impl.v3 p bs) + (begin + (write-bytes (chunked-bytes->bytes bs) p) + (flush-output p) + (sum 1 #f))) + + (define (unison-FOp-Char.toText c) (string->chunked-string (string (integer->char c)))) + + (define (unison-FOp-IO.getArgs.impl.v1) + (sum 1 (cdr (command-line)))) + + (define unison-FOp-IO.systemTimeMicroseconds.v1 current-microseconds) + + ;; TODO should we convert Bytes -> Text directly without the intermediate conversions? + (define (unison-FOp-Text.fromUtf8.impl.v3 b) + (with-handlers + ([exn:fail:contract? (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) - (declare-builtin-link builtin-Float.toRepresentation) - (declare-builtin-link builtin-Float.ceiling) - (declare-builtin-link builtin-Float.exp) - (declare-builtin-link builtin-Float.log) - (declare-builtin-link builtin-Float.max) - (declare-builtin-link builtin-Float.min) - (declare-builtin-link builtin-Float.tan) - (declare-builtin-link builtin-Float.tanh) - (declare-builtin-link builtin-Float.logBase) - (declare-builtin-link builtin-Float.pow) - (declare-builtin-link builtin-Float.>) - (declare-builtin-link builtin-Float.<) - (declare-builtin-link builtin-Float.>=) - (declare-builtin-link builtin-Float.<=) - (declare-builtin-link builtin-Float.==) - (declare-builtin-link builtin-Int.pow) - (declare-builtin-link builtin-Int.*) - (declare-builtin-link builtin-Int.+) - (declare-builtin-link builtin-Int.-) - (declare-builtin-link builtin-Int./) - (declare-builtin-link builtin-Int.>) - (declare-builtin-link builtin-Int.<) - (declare-builtin-link builtin-Int.>=) - (declare-builtin-link builtin-Int.<=) - (declare-builtin-link builtin-Int.==) - (declare-builtin-link builtin-Int.isEven) - (declare-builtin-link builtin-Int.isOdd) - (declare-builtin-link builtin-Int.increment) - (declare-builtin-link builtin-Int.negate) - (declare-builtin-link builtin-Int.fromRepresentation) - (declare-builtin-link builtin-Int.toRepresentation) - (declare-builtin-link builtin-Int.signum) - (declare-builtin-link builtin-Int.trailingZeros) - (declare-builtin-link builtin-Int.popCount) - (declare-builtin-link builtin-Nat.increment) - (declare-builtin-link builtin-Nat.popCount) - (declare-builtin-link builtin-Nat.toFloat) - (declare-builtin-link builtin-Nat.trailingZeros) - (declare-builtin-link builtin-Nat.+) - (declare-builtin-link builtin-Nat.>) - (declare-builtin-link builtin-Nat.<) - (declare-builtin-link builtin-Nat.>=) - (declare-builtin-link builtin-Nat.<=) - (declare-builtin-link builtin-Nat.==) - (declare-builtin-link builtin-Nat.drop) - (declare-builtin-link builtin-Nat.isEven) - (declare-builtin-link builtin-Nat.isOdd) - (declare-builtin-link builtin-Text.indexOf) - (declare-builtin-link builtin-Text.>) - (declare-builtin-link builtin-Text.<) - (declare-builtin-link builtin-Text.>=) - (declare-builtin-link builtin-Text.<=) - (declare-builtin-link builtin-Text.==) - (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) - (declare-builtin-link builtin-Value.fromBuiltin) - (declare-builtin-link builtin-Code.fromGroup) - (declare-builtin-link builtin-Code.toGroup) - (declare-builtin-link builtin-TermLink.fromReferent) - (declare-builtin-link builtin-TermLink.toReferent) - (declare-builtin-link builtin-TypeLink.toReference) - (declare-builtin-link builtin-IO.seekHandle.impl.v3) - (declare-builtin-link builtin-IO.getLine.impl.v1) - (declare-builtin-link builtin-IO.getSomeBytes.impl.v1) - (declare-builtin-link builtin-IO.setBuffering.impl.v3) - (declare-builtin-link builtin-IO.getBuffering.impl.v3) - (declare-builtin-link builtin-IO.setEcho.impl.v1) - (declare-builtin-link builtin-IO.isFileOpen.impl.v3) - (declare-builtin-link builtin-IO.ready.impl.v1) - (declare-builtin-link builtin-IO.process.call) - (declare-builtin-link builtin-IO.getEcho.impl.v1) - (declare-builtin-link builtin-IO.getArgs.impl.v1) - (declare-builtin-link builtin-IO.getEnv.impl.v1) - (declare-builtin-link builtin-IO.getChar.impl.v1) - (declare-builtin-link builtin-IO.directoryContents.impl.v3) - (declare-builtin-link builtin-IO.getCurrentDirectory.impl.v3) - (declare-builtin-link builtin-IO.removeDirectory.impl.v3) - (declare-builtin-link builtin-IO.renameFile.impl.v3) - (declare-builtin-link builtin-IO.createTempDirectory.impl.v3) - (declare-builtin-link builtin-IO.createDirectory.impl.v3) - (declare-builtin-link builtin-IO.setCurrentDirectory.impl.v3) - (declare-builtin-link builtin-IO.renameDirectory.impl.v3) - (declare-builtin-link builtin-IO.fileExists.impl.v3) - (declare-builtin-link builtin-IO.isDirectory.impl.v3) - (declare-builtin-link builtin-IO.isFileEOF.impl.v3) - (declare-builtin-link builtin-IO.isSeekable.impl.v3) - (declare-builtin-link builtin-IO.handlePosition.impl.v3) - (declare-builtin-link builtin-IO.systemTime.impl.v3) - (declare-builtin-link builtin-IO.systemTimeMicroseconds.impl.v3) - (declare-builtin-link builtin-Universal.==) - (declare-builtin-link builtin-Universal.>) - (declare-builtin-link builtin-Universal.<) - (declare-builtin-link builtin-Universal.>=) - (declare-builtin-link builtin-Universal.<=) - (declare-builtin-link builtin-Universal.compare) - (declare-builtin-link builtin-Pattern.isMatch) - (declare-builtin-link builtin-Scope.bytearrayOf) - (declare-builtin-link builtin-Char.Class.is) - (declare-builtin-link builtin-Pattern.many.corrected) - (declare-builtin-link builtin-unsafe.coerceAbilities) - (declare-builtin-link builtin-Clock.internals.systemTimeZone.v1) - ) + (exception + ref-iofailure:typelink + (string->chunked-string + (string-append + "Invalid UTF-8 stream: " + (describe-value b))) + (exception->string e)))]) + (right (string->chunked-string (bytes->string/utf-8 (chunked-bytes->bytes b)))))) + + ;; TODO should we convert Text -> Bytes directly without the intermediate conversions? + (define (unison-FOp-Text.toUtf8 s) + (bytes->chunked-bytes (string->bytes/utf-8 (chunked-string->string s)))) + + (define-unison-builtin (builtin-IO.isFileEOF.impl.v3 p) + (ref-either-right (eof-object? (peek-byte p)))) + + (define (unison-FOp-IO.closeFile.impl.v3 h) + (if (input-port? h) + (close-input-port h) + (close-output-port h)) + (right none)) + + (define (unison-FOp-Text.repeat n t) + (let loop ([cnt 0] + [acc empty-chunked-string]) + (if (= cnt n) + acc + (loop (+ cnt 1) (chunked-string-append acc t))))) + + (define (unison-FOp-Text.reverse s) + (chunked-string-foldMap-chunks + s + string-reverse + (lambda (acc c) (chunked-string-append c acc)))) + + (define (unison-FOp-Text.toLowercase s) + (chunked-string-foldMap-chunks s string-downcase chunked-string-append)) + + (define (unison-FOp-Text.toUppercase s) + (chunked-string-foldMap-chunks s string-upcase chunked-string-append)) + + (define (unison-FOp-Pattern.run p s) + (let* ([r (pattern-match p s)]) + (if r (sum 1 (cdr r) (car r)) (sum 0)))) + + (define (unison-FOp-Pattern.isMatch p s) (bool (pattern-match? p s))) + (define (unison-FOp-Pattern.many p) (many p)) + (define (unison-FOp-Pattern.capture p) (capture p)) + (define (unison-FOp-Pattern.join ps) + (join* ps)) + (define (unison-FOp-Pattern.or p1 p2) (choice p1 p2)) + (define (unison-FOp-Pattern.replicate n m p) (replicate p n m)) + + (define (unison-FOp-Text.patterns.digit) digit) + (define (unison-FOp-Text.patterns.letter) letter) + (define (unison-FOp-Text.patterns.punctuation) punctuation) + (define (unison-FOp-Text.patterns.charIn cs) (chars cs)) + (define (unison-FOp-Text.patterns.notCharIn cs) (not-chars cs)) + (define (unison-FOp-Text.patterns.anyChar) any-char) + (define (unison-FOp-Text.patterns.space) space) + (define (unison-FOp-Text.patterns.charRange a z) (char-range (integer->char a) (integer->char z))) + (define (unison-FOp-Text.patterns.notCharRange a z) (not-char-range (integer->char a) (integer->char z))) + (define (unison-FOp-Text.patterns.literal s) (literal s)) + (define (unison-FOp-Text.patterns.eof) eof) + (define (unison-FOp-Text.patterns.char cc) cc) + (define (unison-FOp-Char.Class.is cc c) + (unison-FOp-Pattern.isMatch cc (unison-FOp-Char.toText c))) + (define (unison-FOp-Char.Class.any) (unison-FOp-Text.patterns.anyChar)) + (define (unison-FOp-Char.Class.punctuation) + (unison-FOp-Text.patterns.punctuation)) + (define (unison-FOp-Char.Class.letter) (unison-FOp-Text.patterns.letter)) + (define (unison-FOp-Char.Class.alphanumeric) alphanumeric) + (define (unison-FOp-Char.Class.upper) upper) + (define (unison-FOp-Char.Class.lower) lower) + (define (unison-FOp-Char.Class.number) number) + (define (unison-FOp-Char.Class.symbol) symbol) + (define (unison-FOp-Char.Class.whitespace) space) + (define (unison-FOp-Char.Class.control) control) + (define (unison-FOp-Char.Class.printable) printable) + (define (unison-FOp-Char.Class.mark) mark) + (define (unison-FOp-Char.Class.separator) separator) + (define (unison-FOp-Char.Class.or p1 p2) (char-class-or p1 p2)) + (define (unison-FOp-Char.Class.range a z) + (unison-FOp-Text.patterns.charRange a z)) + (define (unison-FOp-Char.Class.anyOf cs) (unison-FOp-Text.patterns.charIn cs)) + (define (unison-FOp-Char.Class.and cc1 cc2) (char-class-and cc1 cc2)) + (define (unison-FOp-Char.Class.not cc) (char-class-not cc)) + + (define (catch-array thunk) + (reify-exn thunk)) + + (define (unison-FOp-ImmutableArray.read vec i) + (catch-array + (lambda () + (sum 1 (vector-ref vec i))))) + + (define (unison-FOp-ImmutableArray.copyTo! dst doff src soff n) + (catch-array + (lambda () + (vector-copy! dst doff src soff n) + (sum 1)))) + + (define (unison-FOp-MutableArray.copyTo! dst doff src soff l) + (catch-array + (lambda () + (vector-copy! dst doff src soff l) + (sum 1)))) + + (define unison-FOp-MutableArray.freeze! freeze-vector!) + + (define unison-FOp-MutableArray.freeze freeze-subvector) + + (define (unison-FOp-MutableArray.read src i) + (catch-array + (lambda () + (sum 1 (vector-ref src i))))) + + (define (unison-FOp-MutableArray.write dst i x) + (catch-array + (lambda () + (vector-set! dst i x) + (sum 1)))) + + (define (unison-FOp-ImmutableByteArray.copyTo! dst doff src soff n) + (catch-array + (lambda () + (bytes-copy! dst doff src soff n) + (sum 1)))) + + (define (unison-FOp-ImmutableByteArray.read8 arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u8-ref arr i))))) + + (define (unison-FOp-MutableByteArray.copyTo! dst doff src soff l) + (catch-array + (lambda () + (bytes-copy! dst doff src soff l) + (sum 1)))) + + (define unison-FOp-MutableByteArray.freeze! freeze-bytevector!) + + (define (unison-FOp-MutableByteArray.write8 arr i b) + (catch-array + (lambda () + (bytevector-u8-set! arr i b) + (sum 1)))) + + (define (unison-FOp-MutableByteArray.write16be arr i b) + (catch-array + (lambda () + (bytevector-u16-set! arr i b 'big) + (sum 1)))) + + (define (unison-FOp-MutableByteArray.write32be arr i b) + (catch-array + (lambda () + (bytevector-u32-set! arr i b 'big) + (sum 1)))) + + (define (unison-FOp-MutableByteArray.write64be arr i b) + (catch-array + (lambda () + (bytevector-u64-set! arr i b 'big) + (sum 1)))) + + (define (unison-FOp-MutableByteArray.read8 arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u8-ref arr i))))) + + (define (unison-FOp-MutableByteArray.read16be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u16-ref arr i 'big))))) + + (define (unison-FOp-MutableByteArray.read24be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u24-ref arr i 'big))))) + + (define (unison-FOp-MutableByteArray.read32be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u32-ref arr i 'big))))) + + (define (unison-FOp-MutableByteArray.read40be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u40-ref arr i 'big))))) + + (define (unison-FOp-MutableByteArray.read64be arr i) + (catch-array + (lambda () + (sum 1 (bytevector-u64-ref arr i 'big))))) + + (define (unison-FOp-Scope.bytearray n) (make-bytes n)) + (define (unison-FOp-IO.bytearray n) (make-bytes n)) + + (define (unison-FOp-Scope.array n) (make-vector n)) + (define (unison-FOp-IO.array n) (make-vector n)) + + (define (unison-FOp-Scope.bytearrayOf b n) (make-bytes n b)) + (define (unison-FOp-IO.bytearrayOf b n) (make-bytes n b)) + + (define (unison-FOp-Scope.arrayOf v n) (make-vector n v)) + (define (unison-FOp-IO.arrayOf v n) (make-vector n v)) + + (define unison-FOp-MutableByteArray.length bytevector-length) + (define unison-FOp-ImmutableByteArray.length bytevector-length) + (define unison-FOp-MutableByteArray.size bytevector-length) + (define unison-FOp-ImmutableByteArray.size bytevector-length) + (define unison-FOp-MutableArray.size vector-length) + (define unison-FOp-ImmutableArray.size vector-length) + + (define (unison-POp-FORK thunk) (fork 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)) + (define (unison-FOp-IO.ref a) (ref-new a)) + (define (unison-FOp-Ref.read ref) (ref-read ref)) + (define (unison-FOp-Ref.write ref a) (ref-write ref a)) + (define (unison-FOp-Ref.readForCas ref) (ref-read ref)) + (define (unison-FOp-Ref.Ticket.read ticket) ticket) + (define (unison-FOp-Ref.cas ref ticket value) (ref-cas ref ticket value)) + (define (unison-FOp-Promise.new) (promise-new)) + (define (unison-FOp-Promise.read promise) (promise-read promise)) + (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 (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) +; (declare-builtin-link builtin-Float.toRepresentation) +; (declare-builtin-link builtin-Float.ceiling) +; (declare-builtin-link builtin-Float.exp) +; (declare-builtin-link builtin-Float.log) +; (declare-builtin-link builtin-Float.max) +; (declare-builtin-link builtin-Float.min) +; (declare-builtin-link builtin-Float.tan) +; (declare-builtin-link builtin-Float.tanh) +; (declare-builtin-link builtin-Float.logBase) +; (declare-builtin-link builtin-Float.pow) +; (declare-builtin-link builtin-Float.>) +; (declare-builtin-link builtin-Float.<) +; (declare-builtin-link builtin-Float.>=) +; (declare-builtin-link builtin-Float.<=) +; (declare-builtin-link builtin-Float.==) +; (declare-builtin-link builtin-Int.pow) +; (declare-builtin-link builtin-Int.*) +; (declare-builtin-link builtin-Int.+) +; (declare-builtin-link builtin-Int.-) +; (declare-builtin-link builtin-Int./) +; (declare-builtin-link builtin-Int.>) +; (declare-builtin-link builtin-Int.<) +; (declare-builtin-link builtin-Int.>=) +; (declare-builtin-link builtin-Int.<=) +; (declare-builtin-link builtin-Int.==) +; (declare-builtin-link builtin-Int.isEven) +; (declare-builtin-link builtin-Int.isOdd) +; (declare-builtin-link builtin-Int.increment) +; (declare-builtin-link builtin-Int.negate) +; (declare-builtin-link builtin-Int.fromRepresentation) +; (declare-builtin-link builtin-Int.toRepresentation) +; (declare-builtin-link builtin-Int.signum) +; (declare-builtin-link builtin-Int.trailingZeros) +; (declare-builtin-link builtin-Int.popCount) +; (declare-builtin-link builtin-Nat.increment) +; (declare-builtin-link builtin-Nat.popCount) +; (declare-builtin-link builtin-Nat.toFloat) +; (declare-builtin-link builtin-Nat.trailingZeros) +; (declare-builtin-link builtin-Nat.+) +; (declare-builtin-link builtin-Nat.>) +; (declare-builtin-link builtin-Nat.<) +; (declare-builtin-link builtin-Nat.>=) +; (declare-builtin-link builtin-Nat.<=) +; (declare-builtin-link builtin-Nat.==) +; (declare-builtin-link builtin-Nat.drop) +; (declare-builtin-link builtin-Nat.isEven) +; (declare-builtin-link builtin-Nat.isOdd) +; (declare-builtin-link builtin-Text.indexOf) +; (declare-builtin-link builtin-Text.>) +; (declare-builtin-link builtin-Text.<) +; (declare-builtin-link builtin-Text.>=) +; (declare-builtin-link builtin-Text.<=) +; (declare-builtin-link builtin-Text.==) +; (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) +; (declare-builtin-link builtin-Value.fromBuiltin) +; (declare-builtin-link builtin-Code.fromGroup) +; (declare-builtin-link builtin-Code.toGroup) +; (declare-builtin-link builtin-TermLink.fromReferent) +; (declare-builtin-link builtin-TermLink.toReferent) +; (declare-builtin-link builtin-TypeLink.toReference) +; (declare-builtin-link builtin-IO.seekHandle.impl.v3) +; (declare-builtin-link builtin-IO.getLine.impl.v1) +; (declare-builtin-link builtin-IO.getSomeBytes.impl.v1) +; (declare-builtin-link builtin-IO.setBuffering.impl.v3) +; (declare-builtin-link builtin-IO.getBuffering.impl.v3) +; (declare-builtin-link builtin-IO.setEcho.impl.v1) +; (declare-builtin-link builtin-IO.isFileOpen.impl.v3) +; (declare-builtin-link builtin-IO.ready.impl.v1) +; (declare-builtin-link builtin-IO.process.call) +; (declare-builtin-link builtin-IO.getEcho.impl.v1) +; (declare-builtin-link builtin-IO.getArgs.impl.v1) +; (declare-builtin-link builtin-IO.getEnv.impl.v1) +; (declare-builtin-link builtin-IO.getChar.impl.v1) +; (declare-builtin-link builtin-IO.directoryContents.impl.v3) +; (declare-builtin-link builtin-IO.getCurrentDirectory.impl.v3) +; (declare-builtin-link builtin-IO.removeDirectory.impl.v3) +; (declare-builtin-link builtin-IO.renameFile.impl.v3) +; (declare-builtin-link builtin-IO.createTempDirectory.impl.v3) +; (declare-builtin-link builtin-IO.createDirectory.impl.v3) +; (declare-builtin-link builtin-IO.setCurrentDirectory.impl.v3) +; (declare-builtin-link builtin-IO.renameDirectory.impl.v3) +; (declare-builtin-link builtin-IO.fileExists.impl.v3) +; (declare-builtin-link builtin-IO.isDirectory.impl.v3) +; (declare-builtin-link builtin-IO.isFileEOF.impl.v3) +; (declare-builtin-link builtin-IO.isSeekable.impl.v3) +; (declare-builtin-link builtin-IO.handlePosition.impl.v3) +; (declare-builtin-link builtin-IO.systemTime.impl.v3) +; (declare-builtin-link builtin-IO.systemTimeMicroseconds.impl.v3) +; (declare-builtin-link builtin-Universal.==) +; (declare-builtin-link builtin-Universal.>) +; (declare-builtin-link builtin-Universal.<) +; (declare-builtin-link builtin-Universal.>=) +; (declare-builtin-link builtin-Universal.<=) +; (declare-builtin-link builtin-Universal.compare) +; (declare-builtin-link builtin-Pattern.isMatch) +; (declare-builtin-link builtin-Scope.bytearrayOf) +; (declare-builtin-link builtin-Char.Class.is) +; (declare-builtin-link builtin-Pattern.many.corrected) +; (declare-builtin-link builtin-unsafe.coerceAbilities) +; (declare-builtin-link builtin-Clock.internals.systemTimeZone.v1) diff --git a/scheme-libs/racket/unison/sandbox.rkt b/scheme-libs/racket/unison/sandbox.rkt index a24c70f2f9..248d0b06e8 100644 --- a/scheme-libs/racket/unison/sandbox.rkt +++ b/scheme-libs/racket/unison/sandbox.rkt @@ -4,7 +4,7 @@ (provide expand-sandbox check-sandbox set-sandbox) (require racket racket/hash) -(require (except-in unison/data true false unit)) +(require unison/data) ; sandboxing information (define sandbox-links (make-hash)) diff --git a/scheme-libs/racket/unison/udp.rkt b/scheme-libs/racket/unison/udp.rkt index 3607673264..2f1170e01b 100644 --- a/scheme-libs/racket/unison/udp.rkt +++ b/scheme-libs/racket/unison/udp.rkt @@ -2,7 +2,7 @@ #lang racket/base (require racket/udp racket/format - (only-in unison/boot define-unison) + (only-in unison/boot define-unison-builtin) unison/data unison/data-info unison/chunked-seq @@ -11,32 +11,29 @@ unison/core) (provide - (prefix-out - builtin-IO.UDP. - (combine-out - clientSocket.impl.v1 - clientSocket.impl.v1:termlink - UDPSocket.recv.impl.v1 - UDPSocket.recv.impl.v1:termlink - UDPSocket.send.impl.v1 - UDPSocket.send.impl.v1:termlink - UDPSocket.close.impl.v1 - UDPSocket.close.impl.v1:termlink - ListenSocket.close.impl.v1 - ListenSocket.close.impl.v1:termlink - UDPSocket.toText.impl.v1 - UDPSocket.toText.impl.v1:termlink - serverSocket.impl.v1 - serverSocket.impl.v1:termlink - ListenSocket.toText.impl.v1 - ListenSocket.toText.impl.v1:termlink - ListenSocket.recvFrom.impl.v1 - ListenSocket.recvFrom.impl.v1:termlink - ClientSockAddr.toText.v1 - ClientSockAddr.toText.v1:termlink - ListenSocket.sendTo.impl.v1 - ListenSocket.sendTo.impl.v1:termlink))) - + builtin-IO.UDP.clientSocket.impl.v1 + builtin-IO.UDP.clientSocket.impl.v1:termlink + builtin-IO.UDP.UDPSocket.recv.impl.v1 + builtin-IO.UDP.UDPSocket.recv.impl.v1:termlink + builtin-IO.UDP.UDPSocket.send.impl.v1 + builtin-IO.UDP.UDPSocket.send.impl.v1:termlink + builtin-IO.UDP.UDPSocket.close.impl.v1 + builtin-IO.UDP.UDPSocket.close.impl.v1:termlink + builtin-IO.UDP.ListenSocket.close.impl.v1 + builtin-IO.UDP.ListenSocket.close.impl.v1:termlink + builtin-IO.UDP.UDPSocket.toText.impl.v1 + builtin-IO.UDP.UDPSocket.toText.impl.v1:termlink + builtin-IO.UDP.serverSocket.impl.v1 + builtin-IO.UDP.serverSocket.impl.v1:termlink + builtin-IO.UDP.ListenSocket.toText.impl.v1 + builtin-IO.UDP.ListenSocket.toText.impl.v1:termlink + builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 + builtin-IO.UDP.ListenSocket.recvFrom.impl.v1:termlink + builtin-IO.UDP.ClientSockAddr.toText.v1 + builtin-IO.UDP.ClientSockAddr.toText.v1:termlink + builtin-IO.UDP.ListenSocket.sendTo.impl.v1 + builtin-IO.UDP.ListenSocket.sendTo.impl.v1:termlink) + (struct client-sock-addr (host port)) @@ -48,10 +45,10 @@ (sum-case a (0 (type msg meta) (ref-either-left (ref-failure-failure type msg (unison-any-any meta)))) - (1 (data) + (1 (data) (ref-either-right data)))) -(define +(define (format-socket socket) (let*-values ([(local-hn local-port remote-hn remote-port) (udp-addresses socket #t)] [(rv) (~a "")]) @@ -64,7 +61,7 @@ (wrap-in-either rv))) ;; define termlink builtins -(define clientSocket.impl.v1:termlink +(define clientSocket.impl.v1:termlink (unison-termlink-builtin "IO.UDP.clientSocket.impl.v1")) (define UDPSocket.recv.impl.v1:termlink (unison-termlink-builtin "IO.UDP.UDPSocket.recv.impl.v1")) @@ -72,7 +69,7 @@ (unison-termlink-builtin "IO.UDP.UDPSocket.send.impl.v1")) (define UDPSocket.close.impl.v1:termlink (unison-termlink-builtin "IO.UDP.UDPSocket.close.impl.v1")) -(define ListenSocket.close.impl.v1:termlink +(define ListenSocket.close.impl.v1:termlink (unison-termlink-builtin "IO.UDP.ListenSocket.close.impl.v1")) (define UDPSocket.toText.impl.v1:termlink (unison-termlink-builtin "IO.UDP.UDPSocket.toText.impl.v1")) @@ -89,22 +86,25 @@ ;; define builtins -(define-unison - (UDPSocket.recv.impl.v1 socket) ; socket -> Either Failure Bytes - (let - ([rv (handle-errors (lambda() +(define-unison-builtin + (builtin-IO.UDP.UDPSocket.recv.impl.v1 socket) + ; socket -> Either Failure Bytes + (let + ([rv (handle-errors (lambda() (let*-values ([(buffer) (make-bytes buffer-size)] [(len a b) (udp-receive! socket buffer)]) (right (bytes->chunked-bytes (subbytes buffer 0 len))))))]) (wrap-in-either rv))) -(define-unison - (ListenSocket.close.impl.v1 socket) ; socket -> Either Failure () +(define-unison-builtin + (builtin-IO.UDP.ListenSocket.close.impl.v1 socket) + ; socket -> Either Failure () (close-socket socket)) -(define-unison - (serverSocket.impl.v1 ip port) ; string string -> Either Failure socket +(define-unison-builtin + (builtin-IO.UDP.serverSocket.impl.v1 ip port) + ; string string -> Either Failure socket (let ([result (handle-errors (lambda() (let* ([iip (chunked-string->string ip)] @@ -115,12 +115,13 @@ (right sock)))))]) (wrap-in-either result))) -(define-unison - (ListenSocket.recvFrom.impl.v1 socket) ; socket -> Either Failure (Bytes, ClientSockAddr) - (let ([result (handle-errors (lambda() +(define-unison-builtin + (builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 socket) + ; socket -> Either Failure (Bytes, ClientSockAddr) + (let ([result (handle-errors (lambda() (if (not (udp? socket)) (raise-argument-error 'socket "a UDP socket" socket) - (let*-values + (let*-values ([(buffer) (make-bytes buffer-size)] [(len host port) (udp-receive! socket buffer)] [(csa) (client-sock-addr host port)] @@ -129,18 +130,20 @@ (right (ref-tuple-pair chunked (ref-tuple-pair csa ref-unit-unit)))))))]) (wrap-in-either result))) -(define-unison - (UDPSocket.send.impl.v1 socket data) ; socket -> Bytes -> Either Failure () +(define-unison-builtin + (builtin-IO.UDP.UDPSocket.send.impl.v1 socket data) + ; socket -> Bytes -> Either Failure () (let ([result (handle-errors (lambda () (begin - (udp-send socket (chunked-bytes->bytes data)) + (udp-send socket (chunked-bytes->bytes data)) (right ref-unit-unit))))]) (wrap-in-either result))) -(define-unison - (ListenSocket.sendTo.impl.v1 sock bytes addr) ; socket -> Bytes -> ClientSockAddr -> Either Failure () +(define-unison-builtin + (builtin-IO.UDP.ListenSocket.sendTo.impl.v1 sock bytes addr) + ; socket -> Bytes -> ClientSockAddr -> Either Failure () (let - ([result (handle-errors (lambda() + ([result (handle-errors (lambda() (let* ([host (client-sock-addr-host addr)] [port (client-sock-addr-port addr)] [bytes (chunked-bytes->bytes bytes)]) @@ -149,28 +152,32 @@ (right ref-unit-unit)))))]) (wrap-in-either result))) -(define-unison - (UDPSocket.toText.impl.v1 socket) ; socket -> string +(define-unison-builtin + (builtin-IO.UDP.UDPSocket.toText.impl.v1 socket) ; socket -> string (format-socket socket)) -(define-unison - (ClientSockAddr.toText.v1 addr) ; ClientSocketAddr -> string +(define-unison-builtin + (builtin-IO.UDP.ClientSockAddr.toText.v1 addr) + ; ClientSocketAddr -> string (string->chunked-string (format "" (client-sock-addr-host addr) (client-sock-addr-port addr)))) -(define-unison - (ListenSocket.toText.impl.v1 socket) ; socket -> string +(define-unison-builtin + (builtin-IO.UDP.ListenSocket.toText.impl.v1 socket) + ; socket -> string (format-socket socket)) -(define-unison - (UDPSocket.close.impl.v1 socket) ; socket -> Either Failure () +(define-unison-builtin + (builtin-IO.UDP.UDPSocket.close.impl.v1 socket) + ; socket -> Either Failure () (let ([rv (handle-errors (lambda() (begin (udp-close socket) (right ref-unit-unit))))]) (wrap-in-either rv))) -(define-unison - (clientSocket.impl.v1 host port) ; string string -> Either Failure socket +(define-unison-builtin + (builtin-IO.UDP.clientSocket.impl.v1 host port) + ; string string -> Either Failure socket (let ([rv (handle-errors (lambda() (let* ([pport (string->number (chunked-string->string port))] [hhost (chunked-string->string host)] [sock (udp-open-socket hhost pport)] diff --git a/unison-src/builtin-tests/jit-tests.output.md b/unison-src/builtin-tests/jit-tests.output.md index 55c9234d59..36da409296 100644 --- a/unison-src/builtin-tests/jit-tests.output.md +++ b/unison-src/builtin-tests/jit-tests.output.md @@ -40,11 +40,11 @@ foo = do ``` ```ucm -.> run.native foo +scratch/main> run.native foo () -.> run.native foo +scratch/main> run.native foo () diff --git a/unison-src/transcripts-manual/gen-racket-libs.md b/unison-src/transcripts-manual/gen-racket-libs.md index 811ec14f50..178503c969 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.md +++ b/unison-src/transcripts-manual/gen-racket-libs.md @@ -4,7 +4,7 @@ When we start out, `./scheme-libs/racket` contains a bunch of library files that Next, we'll download the jit project and generate a few Racket files from it. ```ucm -jit-setup/main> lib.install @unison/internal/releases/0.0.17 +jit-setup/main> lib.install @unison/internal/releases/0.0.18 ``` ```unison diff --git a/unison-src/transcripts-manual/gen-racket-libs.output.md b/unison-src/transcripts-manual/gen-racket-libs.output.md index 241a9cdc59..1e003ab489 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.output.md +++ b/unison-src/transcripts-manual/gen-racket-libs.output.md @@ -4,29 +4,12 @@ When we start out, `./scheme-libs/racket` contains a bunch of library files that Next, we'll download the jit project and generate a few Racket files from it. ```ucm -.> project.create-empty jit-setup +jit-setup/main> lib.install @unison/internal/releases/0.0.18 - 🎉 I've created the project jit-setup. + Downloaded 14917 entities. - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - -jit-setup/main> pull @unison/internal/releases/0.0.17 lib.jit - - Downloaded 15091 entities. - - ✅ - - Successfully pulled into lib.jit, which was empty. + I installed @unison/internal/releases/0.0.18 as + unison_internal_0_0_18. ``` ```unison