substrate-lang 0.9.3 → 0.10.0

package/std/http/static.sub

@@ -200,15 +200,15 @@
            (http-finish! r)]
           [(<= size whole)
            (let ([f (slice u8)])
-             (if (< (fs-read-file name (& f) 0) 0)
+             (if (not (fs-read-file name (& f) 0))
                  (failed! r)
                  (begin
                    (head-of! r name partial s size)
                    (http-send! r (slice f (cast u32 (-> s start)) (cast u32 (-> s end))))
                    (free (-> f items)))))]
           [else
-           (let* ([h (fs-open-file name fs-read-flag 0)] [file (if (== h 0) 0 (fs-read-stream h (-> s start) 0 0))])
-             (if (== file 0)
+           (let ([h u32 0] [file u32 0])
+             (if (not (and (fs-open-file name fs-read-flag (& h) 0) (fs-read-stream h (-> s start) 0 (& file) 0)))
                  (failed! r)
                  (begin
                    (head-of! r name partial s size)
@@ -262,7 +262,7 @@
         (if (and ok (> n 0) (== (refusal (slice parts n)) 0))
             (begin
               (joined! (& name) (slice parts n))
-              (if (and (>= (fs-stat (buffer-string (& name)) (& info) 0) 0) (== (-> info kind) fs-file))
+              (if (and (fs-stat (buffer-string (& name)) (& info) 0) (== (-> info kind) fs-file))
                   (send! r files (buffer-string (& name)) (slice (buffer-string (& name)) (+ prefix 1)) (& info))
                   (not-found! r)))
             (not-found! r))))
@@ -282,7 +282,7 @@
                        (joined! (& name) parts)
                        (when (== (-> parts length) 0) (buffer-add-byte! (& name) #\/))
                        (when slash (buffer-add-string! (& name) "index.html"))
-                       (let ([found (>= (fs-stat (buffer-string (& name)) (& info) 0) 0)])
+                       (let ([found (fs-stat (buffer-string (& name)) (& info) 0)])
                          (cond [(and found (== (-> info kind) fs-directory) (not slash)) (moved! r)]
                                [(or (not found) (!= (-> info kind) fs-file)) (not-found! r)]
                                [else

package/std/http/url.sub

@@ -26,7 +26,7 @@
     (for ([i u32 0]) (< i n) (+= i 1)
       (when (or (escape? s i) (and plus (== (@ s i) #\+))) (set! plain #f)))
     (when plain (return s))
-    (let ([p (cast (ptr u8) (arena-alloc a n))] [i u32 0] [k u32 0])
+    (let ([p (new a u8 n)] [i u32 0] [k u32 0])
       (while (< i n)
         (cond [(escape? s i)
                (set! (@ p k) (+ (* 16 (digit-value (@ s (+ i 1)) 16)) (digit-value (@ s (+ i 2)) 16)))
@@ -38,7 +38,7 @@
                (set! (@ p k) (@ s i))
                (+= i 1)])
         (+= k 1))
-      (cast string (slice p k)))))
+      (cast string (slice p 0 k)))))
 
 ;; A path's segments after its first slash, decoded into the arena: "/" has none, and a final slash gives an empty last
 ;; segment. It returns 1 when a segment is . or .., or empty before the end, and -1 when the path does not start with a
@@ -49,7 +49,7 @@
     (when (or (== n 0) (!= (@ path 0) #\/)) (return -1))
     (when (== n 1) (return 0))
     (for ([i u32 1]) (< i n) (+= i 1) (when (== (@ path i) #\/) (+= count 1)))
-    (let ([items (cast (ptr string) (arena-alloc a (* count (sizeof string))))])
+    (let ([items (new a string count)])
       (for ([i u32 1]) (<= i n) (+= i 1)
         (when (or (== i n) (== (@ path i) #\/))
           (let ([s (url-unescape a (slice path start i) #f)])
@@ -57,12 +57,12 @@
             (set! (@ items k) s)
             (+= k 1)
             (set! start (+ i 1)))))
-      (set! (@ to) (slice items k))
+      (set! (@ to) (slice items 0 k))
       (if unclean 1 0))))
 
 ;; The path the segments name, resolved as Go's path.Clean does, keeping a final slash.
 (define (url-add-clean! [b (ptr buffer)] [segments (slice string)])
-  (let* ([n (-> segments length)] [kept (cast (ptr u32) (malloc (* 4 (+ n 1))))] [k u32 0]
+  (let* ([n (-> segments length)] [kept (new 0 u32 (+ n 1))] [k u32 0]
          [last (if (> n 0) (@ segments (- n 1)) "x")] [slash (or (== last "") (== last ".") (== last ".."))])
     (for ([i u32 0]) (< i n) (+= i 1)
       (let ([s (@ segments i)])
@@ -76,7 +76,7 @@
       (buffer-add-byte! b #\/)
       (url-add-segment! b (@ segments (@ kept j))))
     (when (and slash (> k 0)) (buffer-add-byte! b #\/))
-    (free kept)))
+    (free (-> kept items))))
 
 (define hex-digits string "0123456789ABCDEF")
 
@@ -109,17 +109,17 @@
 (define (url-form-parse [a (ptr arena)] [s string]) -> (slice url-pair)
   (let ([n (-> s length)] [count u32 1] [k u32 0] [start u32 0])
     (for ([i u32 0]) (< i n) (+= i 1) (when (== (@ s i) #\&) (+= count 1)))
-    (let ([pairs (cast (ptr url-pair) (arena-alloc a (* count (sizeof url-pair))))])
+    (let ([pairs (new a url-pair count)])
       (for ([i u32 0]) (<= i n) (+= i 1)
         (when (or (== i n) (== (@ s i) #\&))
           (when (> i start)
             (let ([part (slice s start i)] [e u32 0])
               (while (and (< e (-> part length)) (!= (@ part e) #\=)) (+= e 1))
-              (set! (-> (+ pairs k) name) (url-unescape a (slice part 0 e) #t))
-              (set! (-> (+ pairs k) value) (url-unescape a (if (< e (-> part length)) (slice part (+ e 1)) "") #t))
+              (set! (-> (@ pairs k) name) (url-unescape a (slice part 0 e) #t))
+              (set! (-> (@ pairs k) value) (url-unescape a (if (< e (-> part length)) (slice part (+ e 1)) "") #t))
               (+= k 1)))
           (set! start (+ i 1))))
-      (slice pairs k))))
+      (slice pairs 0 k))))
 
 ;; The value of the first pair with the name.
 (define (url-form-value [pairs (slice url-pair)] [name string] [to (ptr string)]) -> bool

package/std/http/websocket.sub

@@ -19,14 +19,11 @@
 ;; A message beyond this many bytes closes the connection with 1009.
 (const largest u32 16777216)
 
-(const state-open i32 0)
-(const state-closing i32 1)
-(const state-finishing i32 2)
-(const state-closed i32 3)
+(enum ws-state state-open state-closing state-finishing state-closed)
 
 (struct ws-connection [head event-head] [stream u32] [user (ptr void)] [server (ptr http-server)] [ping f64]
   [hook http-hook] [frames buffer] [message buffer] [out buffer]
-  [kind i32] [state i32] [code i32] [reading bool] [full bool] [timer u32] [timer-at f64] [heard f64] [pinged bool]
+  [kind i32] [state ws-state] [code i32] [reading bool] [full bool] [timer u32] [timer-at f64] [heard f64] [pinged bool]
   [any-origin bool]
   [on-message (fn ((ptr ws-connection) (slice u8) i32))]
   [on-closed (fn ((ptr ws-connection) i32))]

package/std/meta/derive.sub

@@ -21,7 +21,6 @@
        (while (< i (length wanted))
          (let* ([u (list-ref wanted i)] [info (type-info u)])
            (when (or (== info 0) (== (car info) 'union)) (raise-syntax-error who "expected a struct or variant type" u))
-           (unless (null? (cadddr info)) (raise-syntax-error who "expected a type without parameters" u))
            (set! out (append out (code u info))))
          (+= i 1))
        #`(begin #,@out))]
@@ -44,7 +43,6 @@
 (define (type-syntax [type datum]) -> datum
   (cond [(symbol? type) (datum->syntax #'here type 0)]
         [(identifier? type) type]
-        [(identifier? (car type)) #`(#,(car type) #,@(for/list ([u (cdr type)]) (type-syntax u)))]
         [(== (car type) 'array) #`(array #,(type-syntax (cadr type)) #,(datum->syntax #'here (caddr type) 0))]
         [(== (car type) 'other) (cadr type)]
         [else #`(#,(datum->syntax #'here (car type) 0) #,(type-syntax (cadr type)))]))

package/std/meta/method.sub

@@ -0,0 +1,41 @@
+;; Operations that pick their function by the type of their first argument, as method calls do. (method form suffix x
+;; arg ...) calls the function whose name is x's type followed by the suffix, for x a pointer to a named type. With
+;; suffix -push! and x a (ptr points), it calls points-push!. form is the operation's own form, for errors.
+;; (define-methods [operation suffix] ...) defines each operation as a macro that calls method with its suffix.
+;; method-name in std/meta/type-info gives the function's name, for macros that define the functions.
+(provide method define-methods)
+
+(begin-for-syntax
+  (require-unqualified compiler/macros)
+  (require-unqualified "type-info.sub")
+
+  (define (method-form [s datum]) -> datum
+    (syntax-match s
+      [(_ form suffix x arg ...) #`(let ([the-receiver #,x]) (method-call #,form #,suffix the-receiver #,@arg))]))
+
+  (define (method-call-form [s datum]) -> datum
+    (syntax-match s
+      [(_ form suffix x arg ...)
+       (let ([t (variable-type x)] [op (syntax-e (car (syntax->list form)))])
+         (unless (and (pair? t) (== (car t) 'ptr) (identifier? (cadr t)))
+           (raise-syntax-error op (datum->string (format "expected a pointer to a named type, not ~s" `(,(type-datum t))))
+                               form))
+         (let* ([name (method-name (cadr t) (syntax-e suffix))] [f (datum->syntax name (syntax-e name) form)])
+           (when (== (identifier-binding-kind f) '#f)
+             (raise-syntax-error op (format-message "~a has no ~a" `(,(syntax-e (cadr t)) ,(syntax-e f))) form))
+           #`(#,f #,x #,@arg)))]))
+
+  (define (operation-form [suffix datum] [s datum]) -> datum
+    (syntax-match s
+      [(_ x arg ...) #`(method #,s #,(datum->syntax s suffix s) #,x #,@arg)]
+      [_ (raise-syntax-error 0 "expected a pointer to a named type" s)]))
+
+  (define (define-methods-form [s datum]) -> datum
+    (syntax-match s
+      [(_ ((? identifier? op) (? identifier? suffix)) ...)
+       #`(begin #,@(for/list ([o op] [x suffix]) #`(define-syntax #,o operation-form '#,x)))]
+      [_ (raise-syntax-error 'define-methods "expected (define-methods [operation suffix] ...)" s)])))
+
+(define-syntax method method-form)
+(define-syntax method-call method-call-form)
+(define-syntax define-methods define-methods-form)

package/std/meta/type-info.sub

@@ -1,54 +1,44 @@
 ;; Types as data at compile time, for macros that write code from a type's fields.
 (require-unqualified compiler/macros)
 
-(provide type-info variable-type type-datum)
+(provide type-info variable-type type-datum method-name)
 
-;; (kind name items parameters), kind struct, union or variant, or 0 when t names none. A struct's or union's items are
-;; (field . type), a variant's (case (field . type) ...). A type is i8 to u64, f32, f64, bool or string, (ptr type),
-;; (slice type), (array type n), a struct's, union's or variant's identifier, (identifier type ...) for one with
-;; parameters, or (other type). For (identifier type ...), the items have those types in place of the parameters, and the
-;; parameters are ().
+;; (kind name items), kind struct, union, variant or enum, or 0 when t names none. A struct's or union's items are
+;; (field . type), a variant's (case (field . type) ...) and an enum's (case). A type is i8 to u64, f32, f64, bool or
+;; string, (ptr type), (slice type), (array type n), a struct's, union's, variant's or enum's identifier, or
+;; (other type).
 (define (type-info [t datum]) -> datum
-  (let ([instance (pair? t)])
-    (syntax-match (binding-of (if instance (car t) t))
-      [('substrate-struct name (item ...) kind (p ...))
-       (let ([k (syntax-e kind)] [env (if instance (for/list ([q p] [a (cdr t)]) (cons (syntax-e q) a)) nil)])
-         `(,k ,name ,(for/list ([i item]) (if (== k 'variant) (case-info i env) (field-info i env)))
-           ,(if instance nil p)))]
-      [('substrate-typedef u)
-       (let ([d (parsed-type (syntax->datum u))])
-         (if (or (identifier? d) (and (pair? d) (identifier? (car d)))) (type-info d) 0))]
-      [_ 0])))
+  (syntax-match (binding-of t)
+    [('substrate-struct name (item ...) kind . _)
+     (let ([k (syntax-e kind)])
+       `(,k ,name ,(for/list ([i item]) (if (!= (memq k '(variant enum)) 0) (case-info i) (field-info i)))))]
+    [('substrate-typedef u) (let ([d (parsed-type (syntax->datum u))]) (if (identifier? d) (type-info d) 0))]
+    [_ 0]))
 
 (define (binding-of [t datum]) -> datum
   (if (and (identifier? t) (== (identifier-binding-kind t) 'compile-time-value)) (syntax-local-value t) 0))
 
-(define (case-info [c datum] [env datum]) -> datum
-  (let ([l (syntax->list c)]) (cons (car l) (for/list ([f (cdr l)]) (field-info f env)))))
+(define (case-info [c datum]) -> datum
+  (let ([l (syntax->list c)]) (cons (car l) (for/list ([f (cdr l)]) (field-info f)))))
 
-(define (field-info [f datum] [env datum]) -> datum
-  (let ([l (syntax->list f)]) (cons (car l) (type-of (cadr l) env))))
+(define (field-info [f datum]) -> datum
+  (let ([l (syntax->list f)]) (cons (car l) (type-of (cadr l)))))
 
 (define scalars datum '(i8 u8 i16 u16 i32 u32 i64 u64 f32 f64 bool string))
 
-(define (type-of [t datum] [env datum]) -> datum
+(define (type-of [t datum]) -> datum
   (syntax-match t
     [(? identifier? x)
-     (cond [(!= (memq (syntax-e x) scalars) 0) (syntax-e x)]
-           [(!= (assq (syntax-e x) env) 0) (cdr (assq (syntax-e x) env))]
-           [else (syntax-match (binding-of x)
-                   [('substrate-struct _ _ _ ()) x]
-                   [('substrate-typedef u) (parsed-type (syntax->datum u))]
-                   [_ `(other ,t)])])]
-    [('ptr u) `(ptr ,(type-of u env))]
-    [('slice u) `(slice ,(type-of u env))]
-    [('array u n) `(array ,(type-of u env) ,(syntax-e n))]
+     (if (!= (memq (syntax-e x) scalars) 0)
+         (syntax-e x)
+         (syntax-match (binding-of x)
+           [('substrate-struct . _) x]
+           [('substrate-typedef u) (parsed-type (syntax->datum u))]
+           [_ `(other ,t)]))]
+    [('ptr u) `(ptr ,(type-of u))]
+    [('slice u) `(slice ,(type-of u))]
+    [('array u n) `(array ,(type-of u) ,(syntax-e n))]
     [('quote u) (parsed-type (syntax->datum u))]
-    [((? identifier? h) a ...)
-     (syntax-match (binding-of h)
-       [('substrate-struct _ _ _ (p ...))
-        (if (and (pair? p) (== (length p) (length a))) `(,h ,@(for/list ([u a]) (type-of u env))) `(other ,t))]
-       [_ `(other ,t)])]
     [_ `(other ,t)]))
 
 (define (variable-type [x datum]) -> datum
@@ -57,11 +47,14 @@
 (define (type-datum [t datum]) -> datum
   (let ([d (syntax->datum (datum->syntax #'here t 0))]) (if (and (pair? d) (== (car d) 'other)) (cadr d) d)))
 
+;; The function std/meta/method calls for type t and a suffix: points-push! for points and -push!.
+(define (method-name [t datum] [suffix datum]) -> datum
+  (datum->syntax t (string->symbol (format-message "~a~a" `(,(syntax-e t) ,suffix))) t))
+
 ;; A type as the checker holds it.
 (define (parsed-type [d datum]) -> datum
   (cond [(and (symbol? d) (!= (memq d scalars) 0)) d]
         [(and (pair? d) (!= (memq (car d) '(ptr slice)) 0)) `(,(car d) ,(parsed-type (cadr d)))]
         [(and (pair? d) (== (car d) 'array)) `(array ,(parsed-type (cadr d)) ,(caddr d))]
-        [(and (pair? d) (== (car d) 'struct) (null? (cdddr d))) (name-identifier (cadr d))]
-        [(and (pair? d) (== (car d) 'struct)) `(,(name-identifier (cadr d)) ,@(for/list ([a (cadddr d)]) (parsed-type a)))]
+        [(and (pair? d) (!= (memq (car d) '(struct enum)) 0)) (name-identifier (cadr d))]
         [else `(other ,d)]))

package/std/package/files.sub

@@ -19,17 +19,17 @@
 ;; tracked-files adds the files package-tree finds. When a git repository tracks dir's marker file, it adds only the files
 ;; git tracks. It gives #f when it cannot read git's index.
 (define (tracked-files [a (ptr arena)] [dir string] [marker string] [files (ptr buffer)] [err (ptr buffer)]) -> bool
-  (let ([all (make-buffer)] [nested (make-buffer)] [tracked (make-buffer)] [got i32 0])
+  (let ([all (make-buffer)] [nested (make-buffer)] [tracked (make-buffer)] [marked #f] [ok #f])
     (package-tree a dir (& all) (& nested))
-    (set! got (git-tracked a dir marker (& tracked) err))
+    (set! ok (git-tracked a dir marker (& tracked) (& marked) err))
     (let ([ps (cast (ptr string) (-> all bytes))] [ts (cast (ptr string) (-> tracked bytes))]
           [t (/ (-> tracked length) (sizeof string))])
-      (for ([i u32 0]) (and (>= got 0) (< i (/ (-> all length) (sizeof string)))) (+= i 1)
-        (when (or (== got 0) (listed? ts t (@ ps i))) (added! files (@ ps i)))))
+      (for ([i u32 0]) (and ok (< i (/ (-> all length) (sizeof string)))) (+= i 1)
+        (when (or (not marked) (listed? ts t (@ ps i))) (added! files (@ ps i)))))
     (buffer-free! (& all))
     (buffer-free! (& nested))
     (buffer-free! (& tracked))
-    (>= got 0)))
+    ok))
 
 (define (listed? [ts (ptr string)] [n u32] [p string]) -> bool
   (let ([lo u32 0] [hi n])
@@ -46,25 +46,24 @@
   (tree! a dir "" files nested))
 
 (define (tree! [a (ptr arena)] [dir string] [rel string] [files (ptr buffer)] [nested (ptr buffer)])
-  (let ([here (if (== (-> rel length) 0) dir (joined-path dir rel))] [names (slice string)] [why string])
-    (if (< (fs-list here (& names) (& why)) 0)
-        (free (-> why bytes))
-        (for ([i u32 0]) (< i (-> names length)) (+= i 1)
-          (let* ([n (@ names i)] [r (if (== (-> rel length) 0) (kept a n) (kept-joined a rel n))] [full (joined-path dir r)]
-                 [info fs-info])
-            (when (and (not (and (== (-> rel length) 0) (== n "build"))) (!= n ".git") (== (fs-lstat full (& info) 0) 0))
-              (cond [(== (-> info kind) fs-file) (when (!= files 0) (added! files r))]
-                    [(== (-> info kind) fs-directory)
-                     (let ([own (joined-path full "package.sub")] [m manifest] [err (make-buffer)] [p nested-package])
-                       (if (and (== (fs-stat own (& info) 0) 0) (== (-> info kind) fs-file))
-                           (begin
-                             (set! (-> p name) (if (manifest-read a own (& m) (& err)) (-> m name) (kept a n)))
-                             (set! (-> p path) r)
-                             (buffer-add! nested (slice (cast (ptr u8) (& p)) (sizeof nested-package))))
-                           (tree! a dir r files nested))
-                       (buffer-free! (& err))
-                       (free (-> own bytes)))]))
-            (free (-> full bytes)))))
+  (let ([here (if (== (-> rel length) 0) dir (joined-path dir rel))] [names (slice string)])
+    (when (fs-list here (& names) 0)
+      (for ([i u32 0]) (< i (-> names length)) (+= i 1)
+        (let* ([n (@ names i)] [r (if (== (-> rel length) 0) (kept a n) (kept-joined a rel n))] [full (joined-path dir r)]
+               [info fs-info])
+          (when (and (not (and (== (-> rel length) 0) (== n "build"))) (!= n ".git") (fs-lstat full (& info) 0))
+            (cond [(== (-> info kind) fs-file) (when (!= files 0) (added! files r))]
+                  [(== (-> info kind) fs-directory)
+                   (let ([own (joined-path full "package.sub")] [m manifest] [err (make-buffer)] [p nested-package])
+                     (if (and (fs-stat own (& info) 0) (== (-> info kind) fs-file))
+                         (begin
+                           (set! (-> p name) (if (manifest-read a own (& m) (& err)) (-> m name) (kept a n)))
+                           (set! (-> p path) r)
+                           (buffer-add! nested (slice (cast (ptr u8) (& p)) (sizeof nested-package))))
+                         (tree! a dir r files nested))
+                     (buffer-free! (& err))
+                     (free (-> own bytes)))]))
+          (free (-> full bytes)))))
     (unless (== (-> rel length) 0) (free (-> here bytes)))))
 
 (define (package-exports [a (ptr arena)] [dir string] [m (ptr manifest)] [exports (ptr buffer)] [err (ptr buffer)]) -> bool
@@ -88,7 +87,7 @@
 
 (define (file-in? [dir string] [p string]) -> bool
   (let ([full (joined-path dir p)] [info fs-info] [found #f])
-    (set! found (and (== (fs-stat full (& info) 0) 0) (== (-> info kind) fs-file)))
+    (set! found (and (fs-stat full (& info) 0) (== (-> info kind) fs-file)))
     (free (-> full bytes))
     found))
 

package/std/package/git.sub

@@ -5,30 +5,29 @@
 
 (provide git-tracked)
 
-;; git-tracked adds the paths, relative to dir, of the regular files the index lists under dir. It gives 1 when they
-;; include dir's marker file, 0 when they do not or no repository holds dir, and -1, with err set, when it cannot read
-;; the index.
-(define (git-tracked [a (ptr arena)] [dir string] [marker string] [into (ptr buffer)] [err (ptr buffer)]) -> i32
-  (let ([top string] [git string] [b (slice u8)] [why string] [prefix ""] [index string] [name (make-buffer)]
-        [got i32 0])
-    (unless (repository a dir (& top) (& git)) (return 0))
+;; git-tracked adds the paths, relative to dir, of the regular files the index lists under dir. It sets marked when they
+;; include dir's marker file.
+(define (git-tracked [a (ptr arena)] [dir string] [marker string] [into (ptr buffer)] [marked (ptr bool)]
+                     [err (ptr buffer)]) -> bool
+  (let ([top string] [git string] [b (slice u8)] [prefix ""] [index string] [name (make-buffer)] [got i32 0])
+    (set! (@ marked) #f)
+    (unless (repository a dir (& top) (& git)) (return #t))
     (unless (== dir top)
       (let ([p (joined-path (slice dir (if (== top "/") 1 (+ (-> top length) 1))) "")])
         (set! prefix (kept a p))
         (free (-> p bytes))))
     (set! index (joined-path git "index"))
-    (if (< (fs-read-file index (& b) (& why)) 0)
-        (free (-> why bytes))
-        (begin
-          (set! got (listed! a b (oid-size git) prefix marker (& name) into))
-          (free (-> b items))
-          (when (< got 0)
-            (buffer-add-string! err "cannot read the git index at ")
-            (buffer-add-string! err index)
-            (buffer-add-string! err ": sub reads index versions 2 to 4, but not a split or sparse index"))))
+    (when (fs-read-file index (& b) 0)
+      (set! got (listed! a b (oid-size git) prefix marker (& name) into))
+      (free (-> b items))
+      (when (< got 0)
+        (buffer-add-string! err "cannot read the git index at ")
+        (buffer-add-string! err index)
+        (buffer-add-string! err ": sub reads index versions 2 to 4, but not a split or sparse index")))
     (buffer-free! (& name))
     (free (-> index bytes))
-    got))
+    (set! (@ marked) (== got 1))
+    (>= got 0)))
 
 ;; repository finds the working tree holding dir, and its git directory: the .git directory, or the directory a .git file
 ;; points to.
@@ -36,7 +35,7 @@
   (let ([d dir] [info fs-info] [found i32 0])
     (while (== found 0)
       (let ([dot (joined-path d ".git")])
-        (cond [(== (fs-lstat dot (& info) 0) 0)
+        (cond [(fs-lstat dot (& info) 0)
                (set! found -1)
                (cond [(== (-> info kind) fs-directory)
                       (set! (@ git) (kept a dot))
@@ -49,10 +48,8 @@
     (== found 1)))
 
 (define (named-git! [a (ptr arena)] [d string] [dot string] [git (ptr string)]) -> bool
-  (let ([b (slice u8)] [why string] [s string] [end u32 8] [full string])
-    (when (< (fs-read-file dot (& b) (& why)) 0)
-      (free (-> why bytes))
-      (return #f))
+  (let ([b (slice u8)] [s string] [end u32 8] [full string])
+    (unless (fs-read-file dot (& b) 0) (return #f))
     (set! s (cast string b))
     (unless (starts? s "gitdir: ")
       (free (-> b items))
@@ -65,24 +62,20 @@
     #t))
 
 (define (oid-size [git string]) -> u32
-  (let ([common (common-dir git)] [config string] [b (slice u8)] [why string] [size u32 20])
+  (let ([common (common-dir git)] [config string] [b (slice u8)] [size u32 20])
     (set! config (joined-path common "config"))
-    (if (< (fs-read-file config (& b) (& why)) 0)
-        (free (-> why bytes))
-        (begin
-          (when (sha256-objects? (cast string b)) (set! size 32))
-          (free (-> b items))))
+    (when (fs-read-file config (& b) 0)
+      (when (sha256-objects? (cast string b)) (set! size 32))
+      (free (-> b items)))
     (free (-> config bytes))
     (free (-> common bytes))
     size))
 
 ;; common-dir gives the main git directory of a worktree, which holds the config.
 (define (common-dir [git string]) -> string
-  (let ([file (joined-path git "commondir")] [b (slice u8)] [why string] [s string] [end u32 0] [out string])
-    (if (< (fs-read-file file (& b) (& why)) 0)
-        (begin
-          (free (-> why bytes))
-          (set! out (string-copy git)))
+  (let ([file (joined-path git "commondir")] [b (slice u8)] [s string] [end u32 0] [out string])
+    (if (not (fs-read-file file (& b) 0))
+        (set! out (string-copy git))
         (begin
           (set! s (cast string b))
           (while (and (< end (-> s length)) (!= (@ s end) 10) (!= (@ s end) 13)) (+= end 1))

package/std/package/hash.sub

@@ -19,9 +19,9 @@
     ok))
 
 (define (hash! [a (ptr arena)] [given string] [w (ptr waiting)] [into (ptr buffer)] [err (ptr buffer)]) -> bool
-  (let ([dir string] [why string] [o w] [m manifest] [paths (make-buffer)] [lines (make-buffer)] [digest (array u8 32)]
-        [ok #t] [me (cast (ptr waiting) (arena-alloc a (sizeof waiting)))])
-    (when (< (fs-real-path given (& dir) (& why)) 0) (return (cannot! err why)))
+  (let ([dir string] [why error] [o w] [m manifest] [paths (make-buffer)] [lines (make-buffer)] [digest (array u8 32)]
+        [ok #t] [me (new a waiting)])
+    (unless (fs-real-path given (& dir) (& why)) (return (cannot! err (& why))))
     (while (and (!= o 0) (!= (-> o dir) dir)) (set! o (-> o next)))
     (when (!= o 0)
       (buffer-add-string! err "the package ")
@@ -79,9 +79,9 @@
     ok))
 
 (define (file-line! [dir string] [path string] [lines (ptr buffer)] [err (ptr buffer)]) -> bool
-  (let ([full (joined-path dir path)] [bytes (slice u8)] [why string] [digest (array u8 32)] [ok #t])
-    (if (< (fs-read-file full (& bytes) (& why)) 0)
-        (set! ok (cannot! err why))
+  (let ([full (joined-path dir path)] [bytes (slice u8)] [why error] [digest (array u8 32)] [ok #t])
+    (if (not (fs-read-file full (& bytes) (& why)))
+        (set! ok (cannot! err (& why)))
         (begin
           (sha256-of bytes (slice digest))
           (add-hex! lines (slice digest))
@@ -92,10 +92,10 @@
     (free (-> full bytes))
     ok))
 
-(define (cannot! [err (ptr buffer)] [why string]) -> bool
+(define (cannot! [err (ptr buffer)] [why (ptr error)]) -> bool
   (buffer-add-string! err "cannot read ")
-  (buffer-add-string! err why)
-  (free (-> why bytes))
+  (buffer-add-string! err (error-text why))
+  (error-free! why)
   #f)
 
 (define (add-hex! [b (ptr buffer)] [bytes (slice u8)])