substrate-lang 0.9.3 → 0.10.0

package/README.md

@@ -1,7 +1,7 @@
 # substrate-lang
 
 Substrate is a Lisp for writing WebAssembly. It has C-like semantics
-(modernized with generics, variants, bounds-checked slices), combined with
+(modernized with variants and bounds-checked slices), combined with
 Racket-style hygienic macros and module hooks for defining new languages and
 DSLs. Its compiler is small (~11k LOC, <600 KiB of Wasm), very fast,
 self-hosted, and runs in the browser.

package/build/compiler/program

@@ -1,21 +1,21 @@
-substrate.4c780d6dd6d4@0+0
-writer.806bc85aa684@0+0
-syntax.9857f6784d63@0+0
-path.dcc4712bcc7b@0+0
-fs.563034be70c3@0+0
-reader.b535e61f99f4@0+0
-roots.6d2942578055@0+0
-running.d73f7826cb74@0+0
-core.fc3dab9d1846@0+0
-ops.b361e858d8e1@0+0
-checker.592d37dcbec9@0+0
-leb128.748b1c37277a@0+0
-binary.3823f89ce414@0+0
-serialize.b2196de75bc8@0+0
-compile.86a2b03b0c9b@0+0
-sha256.5fc9d60f8bb2@0+0
-link.11b643d35670@0+0
-macros.4083601c00db@0+0
-expander.689d326e5a1b@0+0
-prune.d4a3f9834095@0+0
-main.ed62cce43000@0+0
+substrate.5ee5d0b4d3e7@0+0
+writer.00b7802cbe39@0+0
+syntax.32f3e40b61c7@0+0
+path.5a6286472cd4@0+0
+fs.01b8aab4a9a8@0+0
+reader.694b03770bf0@0+0
+roots.cefd10e93684@0+0
+running.0d25dbaec018@0+0
+core.f2defb75e00b@0+0
+ops.515b5e05f646@0+0
+checker.4dd4556dd421@0+0
+leb128.15d814b7b4f2@0+0
+binary.2d43b43d1600@0+0
+serialize.b0d82f3d63d2@0+0
+compile.5d8f6407af2a@0+0
+sha256.a6c32b04d799@0+0
+link.b826ea7c8f17@0+0
+macros.b269e0c42784@0+0
+expander.967ce443d379@0+0
+prune.406215c3e4f8@0+0
+main.4fc52f204d54@0+0

package/build/sub/program

@@ -1,48 +1,48 @@
-substrate.4c780d6dd6d4@0+0
-process.aea2c88cb7a0@0+0
-path.dcc4712bcc7b@0+0
-path.b7a8e1cf3aaa@0+0
-fs.563034be70c3@0+0
-common.91ddee6b7a67@0+0
-grants.5bf25700d47c@0+0
-writer.806bc85aa684@0+0
-syntax.9857f6784d63@0+0
-reader.b535e61f99f4@0+0
-roots.6d2942578055@0+0
-read.cd1e693f4fb4@0+0
-manifest.cf7471880377@0+0
-git.48aefa1644be@0+0
-files.30e55182c5df@0+0
-sha256.5fc9d60f8bb2@0+0
-hash.3f0d118da63f@0+0
-store.d4e845ff24ac@0+0
-map.dc516eec27ff@0+0
-env.f051f8166526@0+0
-events.f952172735e0@0+0
-build.84ac996eda63@0+0
-pack.55992e8cc09c@0+0
-site.7c6d8c7747af@0+0
-site.81548474c323@0+0
-fetch.097f1cc9502d@0+0
-stream.4c07247477f7@0+0
-worker.f1190de21b21@0+0
-deflate.fc8075e3aed1@0+0
-inflate.8899e0933792@0+0
-gzip.69588e97c35a@0+0
-tar.e482cf873cfc@0+0
-fetch.5d2f427c995e@0+0
-doc.566f9861828e@0+0
-html.c1671a102b4d@0+0
-html.20baa1dc7ca6@0+0
-text.4ab70ac35b5a@0+0
-root.9b713ec588c1@0+0
-doc.0b48bbac404b@0+0
-timer.3809bb17a7a1@0+0
-chromium.e4db7d29897c@0+0
-test.0d9c079bb309@0+0
-utf8.524c475ecd40@0+0
-json.f15a29d99d8d@0+0
-sha512.b988b9dc6114@0+0
-base64.8fba03e1be0a@0+0
-upgrade.18a5aa0dae89@0+0
-sub.b57e17b6876b@0+0
+substrate.5ee5d0b4d3e7@0+0
+process.7106571fa723@0+0
+path.5a6286472cd4@0+0
+path.6891ffea73ca@0+0
+fs.01b8aab4a9a8@0+0
+common.1edc613607a0@0+0
+grants.c54776c0d7e3@0+0
+writer.00b7802cbe39@0+0
+syntax.32f3e40b61c7@0+0
+reader.694b03770bf0@0+0
+roots.cefd10e93684@0+0
+read.0b93933d62a2@0+0
+manifest.ef317480deb0@0+0
+git.dc4c0e757ebe@0+0
+files.ad0469fdf6fa@0+0
+sha256.a6c32b04d799@0+0
+hash.660682e4f491@0+0
+store.a24d7a25daa6@0+0
+map.f455cca6a42a@0+0
+env.e5451da6e747@0+0
+events.bf5473ebf220@0+0
+build.459c5b9412bd@0+0
+pack.e02836264f6a@0+0
+site.ae3913b0b0f4@0+0
+site.1732b58ec0e8@0+0
+fetch.7790d4943758@0+0
+stream.126e3bd5d626@0+0
+worker.762a9d642af0@0+0
+deflate.23f7c4679260@0+0
+inflate.59bb61f14001@0+0
+gzip.16e372eda1cf@0+0
+tar.2a633861e654@0+0
+fetch.96b2d10f025e@0+0
+doc.ef9965d5d402@0+0
+html.e9ed37f34977@0+0
+html.a23126eb949a@0+0
+text.1bc90482bd43@0+0
+root.f10a4906f460@0+0
+doc.0775df5de6fe@0+0
+timer.f35eb62ae446@0+0
+chromium.3d5818f2707d@0+0
+test.9bd59c73f65e@0+0
+utf8.e7216bd054e1@0+0
+json.55590d2f518a@0+0
+sha512.c24a792d7891@0+0
+base64.a26bdcf60a2d@0+0
+upgrade.39ee449b00d5@0+0
+sub.2e3092140706@0+0

