From a9c32c10dab7be18343fc53ded4c35e4ca5a9948 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 13 Jun 2024 11:30:58 -0400 Subject: [PATCH 1/7] Various changes to definitions in preparation for cont serialization - The define-unison macro has been reworked in various ways. It can now accept some hint flags that influence its behavior. It also, by default, generates definitions that will annotate the continuation with procedure arguments so that they can later be recovered and reflected for continuation serialization. - A helper macro define-unison-builtin has been added and made use of in the builtin files. This uses hints that turn off the continuation management, because they'll never occur in a captured continuation. The macro also auto-generates termlink information for builtins, so it's no longer necessary to separately define/declare those (required porting some files to racket language). - The unison-continuation struct now acts as the slow path. Static calls to a unison procedure are now macros that either build a closure or call directly into the fast path. - One thing to note: the auto-generation features of the macro are based on the name that occurs in the definition. So declaring abbreviated names and using `prefix-out` is not an option with them. I think this seems like a decent trade off. --- scheme-libs/racket/unison/arithmetic.rkt | 105 +- scheme-libs/racket/unison/boot.ss | 351 +- scheme-libs/racket/unison/concurrent.ss | 12 +- scheme-libs/racket/unison/core.ss | 2 +- scheme-libs/racket/unison/data.ss | 57 +- scheme-libs/racket/unison/io-handles.rkt | 103 +- scheme-libs/racket/unison/io.rkt | 75 +- scheme-libs/racket/unison/math.rkt | 102 +- .../racket/unison/primops-generated.rkt | 59 +- scheme-libs/racket/unison/primops.ss | 2961 ++++++++--------- scheme-libs/racket/unison/sandbox.rkt | 2 +- scheme-libs/racket/unison/udp.rkt | 125 +- 12 files changed, 2155 insertions(+), 1799 deletions(-) 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..64b1342344 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,7 +117,8 @@ (require (for-syntax racket/set - (only-in racket partition flatten)) + (only-in racket partition flatten split-at) + (only-in racket/syntax format-id)) (rename-in (except-in racket false true unit any) [make-continuation-prompt-tag make-prompt]) @@ -151,78 +153,287 @@ (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? #f] + [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 name:txt (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 . args)] ...) body ...))])) ; Wrapper that more closely matches `handle` constructs ; 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..0c6e85a59e 100644 --- a/scheme-libs/racket/unison/core.ss +++ b/scheme-libs/racket/unison/core.ss @@ -192,7 +192,7 @@ (string-append "{Value " (describe-value v) "}")] [(unison-code v) (string-append "{Code " (describe-value v) "}")] - [(unison-closure code env) + [(unison-closure _ code env) (define dc (termlink->string (lookup-function-link code) #t)) (define (f v) diff --git a/scheme-libs/racket/unison/data.ss b/scheme-libs/racket/unison/data.ss index 7ab75d6d5b..02171a5411 100644 --- a/scheme-libs/racket/unison/data.ss +++ b/scheme-libs/racket/unison/data.ss @@ -45,9 +45,9 @@ left? either-get either-get - unit - false - true + sum-unit + sum-false + sum-true bool char ord @@ -290,13 +290,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 +305,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 @@ -344,9 +360,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 +375,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 +401,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)) 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..54bd9cd4c4 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))] @@ -413,7 +428,7 @@ (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-closure arity f as) (ref-value-partial (function->groupref f) (list->chunked-list (map reflect-value as)))] @@ -438,7 +453,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 +489,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 +721,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)] From c772ebd046f2b506ce32eb205ebf54900abb9798 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 13 Jun 2024 20:44:02 -0400 Subject: [PATCH 2/7] Fix some problems with new macros - #:by-name annotations were inconsistent and eating arguments - Auto-generated builtin links were including "builtin-" in the termlink text --- scheme-libs/racket/unison/boot.ss | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/scheme-libs/racket/unison/boot.ss b/scheme-libs/racket/unison/boot.ss index 64b1342344..e938e68ef8 100644 --- a/scheme-libs/racket/unison/boot.ss +++ b/scheme-libs/racket/unison/boot.ss @@ -118,6 +118,7 @@ (for-syntax racket/set (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) @@ -282,7 +283,7 @@ (syntax/loc loc (define-syntax (name stx) (syntax-case stx () - [(_ #:by-name . bs) + [(_ #:by-name _ . bs) (syntax/loc stx (unison-closure arity name:fast (list . bs)))] [(_ . bs) @@ -306,7 +307,7 @@ (syntax/loc loc (define-syntax (name stx) (syntax-case stx () - [(_ #:by-name . bs) + [(_ #:by-name _ . bs) (syntax/loc stx (unison-closure arity name:fast (list . bs)))] [(_ . bs) @@ -364,7 +365,15 @@ (define-for-syntax (make-link-def gen-link? loc name:stx name:link:stx) - (define name:txt (symbol->string (syntax->datum name: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? @@ -433,7 +442,7 @@ (syntax-case stx () [(name ([v (f . args)] ...) body ...) (syntax/loc stx - (let ([v (f #:by-name . args)] ...) body ...))])) + (let ([v (f #:by-name #t . args)] ...) body ...))])) ; Wrapper that more closely matches `handle` constructs ; From 620a6334ff79827fa1b0bb1a1bd6fc693f82da48 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Wed, 26 Jun 2024 15:11:12 -0400 Subject: [PATCH 3/7] Add continuation representations and move some support around unison/data needs to have some of the continuation functions to allow using the struct wrappers like procedures. Includes some infrastructure for deserializing continuations. --- scheme-libs/racket/unison/boot.ss | 35 +---- scheme-libs/racket/unison/core.ss | 10 +- scheme-libs/racket/unison/data.ss | 130 +++++++++++++++++- .../racket/unison/primops-generated.rkt | 127 +++++++++++++---- 4 files changed, 237 insertions(+), 65 deletions(-) diff --git a/scheme-libs/racket/unison/boot.ss b/scheme-libs/racket/unison/boot.ss index e938e68ef8..b12f45cc45 100644 --- a/scheme-libs/racket/unison/boot.ss +++ b/scheme-libs/racket/unison/boot.ss @@ -126,7 +126,7 @@ ; (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 @@ -445,41 +445,10 @@ (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/core.ss b/scheme-libs/racket/unison/core.ss index 0c6e85a59e..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,6 +193,8 @@ (string-append "{Value " (describe-value v) "}")] [(unison-code v) (string-append "{Code " (describe-value v) "}")] + [(unison-cont-reflected fs) "{Continuation}"] + [(unison-cont-wrapped _) "{Continuation}"] [(unison-closure _ code env) (define dc (termlink->string (lookup-function-link code) #t)) @@ -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 02171a5411..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 @@ -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) @@ -351,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) @@ -561,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/primops-generated.rkt b/scheme-libs/racket/unison/primops-generated.rkt index 54bd9cd4c4..105d3ec205 100644 --- a/scheme-libs/racket/unison/primops-generated.rkt +++ b/scheme-libs/racket/unison/primops-generated.rkt @@ -210,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 @@ -316,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)) @@ -342,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 @@ -428,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-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) From c1bd940ce124e8afeb935e303dd8b656fb6884fb Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 27 Jun 2024 12:28:39 -0400 Subject: [PATCH 4/7] Bump share dependency --- .github/workflows/ci.md | 2 +- .github/workflows/ci.yaml | 2 +- .../transcripts-manual/gen-racket-libs.md | 2 +- .../gen-racket-libs.output.md | 25 +++---------------- unison-src/transcripts/fix5080.output.md | 2 +- 5 files changed, 8 insertions(+), 25 deletions(-) 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/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 diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md index c2384f98b3..745b2e0478 100644 --- a/unison-src/transcripts/fix5080.output.md +++ b/unison-src/transcripts/fix5080.output.md @@ -6,7 +6,7 @@ I'll now fetch the latest version of the base Unison library... - Downloaded 14053 entities. + Downloaded 14067 entities. 🎨 Type `ui` to explore this project's code in your browser. 🔭 Discover libraries at https://share.unison-lang.org From 658d490b25e4ff57bdc79e7c4abc878178ec0e01 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 27 Jun 2024 14:18:09 -0400 Subject: [PATCH 5/7] Transcript update --- unison-src/transcripts/fix5080.output.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md index 745b2e0478..3fc487dae7 100644 --- a/unison-src/transcripts/fix5080.output.md +++ b/unison-src/transcripts/fix5080.output.md @@ -6,7 +6,7 @@ I'll now fetch the latest version of the base Unison library... - Downloaded 14067 entities. + Downloaded 14117 entities. 🎨 Type `ui` to explore this project's code in your browser. 🔭 Discover libraries at https://share.unison-lang.org From d45563e8e5b2deff545596119b4b0a362a8ae367 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 27 Jun 2024 14:21:36 -0400 Subject: [PATCH 6/7] Disable continuation annotation until it's actually useful --- scheme-libs/racket/unison/boot.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scheme-libs/racket/unison/boot.ss b/scheme-libs/racket/unison/boot.ss index b12f45cc45..ed8b0f7d35 100644 --- a/scheme-libs/racket/unison/boot.ss +++ b/scheme-libs/racket/unison/boot.ss @@ -352,7 +352,7 @@ (define-for-syntax (process-hints hs) (for/fold ([internal? #f] - [force-pure? #f] + [force-pure? #t] [gen-link? #f] [no-link-decl? #f]) ([h hs]) From 907aba9550026dfa5f264d47a1f4fe8d47076679 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 27 Jun 2024 17:21:42 -0400 Subject: [PATCH 7/7] Rerun jit tests with regenerated file --- unison-src/builtin-tests/jit-tests.output.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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 ()