package/package.json

@@ -1,6 +1,6 @@
 {
   "name": "substrate-lang",
-  "version": "0.9.3",
+  "version": "0.10.0",
   "description": "A Lisp for writing WebAssembly, and the substrate command that builds, runs and tests it",
   "license": "MIT",
   "repository": {

package/std/archive/tar.sub

@@ -2,13 +2,11 @@
 ;; names. tar-next! gives each entry in turn: a file with its bytes, a directory, or another kind, with its path.
 (require-unqualified host/fs)
 
-(provide tar-reader tar-entry tar-reader-init! tar-next! tar-file tar-directory tar-other tar-unpack!)
+(provide tar-reader tar-entry tar-reader-init! tar-next! tar-kind tar-file tar-directory tar-other tar-unpack!)
 
-(const tar-file i32 1)
-(const tar-directory i32 2)
-(const tar-other i32 3)
+(enum tar-kind [tar-file 1] tar-directory tar-other)
 
-(struct tar-entry [kind i32] [path string] [bytes (slice u8)])
+(struct tar-entry [kind tar-kind] [path string] [bytes (slice u8)])
 (struct tar-reader [data (slice u8)] [at u32])
 
 (define (tar-reader-init! [r (ptr tar-reader)] [data (slice u8)])
@@ -16,15 +14,17 @@
   (set! (-> r at) 0))
 
 ;; An entry's path is in a or the data, and a file's bytes are in the data.
-(define (tar-next! [a (ptr arena)] [r (ptr tar-reader)] [e (ptr tar-entry)] [err (ptr buffer)]) -> i32
+(define (tar-next! [a (ptr arena)] [r (ptr tar-reader)] [e (ptr tar-entry)] [found (ptr bool)] [err (ptr buffer)])
+  -> bool
   (let ([long string] [sized #f] [given-size u64 0])
+    (set! (@ found) #f)
     (while #t
       (let* ([data (-> r data)] [at (-> r at)] [left (- (-> data length) at)] [h (slice u8)] [size u64 0] [type u8 0]
              [body (slice u8)] [next u64 0])
-        (when (== left 0) (return 0))
+        (when (== left 0) (return #t))
         (when (< left 512) (return (bad! err "the archive is cut short")))
         (set! h (slice data at (+ at 512)))
-        (when (zeros? h) (return 0))
+        (when (zeros? h) (return #t))
         (unless (summed? h) (return (bad! err "a header's checksum is wrong")))
         (unless (octal h 124 12 (& size)) (return (bad! err "a header's size is not a number")))
         (when sized (set! size given-size))
@@ -36,45 +36,50 @@
         (cond [(== type #\x)
                (unless (pax! a body (& long) (& sized) (& given-size)) (return (bad! err "a pax header is not key=value records")))]
               [(or (== type #\g) (== type #\K)) (begin)]
-              [(== type #\L) (set! long (copied a (until-zero body)))]
+              [(== type #\L) (set! long (cast string (copy a (until-zero body))))]
               [else
                (set! (-> e kind) (cond [(or (== type #\0) (== type 0) (== type #\7)) tar-file]
                                        [(== type #\5) tar-directory]
                                        [else tar-other]))
                (set! (-> e path) (if (> (-> long length) 0) long (header-path a h)))
                (set! (-> e bytes) (if (== (-> e kind) tar-file) body (slice body 0 0)))
-               (return 1)])))))
+               (set! (@ found) #t)
+               (return #t)])))))
 
-;; tar-unpack! gives 0, or -1 when data is not a tar archive and -2 when a file cannot be written, with err saying why.
-(define (tar-unpack! [a (ptr arena)] [data (slice u8)] [dir string] [err (ptr buffer)]) -> i32
-  (let ([r tar-reader] [e tar-entry] [got i32 1] [top ""] [one #t] [why string])
+(define (tar-unpack! [a (ptr arena)] [data (slice u8)] [dir string] [err (ptr buffer)]) -> bool
+  (let ([r tar-reader] [e tar-entry] [found #t] [top ""] [one #t] [why error] [reason (make-buffer)])
     (tar-reader-init! (& r) data)
-    (while (== got 1)
-      (set! got (tar-next! a (& r) (& e) err))
-      (when (and (== got 1) (!= (-> e kind) tar-other))
+    (while found
+      (unless (tar-next! a (& r) (& e) (& found) (& reason))
+        (buffer-add-string! err "not a tar archive: ")
+        (buffer-add! err (buffer-bytes (& reason)))
+        (buffer-free! (& reason))
+        (return #f))
+      (when (and found (!= (-> e kind) tar-other))
         (let ([p (cleaned (-> e path))])
           (when (> (-> p length) 0)
             (when (== (-> top length) 0) (set! top (first-part p)))
             (unless (or (and (== p top) (== (-> e kind) tar-directory)) (inside-top? p top)) (set! one #f))))))
-    (when (< got 0) (return -1))
+    (buffer-free! (& reason))
     (tar-reader-init! (& r) data)
-    (set! got 1)
-    (while (== got 1)
-      (set! got (tar-next! a (& r) (& e) err))
-      (when (and (== got 1) (!= (-> e kind) tar-other))
+    (set! found #t)
+    (while found
+      (tar-next! a (& r) (& e) (& found) err)
+      (when (and found (!= (-> e kind) tar-other))
         (let ([p (cleaned (-> e path))])
           (when (and one (> (-> top length) 0)) (set! p (if (== p top) "" (slice p (+ (-> top length) 1)))))
           (when (> (-> p length) 0)
             (let ([full (under a dir p)])
-              (when (or (and (== (-> e kind) tar-directory) (< (fs-make-dir full (& why)) 0))
+              (when (or (and (== (-> e kind) tar-directory) (not (fs-make-dir full (& why))))
                         (and (== (-> e kind) tar-file)
-                             (or (< (fs-make-dir (up-to-last-slash full) (& why)) 0)
-                                 (< (fs-write-file full (-> e bytes) (& why)) 0))))
+                             (not (and (fs-make-dir (up-to-last-slash full) (& why))
+                                       (fs-write-file full (-> e bytes) (& why))))))
                 (buffer-add-string! err p)
                 (buffer-add-string! err ": ")
-                (buffer-add-string! err why)
-                (return -2)))))))
-    0))
+                (buffer-add-string! err (error-text (& why)))
+                (error-free! (& why))
+                (return #f)))))))
+    #t))
 
 (define (cleaned [p string]) -> string
   (let ([s p])
@@ -91,20 +96,20 @@
   (and (> (-> p length) (-> top length)) (== (slice p 0 (-> top length)) top) (== (@ p (-> top length)) #\/)))
 
 (define (under [a (ptr arena)] [dir string] [p string]) -> string
-  (let ([out (cast (ptr u8) (arena-alloc a (+ (-> dir length) 1 (-> p length))))])
-    (memcpy out (-> dir bytes) (-> dir length))
+  (let ([out (new a u8 (+ (-> dir length) 1 (-> p length)))])
+    (memcpy (-> out items) (-> dir bytes) (-> dir length))
     (set! (@ out (-> dir length)) #\/)
-    (memcpy (+ out (-> dir length) 1) (-> p bytes) (-> p length))
-    (cast string (slice out (+ (-> dir length) 1 (-> p length))))))
+    (memcpy (+ (-> out items) (-> dir length) 1) (-> p bytes) (-> p length))
+    (cast string out)))
 
 (define (up-to-last-slash [p string]) -> string
   (let ([i (-> p length)])
     (while (and (> i 0) (!= (@ p (- i 1)) #\/)) (-= i 1))
     (if (<= i 1) "/" (slice p 0 (- i 1)))))
 
-(define (bad! [err (ptr buffer)] [why string]) -> i32
+(define (bad! [err (ptr buffer)] [why string]) -> bool
   (buffer-add-string! err why)
-  -1)
+  #f)
 
 (define (zeros? [h (slice u8)]) -> bool
   (for ([i u32 0]) (< i (-> h length)) (+= i 1) (when (!= (@ h i) 0) (return #f)))
@@ -154,7 +159,7 @@
         (while (and (< eq (- end 1)) (!= (@ body eq) #\=)) (+= eq 1))
         (when (>= eq (- end 1)) (return #f))
         (let ([key (cast string (slice body (+ i 1) eq))] [value (cast string (slice body (+ eq 1) (- end 1)))])
-          (cond [(== key "path") (set! (@ path) (copied a (cast (slice u8) value)))]
+          (cond [(== key "path") (set! (@ path) (copy a value))]
                 [(== key "size")
                  (unless (decimal value size) (return #f))
                  (set! (@ sized) #t)]))
@@ -164,19 +169,14 @@
 (define (header-path [a (ptr arena)] [h (slice u8)]) -> string
   (let ([name (until-zero (slice h 0 100))] [prefix (until-zero (slice h 345 500))])
     (if (and (== (cast string (slice h 257 263)) "ustar\x00;") (> (-> prefix length) 0))
-        (let ([out (cast (ptr u8) (arena-alloc a (+ (-> prefix length) 1 (-> name length))))])
-          (memcpy out (-> prefix items) (-> prefix length))
+        (let ([out (new a u8 (+ (-> prefix length) 1 (-> name length)))])
+          (memcpy (-> out items) (-> prefix items) (-> prefix length))
           (set! (@ out (-> prefix length)) #\/)
-          (memcpy (+ out (-> prefix length) 1) (-> name items) (-> name length))
-          (cast string (slice out (+ (-> prefix length) 1 (-> name length)))))
-        (copied a name))))
+          (memcpy (+ (-> out items) (-> prefix length) 1) (-> name items) (-> name length))
+          (cast string out))
+        (cast string (copy a name)))))
 
 (define (until-zero [s (slice u8)]) -> (slice u8)
   (let ([i u32 0])
     (while (and (< i (-> s length)) (!= (@ s i) 0)) (+= i 1))
     (slice s 0 i)))
-
-(define (copied [a (ptr arena)] [s (slice u8)]) -> string
-  (let ([out (cast (ptr u8) (arena-alloc a (-> s length)))])
-    (memcpy out (-> s items) (-> s length))
-    (cast string (slice out (-> s length)))))

package/std/browser/chromium.sub

@@ -16,7 +16,7 @@
                  [stopped (fn ((ptr chromium)))])
 
 (define (chromium-start [c (ptr chromium)] [file string] [profile string] [args (slice string)] [ms f64]
-                        [started (fn ((ptr chromium)))] [err (ptr string)]) -> bool
+                        [started (fn ((ptr chromium)))] [err (ptr error)]) -> bool
   (let ([argv (make-buffer)] [o process-options] [profile-flag (make-buffer)]
         [fixed (slice (array-of string "--headless=new" "--remote-debugging-port=0" "--no-first-run"
                                 "--no-default-browser-check" "--no-sandbox" "--mute-audio"
@@ -41,9 +41,10 @@
     (process-options-init! (& o))
     (set! (-> o stdin) process-ignore)
     (set! (-> o stdout) process-ignore)
-    (set! (-> c id) (process-spawn file (strings-in (& argv)) (& o) (cast (ptr void) (& (-> c head))) err))
-    (buffer-free! (& argv))
-    (when (== (-> c id) 0) (return #f))
+    (let ([spawned (process-spawn file (strings-in (& argv)) (& o) (cast (ptr void) (& (-> c head))) (& (-> c id))
+                                  err)])
+      (buffer-free! (& argv))
+      (unless spawned (return #f)))
     (set! (-> c running) #t)
     (stream-tag! (process-stderr (-> c id)) (cast (ptr void) (& (-> c head))))
     (stream-read! (process-stderr (-> c id)) (slice (-> c chunk)))