diff --git a/.github/workflows/rust.yml b/.github/workflows/rust.yml index 01db31b1d..61e632469 100644 --- a/.github/workflows/rust.yml +++ b/.github/workflows/rust.yml @@ -41,7 +41,7 @@ jobs: - name: install steel dylib installer env: STEEL_HOME: ${{ env.STEEL_HOME }} - run: mkdir -p $STEEL_HOME/native && cd crates/cargo-steel-lib && cargo install --path . + run: mkdir -p $STEEL_HOME/native && cd crates/cargo-steel-lib && cargo install --path . --force - name: Install cogs env: @@ -60,10 +60,10 @@ jobs: args: --all --no-default-features - name: install cargo-tarpaulin - run: cargo install cargo-tarpaulin + run: cargo install cargo-tarpaulin --force - name: run code coverage - run: cargo tarpaulin --all --no-default-features -o "lcov" --engine llvm + run: cargo tarpaulin --exclude steel-derive --all --no-default-features -o "lcov" --engine llvm - name: Coveralls GitHub Action uses: coverallsapp/github-action@v1.1.2 @@ -109,10 +109,11 @@ jobs: - name: Build run: cargo build --verbose - - name: install steel dylib installer + - name: Install steel dylib installer and package manager env: STEEL_HOME: ${{ env.STEEL_HOME }} - run: mkdir -p $STEEL_HOME/native && cd crates/cargo-steel-lib && cargo install --path . + # run: mkdir -p $STEEL_HOME/native && cd crates/cargo-steel-lib && cargo install --path . + run: cargo install --path crates/cargo-steel-lib --force && cargo install --path crates/forge --force - name: Install cogs env: diff --git a/Cargo.lock b/Cargo.lock index 456f275fc..d3d2d38db 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -1,6 +1,6 @@ # This file is automatically @generated by Cargo. # It is not intended for manual editing. -version = 3 +version = 4 [[package]] name = "abi_stable" @@ -354,7 +354,7 @@ dependencies = [ "rustc-hash", "shlex", "syn 2.0.87", - "which", + "which 4.4.2", ] [[package]] @@ -700,9 +700,9 @@ checksum = "6051f239ecec86fde3410901ab7860d458d160371533842974fc61f96d15879b" [[package]] name = "coolor" -version = "0.5.0" +version = "1.0.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "af4d7a805ca0d92f8c61a31c809d4323fdaa939b0b440e544d21db7797c5aaad" +checksum = "691defa50318376447a73ced869862baecfab35f6aabaa91a4cd726b315bfe1a" dependencies = [ "crossterm", ] @@ -899,6 +899,32 @@ dependencies = [ "itertools", ] +[[package]] +name = "crokey" +version = "1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "520e83558f4c008ac06fa6a86e5c1d4357be6f994cce7434463ebcdaadf47bb1" +dependencies = [ + "crokey-proc_macros", + "crossterm", + "once_cell", + "serde", + "strict", +] + +[[package]] +name = "crokey-proc_macros" +version = "1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "370956e708a1ce65fe4ac5bb7185791e0ece7485087f17736d54a23a0895049f" +dependencies = [ + "crossterm", + "proc-macro2", + "quote", + "strict", + "syn 1.0.109", +] + [[package]] name = "crossbeam" version = "0.8.4" @@ -957,15 +983,15 @@ checksum = "22ec99545bb0ed0ea7bb9b8e1e9122ea386ff8a48c0922e43f36d45ab09e0e80" [[package]] name = "crossterm" -version = "0.23.2" +version = "0.28.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a2102ea4f781910f8a5b98dd061f4c2023f479ce7bb1236330099ceb5a93cf17" +checksum = "829d955a0bb380ef178a640b91779e3987da38c9aea133b20614cfed8cdea9c6" dependencies = [ - "bitflags 1.3.2", + "bitflags 2.6.0", "crossterm_winapi", - "libc", - "mio 0.8.11", + "mio", "parking_lot", + "rustix", "signal-hook", "signal-hook-mio", "winapi", @@ -1267,9 +1293,9 @@ dependencies = [ [[package]] name = "fallible-iterator" -version = "0.2.0" +version = "0.3.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4443176a9f2c162692bd3d352d745ef9413eec5782a80d8fd6f8a1ac692a07f7" +checksum = "2acce4a10f12dc2fb14a218589d4f1f62ef011b2d0cc4b3cb1bba8e94da14649" [[package]] name = "fallible-streaming-iterator" @@ -1319,6 +1345,13 @@ version = "1.0.7" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "3f9eec918d3f24069decb9af1554cad7c880e2da24a9afd88aca000531ab82c1" +[[package]] +name = "forge" +version = "0.6.0" +dependencies = [ + "steel-core", +] + [[package]] name = "form_urlencoded" version = "1.2.1" @@ -1505,6 +1538,21 @@ version = "0.29.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "40ecd4077b5ae9fd2e9e169b102c6c330d0605168eb0e8bf79952b256dbefffd" +[[package]] +name = "git2" +version = "0.19.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b903b73e45dc0c6c596f2d37eccece7c1c8bb6e4407b001096387c63d0d93724" +dependencies = [ + "bitflags 2.6.0", + "libc", + "libgit2-sys", + "log", + "openssl-probe", + "openssl-sys", + "url", +] + [[package]] name = "glob" version = "0.3.1" @@ -1540,9 +1588,9 @@ dependencies = [ [[package]] name = "hashlink" -version = "0.8.4" +version = "0.9.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e8094feaf31ff591f651a2664fb9cfd92bba7a60ce3197265e9482ebe753c8f7" +checksum = "6ba4ff7128dee98c7dc9794b6a411377e1404dba1c97deb8d1a55297bd25d8af" dependencies = [ "hashbrown 0.14.5", ] @@ -1838,6 +1886,29 @@ dependencies = [ "serde", ] +[[package]] +name = "lazy-regex" +version = "3.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f82f270298cdeeffe3ce09272627714a227bce8b499afa71fc47efb84dc582b7" +dependencies = [ + "lazy-regex-proc_macros", + "once_cell", + "regex", +] + +[[package]] +name = "lazy-regex-proc_macros" +version = "3.4.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4ba01db5ef81e17eb10a5e0f2109d1b3a3e29bac3070fdbd7d156bf7dbd206a1" +dependencies = [ + "proc-macro2", + "quote", + "regex", + "syn 2.0.87", +] + [[package]] name = "lazy_static" version = "1.5.0" @@ -1856,6 +1927,20 @@ version = "0.2.156" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "a5f43f184355eefb8d17fc948dbecf6c13be3c141f20d834ae842193a448c72a" +[[package]] +name = "libgit2-sys" +version = "0.17.0+1.8.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "10472326a8a6477c3c20a64547b0059e4b0d086869eee31e6d7da728a8eb7224" +dependencies = [ + "cc", + "libc", + "libssh2-sys", + "libz-sys", + "openssl-sys", + "pkg-config", +] + [[package]] name = "libloading" version = "0.7.4" @@ -1882,6 +1967,16 @@ version = "0.2.8" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "4ec2a862134d2a7d32d7983ddcdd1c4923530833c9f2ea1a44fc5fa473989058" +[[package]] +name = "libmimalloc-sys" +version = "0.1.39" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "23aa6811d3bd4deb8a84dde645f943476d13b248d818edcf8ce0b2f37f036b44" +dependencies = [ + "cc", + "libc", +] + [[package]] name = "libnghttp2-sys" version = "0.1.10+1.61.0" @@ -1904,11 +1999,25 @@ dependencies = [ [[package]] name = "libsqlite3-sys" -version = "0.25.2" +version = "0.30.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2e99fb7a497b1e3339bc746195567ed8d3e24945ecd636e3619d20b9de9e9149" +dependencies = [ + "cc", + "pkg-config", + "vcpkg", +] + +[[package]] +name = "libssh2-sys" +version = "0.3.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "29f835d03d717946d28b1d1ed632eb6f0e24a299388ee623d0c23118d3e8a7fa" +checksum = "2dc8a030b787e2119a731f1951d6a773e2280c660f8ec4b0f5e1505a386e71ee" dependencies = [ "cc", + "libc", + "libz-sys", + "openssl-sys", "pkg-config", "vcpkg", ] @@ -1987,6 +2096,15 @@ version = "2.7.4" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "78ca9ab1a0babb1e7d5695e3530886289c18cf2f87ec19a575a0abdce112e3a3" +[[package]] +name = "mimalloc" +version = "0.1.43" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "68914350ae34959d83f732418d51e2427a794055d0b9529f48259ac07af65633" +dependencies = [ + "libmimalloc-sys", +] + [[package]] name = "mime" version = "0.3.17" @@ -1995,9 +2113,9 @@ checksum = "6877bb514081ee2a7ff5ef9de3281f14a4dd4bceac4c09388074a6b5df8a139a" [[package]] name = "minimad" -version = "0.10.0" +version = "0.13.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fed1b13e2000bd8e238d97a97de6fc30224f89a08b0aa5aaa09ed1bd68ba2fa1" +checksum = "a9c5d708226d186590a7b6d4a9780e2bdda5f689e0d58cd17012a298efd745d2" dependencies = [ "once_cell", ] @@ -2026,18 +2144,6 @@ dependencies = [ "adler2", ] -[[package]] -name = "mio" -version = "0.8.11" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a4a650543ca06a924e8b371db273b2756685faae30f8487da1b56505a8f78b0c" -dependencies = [ - "libc", - "log", - "wasi", - "windows-sys 0.48.0", -] - [[package]] name = "mio" version = "1.0.2" @@ -2046,6 +2152,7 @@ checksum = "80e04d1dcff3aae0704555fe5fee3bcfaf3d1fdf8a7e521d5b9d2b42acb52cec" dependencies = [ "hermit-abi 0.3.9", "libc", + "log", "wasi", "windows-sys 0.52.0", ] @@ -2240,6 +2347,15 @@ version = "0.1.5" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "ff011a302c396a5197692431fc1948019154afc178baf7d8e37367442a4601cf" +[[package]] +name = "openssl-src" +version = "300.4.1+3.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "faa4eac4138c62414b5622d1b31c5c304f34b406b013c079c2bbc652fdd6678c" +dependencies = [ + "cc", +] + [[package]] name = "openssl-sys" version = "0.9.104" @@ -2248,6 +2364,7 @@ checksum = "45abf306cbf99debc8195b66b7346498d7b10c210de50418b5ccd7ceba08c741" dependencies = [ "cc", "libc", + "openssl-src", "pkg-config", "vcpkg", ] @@ -2694,9 +2811,9 @@ dependencies = [ [[package]] name = "regex" -version = "1.10.6" +version = "1.11.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4219d74c6b67a3654a9fbebc4b419e22126d13d2f3c4a07ee0cb61ff79a79619" +checksum = "b544ef1b4eac5dc2db33ea63606ae9ffcfac26c1416a2806ae0bf5f56b201191" dependencies = [ "aho-corasick", "memchr", @@ -2706,9 +2823,9 @@ dependencies = [ [[package]] name = "regex-automata" -version = "0.4.7" +version = "0.4.9" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "38caf58cc5ef2fed281f89292ef23f6365465ed9a41b7a7754eb4e26496c92df" +checksum = "809e8dc61f6de73b46c85f4c96486310fe304c434cfa43669d7b40f711150908" dependencies = [ "aho-corasick", "memchr", @@ -2717,9 +2834,9 @@ dependencies = [ [[package]] name = "regex-syntax" -version = "0.8.4" +version = "0.8.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7a66a03ae7c801facd77a29370b4faec201768915ac14a721ba36f20bc9c209b" +checksum = "2b15c43186be67a4fd63bee50d0303afffcef381492ebe2c5d87f324e1b8815c" [[package]] name = "region" @@ -2784,11 +2901,11 @@ dependencies = [ [[package]] name = "rusqlite" -version = "0.28.0" +version = "0.32.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "01e213bc3ecb39ac32e81e51ebe31fd888a940515173e3a18a35f8c6e896422a" +checksum = "7753b721174eb8ff87a9a0e799e2d7bc3749323e773db92e0984debb00019d6e" dependencies = [ - "bitflags 1.3.2", + "bitflags 2.6.0", "fallible-iterator", "fallible-streaming-iterator", "hashlink", @@ -3128,7 +3245,7 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "34db1a06d485c9142248b7a054f034b349b212551f3dfd19c94d45a754a217cd" dependencies = [ "libc", - "mio 0.8.11", + "mio", "signal-hook", ] @@ -3261,6 +3378,7 @@ dependencies = [ "futures-util", "fxhash", "getrandom", + "git2", "home", "http 1.1.0", "httparse", @@ -3289,7 +3407,7 @@ dependencies = [ "strsim 0.11.1", "termimad", "weak-table", - "which", + "which 7.0.0", ] [[package]] @@ -3325,6 +3443,7 @@ dependencies = [ "clap", "env_logger", "log", + "mimalloc", "once_cell", "serde", "steel-core", @@ -3477,6 +3596,12 @@ version = "0.4.3" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "e9557cb6521e8d009c51a8666f09356f4b817ba9ba0981a305bd86aee47bd35c" +[[package]] +name = "strict" +version = "0.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f42444fea5b87a39db4218d9422087e66a85d0e7a0963a439b07bcdf91804006" + [[package]] name = "strsim" version = "0.10.0" @@ -3585,14 +3710,16 @@ dependencies = [ [[package]] name = "termimad" -version = "0.21.1" +version = "0.31.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8743d628f9b0eb33087c1e1c4915d91efca23ae69f7c81981489128a0e17d300" +checksum = "ea6a5d4cf55d9f1cb04fcda48f725772d0733ae34e030dfc4dd36e738a5965f4" dependencies = [ "coolor", + "crokey", "crossbeam", - "crossterm", + "lazy-regex", "minimad", + "serde", "thiserror", "unicode-width", ] @@ -3684,7 +3811,7 @@ dependencies = [ "backtrace", "bytes", "libc", - "mio 1.0.2", + "mio", "parking_lot", "pin-project-lite", "signal-hook-registry", @@ -4201,6 +4328,18 @@ dependencies = [ "rustix", ] +[[package]] +name = "which" +version = "7.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c9cad3279ade7346b96e38731a641d7343dd6a53d55083dd54eadfa5a1b38c6b" +dependencies = [ + "either", + "home", + "rustix", + "winsafe", +] + [[package]] name = "winapi" version = "0.3.9" @@ -4398,9 +4537,18 @@ dependencies = [ "memchr", ] +[[package]] +name = "winsafe" +version = "0.0.19" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d135d17ab770252ad95e9a872d365cf3090e3be864a34ab46f48555993efc904" + [[package]] name = "xtask" version = "0.6.0" +dependencies = [ + "which 7.0.0", +] [[package]] name = "yaml-rust" diff --git a/Cargo.toml b/Cargo.toml index 0ffabcd2e..9afeb319d 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -6,13 +6,13 @@ edition = "2021" license = "MIT OR Apache-2.0" repository = "https://github.com/mattwparas/steel" description = "Steel repl and command line interface" +default-run = "steel" include = ["/src/**/*", "/Cargo.toml", "/README.md", "LICENSE*"] [workspace.package] version = "0.6.0" -# See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [[bin]] name = "steel" path = "src/main.rs" @@ -22,7 +22,9 @@ path = "src/main.rs" steel-core = { path = "./crates/steel-core", version = "0.6.0", features = ["dylibs", "markdown", "stacker", "sync"] } [features] +default = ["mimalloc"] build-info = ["vergen"] +mimalloc = ["dep:mimalloc"] # Note: It does not appear that this will get propagated to any crate that depends on # the workspace feature. This is unfortunate, since we'd like everything to actually # use the workspace dependency. For now, if you want to test with sync, you should @@ -39,6 +41,7 @@ env_logger = "0.10.0" log = "0.4.17" clap = { version = "=4.1.4", features = ["derive"] } steel-doc = { path = "./crates/steel-doc", version = "0.6.0" } +mimalloc = { version = "0.1.43", optional = true } [target.'cfg(not(target_os = "redox"))'.dependencies] cargo-steel-lib = { path = "./crates/cargo-steel-lib", version = "0.1.0" } @@ -55,7 +58,7 @@ members = [ ] [profile.release] -debug = false +debug = true lto = true [profile.test] diff --git a/benchmarks/bench.scm b/benchmarks/bench.scm index e11824416..0d45fa8e4 100644 --- a/benchmarks/bench.scm +++ b/benchmarks/bench.scm @@ -6,7 +6,14 @@ (define (run-bench args) (~> (command "hyperfine" args) (spawn-process) (Ok->value) (wait))) -(define *interpreter-map* (hash "py" "python3.10" "scm" "../target/release/steel" "lua" "lua")) +(define *interpreter-map* + (hash "py" + "python3.13" + ;; "scm" "../target/release/steel" + "scm" + "../target/aarch64-apple-darwin/release/steel" + "lua" + "lua")) (define (extension->interpreter ext) (hash-get *interpreter-map* ext)) diff --git a/benchmarks/bin-trees/bin-trees.scm b/benchmarks/bin-trees/bin-trees.scm index ede6271ab..f479204b5 100644 --- a/benchmarks/bin-trees/bin-trees.scm +++ b/benchmarks/bin-trees/bin-trees.scm @@ -16,13 +16,13 @@ (node #f val #f)) (define (leaf? l) (not (node-left l))) -(define (leaf-val l) - node-val) (define (make item d) (if (= d 0) (leaf item) - (let ([item2 (* item 2)] [d2 (- d 1)]) (node (make (- item2 1) d2) item (make item2 d2))))) + (let ([item2 (* item 2)] + [d2 (- d 1)]) + (node (make (- item2 1) d2) item (make item2 d2))))) (define (check t) (if (leaf? t) 1 (+ 1 (+ (check (node-left t)) (check (node-right t)))))) @@ -42,7 +42,8 @@ (loop (+ 2 d) end max-depth min-depth)))) (define (main n) - (let* ([min-depth 4] [max-depth (max (+ min-depth 2) n)]) + (let* ([min-depth 4] + [max-depth (max (+ min-depth 2) n)]) (let ([stretch-depth (+ max-depth 1)]) (displayln "stretch tree of depth " stretch-depth " check: " (check (make 0 stretch-depth)))) (let ([long-lived-tree (make 0 max-depth)]) diff --git a/benchmarks/fib/fib.scm b/benchmarks/fib/fib.scm index f37e30a16..df5399d3e 100644 --- a/benchmarks/fib/fib.scm +++ b/benchmarks/fib/fib.scm @@ -1,4 +1,4 @@ (define (fib n) (if (<= n 2) 1 (+ (fib (- n 1)) (fib (- n 2))))) -(fib 40) +(fib 28) diff --git a/build.rs b/build.rs new file mode 100644 index 000000000..de46a5ef7 --- /dev/null +++ b/build.rs @@ -0,0 +1,16 @@ +fn main() -> Result<(), Box> { + #[cfg(feature = "build-info")] + { + use vergen::{BuildBuilder, CargoBuilder, Emitter, RustcBuilder}; + let build = BuildBuilder::all_build()?; + let cargo = CargoBuilder::all_cargo()?; + let rustc = RustcBuilder::all_rustc()?; + + Emitter::default() + .add_instructions(&build)? + .add_instructions(&cargo)? + .add_instructions(&rustc)? + .emit()?; + } + Ok(()) +} diff --git a/cogs/command-line/args.scm b/cogs/command-line/args.scm index a2f691434..16c177606 100644 --- a/cogs/command-line/args.scm +++ b/cogs/command-line/args.scm @@ -16,7 +16,7 @@ [(empty? arg-list) ;; Check that the positionl args have been fulfilled (when (not (= (length (ArgumentParserSpec-positional-args spec)) (length positional-args))) - (displayln "getting here") + ; (displayln "getting here") (error "Missing positional arguments: " (drop (ArgumentParserSpec-positional-args spec) (length positional-args)))) diff --git a/cogs/fs/cog.scm b/cogs/fs/cog.scm index 6f27f2b14..8b616279f 100644 --- a/cogs/fs/cog.scm +++ b/cogs/fs/cog.scm @@ -2,4 +2,4 @@ (define version "0.1.0") ;; Core library, requires no dependencies -(define dependencies '()) \ No newline at end of file +(define dependencies '()) diff --git a/cogs/installer/cog.scm b/cogs/installer/cog.scm index 2992b06a2..373fa3b5c 100644 --- a/cogs/installer/cog.scm +++ b/cogs/installer/cog.scm @@ -1,4 +1,11 @@ (define package-name 'installer) (define version "0.1.0") -(define dependencies '()) +(define dependencies '((#:name steel/command-line #:path "../command-line"))) + +;; Create bin directory for entrypoints, and then +;; copy this file to that location, installing a +;; shebang on it? +;; +;; That would then work +(define entrypoint '(#:name "spm" #:path "spm.scm")) diff --git a/cogs/installer/download.scm b/cogs/installer/download.scm index 3185dca06..a09e31adf 100644 --- a/cogs/installer/download.scm +++ b/cogs/installer/download.scm @@ -2,18 +2,24 @@ ;; $STEEL_HOME directory. (require-builtin steel/process) +(require-builtin steel/git) (require "steel/result") (require "parser.scm") -(provide git-clone +(provide maybe-git-clone in-directory run-dylib-installation download-and-install-library - download-cog-to-sources-and-parse-module) + download-cog-to-sources-and-parse-module + wait-for-jobs + find-dylib-name) -;; Sources! -(define (append-with-separator path dir-name) - (if (ends-with? path "/") (string-append path dir-name) (string-append path "/" dir-name))) +(define SEP (if (equal? (current-os!) "windows") "\\" "/")) + +(define (append-with-separator path dir) + (if (ends-with? path SEP) + (string-append path dir) + (string-append path SEP dir))) (define (path-from-steel-home dir) (~> (steel-home-location) (append-with-separator dir))) @@ -22,36 +28,53 @@ (define *COG-SOURCES* (path-from-steel-home "cog-sources")) (define *NATIVE_SOURCES_DIR* (path-from-steel-home "sources")) (define *DYLIB-DIR* (path-from-steel-home "native")) +(define *CARGO_TARGET_DIR* (path-from-steel-home "target")) ;;@doc ;; Most likely should use gix here instead of shelling out to git? ;; Use the sha to pin to a specific commit, if interested -(define (git-clone package-name https-address installation-dir #:sha (*sha* void)) +(define (maybe-git-clone package-name https-address installation-dir #:sha (*sha* void)) - (define resulting-path (string-append installation-dir "/" package-name)) + (define resulting-path + (string-append installation-dir + "/" + (if (symbol? package-name) + (symbol->string package-name) + package-name))) (displayln "Fetching package from git: " package-name) ;; Delete the target directory if it already exists (when (path-exists? resulting-path) - (display "Clearing the target directory since it already exists: ") - (displayln resulting-path) - (delete-directory! resulting-path)) + ; (display "Clearing the target directory since it already exists: ") + ; (displayln resulting-path) + ; (delete-directory! resulting-path) + + (displayln "Updating git repo from remote...") + + ; (~> (command "git" (list "pull")) (in-directory resulting-path) spawn-process Ok->value wait) + + (git-pull resulting-path #f #f) + + (return! resulting-path)) ;; Git clone command, run against specific directory. For now we're going to ;; naively install them all into the same spot. - (~> (command "git" (list "clone" https-address resulting-path)) (spawn-process) (Ok->value) (wait)) + ; (~> (command "git" (list "clone" https-address resulting-path)) (spawn-process) (Ok->value) (wait)) + + (git-clone https-address resulting-path (if (not (void? *sha*)) *sha* #f)) + ;; If we have a SHA, check out that commit - (when (not (void? *sha*)) + ; (when (not (void? *sha*)) - (display "...Checking out sha: ") - (displayln *sha*) + ; (display "...Checking out sha: ") + ; (displayln *sha*) - (~> (command "git" (list "checkout" *sha*)) - (in-directory resulting-path) - (spawn-process) - (Ok->value) - (wait))) + ; (~> (command "git" (list "checkout" *sha*)) + ; (in-directory resulting-path) + ; (spawn-process) + ; (Ok->value) + ; (wait))) resulting-path) @@ -60,14 +83,48 @@ (set-current-dir! command directory) command) +(define (with-env-var command key value) + (set-env-var! command key value) + command) + +;; Jobs that need to run. +(define *jobs* '()) + +(define (wait-for-jobs) + (unless (empty? *jobs*) + (displayln "Waiting for dylib builds to finish") + (if (feature-dylib-build?) + (for-each thread-join! *jobs*) + (for-each wait *jobs*)))) + ;; Run the cargo-steel-lib installer in the target directory +; (define (run-dylib-installation target-directory #:subdir [subdir ""]) +; (wait (run-dylib-installation-in-background target-directory #:subdir subdir))) + +;; At the end, we're gonna await the jobs to finish compilation (define (run-dylib-installation target-directory #:subdir [subdir ""]) - (wait (run-dylib-installation-in-background target-directory #:subdir subdir))) + (define process (run-dylib-installation-in-background target-directory #:subdir subdir)) + (set! *jobs* (cons process *jobs*))) (define (run-dylib-installation-in-background target-directory #:subdir [subdir ""]) (define target (append-with-separator target-directory subdir)) (displayln "Running dylib build in: " target) - (~> (command "cargo-steel-lib" '()) (in-directory target) spawn-process Ok->value)) + (if (feature-dylib-build?) + ;; Kick off on a new thread + (spawn-native-thread + (lambda () + (#%build-dylib (list "--manifest-path" (append-with-separator target "Cargo.toml")) + (list (list "CARGO_TARGET_DIR" + (append-with-separator *CARGO_TARGET_DIR* + (file-name target-directory))))))) + + ;; This... should be run in the background? + (~> (command "cargo-steel-lib" '()) + (in-directory target) + (with-env-var "CARGO_TARGET_DIR" + (append-with-separator *CARGO_TARGET_DIR* (file-name target-directory))) + spawn-process + Ok->value))) ;;@doc ;; Download cog source to sources directory, and then install from there. @@ -78,29 +135,42 @@ #:subdir [subdir ""] #:sha [*sha* void]) - (~> (git-clone library-name git-url *COG-SOURCES* #:sha *sha*) + (~> (maybe-git-clone library-name git-url *COG-SOURCES* #:sha *sha*) ;; If we're attempting to install the package from a subdirectory of ;; git urls, we should do that accordingly here. (append-with-separator subdir) parse-cog car)) -;; TODO: steps -;; - git clone to temporary directory (or site-packages style thing, something) -;; Probably install native dylibs to their own native section -;; Then, run the installation script. - -;; Install to the im-lists directory. What we probably have to do is install it to some -;; temporary location, parse the module name, and move it back out. Unless - we do something -;; like the org name, but I don't love that. -; (git-clone "im-lists" "https://github.com/mattwparas/im-lists.git" *NATIVE_SOURCES_DIR*) - ;;@doc ;; Download and install the dylib library! (define (download-and-install-library library-name git-url #:subdir [subdir ""] #:sha [*sha* void]) - (~> (git-clone library-name git-url *NATIVE_SOURCES_DIR*) (run-dylib-installation #:subdir subdir))) - -;; Grabs the latest from the git url, stores in sources, and runs the installation in the target directory -; (download-and-install-library "steel-sys-info" -; "https://github.com/mattwparas/steel.git" -; #:subdir "crates/steel-sys-info") + (~> (maybe-git-clone library-name git-url *NATIVE_SOURCES_DIR*) + (run-dylib-installation #:subdir subdir))) + +;; Attempt to get the toml - This should actually just expand to the function to parse it, +;; otherwise return a function that can't do anything with it if the toml library +;; isn't present. +(define (try-parse-toml str) + ;; Include the dylib if relevant + (eval '(#%require-dylib "libsteel_toml" (only-in toml->value string->toml))) + (eval `(toml->value (string->toml ,str)))) + +;; TODO: Implement some proper error handling, assuming we can't discover +;; the reason for not finding the lib name +(define (find-dylib-name path) + (define contents (read-port-to-string (open-input-file path))) + (define toml-contents (try-parse-toml contents)) + + (define current-os (current-os!)) + + ;; TODO: Replace with the constants where `current-os!` is defined + ;; they have the shared prefix and shared suffix information + (define *file-extension* + (cond + [(equal? current-os "macos") ".dylib"] + [(equal? current-os "linux") ".so"] + [(equal? current-os "windows") ".dll"] + [else ".so"])) + + (string-append "lib" (~> toml-contents (hash-ref "lib") (hash-ref "name")) *file-extension*)) diff --git a/cogs/installer/forge.scm b/cogs/installer/forge.scm new file mode 100644 index 000000000..9bfc1990f --- /dev/null +++ b/cogs/installer/forge.scm @@ -0,0 +1,3 @@ +(require "main.scm") + +(main) diff --git a/cogs/installer/main.scm b/cogs/installer/main.scm new file mode 100644 index 000000000..f3c91b4a6 --- /dev/null +++ b/cogs/installer/main.scm @@ -0,0 +1,240 @@ +; (require "steel/command-line/args.scm") +(require "package.scm") +(require "parser.scm") +(require "download.scm") + +; (define my-options +; (make-command-line-arg-parser #:positional (list '("command" "The subcommand to run")) +; ; #:required '((("list" #f) "Setting up the values"))) +; )) + +; (define list-parser +; (make-command-line-arg-parser #:required '((("path" #f) "Path to discover packages")))) + +(define (list-packages index) + (define package-name-width + (apply max + (map (lambda (package) (string-length (symbol->string (hash-ref package 'package-name)))) + (hash-values->list index)))) + + (define version-width (string-length "Version")) + + (displayln "Listing packages from: " *STEEL_HOME*) + (displayln) + + (display "Package") + (display (make-string (- package-name-width (string-length "Package")) #\SPACE)) + (display " ") + (displayln "Version") + + (display (make-string package-name-width #\-)) + (display " ") + (displayln (make-string version-width #\-)) + + ;; Installed packages + (for-each (lambda (package) + (define package-name (hash-ref package 'package-name)) + (display package-name) + (display (make-string (- package-name-width + (string-length (symbol->string package-name))) + #\SPACE)) + (display " ") + (displayln (hash-ref package 'version))) + (hash-values->list index))) + +;; TODO: Move this to `installer/package.scm` +(define (refresh-package-index index) + (define package-spec + (download-cog-to-sources-and-parse-module "steel/packages" + "https://github.com/mattwparas/steel-packages.git")) + (check-install-package index package-spec)) + +;; TODO: Move this to `installer/package.scm` +(define (list-package-index) + ;; What is going on here? + (eval '(require "steel/packages/packages.scm")) + (eval 'package-index)) + +(define (print-package-index) + (define package-index (list-package-index)) + + ;; TODO: + ;; Do a better job of formatting this. Also, set up versioning a little bit better? + (transduce package-index + (into-for-each (lambda (p) + (displayln (symbol->string (car p))) + ;; Display the keys, each on a new line, indented. + (transduce (cadr p) + (into-for-each (lambda (kvp) + (display " - ") + (display (symbol->string (car kvp))) + (display ": ") + (displayln (cadr kvp))))))))) + +(define (install-package-temp index args) + (define cogs-to-install + (if (empty? args) + (list (current-directory)) + args)) + (transduce cogs-to-install + (flat-mapping parse-cog) + (into-for-each (lambda (x) (check-install-package index x))))) + +(define (install-package-if-not-installed installed-cogs cog-to-install) + (define package-name (hash-get cog-to-install 'package-name)) + (if (hash-contains? installed-cogs package-name) + (displayln "Package already installed. Skipping installation.") + (begin + (displayln "Package is not currently installed.") + (install-package-and-log cog-to-install)))) + +;; TODO: Move this to `installer/package.scm` +(define (install-package-from-pkg-index index package args) + (define pkg-index (list-package-index)) + (define remote-pkg-spec (hash-ref pkg-index (string->symbol package))) + (define git-url (hash-ref remote-pkg-spec '#:url)) + (define subdir (or (hash-try-get remote-pkg-spec '#:path) "")) + ;; Pass the path down as well - so that we can install things that way + (define package-spec (download-cog-to-sources-and-parse-module package git-url #:subdir subdir)) + + (define force (member "--force" args)) + + (if force + (install-package-and-log package-spec) + (install-package-if-not-installed index package-spec))) + +(define (uninstall-package-from-index index package) + (define pkg + (if (symbol? package) + package + (string->symbol package))) + (unless (hash-contains? index pkg) + (displayln "Package not found:" package) + (return! void)) + + (define package (hash-ref index pkg)) + ;; TODO: Contracts called in tail position get the call site location + ;; wrong, since that is removed from the stack. + (uninstall-package package)) + +;; Automatically re-installing isn't good. We'll fix that. +(define (install-dependencies index args) + ;; Find all the dependencies, install those + (match args + [(list) + ;; Only discover top level projects here + (define top-level-files (read-dir (current-directory))) + ;; Are there any cog files here? + (define cog-files (filter (lambda (x) (equal? (file-name x) "cog.scm")) top-level-files)) + (define spec (hash-insert (parse-cog-file (car cog-files)) 'path (current-directory))) + (walk-and-install spec) + (displayln "Package built!")] + + [(list package) + ;; Get the passed in argument + (define path-to-package (car args)) + (define spec (car (parse-cog path-to-package))) + (walk-and-install spec) + (displayln "Package built!")])) + +;; Generate a directory with a cog.scm, a hello world, etc +(define (generate-new-project args) + (error "Implement generate new project")) + +(define (install-dependencies-and-run-entrypoint index args) + (define top-level-files (read-dir (current-directory))) + (define cog-files (filter (lambda (x) (equal? (file-name x) "cog.scm")) top-level-files)) + (define spec (hash-insert (parse-cog-file (car cog-files)) 'path (current-directory))) + (define entrypoint (~> (apply hash (hash-ref spec 'entrypoint)) (hash-ref '#:path))) + ;; Run the entrypoint specified + (~> (command "steel" (list entrypoint)) spawn-process Ok->value wait)) + +(define (render-help) + (displayln + "Forge - the Steel Packager Manager + +Usage: + forge [options] + +Commands: + new Scaffold a new package + list List the installed packages + install Install a local package + build Install the dependencies for the package + run Run the entrypoint as specified in the package + + pkg Subcommand for the package repository + pkg refresh Update the package repository from the remote + pkg list List the packages in the remote index + pkg install Install a package from the remote index + + pkg install --force Force an install of a package from the remote index")) + +(define (get-command-line-args) + (define args (command-line)) + ;; Running as a program, vs embedded elsewhere? + (if (ends-with? (car args) "steel") + (drop args 2) + (drop args 1))) + +(provide main) +(define (main) + (define package-index (discover-cogs *STEEL_HOME*)) + (define command-line-args (get-command-line-args)) + + (when (empty? command-line-args) + (render-help) + (return! void)) + + (when (not (path-exists? *DYLIB-DIR*)) + (displayln "dylib directory does not exist, creating now...") + (create-directory! *DYLIB-DIR*)) + + (when (not (path-exists? *BIN*)) + (displayln "bin directory does not exist, creating now...") + (create-directory! *BIN*)) + + (let ([command (car command-line-args)]) + ;; Dispatch on the command + (cond + ;; Generate a new project + [(equal? "new" command) (generate-new-project (cdr command-line-args))] + [(equal? "help" command) (render-help)] + [(equal? "--help" command) (render-help)] + ;; list the packages + [(equal? "list" command) (list-packages package-index)] + + ;; Build the dependencies + [(equal? "build" command) (install-dependencies package-index (cdr command-line-args))] + + ;; Run the entrypoint as specified in the cog.scm, if present. + ;; Only install dependencies if they haven't been installed before. + ;; For packages that already exist, we should take what is there. + ;; + ;; Versioning is hard. This will have to come up with some versioning scheme + ;; that makes sense. + [(equal? "run" command) + (install-dependencies-and-run-entrypoint package-index (cdr command-line-args))] + + ;; install the given package + [(equal? "install" command) (install-package-temp package-index (cdr command-line-args))] + ;; Try to install the package index from the remote + [(equal? '("pkg" "refresh") command-line-args) (refresh-package-index package-index)] + ;; List the remote package index + [(equal? '("pkg" "list") command-line-args) (print-package-index)] + + ;; Install package from remote + [(equal? '("pkg" "install") (take command-line-args 2)) + ;; Force a re-install + (install-package-from-pkg-index package-index + (list-ref command-line-args 2) + (drop command-line-args 3))] + + [(equal? '("pkg" "uninstall") (take command-line-args 2)) + (uninstall-package-from-index package-index (list-ref command-line-args 2))] + + ;; No matching command + [else (displayln "No matching command: " command)])) + + ;; Wait for the jobs to finish + (wait-for-jobs)) diff --git a/cogs/installer/package.scm b/cogs/installer/package.scm index 0d2cbdc8a..83c27694b 100644 --- a/cogs/installer/package.scm +++ b/cogs/installer/package.scm @@ -12,7 +12,8 @@ (require (only-in "download.scm" download-and-install-library download-cog-to-sources-and-parse-module - run-dylib-installation)) + run-dylib-installation + find-dylib-name)) (provide package-installer-main parse-cog @@ -20,16 +21,32 @@ create-dylib-index parse-cog-file install-package - install-package-and-log) + install-package-and-log + *STEEL_HOME* + check-install-package + walk-and-install + uninstall-package + *DYLIB-DIR* + *BIN*) + +(define SEP (if (equal? (current-os!) "windows") "\\" "/")) (define (append-with-separator path dir) - (if (ends-with? path "/") (string-append path dir) (string-append path "/" dir))) + (if (ends-with? path SEP) + (string-append path dir) + (string-append path SEP dir))) + +(define (convert-path path) + (if (equal? (current-os!) "windows") + (string-replace path "/" "\\") + path)) ;; Should make this lazy? (define *STEEL_HOME* (~> (steel-home-location) (append-with-separator "cogs"))) (define *NATIVE-SOURCES-DIR* (~> (steel-home-location) (append-with-separator "sources"))) (define *COG-SOURCES* (~> (steel-home-location) (append-with-separator "cog-sources"))) (define *DYLIB-DIR* (~> (steel-home-location) (append-with-separator "native"))) +(define *BIN* (~> (steel-home-location) (append-with-separator "bin"))) (define (for-each func lst) (if (null? lst) @@ -40,21 +57,64 @@ (return! void)) (for-each func (cdr lst))))) +(define (shebang-line) + "#!/usr/bin/env steel") + ;;@doc ;; Given a package spec, install that package directly to the file system (define/contract (install-package package) (->/c hash? string?) (define destination - (string-append *STEEL_HOME* "/" (symbol->string (hash-get package 'package-name)))) + (convert-path (string-append *STEEL_HOME* "/" (symbol->string (hash-get package 'package-name))))) (displayln "=> Installing: " package) + (displayln " ...Installing to:" destination) + + (when (path-exists? destination) + (delete-directory! destination)) ;; Install the package cog sources to the target location. ;; When this package does not have any dylibs, this is a trivial copy to the ;; sources directory. (copy-directory-recursively! (hash-get package 'path) destination) + (when (hash-contains? package 'entrypoint) + (define entrypoint-spec (apply hash (hash-get package 'entrypoint))) + (define executable-name (hash-get entrypoint-spec '#:name)) + (define executable-path (hash-get entrypoint-spec '#:path)) + ;; Path to the entrypoint should go here, and since it is most likely expressed + ;; as a path relative to the cog.scm file, we should expand the path. + (define path-to-entrypoint + (convert-path (append-with-separator (hash-get package 'path) executable-path))) + + (define destination-binary (convert-path (append-with-separator *BIN* executable-name))) + + (displayln "-----> Discovered entrypoint:" path-to-entrypoint) + (displayln "-----> Entrypoint name:" executable-name) + (displayln "-----> Resulting executable location:" destination-binary) + + (let ([binary-file (open-output-file destination-binary)]) + + (write-string (shebang-line) binary-file) + (newline binary-file) + (let ([file (open-input-file path-to-entrypoint)]) + (write-string (read-port-to-string file) binary-file) + (close-input-port file)) + (close-output-port binary-file)) + + (~> (command "chmod" (list "755" destination-binary)) + spawn-process + Ok->value + wait->stdout + Ok->value) + + ;; Open up the file, inject a shebang, write to the bin, chmod it according to the + ;; host platform + + ; (let [(binary (open-output-file ))]) + ) + (displayln "=> Copied package over to: " destination) (walk-and-install package) @@ -82,8 +142,35 @@ (symbol->string (hash-ref package 'package-name))) #:subdir (or (hash-try-get dylib-dependency '#:subdir) ""))])) +(define (list-package-index) + (eval '(require "steel/packages/packages.scm")) + (eval 'package-index)) + +(define (install-package-from-pkg-index index package) + + ;; TODO: Cache this result from list-package-index + (define pkg-index (list-package-index)) + + (define remote-pkg-spec + (hash-ref pkg-index + (if (symbol? package) + package + (string->symbol package)))) + + (define git-url (hash-ref remote-pkg-spec '#:url)) + (define subdir (or (hash-try-get remote-pkg-spec '#:path) "")) + ;; Pass the path down as well - so that we can install things that way + (define package-spec (download-cog-to-sources-and-parse-module package git-url #:subdir subdir)) + + (check-install-package index package-spec)) + ;; TODO: Decide if we actually need the package spec here -(define (fetch-and-install-cog-dependency-from-spec cog-dependency) +(define (fetch-and-install-cog-dependency-from-spec cog-dependency [search-from #f]) + + ;; TODO: Figure out a way to resolve if the specified package is + ;; the correct package. + (when (package-installed? (hash-ref cog-dependency '#:name)) + (displayln "=> Package already installed:" (hash-ref cog-dependency '#:name))) ;; For each cog, go through and install the package to the `STEEL_HOME` directory. ;; This should not only check if the package is installed, but also check @@ -116,21 +203,39 @@ ;; Attempt to find the local path to the package if this is ;; just another package installed locally. [(hash-contains? cog-dependency '#:path) - (define source (hash-get cog-dependency '#:path)) - - (install-package (car (parse-cog source)))] + (define spec (car (parse-cog source search-from))) + (install-package spec)] ;; We're unable to find the package! Logically, here would be a place ;; we'd check against some kind of package index to help with this. - [else (error "Unable to resolve module!: " cog-dependency)]))) + [else + (displayln "Attempting to resolve from the package index.") + (define package-index (list-package-index)) + ;; Check if the package exists in the package index. + ;; If it does, we can go ahead and install it into our fake + ;; hash. Right now we pretty much install everything sequentially, + ;; which is not the worst thing since we have to discover dependencies + ;; along the way, but something better would be to try to find all + ;; the leaves, and then we can install in one big command + (if (hash-contains? package-index (hash-ref cog-dependency '#:name)) + (install-package-from-pkg-index (hash) (hash-ref cog-dependency '#:name)) + (error "Unable to resolve module!: " cog-dependency))]))) ;; Go through each of the dependencies, and install the cogs ;; and subsequently go through each of the dylibs, and install ;; those as well. (define (walk-and-install package) + + (define current-path (hash-try-get package 'path)) + (define maybe-canonicalized + (if current-path + (canonicalize-path current-path) + current-path)) + ;; Check the direct cog level dependencies - (for-each fetch-and-install-cog-dependency-from-spec (hash-ref package 'dependencies)) + (for-each (lambda (d) (fetch-and-install-cog-dependency-from-spec d maybe-canonicalized)) + (hash-ref package 'dependencies)) ;; Check the dylibs next (for-each (lambda (spec) (install-dylib-from-spec package spec)) @@ -141,15 +246,35 @@ ;; Does not currently check the in memory index, since this could be done during the ;; package installation process where the index is constantly getting updated. (define (package-installed? name) - (define destination (string-append *STEEL_HOME* "/" (symbol->string name))) + (define destination + (string-append *STEEL_HOME* + "/" + (if (string? name) + name + (symbol->string name)))) (path-exists? destination)) -;; Given a package pec, uninstall that package by deleting the contents of the installation +;; Given a package spec, uninstall that package by deleting the contents of the installation (define/contract (uninstall-package package) (->/c hash? string?) (define destination (string-append *STEEL_HOME* "/" (symbol->string (hash-get package 'package-name)))) - (displayln destination)) + (displayln "Deleting:" destination) + + ;; Check if this produced a dylib, and if so, delete it + (when (hash-contains? package 'dylibs) + (let ([cargo-toml-path (append-with-separator destination "Cargo.toml")]) + (when (path-exists? cargo-toml-path) + (define dylib-name (find-dylib-name cargo-toml-path)) + (define dylib-path (append-with-separator *DYLIB-DIR* dylib-name)) + ;; Delete the dylib. If it doesn't exist, we can continue on. + (if (path-exists? dylib-path) + (delete-file! dylib-path) + (displayln "Dylib not found."))))) + + (delete-directory! destination) + + destination) (define/contract (install-package-and-log cog-to-install) (->/c hash? void?) @@ -162,7 +287,7 @@ (define package-name (hash-get cog-to-install 'package-name)) (if (hash-contains? installed-cogs package-name) (begin - (displayln "Beginning installation for " package-name) + (displayln "Beginning installation for:" package-name) (displayln " Package already installed...") (displayln " Overwriting existing package installation...") (install-package-and-log cog-to-install)) @@ -172,7 +297,9 @@ (install-package-and-log cog-to-install)))) (define (parse-cogs-from-command-line) - (if (empty? std::env::args) (list (current-directory)) std::env::args)) + (if (empty? std::env::args) + (list (current-directory)) + std::env::args)) (define (package-installer-main) @@ -186,6 +313,10 @@ (displayln "dylib directory does not exist, creating now...") (create-directory! *DYLIB-DIR*)) + (when (not (path-exists? *BIN*)) + (displayln "bin directory does not exist, creating now...") + (create-directory! *BIN*)) + (transduce cogs-to-install (flat-mapping parse-cog) (into-for-each (lambda (x) (check-install-package installed-cogs x))))) diff --git a/cogs/installer/parser.scm b/cogs/installer/parser.scm index d281aafa3..f70870a80 100644 --- a/cogs/installer/parser.scm +++ b/cogs/installer/parser.scm @@ -17,16 +17,33 @@ (mapping (lambda (package) (list (hash-get package 'package-name) package))) (into-hashmap))) -(define/contract (parse-cog module) - (->/c string? list?) +(define (convert-path path) + (if (equal? (current-os!) "windows") + (string-replace path "/" "\\") + path)) + +(define (parse-cog module [search-from #f]) + ;; TODO: This needs to handle relative paths + (displayln "searching for: " module) (if (is-dir? module) - (let ([cog-path (string-append module "/cog.scm")]) + (let ([cog-path (convert-path (string-append module "/cog.scm"))]) (if (is-file? cog-path) ;; Update the resulting map with the path to the module (list (hash-insert (parse-cog-file cog-path) 'path module)) (hash-values->list (discover-cogs module)))) - (error! "Unable to locate the module " module))) + + (if search-from + (begin + ;; This is no good - need to do platform agnostic separator + (define new-search-path + (convert-path (string-append (trim-end-matches search-from "/") "/" module))) + + (displayln "Searching in: " new-search-path) + + (parse-cog new-search-path)) + + (error! "Unable to locate the module " module)))) ;; Parses a cog file directly into a hashmap (define/contract (parse-cog-file path) @@ -38,7 +55,10 @@ ;; TODO: Move this out - also make sure (if (member (car p) '(dylibs dependencies)) (list (car p) - (map (lambda (spec) (if (list? spec) (apply hash spec) spec)) + (map (lambda (spec) + (if (list? spec) + (apply hash spec) + spec)) (cadr p))) p))) (into-hashmap))) diff --git a/cogs/installer/spm.scm b/cogs/installer/spm.scm new file mode 100644 index 000000000..e39a89549 --- /dev/null +++ b/cogs/installer/spm.scm @@ -0,0 +1,3 @@ +(require "installer/main.scm") + +(main) diff --git a/cogs/match/match-tests.scm b/cogs/match/match-tests.scm index a8f4ca612..6464c54fa 100644 --- a/cogs/match/match-tests.scm +++ b/cogs/match/match-tests.scm @@ -143,87 +143,76 @@ ;; the contract level, assuming those checks are visible to the optimizer (define (check-type-info raw-expr type-info) - (match-syntax raw-expr - ;; Do this generically for every type? - ;; For primitive checks, we can do this - [`(if (,primitive-type-check ,variable) ,then-expr ,else-expr) - ; #:when (equal? (syntax-e ifp) 'if) - ;; Check the type? - (define primitive-type-check-type (hash-try-get primitive-table (syntax-e primitive-type-check))) - (define maybe-type (check-type-info variable type-info)) - - ; (displayln "maybe-type" maybe-type) - ; (displayln "primitive-type-check-type" primitive-type-check-type) - - ;; Check that the expected types are the same - if we've concretely found that they won't - ;; line up, we should suggest that the then branch is unreachable. - (when (and maybe-type - primitive-type-check-type - (not (equal? 'any maybe-type)) - (not (equal? primitive-type-check-type maybe-type))) - (displayln "Warning: It appears that the then branch is unreachable")) - - ;; Unify these types, otherwise lift to None - (let ([then-expr-type (check-type-info - then-expr - (hash-insert type-info (syntax-e variable) primitive-type-check-type))] - [else-expr-type (check-type-info else-expr type-info)]) - - (if (equal? then-expr-type else-expr-type) - - then-expr-type - - ;; Just promote to the any type - 'any)) - - ; (list (check-type-info then-expr - ; (hash-insert type-info (syntax-e variable) primitive-type-check-type)) - ; (check-type-info else-expr type-info)) - ] - ;; Function application, check that the variable found in `known-variable` - ;; matches the expected type from known-variable - - [(list application args ...) - - (define maybe-type (check-type-info application type-info)) - (define args-types (map (lambda (e) (check-type-info e type-info)) args)) - - (match maybe-type - [(list args ret-val) - - (unless (equal? args args-types) - (error-with-span (syntax-span application) - "Type mismatch! expected " - args - " found " - args-types)) - - ret-val] - - [any any]) - - ;; Application - ; (define maybe-type (hash-try-get type-info (syntax-e known-variable))) - ; (define maybe-signature (hash-try-get type-info (syntax-e function-application))) - ; (when (and maybe-type maybe-signature (not (equal? maybe-type (car maybe-signature)))) - ; (error-with-span (syntax-span function-application) - ; "Type mismatch! expected " - ; (car maybe-signature) - ; " found " - ; maybe-type)) - - ;; This should then return the - ; (displayln maybe-signature) - - ; (list (check-type-info function-application type-info) - ; (check-type-info known-variable type-info)) - ] - - ;; If this doesn't match any of our other forms, recur - [(list other ...) (map (lambda (e) (check-type-info e type-info)) other)] - - ;; We've bottomed out, just return the collected type information - [other (or (hash-try-get type-info (syntax-e other)) 'any)])) + (match-syntax + raw-expr + ;; Do this generically for every type? + ;; For primitive checks, we can do this + [`(if (,primitive-type-check ,variable) ,then-expr ,else-expr) + ; #:when (equal? (syntax-e ifp) 'if) + ;; Check the type? + (define primitive-type-check-type (hash-try-get primitive-table (syntax-e primitive-type-check))) + (define maybe-type (check-type-info variable type-info)) + ; (displayln "maybe-type" maybe-type) + ; (displayln "primitive-type-check-type" primitive-type-check-type) + ;; Check that the expected types are the same - if we've concretely found that they won't + ;; line up, we should suggest that the then branch is unreachable. + (when (and maybe-type + primitive-type-check-type + (not (equal? 'any maybe-type)) + (not (equal? primitive-type-check-type maybe-type))) + (displayln "Warning: It appears that the then branch is unreachable")) + ;; Unify these types, otherwise lift to None + (let ([then-expr-type (check-type-info + then-expr + (hash-insert type-info (syntax-e variable) primitive-type-check-type))] + [else-expr-type (check-type-info else-expr type-info)]) + + (if (equal? then-expr-type else-expr-type) + + then-expr-type + + ;; Just promote to the any type + 'any)) + ; (list (check-type-info then-expr + ; (hash-insert type-info (syntax-e variable) primitive-type-check-type)) + ; (check-type-info else-expr type-info)) + ] + ;; Function application, check that the variable found in `known-variable` + ;; matches the expected type from known-variable + [(list application args ...) + (define maybe-type (check-type-info application type-info)) + (define args-types (map (lambda (e) (check-type-info e type-info)) args)) + (match maybe-type + [(list args ret-val) + + (unless (equal? args args-types) + (error-with-span (syntax-span application) + "Type mismatch! expected " + args + " found " + args-types)) + + ret-val] + + [any any]) + ;; Application + ; (define maybe-type (hash-try-get type-info (syntax-e known-variable))) + ; (define maybe-signature (hash-try-get type-info (syntax-e function-application))) + ; (when (and maybe-type maybe-signature (not (equal? maybe-type (car maybe-signature)))) + ; (error-with-span (syntax-span function-application) + ; "Type mismatch! expected " + ; (car maybe-signature) + ; " found " + ; maybe-type)) + ;; This should then return the + ; (displayln maybe-signature) + ; (list (check-type-info function-application type-info) + ; (check-type-info known-variable type-info)) + ] + ;; If this doesn't match any of our other forms, recur + [(list other ...) (map (lambda (e) (check-type-info e type-info)) other)] + ;; We've bottomed out, just return the collected type information + [other (or (hash-try-get type-info (syntax-e other)) 'any)])) (define my-expr2 (quasisyntax (define loop @@ -236,25 +225,20 @@ (define (tile-null-cdr-checks expr) (match-syntax expr - ;; Function call merging optimizations - [`(#%prim.null? (#%prim.cdr ,expr)) - - ;; Map the span of this object to the span - ;; of the incoming one. - (syntax/loc (list (syntax/loc '#%prim.cdr-null? - (syntax-span expr)) - expr) - (syntax-span expr))] - - [(list other ...) - - (syntax/loc (map tile-null-cdr-checks other) - (syntax-span expr))] - - [other other])) + ;; Function call merging optimizations + [`(#%prim.null? (#%prim.cdr ,expr)) + ;; Map the span of this object to the span + ;; of the incoming one. + (syntax/loc (list (syntax/loc '#%prim.cdr-null? + (syntax-span expr)) + expr) + (syntax-span expr))] + [(list other ...) + (syntax/loc (map tile-null-cdr-checks other) + (syntax-span expr))] + [other other])) (define test-expr - (quasisyntax (define foo (lambda (x) @@ -271,18 +255,13 @@ (lambda (expr) ;; - (match-syntax expr - pat ... - [other other]) + (match-syntax expr pat ... [other other]) (match-syntax expr - - [(list other ...) - - (syntax/loc (map name other) - (syntax-span expr))] - - [other other])))])) + [(list other ...) + (syntax/loc (map name other) + (syntax-span expr))] + [other other])))])) ;; define/lint (define/lint (null-cdr-check expr) @@ -301,21 +280,16 @@ (define (flatten-cons expr) (match-syntax expr - - [`(#%prim.cons ,x (#%prim.list ,@expr)) - - (syntax/loc (cons (syntax/loc '#%prim.list - (syntax-span (car expr))) - (cons x expr)) - - (syntax-span (car expr)))] - - [(list other ...) - - (syntax/loc (map flatten-cons other) - (syntax-span expr))] - - [other other])) + [`(#%prim.cons ,x (#%prim.list ,@expr)) + (syntax/loc (cons (syntax/loc '#%prim.list + (syntax-span (car expr))) + (cons x expr)) + + (syntax-span (car expr)))] + [(list other ...) + (syntax/loc (map flatten-cons other) + (syntax-span expr))] + [other other])) (flatten-cons (quasisyntax diff --git a/crates/cargo-steel-lib/src/lib.rs b/crates/cargo-steel-lib/src/lib.rs index a97853dac..ffcf7fc9f 100644 --- a/crates/cargo-steel-lib/src/lib.rs +++ b/crates/cargo-steel-lib/src/lib.rs @@ -38,12 +38,24 @@ pub fn steel_home() -> Option { }) } -pub fn run() -> Result<(), Box> { +pub fn run(args: Vec, env_vars: Vec<(String, String)>) -> Result<(), Box> { let mut steel_home = steel_home().expect("Unable to find STEEL_HOME"); steel_home.push("native"); - let metadata = MetadataCommand::new().exec()?; + // --manifest-path + let mut metadata_command = MetadataCommand::new(); + + for pair in args.chunks(2) { + match &pair { + &[arg, path] if arg == "--manifest-path" => { + metadata_command.manifest_path(path); + } + _ => {} + } + } + + let metadata = metadata_command.exec()?; let package = match metadata.root_package() { Some(p) => p, @@ -65,6 +77,8 @@ pub fn run() -> Result<(), Box> { "--release", "--message-format=json-render-diagnostics", ]) + .args(args) + .envs(env_vars) .stdout(Stdio::piped()) .spawn() .unwrap(); diff --git a/crates/cargo-steel-lib/src/main.rs b/crates/cargo-steel-lib/src/main.rs index fd249a4c5..6e60baa82 100644 --- a/crates/cargo-steel-lib/src/main.rs +++ b/crates/cargo-steel-lib/src/main.rs @@ -1,5 +1,6 @@ use std::error::Error; fn main() -> Result<(), Box> { - cargo_steel_lib::run() + let args = std::env::args().skip(1).collect(); + cargo_steel_lib::run(args, Vec::new()) } diff --git a/crates/forge/Cargo.toml b/crates/forge/Cargo.toml new file mode 100644 index 000000000..4b64f38d7 --- /dev/null +++ b/crates/forge/Cargo.toml @@ -0,0 +1,16 @@ +[package] +name = "forge" +edition = "2021" +version.workspace = true + +[dependencies] +# TODO: Don't use the workspace, instead explicitly +# depend on the version with the git dependency +steel-core = { path = "../steel-core", version = "0.6.0", features = ["dylibs", "stacker", "sync", "git"] } + +[build-dependencies] +steel-core = { path = "../steel-core", version = "0.6.0", features = ["dylibs", "stacker", "sync", "git"] } + +[features] +default = ["dylib-build"] +dylib-build = ["steel-core/dylib-build"] diff --git a/crates/forge/build.rs b/crates/forge/build.rs new file mode 100644 index 000000000..4c87454dd --- /dev/null +++ b/crates/forge/build.rs @@ -0,0 +1,36 @@ +use std::path::PathBuf; + +use steel::steel_vm::engine::Engine; + +fn main() { + // Re run this if any of the files within the directory + // have changed. Note - this may not pick up changes in any + // dependencies, but it should be good enough. + println!("cargo::rerun-if-changed=../../cogs/installer/"); + + let out_dir = std::env::var_os("OUT_DIR").unwrap(); + let dest_path = std::path::Path::new(&out_dir).join("program.rs"); + let dest_bytes = std::path::Path::new(&out_dir).join("program.bin"); + + let entrypoint = include_str!("../../cogs/installer/forge.scm"); + + let non_interactive_program = Engine::create_non_interactive_program_image( + entrypoint, + PathBuf::from("../../cogs/installer/spm.scm"), + ) + .unwrap(); + + // Write the bytes out + non_interactive_program.write_bytes_to_file(&dest_bytes); + + let rust_entrypoint = format!( + r#" +fn main() {{ + steel::steel_vm::engine::Engine::execute_non_interactive_program_image(include_bytes!(r"{}")).unwrap(); +}} + "#, + dest_bytes.as_os_str().to_str().unwrap() + ); + + std::fs::write(dest_path, rust_entrypoint).unwrap(); +} diff --git a/crates/forge/src/main.rs b/crates/forge/src/main.rs new file mode 100644 index 000000000..73ec47a87 --- /dev/null +++ b/crates/forge/src/main.rs @@ -0,0 +1 @@ +include!(concat!(env!("OUT_DIR"), "/program.rs")); diff --git a/crates/steel-core/Cargo.toml b/crates/steel-core/Cargo.toml index 9762d221f..c1ad618c1 100644 --- a/crates/steel-core/Cargo.toml +++ b/crates/steel-core/Cargo.toml @@ -52,7 +52,7 @@ radix_fmt = "1.0.0" smallvec = { version = "1.13.0" } # Pretty printing documentation -termimad = { version = "0.21.0", optional = true } +termimad = { version = "0.31.1", optional = true } # FFI for dylibs abi_stable = { version = "0.11.2", optional = true } @@ -81,11 +81,13 @@ http = "1.1.0" compact_str = { version = "0.8.0", features = ["serde"] } +git2 = { version = "0.19.0", optional = true, features = ["vendored-openssl"] } + [target.'cfg(target_arch = "wasm32")'.dependencies] getrandom = { version = "*", features = ["js"] } [target.'cfg(not(target_arch = "wasm32"))'.dependencies] -which = { version = "4.4.0" } +which = "7.0.0" home = "0.5.9" polling = "3.7.3" @@ -115,7 +117,12 @@ stacker = ["dep:stacker"] dylib-build = ["dep:cargo-steel-lib"] sync = ["dep:im"] interrupt = [] - +rooted-instructions = [] +recycle = [] +# git = ["dep:gix", "anyhow"] +git = ["dep:git2", "anyhow"] +experimental-drop-handler = [] +unsandboxed-kernel = [] [[bench]] name = "my_benchmark" diff --git a/crates/steel-core/src/compiler/compiler.rs b/crates/steel-core/src/compiler/compiler.rs index f33a47003..85c9d3e40 100644 --- a/crates/steel-core/src/compiler/compiler.rs +++ b/crates/steel-core/src/compiler/compiler.rs @@ -528,6 +528,35 @@ impl Compiler { self.compile_raw_program(parsed?, path) } + pub fn fully_expand_to_file + Into>>( + &mut self, + expr_str: E, + path: Option, + ) -> Result<()> { + #[cfg(feature = "profiling")] + let now = Instant::now(); + + let expr_str = expr_str.into(); + + let id = self.sources.add_source(expr_str.clone(), path.clone()); + + // Could fail here + let parsed: std::result::Result, ParseError> = path + .as_ref() + .map(|p| Parser::new_from_source(expr_str.as_ref(), p.clone(), Some(id))) + .unwrap_or_else(|| Parser::new(expr_str.as_ref(), Some(id))) + .without_lowering() + .map(|x| x.and_then(lower_macro_and_require_definitions)) + .collect(); + + #[cfg(feature = "profiling")] + if log::log_enabled!(target: "pipeline_time", log::Level::Debug) { + log::debug!(target: "pipeline_time", "Parsing Time: {:?}", now.elapsed()); + } + + self.expand_to_file(parsed?, path) + } + // TODO: Add a flag/function for parsing comments as well // Move the body of this function into the other one, so that way we have proper pub fn emit_expanded_ast( @@ -1047,6 +1076,40 @@ impl Compiler { // self.apply_const_evaluation(constant_primitives(), expanded_statements, true) } + // Just write the fully expanded AST out. Then, read it in ~special~. + // This will have to do a lot of noise in order to get things to work properly, + // but its probably still faster than starting from scratch each time? + // + // Unknown. + pub fn expand_to_file(&mut self, exprs: Vec, path: Option) -> Result<()> { + let expanded_statements = self.lower_expressions_impl(exprs, path)?; + let mut file = std::fs::File::create("fully-expanded.bin").unwrap(); + let buffer = bincode::serialize(&expanded_statements).unwrap(); + std::io::Write::write_all(&mut file, &buffer).unwrap(); + Ok(()) + } + + pub fn load_from_file(&mut self, path: &str) -> Result { + let contents = std::fs::read(path).unwrap(); + let expanded_statements = bincode::deserialize(&contents).unwrap(); + + let instructions = self.generate_instructions_for_executable(expanded_statements)?; + + let mut raw_program = RawProgramWithSymbols::new( + instructions, + self.constant_map.clone(), + "0.1.0".to_string(), + ); + + // Make sure to apply the peephole optimizations + raw_program.apply_optimizations(); + + // Lets see everything that gets run! + // raw_program.debug_print_log(); + + Ok(raw_program) + } + // TODO // figure out how the symbols will work so that a raw program with symbols // can be later pulled in and symbols can be interned correctly @@ -1059,18 +1122,6 @@ impl Compiler { let expanded_statements = self.lower_expressions_impl(exprs, path)?; - // println!("--- Final AST ---"); - // println!(""); - // steel_parser::ast::AstTools::pretty_print(&expanded_statements); - - // log::info!( - // "{}", - // expanded_statements - // .iter() - // .map(|x| x.to_pretty(60)) - // .join("\n\n") - // ); - log::debug!(target: "expansion-phase", "Generating instructions"); let instructions = self.generate_instructions_for_executable(expanded_statements)?; diff --git a/crates/steel-core/src/compiler/constants.rs b/crates/steel-core/src/compiler/constants.rs index 633d18c8f..e9e260783 100644 --- a/crates/steel-core/src/compiler/constants.rs +++ b/crates/steel-core/src/compiler/constants.rs @@ -112,9 +112,7 @@ impl ConstantMap { pub fn to_bytes(&self) -> Result> { let str_vector = self.to_constant_expr_map(); - - println!("{:?}", str_vector); - + // println!("{:?}", str_vector); let result = bincode::serialize(&str_vector); Ok(result.unwrap()) diff --git a/crates/steel-core/src/compiler/modules.rs b/crates/steel-core/src/compiler/modules.rs index 2b94b1611..9f7896058 100644 --- a/crates/steel-core/src/compiler/modules.rs +++ b/crates/steel-core/src/compiler/modules.rs @@ -67,6 +67,13 @@ macro_rules! declare_builtins { static BUILT_INS: &[(&str, &str)] = &[ $( ($name, include_str!($path)), )* ]; + + pub(crate) fn intern_modules() { + $( + let _ = InternedString::from($name); + let _ = InternedString::from($path); + )* + } }; } @@ -91,6 +98,7 @@ macro_rules! create_prelude { } } +// TODO: These need to be set up and interned in a stable position. declare_builtins!( "steel/option" => "../scheme/modules/option.scm", "steel/result" => "../scheme/modules/result.scm", diff --git a/crates/steel-core/src/compiler/program.rs b/crates/steel-core/src/compiler/program.rs index 044fe3ed1..c6b6e3f3f 100644 --- a/crates/steel-core/src/compiler/program.rs +++ b/crates/steel-core/src/compiler/program.rs @@ -81,7 +81,7 @@ fn eval_atom(t: &SyntaxObject) -> Result { // TODO: Keywords shouldn't be misused as an expression - only in function calls are keywords allowed TokenType::Keyword(k) => Ok(SteelVal::SymbolV(k.clone().into())), what => { - println!("getting here in the eval_atom - code_generator"); + // println!("getting here in the eval_atom - code_generator"); stop!(UnexpectedToken => what; t.span) } } diff --git a/crates/steel-core/src/env.rs b/crates/steel-core/src/env.rs index eaace1f2c..b39609608 100644 --- a/crates/steel-core/src/env.rs +++ b/crates/steel-core/src/env.rs @@ -17,6 +17,10 @@ pub struct Env { // things are relatively consistent. #[cfg(feature = "sync")] pub(crate) bindings_vec: Arc>>, + // Keep a copy of the globals that we can access + // just by offset. + // #[cfg(feature = "sync")] + // pub(crate) thread_local_bindings: Vec, } #[cfg(feature = "sync")] @@ -24,6 +28,7 @@ impl Clone for Env { fn clone(&self) -> Self { Self { bindings_vec: self.bindings_vec.clone(), + // thread_local_bindings: self.thread_local_bindings.clone(), } } } @@ -129,6 +134,7 @@ impl Env { pub fn root() -> Self { Env { bindings_vec: Arc::new(RwLock::new(Vec::with_capacity(1024))), + // thread_local_bindings: Vec::with_capacity(1024), } } @@ -137,6 +143,7 @@ impl Env { bindings_vec: Arc::new(RwLock::new( self.bindings_vec.read().iter().map(|x| x.clone()).collect(), )), + // thread_local_bindings: self.thread_local_bindings.clone(), } } @@ -155,6 +162,7 @@ impl Env { #[inline(always)] pub fn repl_lookup_idx(&self, idx: usize) -> SteelVal { self.bindings_vec.read()[idx].clone() + // self.thread_local_bindings[idx].clone() } // /// Get the value located at that index @@ -167,7 +175,8 @@ impl Env { let mut guard = self.bindings_vec.write(); if idx < guard.len() { - guard[idx] = val; + guard[idx] = val.clone(); + // self.thread_local_bindings[idx] = val; } else { if idx > guard.len() { // TODO: This seems suspect. Try to understand @@ -178,10 +187,12 @@ impl Env { // to the correct values. for _ in 0..(idx - guard.len()) { guard.push(SteelVal::Void); + // self.thread_local_bindings.push(SteelVal::Void); } } - guard.push(val); + guard.push(val.clone()); + // self.thread_local_bindings.push(val); assert_eq!(guard.len() - 1, idx); } } @@ -189,7 +200,8 @@ impl Env { pub fn repl_set_idx(&mut self, idx: usize, val: SteelVal) -> Result { let mut guard = self.bindings_vec.write(); let output = guard[idx].clone(); - guard[idx] = val; + guard[idx] = val.clone(); + // self.thread_local_bindings[idx] = val; Ok(output) } diff --git a/crates/steel-core/src/gc.rs b/crates/steel-core/src/gc.rs index 3491a0051..3d561290d 100644 --- a/crates/steel-core/src/gc.rs +++ b/crates/steel-core/src/gc.rs @@ -139,10 +139,22 @@ pub mod shared { } impl ShareableMut for Rc> { - type ShareableRead<'a> = Ref<'a, T> where T: 'a; - type ShareableWrite<'a> = RefMut<'a, T> where T: 'a; - type TryReadResult<'a> = Result, BorrowError> where T: 'a; - type TryWriteResult<'a> = Result, BorrowMutError> where T: 'a; + type ShareableRead<'a> + = Ref<'a, T> + where + T: 'a; + type ShareableWrite<'a> + = RefMut<'a, T> + where + T: 'a; + type TryReadResult<'a> + = Result, BorrowError> + where + T: 'a; + type TryWriteResult<'a> + = Result, BorrowMutError> + where + T: 'a; fn read<'a>(&'a self) -> Self::ShareableRead<'a> { Rc::deref(self).borrow() @@ -162,10 +174,22 @@ pub mod shared { } impl ShareableMut for Gc> { - type ShareableRead<'a> = Ref<'a, T> where T: 'a; - type ShareableWrite<'a> = RefMut<'a, T> where T: 'a; - type TryReadResult<'a> = Result, BorrowError> where T: 'a; - type TryWriteResult<'a> = Result, BorrowMutError> where T: 'a; + type ShareableRead<'a> + = Ref<'a, T> + where + T: 'a; + type ShareableWrite<'a> + = RefMut<'a, T> + where + T: 'a; + type TryReadResult<'a> + = Result, BorrowError> + where + T: 'a; + type TryWriteResult<'a> + = Result, BorrowMutError> + where + T: 'a; fn read<'a>(&'a self) -> Self::ShareableRead<'a> { Gc::deref(self).borrow() @@ -185,16 +209,26 @@ pub mod shared { } impl ShareableMut for Arc> { - type ShareableRead<'a> = RwLockReadGuard<'a, T> where T: 'a; - type ShareableWrite<'a> = RwLockWriteGuard<'a, T> where T: 'a; + type ShareableRead<'a> + = RwLockReadGuard<'a, T> + where + T: 'a; + type ShareableWrite<'a> + = RwLockWriteGuard<'a, T> + where + T: 'a; // type TryReadResult<'a> // = TryLockResult> where T: 'a; type TryReadResult<'a> - = Result, ()> where T: 'a; + = Result, ()> + where + T: 'a; // type TryWriteResult<'a> // = TryLockResult> where T: 'a; type TryWriteResult<'a> - = Result, ()> where T: 'a; + = Result, ()> + where + T: 'a; fn read<'a>(&'a self) -> Self::ShareableRead<'a> { Arc::deref(self).read() @@ -222,16 +256,26 @@ pub mod shared { } impl ShareableMut for Gc> { - type ShareableRead<'a> = RwLockReadGuard<'a, T> where T: 'a; - type ShareableWrite<'a> = RwLockWriteGuard<'a, T> where T: 'a; + type ShareableRead<'a> + = RwLockReadGuard<'a, T> + where + T: 'a; + type ShareableWrite<'a> + = RwLockWriteGuard<'a, T> + where + T: 'a; // type TryReadResult<'a> // = TryLockResult> where T: 'a; // type TryWriteResult<'a> // = TryLockResult> where T: 'a; type TryReadResult<'a> - = Result, ()> where T: 'a; + = Result, ()> + where + T: 'a; type TryWriteResult<'a> - = Result, ()> where T: 'a; + = Result, ()> + where + T: 'a; fn read<'a>(&'a self) -> Self::ShareableRead<'a> { Gc::deref(self).read() @@ -259,12 +303,22 @@ pub mod shared { } impl ShareableMut for Arc> { - type ShareableRead<'a> = MutexGuard<'a, T> where T: 'a; - type ShareableWrite<'a> = MutexGuard<'a, T> where T: 'a; + type ShareableRead<'a> + = MutexGuard<'a, T> + where + T: 'a; + type ShareableWrite<'a> + = MutexGuard<'a, T> + where + T: 'a; type TryReadResult<'a> - = TryLockResult> where T: 'a; + = TryLockResult> + where + T: 'a; type TryWriteResult<'a> - = TryLockResult> where T: 'a; + = TryLockResult> + where + T: 'a; fn read<'a>(&'a self) -> Self::ShareableRead<'a> { Arc::deref(self) @@ -288,12 +342,22 @@ pub mod shared { } impl ShareableMut for Gc> { - type ShareableRead<'a> = MutexGuard<'a, T> where T: 'a; - type ShareableWrite<'a> = MutexGuard<'a, T> where T: 'a; + type ShareableRead<'a> + = MutexGuard<'a, T> + where + T: 'a; + type ShareableWrite<'a> + = MutexGuard<'a, T> + where + T: 'a; type TryReadResult<'a> - = TryLockResult> where T: 'a; + = TryLockResult> + where + T: 'a; type TryWriteResult<'a> - = TryLockResult> where T: 'a; + = TryLockResult> + where + T: 'a; fn read<'a>(&'a self) -> Self::ShareableRead<'a> { Gc::deref(self) diff --git a/crates/steel-core/src/parser/expand_visitor.rs b/crates/steel-core/src/parser/expand_visitor.rs index 511f7ed75..d5e641956 100644 --- a/crates/steel-core/src/parser/expand_visitor.rs +++ b/crates/steel-core/src/parser/expand_visitor.rs @@ -1,7 +1,9 @@ use fxhash::{FxBuildHasher, FxHashMap, FxHashSet}; use quickscope::ScopeSet; -use steel_parser::ast::{parse_lambda, Begin}; +use smallvec::SmallVec; +use steel_parser::ast::{self, parse_lambda, Begin}; use steel_parser::parser::SourceId; +use steel_parser::tokens::NumberLiteral; use crate::parser::ast::ExprKind; use crate::parser::parser::SyntaxObject; @@ -21,6 +23,8 @@ use super::{ use crate::parser::expander::SteelMacro; +static REST_ARG: &'static str = "##%list-args"; + pub fn extract_macro_defs( exprs: &mut Vec, macro_map: &mut FxHashMap, @@ -387,6 +391,7 @@ pub fn expand_kernel_in_env_with_allowed( environment: Some(env), depth: 0, allowed_macros: Some(allowed), + define_context: None, }; expander.visit(&mut expr)?; @@ -409,6 +414,7 @@ pub fn expand_kernel_in_env_with_change( environment: Some(env), depth: 0, allowed_macros: None, + define_context: None, }; expander.visit(expr)?; @@ -431,6 +437,7 @@ pub fn expand_kernel_in_env( environment: Some(env), depth: 0, allowed_macros: None, + define_context: None, }; expander.visit(expr) @@ -448,6 +455,7 @@ pub fn expand_kernel( environment: None, depth: 0, allowed_macros: None, + define_context: None, }; expander.visit(&mut expr)?; @@ -462,6 +470,7 @@ pub struct KernelExpander<'a> { environment: Option<&'a str>, depth: usize, allowed_macros: Option<&'a FxHashSet>, + define_context: Option, } impl<'a> KernelExpander<'a> { @@ -473,6 +482,7 @@ impl<'a> KernelExpander<'a> { environment: None, depth: 0, allowed_macros: None, + define_context: None, } } @@ -483,80 +493,56 @@ impl<'a> KernelExpander<'a> { } } -fn _expand_default_arguments( - lambda_function: Box, -) -> Result> { - // todo!() +fn expr_usize(value: usize) -> ExprKind { + ExprKind::Atom(Atom::new(SyntaxObject::default(TokenType::Number( + Box::new(NumberLiteral::Real(steel_parser::tokens::RealLiteral::Int( + steel_parser::tokens::IntLiteral::Small(value as _), + ))), + )))) +} - let _args_len = lambda_function.args.len(); +// Requirements: +// - Don't actually implement using a hashmap. Most likely +// not necessary, and we don't need to introduce _another_ +// allocation into a kwargs dictionary. +// +// - We can just provide this as a function where the default +// value is provided to the plist-get function +// if the value is not there. +// +// As a result, expansion with default arguments should look like this: +// +// (define (test-kwargs #:foo [foo 10] #:bar [bar 20]) +// (+ foo bar)) +// +// (define test-kwargs (lambda args +// (let [(foo (plist-try-get args 10)) +// (bar (plist-try-get args 20))] +// (+ foo bar))) +// +// This gives us the ability to fetch args quickly - just one linear scan, +// no additional allocation beyond the rest args that are already getting allocated. +// +// Handling args with non defaults just means we'll just plist-get instead of plist-try-get +// with a default value. That more or less means we'll only do a handful of scans. +fn expand_keyword_and_default_arguments( + lambda_function: &mut super::ast::LambdaFunction, + define_name: &Option, +) -> Result<()> { + let is_rest = lambda_function.rest; - let mut found_pair = false; - for argument in &lambda_function.args { - if let ExprKind::List(_) = argument { - found_pair = true; - } else if found_pair { - stop!(BadSyntax => "Non default argument occurs after a default argument"; lambda_function.location.span) - } - } + // First, lets find the pairs of keyword args. These could be default or not. + // The order of keyword args doesn't matter, and they can be interwoven with + // non key word arguments. - let _non_default_bindings = lambda_function - .args - .iter() - .filter(|x| !matches!(x, ExprKind::List(_))) - .collect::>(); - - // let bindings = lambda_function - // .args - // .iter() - // .enumerate() - // .filter(|x| matches!(x.1, ExprKind::List(_))) - // .map(|x| { - // if let ExprKind::List(l) = x.1 { - // let var_name = l - // .get(0) - // .ok_or_else(throw!(BadSyntax => "empty default argument"))?; - // let expr = l.get(1).ok_or_else( - // throw!(BadSyntax => "default argument missing default expression"), - // )?; - - // let index = ExprKind::integer_literal(x.0 as isize, lambda_function.location.span); - - // let body = vec![ - - // ] - - // todo!() - // } else { - // unreachable!() - // } - // }) - // .collect::>>(); - - todo!() -} + // kwargs - These are things that are of the format: + // #:foo [foo 10] or #:foo foo. + let mut keyword_map: SmallVec<[(&ExprKind, &ExprKind); 6]> = SmallVec::new(); -// Adjust the generated code to raise a specific error saying certain keys were missing. -fn expand_keyword_arguments(lambda_function: &mut super::ast::LambdaFunction) -> Result<()> { - // TODO: Check if this already has a rest argument - if so, the generated code will need to be changed. - // The naive generated code will not handle rest arguments with keyword arguments, which can be a concern. - // In addition, this naively assumes that keyword arguments cannot be applied before positional arguments - which - // on its own is not the worst restriction, and perhaps we can leave that in place. - // - // If there are rest arguments though, we'll need to split the rest argument list into two - the first half will then get - // applied to the hashmap list, while the rest of the arguments will get applied to the correct place. - - // If this already has a rest arguments, we need to slice out the - // remaining function values from the keywords, and then bind those to whatever variable in the original - // list before we create the hash. Making the hash itself is also not exactly my favorite pattern - we need - // to allocate extra stuff - what we should probably do is create a special keyword allocation that we - // can consistently reuse inside the VM. If we can reuse that allocation repeatedly, we should be able - // to avoid much of the overhead of the allocation. - - // TODO: Can partition these directly into the two groups - let keyword_args: Vec<&ExprKind> = lambda_function + let mut non_keyword_or_default_args: SmallVec<[ExprKind; 6]> = lambda_function .args .iter() - .skip_while(|x| { + .take_while(|x| { !matches!( x, ExprKind::Atom(Atom { @@ -564,77 +550,176 @@ fn expand_keyword_arguments(lambda_function: &mut super::ast::LambdaFunction) -> ty: TokenType::Keyword(_), .. } - }) + }) | ExprKind::List(_) ) }) + .cloned() .collect(); - // If there is a rest argument, we'll want to grab it for later use in the expansion - // TODO: @Matt - Come back to this one - // let mut rest_arg_expr = None; - - // Bail out if theres no keyword args - if keyword_args.is_empty() { - return Ok(()); + enum MaybeDefault<'a> { + Rest(&'a ExprKind), + Positional(&'a ExprKind), + DefaultArg(&'a ExprKind, &'a ExprKind), } - // println!("Expanding keyword args"); - // println!("Body: {}", lambda_function.body); + // Fetch positional args this way as well + let mut positional_args: Vec = Vec::new(); + let mut iter = lambda_function.args.iter().peekable(); + let mut seen_default_or_kwarg = false; + let mut seen_default = false; - if (keyword_args.len() % 2 != 0 && !lambda_function.rest) - || (lambda_function.rest && keyword_args.len() - 1 % 2 != 0) - { - // The last argument is going to be the rest argument - // if lambda_function.rest { - // rest_arg_expr = keyword_args.pop(); - // } + let mut required_positional_arg_count = 0; + let mut optional_positional_arg_count = 0; - stop!(Generic => "keyword arguments malformed - each option requires a value"; lambda_function.location.span) - } + let mut required_keyword_arg_count = 0; + let mut optional_keyword_arg_count = 0; - let mut non_keyword_args: Vec = lambda_function - .args - .iter() - .take_while(|x| { - !matches!( - x, - ExprKind::Atom(Atom { - syn: SyntaxObject { - ty: TokenType::Keyword(_), - .. - } - }) - ) - }) - .cloned() - .collect(); - - // From the keyword args, group them into pairs - let keyword_map = keyword_args - .chunks(2) - .into_iter() - .map(|x| (x[0], x[1])) - .collect::>(); - - if !keyword_map.iter().map(|x| x.0).all(|x| { - matches!( - x, + while let Some(next) = iter.next() { + let is_keyword = matches!( + next, ExprKind::Atom(Atom { syn: SyntaxObject { ty: TokenType::Keyword(_), .. } }) - ) - }) { - stop!(Generic => "Non keyword arguments found after the first keyword argument"; lambda_function.location.span) + ); + + let is_default_arg = matches!(next, ExprKind::List(_)); + seen_default_or_kwarg = seen_default_or_kwarg || is_default_arg; + + if is_keyword { + let value = iter.next(); + match value { + Some(v) => { + if matches!(v, ExprKind::List(_)) { + optional_keyword_arg_count += 1; + } else { + required_keyword_arg_count += 1; + } + + keyword_map.push((next, v)); + } + None => { + stop!(BadSyntax => format!("keyword arg missing variable name: {}", next); lambda_function.location.span) + } + } + + seen_default_or_kwarg = true; + } else { + if seen_default_or_kwarg { + match next { + ExprKind::Atom(a) => { + if is_rest && iter.peek().is_none() { + positional_args.push(MaybeDefault::Rest(next)) + } else { + if seen_default { + stop!(BadSyntax => "positional arg without default found after default argument"; a.syn.span) + } + + required_positional_arg_count += 1; + positional_args.push(MaybeDefault::Positional(next)) + } + } + ExprKind::List(l) => { + if l.len() != 2 { + stop!(BadSyntax => "malformed default argument"; lambda_function.location.span) + } + + seen_default = true; + + optional_positional_arg_count += 1; + positional_args.push(MaybeDefault::DefaultArg( + l.get(0).unwrap(), + l.get(1).unwrap(), + )); + } + _ => { + stop!(BadSyntax => "Internal compiler error") + } + } + } + } + } + + // Bail out if theres no keyword args or default arguments to expand + if keyword_map.is_empty() + && positional_args + .iter() + .all(|x| matches!(x, MaybeDefault::Positional(_))) + { + return Ok(()); } + let positional_arg_iter = positional_args + .into_iter() + .enumerate() + .map(|(index, x)| match x { + MaybeDefault::Rest(p) => { + let mut p = p.clone(); + if let Some(var) = p.atom_syntax_object_mut() { + var.introduced_via_macro = true; + } + + let expression = expr_list![ + // TODO: this should actually be the call site span? How do we anchor against + // the calling function? Tail calls seem to mess that up - how do we reserve that + // information? + ExprKind::ident("#%prim.plist-get-positional-arg-list",), + ExprKind::ident(REST_ARG), + expr_usize(index), + ]; + + Ok((p.clone(), expression)) + } + + MaybeDefault::Positional(p) => { + let mut p = p.clone(); + if let Some(var) = p.atom_syntax_object_mut() { + var.introduced_via_macro = true; + } + + let expression = expr_list![ + // TODO: this should actually be the call site span? How do we anchor against + // the calling function? Tail calls seem to mess that up - how do we reserve that + // information? + ExprKind::ident("#%prim.plist-get-positional-arg",), + ExprKind::ident(REST_ARG), + expr_usize(index), + ]; + + Ok((p.clone(), expression)) + } + MaybeDefault::DefaultArg(p, default_value) => { + let mut p = p.clone(); + if let Some(var) = p.atom_syntax_object_mut() { + var.introduced_via_macro = true; + } + + let expression = expr_list![ + // TODO: this should actually be the call site span? How do we anchor against + // the calling function? Tail calls seem to mess that up - how do we reserve that + // information? + ExprKind::ident("#%prim.plist-try-get-positional-arg",), + ExprKind::ident(REST_ARG), + ExprKind::Atom(Atom::new(SyntaxObject::default(TokenType::Number( + Box::new(NumberLiteral::Real(steel_parser::tokens::RealLiteral::Int( + steel_parser::tokens::IntLiteral::Small(index as _) + ))) + )))), + default_value.clone() + ]; + + Ok((p.clone(), expression)) + } + }); + let bindings = keyword_map .into_iter() .map(|x| { let keyword = x.0; let original_var_name = x.1; + let mut required_kwarg = false; // This is a bit wasteful... come back to this let (mut var_name, expr) = if let ExprKind::List(l) = original_var_name { @@ -645,6 +730,8 @@ fn expand_keyword_arguments(lambda_function: &mut super::ast::LambdaFunction) -> (l[0].clone(), l[1].clone()) } else { + required_kwarg = true; + (original_var_name.clone(), original_var_name.clone()) }; @@ -652,58 +739,51 @@ fn expand_keyword_arguments(lambda_function: &mut super::ast::LambdaFunction) -> var.introduced_via_macro = true; } - // TODO: Go here to implement default arguments - let expression = ExprKind::default_if( + let mut expression = if required_kwarg { expr_list![ - ExprKind::ident("hash-contains?"), - ExprKind::ident("!!dummy-rest-arg!!"), + // TODO: this should actually be the call site span? How do we anchor against + // the calling function? Tail calls seem to mess that up - how do we reserve that + // information? + ExprKind::ident("#%prim.plist-get-kwarg",), + ExprKind::ident(REST_ARG), ExprKind::Quote(Box::new(Quote::new( keyword.clone(), lambda_function.location.clone(), ))), - ], - var_name.clone(), - ExprKind::default_if( - ExprKind::bool_lit(matches!(original_var_name, ExprKind::List(_))), - expr, - expr_list![ - ExprKind::ident("error!"), - ExprKind::string_lit(format!( - "Function application missing required keyword argument: {keyword}" - )) - ], - ), - ); - - let func = ExprKind::LambdaFunction(Box::new(LambdaFunction::new( - vec![var_name.clone()], - expression, - SyntaxObject::default(TokenType::Lambda), - ))); - - let application = expr_list![ - func, + ExprKind::Quote(Box::new(Quote::new( + define_name + .clone() + .unwrap_or_else(|| ExprKind::ident("anonymous function")), + lambda_function.location.clone() + ))) + ] + } else { expr_list![ - ExprKind::ident("hash-try-get"), - ExprKind::ident("!!dummy-rest-arg!!"), + ExprKind::ident("#%prim.plist-try-get"), + ExprKind::ident(REST_ARG), ExprKind::Quote(Box::new(Quote::new( keyword.clone(), lambda_function.location.clone(), ))), - ], - ]; + expr + ] + }; - Ok((var_name, application)) + if let ExprKind::List(l) = &mut expression { + l.location = lambda_function.location.span; + } else { + unreachable!() + } + + Ok((var_name, expression)) }) + .chain(positional_arg_iter) .collect::>>()?; - non_keyword_args.push(ExprKind::ident("!!dummy-rest-arg!!")); + // if let Some(rest_arg) = - // let inner_application = ExprKind::Let(Box::new(Let::new( - // bindings, - // lambda_function.body.clone(), - // SyntaxObject::default(TokenType::Let), - // ))); + // TODO: Pick up all keyword args before the start + non_keyword_or_default_args.push(ExprKind::ident(REST_ARG)); let mut inner_application = vec![ExprKind::LambdaFunction(Box::new(LambdaFunction::new( bindings.iter().map(|x| x.0.clone()).collect(), @@ -713,33 +793,44 @@ fn expand_keyword_arguments(lambda_function: &mut super::ast::LambdaFunction) -> inner_application.extend(bindings.iter().map(|x| x.1.clone())); - *lambda_function = LambdaFunction::new_with_rest_arg( - non_keyword_args, + // TODO: This check has to be a little bit better. + // For this to behave, we have to check the arity of the positional arguments, + // as well as the non positional args. To do so, we should + // just count the length of kwargs provided, as well as the length + // of the positional args. + // + // Required positional and keyword args will count for 1 and 2 spaces + // at the callsite, respectively. + let arity_check_condition = ExprKind::If(Box::new(ast::If::new( + ExprKind::List(List::new(vec![ + ExprKind::ident("#%prim.plist-validate-args"), + ExprKind::ident(REST_ARG), + expr_usize(required_keyword_arg_count), + expr_usize(required_positional_arg_count), + expr_usize(optional_keyword_arg_count), + expr_usize(optional_positional_arg_count), + ExprKind::bool_lit(is_rest), + ])), + ExprKind::List(List::new(inner_application)), expr_list![ - ExprKind::LambdaFunction(Box::new(LambdaFunction::new( - vec![ExprKind::ident("!!dummy-rest-arg!!")], - ExprKind::List(List::new(inner_application)), - // inner_application, - SyntaxObject::default(TokenType::Lambda), - ))), - expr_list![ - ExprKind::ident("apply"), - ExprKind::ident("%keyword-hash"), // This shouldn't be `hash` directly - something with a specific error - // TODO: do like, `(take x !!dummy-rest-arg!!)` - ExprKind::ident("!!dummy-rest-arg!!"), - ], + ExprKind::ident("#%prim.error-with-span"), + expr_list![ExprKind::ident("#%prim.current-function-span")], + ExprKind::string_lit(format!( + "Optional args - arity mismatch: {}", + define_name + .clone() + .unwrap_or_else(|| ExprKind::ident("anonymous function")), + )) ], + SyntaxObject::default(TokenType::If), + ))); + + *lambda_function = LambdaFunction::new_with_rest_arg( + non_keyword_or_default_args.to_vec(), + arity_check_condition, SyntaxObject::default(TokenType::Lambda), ); - // let pretty = { - // let mut w = Vec::new(); - // lambda_function.to_doc().render(60, &mut w).unwrap(); - // String::from_utf8(w).unwrap() - // }; - - // println!("After expansion: {}", pretty); - Ok(()) } @@ -754,7 +845,11 @@ impl<'a> VisitorMutRef for KernelExpander<'a> { } fn visit_define(&mut self, define: &mut super::ast::Define) -> Self::Output { - self.visit(&mut define.body) + self.define_context = Some(define.name.clone()); + self.visit(&mut define.body)?; + self.define_context = None; + + Ok(()) } // TODO: Kernel expander should have the liberty to parse everything @@ -772,7 +867,9 @@ impl<'a> VisitorMutRef for KernelExpander<'a> { // TODO: If this isn't a lambda function, we're gonna have problems // if its a list, we should run the same thing, but on a list // that starts with lambda, and coerce it to be expanded that way - expand_keyword_arguments(lambda_function)?; + // expand_keyword_arguments(lambda_function)?; + + expand_keyword_and_default_arguments(lambda_function, &self.define_context)?; Ok(()) } diff --git a/crates/steel-core/src/parser/expander.rs b/crates/steel-core/src/parser/expander.rs index bb9f08e56..bbacbbff1 100644 --- a/crates/steel-core/src/parser/expander.rs +++ b/crates/steel-core/src/parser/expander.rs @@ -144,7 +144,7 @@ pub struct GlobalMacroManager { pub struct SteelMacro { name: InternedString, special_forms: Vec, - cases: Vec, + pub(crate) cases: Vec, mangled: bool, pub(crate) location: Span, pub(crate) special_mangled: bool, @@ -188,7 +188,14 @@ impl SteelMacro { self.mangled } - pub fn parse_from_ast_macro(ast_macro: Box) -> Result { + pub fn parse_from_ast_macro(mut ast_macro: Box) -> Result { + // HACK: Parse the token as a specific kind of identifier + if let Some(ident) = ast_macro.name.atom_syntax_object_mut() { + if ident.ty == TokenType::DefineSyntax { + ident.ty = TokenType::Identifier("define-syntax".into()) + } + } + let name = *ast_macro .name .atom_identifier_or_else(throw!(BadSyntax => "macros only currently support @@ -227,7 +234,7 @@ impl SteelMacro { // TODO the case matching should be a little bit more informed than this // I think it should also not be greedy, and should report if there are ambiguous matchings - fn match_case(&self, expr: &List) -> Result<&MacroCase> { + pub(crate) fn match_case(&self, expr: &List) -> Result<&MacroCase> { for case in &self.cases { if case.recursive_match(expr) { return Ok(case); @@ -241,6 +248,20 @@ impl SteelMacro { } } + pub(crate) fn match_case_index(&self, expr: &List) -> Result<(&MacroCase, usize)> { + for (index, case) in self.cases.iter().enumerate() { + if case.recursive_match(expr) { + return Ok((case, index)); + } + } + + if let Some(ExprKind::Atom(a)) = expr.first() { + stop!(BadSyntax => format!("macro expansion unable to match case: {expr}"); a.syn.span); + } else { + unreachable!() + } + } + pub fn expand(&self, expr: List, span: Span) -> Result { // if log::log_enabled!(log::Level::Debug) { // log::debug!("Expanding macro with tokens: {}", expr); @@ -262,7 +283,7 @@ impl SteelMacro { #[derive(Clone, Debug, PartialEq, Serialize, Deserialize)] pub struct MacroCase { args: Vec, - body: ExprKind, + pub(crate) body: ExprKind, } impl MacroCase { @@ -271,6 +292,33 @@ impl MacroCase { MacroCase { args, body } } + pub fn all_bindings(&self) -> Vec { + fn walk_bindings(pattern: &MacroPattern, idents: &mut Vec) { + match pattern { + MacroPattern::Rest(r) => walk_bindings(&r, idents), + MacroPattern::Single(s) | MacroPattern::Many(s) | MacroPattern::Quote(s) + if *s != InternedString::from_static("_") => + { + idents.push(s.resolve().to_owned()); + } + MacroPattern::Nested(n) | MacroPattern::ManyNested(n) => { + for p in n { + walk_bindings(p, idents) + } + } + _ => {} + } + } + + let mut idents = Vec::new(); + + for pattern in &self.args { + walk_bindings(&pattern, &mut idents) + } + + idents + } + fn parse_from_pattern_pair( pattern_pair: PatternPair, name: &InternedString, @@ -315,6 +363,27 @@ impl MacroCase { match_list_pattern(&self.args[1..], &list.args[1..], list.improper) } + pub(crate) fn gather_bindings( + &self, + expr: List, + ) -> Result<( + FxHashMap, + FxHashMap, + )> { + let mut bindings = Default::default(); + let mut binding_kind = Default::default(); + + collect_bindings( + &self.args[1..], + &expr[1..], + &mut bindings, + &mut binding_kind, + expr.improper, + )?; + + Ok((bindings, binding_kind)) + } + fn expand(&self, expr: List, span: Span) -> Result { thread_local! { static BINDINGS: RefCell> = RefCell::new(FxHashMap::default()); @@ -959,6 +1028,7 @@ fn match_single_pattern(pattern: &MacroPattern, expr: &ExprKind) -> bool { } } +#[derive(Debug)] pub enum BindingKind { Many, Single, diff --git a/crates/steel-core/src/parser/kernel.rs b/crates/steel-core/src/parser/kernel.rs index 5e733a137..5370388d6 100644 --- a/crates/steel-core/src/parser/kernel.rs +++ b/crates/steel-core/src/parser/kernel.rs @@ -97,7 +97,8 @@ impl Default for Kernel { impl Kernel { pub fn new() -> Self { - let mut engine = fresh_kernel_image(false); + // Does... sandboxing help here? + let mut engine = fresh_kernel_image(!cfg!(feature = "unsandboxed-kernel")); let transformers = Transformers { set: Arc::new(RwLock::new(HashMap::default())), @@ -137,6 +138,15 @@ impl Kernel { }, ); + // Load in parameters. + // TODO: Merge this with the path in modules.rs + if let Err(err) = + engine.compile_and_run_raw_program(include_str!("../scheme/modules/parameters.scm")) + { + engine.raise_error(err); + panic!("Kernel failed to load: This shouldn't happen!"); + } + // Run the script for building the core interface for structs if let Err(err) = engine.compile_and_run_raw_program(KERNEL) { engine.raise_error(err); @@ -338,6 +348,11 @@ impl Kernel { // Create the generated module let generated_module = ExprKind::List(steel_parser::ast::List::new(def_macro_exprs)); + self.engine.run(format!( + "(set! #%loading-current-module \"{}\")", + environment + ))?; + // TODO: Load this as a module instead, so that way we have some real // separation from each other. // @@ -356,6 +371,9 @@ impl Kernel { self.engine .run_raw_program_from_exprs(vec![generated_module])?; + self.engine + .run(format!("(set! #%loading-current-module \"default\")",))?; + Ok(()) } diff --git a/crates/steel-core/src/parser/replace_idents.rs b/crates/steel-core/src/parser/replace_idents.rs index b58b9fe09..1da1d1186 100644 --- a/crates/steel-core/src/parser/replace_idents.rs +++ b/crates/steel-core/src/parser/replace_idents.rs @@ -41,6 +41,14 @@ pub fn replace_identifiers( ReplaceExpressions::new(bindings, binding_kind, fallback_bindings).visit(expr) } +pub fn expand_template( + expr: &mut ExprKind, + bindings: &mut FxHashMap, + binding_kind: &mut FxHashMap, +) -> Result<()> { + ReplaceExpressions::new(bindings, binding_kind, &mut Default::default()).visit(expr) +} + // struct ConstExprKindTransformers { // functions: HashMap<&'static str, fn(&ReplaceExpressions<'_>, ExprKind) -> Result>, // } @@ -422,8 +430,9 @@ impl<'a> ReplaceExpressions<'a> { let start = ExprKind::integer_literal(span.start as isize, span); let end = ExprKind::integer_literal(span.end as isize, span); + // TODO: Fix this unwrap let source_id = ExprKind::integer_literal( - span.source_id().map(|x| x.0).unwrap() as isize, + span.source_id().map(|x| x.0).unwrap_or(0) as isize, span, ); diff --git a/crates/steel-core/src/parser/tryfrom_visitor.rs b/crates/steel-core/src/parser/tryfrom_visitor.rs index fb8d1e6ac..65569e8e6 100644 --- a/crates/steel-core/src/parser/tryfrom_visitor.rs +++ b/crates/steel-core/src/parser/tryfrom_visitor.rs @@ -45,6 +45,8 @@ impl ConsumingVisitor for TryFromExprKindForSteelVal { fn visit_define(&mut self, define: Box) -> Self::Output { let expr = [ + // TODO: This needs to get converted into a syntax object, + // not a symbol? SteelVal::try_from(define.location)?, self.visit(define.name)?, self.visit(define.body)?, @@ -581,9 +583,10 @@ impl ConsumingVisitor for SyntaxObjectFromExprKind { let raw = TryFromExprKindForSteelVal::try_from_expr_kind_quoted(ExprKind::If(f.clone()))?; let span = f.location.span; + let if_ident = SteelVal::try_from(f.location)?; let expr = [ - SteelVal::try_from(f.location)?, + Syntax::proto(if_ident.clone(), if_ident, span.into()).into(), self.visit(f.test_expr)?, self.visit(f.then_expr)?, self.visit(f.else_expr)?, @@ -600,8 +603,11 @@ impl ConsumingVisitor for SyntaxObjectFromExprKind { let span = define.location.span; + let define_ident = SteelVal::try_from(define.location)?; + let expr = [ - SteelVal::try_from(define.location)?, + // Make this a proto + Syntax::proto(define_ident.clone(), define_ident, span).into(), self.visit(define.name)?, self.visit(define.body)?, ]; @@ -624,9 +630,13 @@ impl ConsumingVisitor for SyntaxObjectFromExprKind { .map(|x| self.visit(x)) .collect::>>()?; + let lambda_ident = SteelVal::try_from(lambda_function.location)?; + + let args = SteelVal::ListV(args); + let expr = [ - SteelVal::try_from(lambda_function.location)?, - SteelVal::ListV(args), + Syntax::proto(lambda_ident.clone(), lambda_ident, span).into(), + Syntax::proto(args.clone(), args, span).into(), self.visit(lambda_function.body)?, ]; @@ -638,7 +648,9 @@ impl ConsumingVisitor for SyntaxObjectFromExprKind { TryFromExprKindForSteelVal::try_from_expr_kind_quoted(ExprKind::Begin(begin.clone()))?; let span = begin.location.span; - let mut exprs = vec![SteelVal::try_from(begin.location)?]; + let begin_ident = SteelVal::try_from(begin.location)?; + + let mut exprs = vec![Syntax::proto(begin_ident.clone(), begin_ident, span).into()]; for expr in begin.exprs { exprs.push(self.visit(expr)?); } @@ -647,7 +659,11 @@ impl ConsumingVisitor for SyntaxObjectFromExprKind { fn visit_return(&mut self, r: Box) -> Self::Output { let span = r.location.span; - let expr = [SteelVal::try_from(r.location)?, self.visit(r.expr)?]; + let return_ident = SteelVal::try_from(r.location)?; + let expr = [ + Syntax::proto(return_ident.clone(), return_ident, span).into(), + self.visit(r.expr)?, + ]; Ok(Syntax::new_with_source(SteelVal::ListV(expr.into_iter().collect()), span).into()) } @@ -753,8 +769,9 @@ impl ConsumingVisitor for SyntaxObjectFromExprKind { TryFromExprKindForSteelVal::try_from_expr_kind_quoted(ExprKind::Set(s.clone()))?; let span = s.location.span; + let set_ident = SteelVal::try_from(s.location)?; let expr = [ - SteelVal::try_from(s.location)?, + Syntax::proto(set_ident.clone(), set_ident, span).into(), self.visit(s.variable)?, self.visit(s.expr)?, ]; diff --git a/crates/steel-core/src/primitives.rs b/crates/steel-core/src/primitives.rs index e8ae391e1..319f1c217 100644 --- a/crates/steel-core/src/primitives.rs +++ b/crates/steel-core/src/primitives.rs @@ -26,6 +26,11 @@ pub mod transducers; mod utils; pub mod vectors; +// This is for boot strapping the package +// manager with an embedded git implementation, +// as to not require depending on the system git. +pub mod git; + use crate::gc::{Gc, GcMut}; use crate::rvals::{FromSteelVal, IntoSteelVal, SteelByteVector}; use crate::rvals::{ diff --git a/crates/steel-core/src/primitives/git.rs b/crates/steel-core/src/primitives/git.rs new file mode 100644 index 000000000..103dd075c --- /dev/null +++ b/crates/steel-core/src/primitives/git.rs @@ -0,0 +1,390 @@ +// Set up module to use for gix integration +// This will be used to bootstrap the existing implementation. + +use crate::steel_vm::{builtin::BuiltInModule, register_fn::RegisterFn}; + +pub fn git_module() -> BuiltInModule { + let mut module = BuiltInModule::new("steel/git".to_string()); + + module + .register_fn("git-clone", libgit::git_clone) + .register_fn("git-pull", libgit::git_pull); + + module +} + +#[cfg(not(feature = "git"))] +mod libgit { + use crate::SteelErr; + + pub fn git_clone( + repo_url: String, + dst: String, + ref_name: Option, + ) -> Result<(), SteelErr> { + std::process::Command::new("git") + .arg("clone") + .arg(repo_url) + .arg(&dst) + .spawn()? + .wait()?; + + if let Some(ref_name) = ref_name { + std::process::Command::new("git") + .arg("checkout") + .arg(ref_name) + .current_dir(dst) + .spawn()? + .wait()?; + } + + Ok(()) + } + + pub fn git_pull( + path: String, + remote_name: Option, + remote_branch: Option, + ) -> Result<(), SteelErr> { + let mut command = std::process::Command::new("git"); + + command.arg("pull").current_dir(path); + + if let Some(remote_name) = remote_name { + command.arg(remote_name); + } + + if let Some(remote_branch) = remote_branch { + command.arg(remote_branch); + } + + command.spawn()?.wait()?; + + Ok(()) + } +} + +#[cfg(feature = "git")] +mod libgit { + + use std::io::{self, Write}; + + use git2::Repository; + + // Clone into repository + pub fn git_clone( + repo_url: String, + dst: String, + ref_name: Option, + ) -> anyhow::Result<()> { + let repo = git2::Repository::clone(&repo_url, dst)?; + + if let Some(refname) = ref_name { + // let refname = "master"; // or a tag (v0.1.1) or a commit (8e8128) + let (object, reference) = repo.revparse_ext(&refname).expect("Object not found"); + + repo.checkout_tree(&object, None) + .expect("Failed to checkout"); + + match reference { + // gref is an actual reference like branches or tags + Some(gref) => repo.set_head(gref.name().unwrap()), + // this is a commit, not a reference + None => repo.set_head_detached(object.id()), + } + .expect("Failed to set HEAD"); + } + + Ok(()) + } + + fn do_fetch<'a>( + repo: &'a git2::Repository, + refs: &[&str], + remote: &'a mut git2::Remote, + ) -> Result, git2::Error> { + let mut cb = git2::RemoteCallbacks::new(); + + // Print out our transfer progress. + cb.transfer_progress(|stats| { + if stats.received_objects() == stats.total_objects() { + print!( + "Resolving deltas {}/{}\r", + stats.indexed_deltas(), + stats.total_deltas() + ); + } else if stats.total_objects() > 0 { + print!( + "Received {}/{} objects ({}) in {} bytes\r", + stats.received_objects(), + stats.total_objects(), + stats.indexed_objects(), + stats.received_bytes() + ); + } + io::stdout().flush().unwrap(); + true + }); + + let mut fo = git2::FetchOptions::new(); + fo.remote_callbacks(cb); + // Always fetch all tags. + // Perform a download and also update tips + fo.download_tags(git2::AutotagOption::All); + println!("Fetching {} for repo", remote.name().unwrap()); + remote.fetch(refs, Some(&mut fo), None)?; + + // If there are local objects (we got a thin pack), then tell the user + // how many objects we saved from having to cross the network. + let stats = remote.stats(); + if stats.local_objects() > 0 { + println!( + "\rReceived {}/{} objects in {} bytes (used {} local \ + objects)", + stats.indexed_objects(), + stats.total_objects(), + stats.received_bytes(), + stats.local_objects() + ); + } else { + println!( + "\rReceived {}/{} objects in {} bytes", + stats.indexed_objects(), + stats.total_objects(), + stats.received_bytes() + ); + } + + let fetch_head = repo.find_reference("FETCH_HEAD")?; + Ok(repo.reference_to_annotated_commit(&fetch_head)?) + } + + fn fast_forward( + repo: &Repository, + lb: &mut git2::Reference, + rc: &git2::AnnotatedCommit, + ) -> Result<(), git2::Error> { + let name = match lb.name() { + Some(s) => s.to_string(), + None => String::from_utf8_lossy(lb.name_bytes()).to_string(), + }; + let msg = format!("Fast-Forward: Setting {} to id: {}", name, rc.id()); + println!("{}", msg); + lb.set_target(rc.id(), &msg)?; + repo.set_head(&name)?; + repo.checkout_head(Some( + git2::build::CheckoutBuilder::default() + // For some reason the force is required to make the working directory actually get updated + // I suspect we should be adding some logic to handle dirty working directory states + // but this is just an example so maybe not. + .force(), + ))?; + Ok(()) + } + + fn normal_merge( + repo: &Repository, + local: &git2::AnnotatedCommit, + remote: &git2::AnnotatedCommit, + ) -> Result<(), git2::Error> { + let local_tree = repo.find_commit(local.id())?.tree()?; + let remote_tree = repo.find_commit(remote.id())?.tree()?; + let ancestor = repo + .find_commit(repo.merge_base(local.id(), remote.id())?)? + .tree()?; + let mut idx = repo.merge_trees(&ancestor, &local_tree, &remote_tree, None)?; + + if idx.has_conflicts() { + println!("Merge conflicts detected..."); + repo.checkout_index(Some(&mut idx), None)?; + return Ok(()); + } + let result_tree = repo.find_tree(idx.write_tree_to(repo)?)?; + // now create the merge commit + let msg = format!("Merge: {} into {}", remote.id(), local.id()); + let sig = repo.signature()?; + let local_commit = repo.find_commit(local.id())?; + let remote_commit = repo.find_commit(remote.id())?; + // Do our merge commit and set current branch head to that commit. + let _merge_commit = repo.commit( + Some("HEAD"), + &sig, + &sig, + &msg, + &result_tree, + &[&local_commit, &remote_commit], + )?; + // Set working tree to match head. + repo.checkout_head(None)?; + Ok(()) + } + + fn do_merge<'a>( + repo: &'a Repository, + remote_branch: &str, + fetch_commit: git2::AnnotatedCommit<'a>, + ) -> Result<(), git2::Error> { + // 1. do a merge analysis + let analysis = repo.merge_analysis(&[&fetch_commit])?; + + // 2. Do the appropriate merge + if analysis.0.is_fast_forward() { + println!("Doing a fast forward"); + // do a fast forward + let refname = format!("refs/heads/{}", remote_branch); + match repo.find_reference(&refname) { + Ok(mut r) => { + fast_forward(repo, &mut r, &fetch_commit)?; + } + Err(_) => { + // The branch doesn't exist so just set the reference to the + // commit directly. Usually this is because you are pulling + // into an empty repository. + repo.reference( + &refname, + fetch_commit.id(), + true, + &format!("Setting {} to {}", remote_branch, fetch_commit.id()), + )?; + repo.set_head(&refname)?; + repo.checkout_head(Some( + git2::build::CheckoutBuilder::default() + .allow_conflicts(true) + .conflict_style_merge(true) + .force(), + ))?; + } + }; + } else if analysis.0.is_normal() { + // do a normal merge + let head_commit = repo.reference_to_annotated_commit(&repo.head()?)?; + normal_merge(&repo, &head_commit, &fetch_commit)?; + } else { + println!("Already up to date."); + } + Ok(()) + } + + pub fn git_pull( + path: String, + remote_name: Option, + remote_branch: Option, + ) -> Result<(), anyhow::Error> { + let repo = git2::Repository::open(path)?; + + let remote_name = remote_name.as_ref().map(|s| &s[..]).unwrap_or("origin"); + let remote_branch = remote_branch + .as_ref() + .map(|s| &s[..]) + .unwrap_or("master") + .to_owned(); + + let remote_branch = repo + .head()? + .shorthand() + .map(|x| x.to_owned()) + .unwrap_or(remote_branch); + + // Just use the existing branch name? + + let mut remote = repo.find_remote(remote_name)?; + let fetch_commit = do_fetch(&repo, &[&remote_branch], &mut remote)?; + Ok(do_merge(&repo, &remote_branch, fetch_commit)?) + } + + // TODO: Eventually, try to use gix instead of git2 + // fn gix_pull(path: String) -> anyhow::Result<()> { + // let repo = gix::discover(path)?; + // todo!() + // } + // Bootstrap git bindings + + // fn gix_pull( + // path: String, + // remote_name: Option, + // remote_branch: Option, + // ) -> Result<(), anyhow::Error> { + // let repo = gix::open(path)?; + + // let remote_name = remote_name.as_ref().map(|s| &s[..]).unwrap_or("origin"); + // let remote_branch = remote_branch + // .as_ref() + // .map(|s| &s[..]) + // .unwrap_or("master") + // .to_owned(); + + // let remote_branch = repo + // .head()? + // .referent_name() + // .map(|x| x.as_bstr().to_string()) + // .unwrap_or(remote_branch); + + // let mut remote = repo + // .find_remote(remote_name)? + // .with_fetch_tags(gix::remote::fetch::Tags::All); + + // println!("Fetching {:?} for repo", remote.name().unwrap()); + + // let connection = remote.connect(Direction::Fetch)?; + + // let outcome = connection + // .prepare_fetch(gix::remote::ref_map::Options::default())? + // .receive(should_interrupt)?; + // Ok(outcome); + + // todo!() + // } + + // // TODO: Check this, see if it works for multiple things? + // pub fn gix_clone( + // repo_url: String, + // dst: String, + // ref_name: Option, + // ) -> anyhow::Result<()> { + // // SAFETY: The closure doesn't use mutexes or memory allocation, so it should be safe to call from a signal handler. + // unsafe { + // gix::interrupt::init_handler(1, || {})?; + // } + // std::fs::create_dir_all(&dst)?; + // let url = gix::url::parse(repo_url.as_str().into())?; + + // println!("Url: {:?}", url.to_bstring()); + // let prepare_clone = gix::prepare_clone(url, &dst)?; + + // println!("Cloning {repo_url:?} into {dst:?}..."); + // let (mut prepare_checkout, _) = prepare_clone + // .with_ref_name(ref_name.as_ref().map(|x| x.as_str()))? + // .fetch_then_checkout(gix::progress::Discard, &gix::interrupt::IS_INTERRUPTED)?; + + // println!( + // "Checking out into {:?} ...", + // prepare_checkout.repo().work_dir().expect("should be there") + // ); + + // let (repo, _) = prepare_checkout + // .main_worktree(gix::progress::Discard, &gix::interrupt::IS_INTERRUPTED)?; + + // println!( + // "Repo cloned into {:?}", + // repo.work_dir().expect("directory pre-created") + // ); + + // let remote = repo + // .find_default_remote(gix::remote::Direction::Fetch) + // .expect("always present after clone")?; + + // println!( + // "Default remote: {} -> {}", + // remote + // .name() + // .expect("default remote is always named") + // .as_bstr(), + // remote + // .url(gix::remote::Direction::Fetch) + // .expect("should be the remote URL") + // .to_bstring(), + // ); + + // Ok(()) + // } +} diff --git a/crates/steel-core/src/primitives/lists.rs b/crates/steel-core/src/primitives/lists.rs index 42f82a0bb..c9acb98ad 100644 --- a/crates/steel-core/src/primitives/lists.rs +++ b/crates/steel-core/src/primitives/lists.rs @@ -88,7 +88,15 @@ pub fn list_module() -> BuiltInModule { .register_native_fn_definition(TAKE_DEFINITION) .register_native_fn_definition(LIST_TAIL_DEFINITION) .register_native_fn_definition(CDR_IS_NULL_DEFINITION) - .register_native_fn_definition(LIST_TO_VECTOR_DEFINITION); + .register_native_fn_definition(LIST_TO_VECTOR_DEFINITION) + .register_native_fn_definition(PLIST_GET_DEFINITION) + .register_native_fn_definition(PLIST_TRY_GET_DEFINITION) + .register_native_fn_definition(PLIST_GET_CONTEXT_DEFINITION) + .register_native_fn_definition(PLIST_GET_POSITIONAL_DEFINITION) + .register_native_fn_definition(PLIST_TRY_GET_POSITIONAL_DEFINITION) + .register_native_fn_definition(PLIST_GET_POSITIONAL_LIST_DEFINITION) + .register_native_fn_definition(PLIST_VALIDATE_ARGS_DEFINITION) + .register_native_fn_definition(DROP_START_DEFINITION); module } @@ -589,6 +597,183 @@ pub fn try_list_ref(list: &List, index: isize) -> Result { } } +#[steel_derive::function(name = "list-drop", constant = true)] +pub fn drop_start(list: &List, skip: usize) -> Result { + let mut list = list.clone(); + for _ in 0..skip { + list.cdr_mut(); + } + Ok(SteelVal::ListV(list)) +} + +#[steel_derive::function(name = "plist-get", constant = true)] +pub fn plist_get(list: &List, key: &SteelVal) -> Result { + let mut iter = list.iter(); + // TODO: Change this to be pointer equality! + let symbol = iter.find(|x| *x == key); + let value = iter.next(); + match (symbol, value) { + (None, _) => stop!(Generic => format!("Key not found: {}", key)), + (Some(_), None) => stop!(Generic => format!("Missing value for key: {}", key)), + (Some(_), Some(v)) => Ok(v.clone()), + } +} + +// Find the arg by index, skipping keyword pairs +#[steel_derive::function(name = "plist-get-positional-arg-list")] +pub fn plist_get_positional_list(list: &List, index: usize) -> Result { + let mut iter = list.iter(); + let mut positional_arg_offset = 0; + + while let Some(next) = iter.next() { + if let SteelVal::SymbolV(v) = next { + // If we found a keyword, skip the next one. + if v.starts_with("#:") { + iter.next(); + continue; + } + } + + if index == positional_arg_offset { + let mut list = iter.collect::>(); + list.cons_mut(next.clone()); + + return Ok(SteelVal::ListV(list)); + } + + positional_arg_offset += 1; + } + + Ok(SteelVal::ListV(List::new())) +} + +#[steel_derive::function(name = "plist-validate-args")] +pub fn plist_validate_args( + list: &List, + required_keyword_arg_count: usize, + required_positional_arg_count: usize, + optional_keyword_arg_count: usize, + optional_positional_arg_count: usize, + is_rest: bool, +) -> bool { + // Count each item + let mut iter = list.iter(); + + let mut found_keyword = 0; + let mut found_positional = 0; + + while let Some(next) = iter.next() { + if let SteelVal::SymbolV(v) = next { + // If we found a keyword, skip the next one. + if v.starts_with("#:") { + let value = iter.next(); + if value.is_none() { + return false; + } + + found_keyword += 1; + continue; + } + } + + found_positional += 1; + } + + // What is the range of arguments that we could expect? + // we should see at least + return found_positional >= required_positional_arg_count + && (is_rest + || found_positional + <= (required_positional_arg_count + optional_positional_arg_count)) + && found_keyword >= required_keyword_arg_count + && (is_rest || found_keyword <= (required_keyword_arg_count + optional_keyword_arg_count)); +} + +// Find the arg by index, skipping keyword pairs +#[steel_derive::function(name = "plist-get-positional-arg")] +pub fn plist_get_positional(list: &List, index: usize) -> Result { + let mut iter = list.iter(); + let mut positional_arg_offset = 0; + + dbg!(list); + + while let Some(next) = iter.next() { + if let SteelVal::SymbolV(v) = next { + // If we found a keyword, skip the next one. + if v.starts_with("#:") { + iter.next(); + continue; + } + } + + if index == positional_arg_offset { + return Ok(next.clone()); + } + + positional_arg_offset += 1; + } + + stop!(Generic => "Missing positional arg") +} + +// Find the arg by index, skipping keyword pairs +#[steel_derive::function(name = "plist-try-get-positional-arg")] +pub fn plist_try_get_positional( + list: &List, + index: usize, + default_value: SteelVal, +) -> Result { + let mut iter = list.iter(); + let mut positional_arg_offset = 0; + + while let Some(next) = iter.next() { + if let SteelVal::SymbolV(v) = next { + // If we found a keyword, skip the next one. + if v.starts_with("#:") { + iter.next(); + } + } else { + if index == positional_arg_offset { + return Ok(next.clone()); + } + + positional_arg_offset += 1; + } + } + + Ok(default_value) +} + +#[steel_derive::function(name = "plist-get-kwarg", constant = true)] +pub fn plist_get_context( + list: &List, + key: &SteelVal, + func: &SteelVal, +) -> Result { + let mut iter = list.iter(); + let symbol = iter.find(|x| x.ptr_eq(key)); + let value = iter.next(); + match (symbol, value) { + (None, _) => stop!(Generic => format!("{} : Key not found: {}", func, key)), + (Some(_), None) => stop!(Generic => format!("{} : Missing value for key: {}", func, key)), + (Some(_), Some(v)) => Ok(v.clone()), + } +} + +#[steel_derive::function(name = "plist-try-get", constant = true)] +pub fn plist_try_get( + list: &List, + key: &SteelVal, + default_value: SteelVal, +) -> Result { + let mut iter = list.iter(); + + Ok(iter + .find(|x| x.ptr_eq(key)) + .and_then(|_| iter.next().cloned()) + .unwrap_or(default_value)) +} + /// Returns the value located at the given index. Will raise an error if you try to index out of bounds. /// /// Note: Runs in time proportional to the length of the list, however lists in Steel are implemented in such a fashion that the diff --git a/crates/steel-core/src/primitives/numbers.rs b/crates/steel-core/src/primitives/numbers.rs index 4cebbdca9..9b34fbcac 100644 --- a/crates/steel-core/src/primitives/numbers.rs +++ b/crates/steel-core/src/primitives/numbers.rs @@ -289,12 +289,28 @@ pub fn subtract_primitive(args: &[SteelVal]) -> Result { [] => steelerr!(TypeMismatch => "- requires at least one argument"), [x] => negate(x), [x, ys @ ..] => { - let y = negate(&add_primitive(ys)?)?; + let y = negate(&add_primitive_no_check(ys)?)?; add_two(x, &y) } } } +#[inline(always)] +fn add_primitive_no_check(args: &[SteelVal]) -> Result { + match args { + [] => 0.into_steelval(), + [x] => x.clone().into_steelval(), + [x, y] => add_two(x, y), + [x, y, zs @ ..] => { + let mut res = add_two(x, y)?; + for z in zs { + res = add_two(&res, z)?; + } + res.into_steelval() + } + } +} + /// Adds the given numbers. /// /// (+ . nums) -> number? @@ -1363,6 +1379,7 @@ fn complex_reciprocal(c: &SteelComplex) -> Result { /// /// # Precondition /// `value` must be a number. +#[inline(always)] fn negate(value: &SteelVal) -> Result { match value { SteelVal::NumV(x) => (-x).into_steelval(), @@ -1387,6 +1404,7 @@ fn negate(value: &SteelVal) -> Result { /// /// # Precondition /// x and y must be valid numbers. +#[inline(always)] pub fn add_two(x: &SteelVal, y: &SteelVal) -> Result { match (x, y) { // Simple integer case. Probably very common. diff --git a/crates/steel-core/src/primitives/ports.rs b/crates/steel-core/src/primitives/ports.rs index 18a445d74..a4d298fb4 100644 --- a/crates/steel-core/src/primitives/ports.rs +++ b/crates/steel-core/src/primitives/ports.rs @@ -42,6 +42,7 @@ pub fn port_module() -> BuiltInModule { .register_native_fn_definition(DEFAULT_INPUT_PORT_DEFINITION) .register_native_fn_definition(DEFAULT_OUTPUT_PORT_DEFINITION) .register_native_fn_definition(CLOSE_OUTPUT_PORT_DEFINITION) + .register_native_fn_definition(CLOSE_INPUT_PORT_DEFINITION) .register_native_fn_definition(DEFAULT_ERROR_PORT_DEFINITION) .register_native_fn_definition(EOF_OBJECT_DEFINITION) .register_native_fn_definition(OPEN_INPUT_STRING_DEFINITION) @@ -382,6 +383,11 @@ pub fn close_output_port(port: &SteelPort) -> Result { port.close_output_port().map(|_| SteelVal::Void) } +#[function(name = "close-input-port")] +pub fn close_input_port(port: &SteelPort) -> Result { + port.close_input_port().map(|_| SteelVal::Void) +} + /// Returns `#t` if the value is an EOF object. /// /// (eof-object? any/c) -> bool? diff --git a/crates/steel-core/src/primitives/process.rs b/crates/steel-core/src/primitives/process.rs index 11b51a6a3..6a17f210b 100644 --- a/crates/steel-core/src/primitives/process.rs +++ b/crates/steel-core/src/primitives/process.rs @@ -21,6 +21,7 @@ pub fn process_module() -> BuiltInModule { .register_fn("child-stdout", ChildProcess::stdout) .register_fn("child-stderr", ChildProcess::stderr) .register_fn("child-stdin", ChildProcess::stdin) + .register_fn("set-env-var!", CommandBuilder::env_var) .register_fn("kill", ChildProcess::kill); module @@ -152,6 +153,10 @@ impl CommandBuilder { self.command.current_dir(directory); } + pub fn env_var(&mut self, key: String, value: String) { + self.command.env(key, value); + } + pub fn stdout_piped(&mut self) { self.command.stdout(Stdio::piped()); self.command.stderr(Stdio::piped()); diff --git a/crates/steel-core/src/primitives/time.rs b/crates/steel-core/src/primitives/time.rs index 8617893a7..01aae421a 100644 --- a/crates/steel-core/src/primitives/time.rs +++ b/crates/steel-core/src/primitives/time.rs @@ -1,7 +1,7 @@ use crate::gc::Gc; use crate::SteelVal; use crate::{rvals::Custom, steel_vm::builtin::MarkdownDoc}; -use chrono::Local; +use chrono::{Datelike, Local, NaiveDate, NaiveDateTime}; use std::time::Duration; use std::time::Instant; use steel_derive::function; @@ -43,6 +43,50 @@ fn current_time_formatted(format_string: String) -> String { Local::now().format(&format_string).to_string() } +// enum TimeZones { +// Local(Local), +// Utc(Utc), +// FixedOffset(FixedOffset), +// } + +// pub struct SteelDateTime { +// datetime: NaiveDateTime, +// timezone: TimeZones, +// } + +impl Custom for NaiveDateTime {} +impl Custom for NaiveDate {} + +#[function(name = "naive-current-date-local")] +fn naive_current_date() -> NaiveDate { + Local::now().date_naive() +} + +#[function(name = "naive-date-ymd")] +fn naive_date(year: i32, month: u32, day: u32) -> Option { + NaiveDate::from_ymd_opt(year, month, day) +} + +#[function(name = "naive-date-and-hms")] +fn with_time(date: NaiveDate, hour: u32, minute: u32, second: u32) -> Option { + date.and_hms_opt(hour, minute, second) +} + +#[function(name = "naive-date-year")] +fn date_year(date: NaiveDate) -> i32 { + date.year() +} + +#[function(name = "naive-date-month")] +fn date_month(date: NaiveDate) -> u32 { + date.month() +} + +#[function(name = "naive-date-day")] +fn date_day(date: NaiveDate) -> u32 { + date.day() +} + /// Sleeps the thread for a given number of milliseconds. /// /// (time/sleep-ms ms) @@ -119,7 +163,13 @@ pub fn time_module() -> BuiltInModule { .register_native_fn_definition(SLEEP_MILLIS_DEFINITION) .register_native_fn_definition(CURRENT_MILLISECONDS_DEFINITION) .register_native_fn_definition(CURRENT_SECONDS_DEFINITION) - .register_native_fn_definition(CURRENT_INEXACT_MILLISECONDS_DEFINITION); + .register_native_fn_definition(CURRENT_INEXACT_MILLISECONDS_DEFINITION) + .register_native_fn_definition(NAIVE_DATE_DEFINITION) + .register_native_fn_definition(WITH_TIME_DEFINITION) + .register_native_fn_definition(DATE_YEAR_DEFINITION) + .register_native_fn_definition(DATE_MONTH_DEFINITION) + .register_native_fn_definition(DATE_DAY_DEFINITION) + .register_native_fn_definition(NAIVE_CURRENT_DATE_DEFINITION); module } diff --git a/crates/steel-core/src/rvals.rs b/crates/steel-core/src/rvals.rs index d2c859ada..29d8178ae 100644 --- a/crates/steel-core/src/rvals.rs +++ b/crates/steel-core/src/rvals.rs @@ -67,6 +67,7 @@ macro_rules! list { } use bigdecimal::BigDecimal; +use smallvec::SmallVec; use SteelVal::*; use crate::values::{HashMap, HashSet, Vector}; @@ -579,6 +580,7 @@ impl AsRefMutSteelVal for T { impl ast::TryFromSteelValVisitorForExprKind { pub fn visit_syntax_object(&mut self, value: &Syntax) -> Result { let span = value.span; + // dbg!(&span); // let source = self.source.clone(); match &value.syntax { @@ -935,7 +937,12 @@ pub fn from_serializable_value(ctx: &mut HeapSerializer, val: SerializableSteelV .into_iter() .map(|x| from_serializable_value(ctx, x)); - let mut recycle: crate::values::recycler::Recycle> = + // fields.collect() + + // let mut recycle: crate::values::recycler::Recycle> = + // crate::values::recycler::Recycle::new(); + + let mut recycle: crate::values::recycler::Recycle> = crate::values::recycler::Recycle::new(); recycle.extend(fields); diff --git a/crates/steel-core/src/rvals/cycles.rs b/crates/steel-core/src/rvals/cycles.rs index f7c724214..aaf580067 100644 --- a/crates/steel-core/src/rvals/cycles.rs +++ b/crates/steel-core/src/rvals/cycles.rs @@ -622,6 +622,8 @@ impl<'a> BreadthFirstSearchSteelValVisitor for CycleCollector<'a> { #[cfg(not(feature = "without-drop-protection"))] pub(crate) mod drop_impls { + // use crate::values::recycler::{Recyclable, Recycle}; + use super::*; thread_local! { @@ -688,9 +690,12 @@ pub(crate) mod drop_impls { // } drop_buffer.extend( - self.fields.drain(..), // std::mem::replace(&mut self.fields, Recycle::noop()).into_iter(), + self.fields.drain(..), + // std::mem::replace(&mut self.fields, Recycle::noop()).into_iter(), ); + // std::mem::replace(&mut self, self.fields.put(); + IterativeDropHandler::bfs(&mut drop_buffer); } }) @@ -745,15 +750,18 @@ pub(crate) mod drop_impls { pub struct IterativeDropHandler<'a> { drop_buffer: &'a mut VecDeque, + #[cfg(feature = "experimental-drop-handler")] + moved_threads: bool, } impl<'a> IterativeDropHandler<'a> { pub fn bfs(drop_buffer: &'a mut VecDeque) { - // println!("Current depth: {}", DEPTH.with(|x| x.get())); - - // DEPTH.with(|x| x.set(x.get() + 1)); - IterativeDropHandler { drop_buffer }.visit(); - // DEPTH.with(|x| x.set(x.get() - 1)); + IterativeDropHandler { + drop_buffer, + #[cfg(feature = "experimental-drop-handler")] + moved_threads: false, + } + .visit(); } } @@ -959,12 +967,6 @@ impl<'a> BreadthFirstSearchSteelValVisitor for IterativeDropHandler<'a> { self.push_back(value); } } - - // if list.strong_count() == 1 { - // for value in list { - // self.push_back(value); - // } - // } } // TODO: When this gets replaced with heap storage, then we can do this more @@ -1002,6 +1004,9 @@ impl<'a> BreadthFirstSearchSteelValVisitor for IterativeDropHandler<'a> { fn visit_heap_allocated(&mut self, _heap_ref: HeapRef) -> Self::Output {} + // TODO: After a certain point, we should just pause + // and continue the iteration on another thread. That will + // help with long drops for recursive data structures. fn visit(&mut self) -> Self::Output { let mut ret = self.default_output(); @@ -1045,9 +1050,365 @@ impl<'a> BreadthFirstSearchSteelValVisitor for IterativeDropHandler<'a> { Pair(p) => self.visit_pair(p), ByteVector(b) => self.visit_bytevector(b), }; + + // Long recursive drops will block the main thread from continuing - we should + // have another thread pick up the work? + #[cfg(feature = "experimental-drop-handler")] + if !self.moved_threads && self.drop_buffer.len() > 20 { + self.moved_threads = true; + + static DROP_THREAD: once_cell::sync::Lazy< + crossbeam::channel::Sender, + > = once_cell::sync::Lazy::new(start_background_drop_thread); + + fn start_background_drop_thread( + ) -> crossbeam::channel::Sender { + let (sender, receiver) = + crossbeam::channel::unbounded::(); + + std::thread::spawn(move || { + while let Ok(mut value) = receiver.recv() { + // let now = std::time::Instant::now(); + value.visit(); + // println!("Dropping: {:?}", now.elapsed()); + } + }); + + sender + } + + // let buffer = VecDeque::new(); + let original_buffer = std::mem::replace(self.drop_buffer, VecDeque::new()); + + // println!("Moving to another thread"); + + DROP_THREAD + .send(OwnedIterativeDropHandler { + drop_buffer: original_buffer, + }) + .ok(); + + // std::thread::spawn(move || { + // let mut handler = OwnedIterativeDropHandler { + // drop_buffer: original_buffer, + // }; + + // handler.visit(); + + // drop(handler) + // }); + } + } + + ret + } + + fn visit_pair(&mut self, pair: Gc) -> Self::Output { + if let Ok(inner) = Gc::try_unwrap(pair) { + self.push_back(inner.car); + self.push_back(inner.cdr); + } + } +} + +// TODO: Figure out a more elegant way to do this! + +#[cfg(feature = "experimental-drop-handler")] +pub struct OwnedIterativeDropHandler { + drop_buffer: VecDeque, +} + +#[cfg(feature = "experimental-drop-handler")] +impl BreadthFirstSearchSteelValVisitor for OwnedIterativeDropHandler { + type Output = (); + + fn default_output(&mut self) -> Self::Output { + () + } + + fn pop_front(&mut self) -> Option { + self.drop_buffer.pop_front() + } + + fn push_back(&mut self, value: SteelVal) { + match &value { + SteelVal::BoolV(_) + | SteelVal::NumV(_) + | SteelVal::IntV(_) + | SteelVal::CharV(_) + | SteelVal::Void + | SteelVal::StringV(_) + | SteelVal::FuncV(_) + | SteelVal::SymbolV(_) + | SteelVal::FutureFunc(_) + | SteelVal::FutureV(_) + | SteelVal::BoxedFunction(_) + | SteelVal::MutFunc(_) + | SteelVal::BuiltIn(_) + | SteelVal::ByteVector(_) + | SteelVal::BigNum(_) => return, + _ => { + self.drop_buffer.push_back(value); + } + } + } + + fn visit_bytevector(&mut self, _bytevector: SteelByteVector) -> Self::Output {} + fn visit_bool(&mut self, _boolean: bool) {} + fn visit_float(&mut self, _float: f64) {} + fn visit_int(&mut self, _int: isize) {} + fn visit_rational(&mut self, _: Rational32) {} + fn visit_bigrational(&mut self, _: Gc) {} + fn visit_char(&mut self, _c: char) {} + fn visit_void(&mut self) {} + fn visit_string(&mut self, _string: SteelString) {} + fn visit_function_pointer(&mut self, _ptr: FunctionSignature) {} + fn visit_symbol(&mut self, _symbol: SteelString) {} + fn visit_port(&mut self, _port: SteelPort) {} + fn visit_future(&mut self, _future: Gc) {} + fn visit_mutable_function(&mut self, _function: MutFunctionSignature) {} + fn visit_complex(&mut self, _: Gc) {} + fn visit_bignum(&mut self, _bignum: Gc) {} + fn visit_future_function(&mut self, _function: BoxedAsyncFunctionSignature) {} + fn visit_builtin_function(&mut self, _function: BuiltInSignature) {} + fn visit_boxed_function(&mut self, _function: Gc) {} + + fn visit_closure(&mut self, closure: Gc) { + if let Ok(mut inner) = closure.try_unwrap() { + for value in std::mem::take(&mut inner.captures) { + self.push_back(value); + } + } + } + + fn visit_immutable_vector(&mut self, mut vector: SteelVector) { + if let Some(inner) = vector.0.get_mut() { + for value in std::mem::take(inner) { + self.push_back(value); + } + } + } + + fn visit_custom_type(&mut self, custom_type: GcMut>) { + if let Ok(inner) = custom_type.try_unwrap() { + let mut inner = inner.consume(); + + // TODO: @matt - Don't leave this while merging + // inner.drop_mut(self); + + // let this decide if we're doing anything with this custom type + // inner.drop_mut(self); + } + } + + fn visit_hash_map(&mut self, mut hashmap: SteelHashMap) { + if let Some(inner) = hashmap.0.get_mut() { + for (key, value) in std::mem::take(inner) { + self.push_back(key); + self.push_back(value); + } + } + } + + fn visit_hash_set(&mut self, mut hashset: SteelHashSet) { + if let Some(inner) = hashset.0.get_mut() { + for key in std::mem::take(inner) { + self.push_back(key); + } + } + } + + fn visit_steel_struct(&mut self, steel_struct: Gc) { + if let Ok(mut inner) = steel_struct.try_unwrap() { + for value in inner.fields.drain(..) { + self.push_back(value); + } + } + } + + fn visit_transducer(&mut self, transducer: Gc) { + if let Ok(inner) = transducer.try_unwrap() { + for transducer in inner.ops { + match transducer { + crate::values::transducers::Transducers::Map(m) => self.push_back(m), + crate::values::transducers::Transducers::Filter(v) => self.push_back(v), + crate::values::transducers::Transducers::Take(t) => self.push_back(t), + crate::values::transducers::Transducers::Drop(d) => self.push_back(d), + crate::values::transducers::Transducers::FlatMap(fm) => self.push_back(fm), + crate::values::transducers::Transducers::Flatten => {} + crate::values::transducers::Transducers::Window(w) => self.push_back(w), + crate::values::transducers::Transducers::TakeWhile(tw) => self.push_back(tw), + crate::values::transducers::Transducers::DropWhile(dw) => self.push_back(dw), + crate::values::transducers::Transducers::Extend(e) => self.push_back(e), + crate::values::transducers::Transducers::Cycle => {} + crate::values::transducers::Transducers::Enumerating => {} + crate::values::transducers::Transducers::Zipping(z) => self.push_back(z), + crate::values::transducers::Transducers::Interleaving(i) => self.push_back(i), + } + } + } + } + + fn visit_reducer(&mut self, reducer: Gc) { + if let Ok(inner) = reducer.try_unwrap() { + match inner { + Reducer::ForEach(f) => self.push_back(f), + Reducer::Generic(rf) => { + self.push_back(rf.initial_value); + self.push_back(rf.function); + } + _ => {} + } + } + } + + fn visit_stream(&mut self, stream: Gc) { + if let Ok(mut inner) = stream.try_unwrap() { + self.push_back(replace_with_void(&mut inner.initial_value)); + self.push_back(replace_with_void(&mut inner.stream_thunk)); } + } + + // Walk the whole thing! This includes the stack and all the stack frames + fn visit_continuation(&mut self, continuation: Continuation) { + if let Ok(inner) = crate::gc::Shared::try_unwrap(continuation.inner).map(|x| x.consume()) { + match inner { + ContinuationMark::Closed(mut inner) => { + for value in std::mem::take(&mut inner.stack) { + self.push_back(value); + } + + if let Some(inner) = inner.current_frame.function.get_mut() { + for value in std::mem::take(&mut inner.captures) { + self.push_back(value); + } + } + + for mut frame in std::mem::take(&mut inner.stack_frames) { + if let Some(inner) = frame.function.get_mut() { + for value in std::mem::take(&mut inner.captures) { + self.push_back(value); + } + } + } + } + + ContinuationMark::Open(mut inner) => { + for value in inner.current_stack_values { + self.push_back(value); + } + + if let Some(inner) = inner.current_frame.function.get_mut() { + for value in std::mem::take(&mut inner.captures) { + self.push_back(value); + } + } + } + } + } + } + + fn visit_list(&mut self, list: List) { + // println!("VISITING LIST: {}", list.strong_count()); + // println!("list: {:?}", list); + + if list.strong_count() == 1 { + for value in list.draining_iterator() { + // println!( + // "PUSHING BACK VALUE - queue size: {}", + // self.drop_buffer.len() + // ); + + // println!("enqueueing: {}", value); + + self.push_back(value); + } + } + } - // println!("--- finished draining drop queue ----"); + // TODO: When this gets replaced with heap storage, then we can do this more + // effectively! + fn visit_mutable_vector(&mut self, _vector: HeapRef>) {} + + // TODO: Once the root is added back to this, bring it back + fn visit_boxed_iterator(&mut self, iterator: GcMut) { + if let Ok(inner) = iterator.try_unwrap() { + self.push_back(inner.consume().root) + } + } + + fn visit_syntax_object(&mut self, syntax_object: Gc) { + if let Ok(inner) = syntax_object.try_unwrap() { + if let Some(raw) = inner.raw { + self.push_back(raw); + } + + self.push_back(inner.syntax); + } + } + + fn visit_boxed_value(&mut self, boxed_value: GcMut) { + if let Ok(inner) = boxed_value.try_unwrap() { + self.push_back(inner.consume()); + } + } + + fn visit_reference_value(&mut self, reference: Gc>) { + if let Ok(mut inner) = Gc::try_unwrap(reference) { + // TODO: @matt - Don't leave this while merging + // inner.drop_mut(self); + } + } + + fn visit_heap_allocated(&mut self, _heap_ref: HeapRef) -> Self::Output {} + + // TODO: After a certain point, we should just pause + // and continue the iteration on another thread. That will + // help with long drops for recursive data structures. + fn visit(&mut self) -> Self::Output { + let mut ret = self.default_output(); + + while let Some(value) = self.pop_front() { + ret = match value { + Closure(c) => self.visit_closure(c), + BoolV(b) => self.visit_bool(b), + NumV(n) => self.visit_float(n), + IntV(i) => self.visit_int(i), + Rational(x) => self.visit_rational(x), + BigRational(x) => self.visit_bigrational(x), + BigNum(b) => self.visit_bignum(b), + Complex(x) => self.visit_complex(x), + CharV(c) => self.visit_char(c), + VectorV(v) => self.visit_immutable_vector(v), + Void => self.visit_void(), + StringV(s) => self.visit_string(s), + FuncV(f) => self.visit_function_pointer(f), + SymbolV(s) => self.visit_symbol(s), + SteelVal::Custom(c) => self.visit_custom_type(c), + HashMapV(h) => self.visit_hash_map(h), + HashSetV(s) => self.visit_hash_set(s), + CustomStruct(c) => self.visit_steel_struct(c), + PortV(p) => self.visit_port(p), + IterV(t) => self.visit_transducer(t), + ReducerV(r) => self.visit_reducer(r), + FutureFunc(f) => self.visit_future_function(f), + FutureV(f) => self.visit_future(f), + StreamV(s) => self.visit_stream(s), + BoxedFunction(b) => self.visit_boxed_function(b), + ContinuationFunction(c) => self.visit_continuation(c), + ListV(l) => self.visit_list(l), + MutFunc(m) => self.visit_mutable_function(m), + BuiltIn(b) => self.visit_builtin_function(b), + MutableVector(b) => self.visit_mutable_vector(b), + BoxedIterator(b) => self.visit_boxed_iterator(b), + SteelVal::SyntaxObject(s) => self.visit_syntax_object(s), + Boxed(b) => self.visit_boxed_value(b), + Reference(r) => self.visit_reference_value(r), + HeapAllocated(b) => self.visit_heap_allocated(b), + Pair(p) => self.visit_pair(p), + ByteVector(b) => self.visit_bytevector(b), + }; + } ret } diff --git a/crates/steel-core/src/scheme/kernel.scm b/crates/steel-core/src/scheme/kernel.scm index b4b777719..1b4904d00 100644 --- a/crates/steel-core/src/scheme/kernel.scm +++ b/crates/steel-core/src/scheme/kernel.scm @@ -8,9 +8,39 @@ ; (define *transformer-functions* (hashset)) +;; TODO: Move the parameter stuff to the stdlib. +; (define #%syntax-bindings (make-parameter (hash))) +; (define #%syntax-binding-kind (make-parameter (hash))) + +(set! #%syntax-bindings (make-parameter (hash))) +(set! #%syntax-binding-kind (make-parameter (hash))) + +;; TODO: Figure out a way to have this bootstrap correctly +;; in the global environment within the stdlib, and not just +;; reserved for the kernel. +(define-syntax with-syntax + (syntax-rules () + [(_ ([var expr]) body ...) + (parameterize ([#%syntax-bindings (hash-insert (#%syntax-bindings) 'var expr)]) + body ...)] + + [(_ ([var expr] others ...) body ...) + (parameterize ([#%syntax-bindings (hash-insert (#%syntax-bindings) 'var expr)]) + (with-syntax (others ...) + body ...))])) + ;; Compatibility layers for making defmacro not as painful (define displayln stdout-simple-displayln) +;; TODO: This needs to be updated with the current module during execution. +;; that way, `syntax-case` can go ahead and check which module to expand +;; from. It also needs a way to dynamically add itself to that module hash. +(define #%loading-current-module "default") + +;; Snag the current environment +(define (current-env) + #%loading-current-module) + (define-syntax #%syntax-transformer-module (syntax-rules (provide) @@ -32,25 +62,19 @@ ;; which will then load and register macros accordingly. (define-syntax defmacro (syntax-rules () - [(defmacro environment - (name arg) - expr) + [(defmacro environment (name arg) expr) (begin (register-macro-transformer! (symbol->string 'name) environment) (define (name arg) expr))] - [(defmacro environment - (name arg) - exprs ...) + [(defmacro environment (name arg) exprs ...) (begin (register-macro-transformer! (symbol->string 'name) environment) (define (name arg) exprs ...))] - [(defmacro environment - name - expr) + [(defmacro environment name expr) (begin (register-macro-transformer! (symbol->string 'name) environment) (define name expr))])) @@ -106,6 +130,12 @@ (define (transparent-keyword? x) (equal? x '#:transparent)) +(define (identifier? x) + (symbol? (syntax-e x))) + +(define (all-but-last l) + (reverse (cdr (reverse l)))) + (#%define-syntax (struct expr) (define unwrapped (syntax-e expr)) (define struct-name (syntax->datum (second unwrapped))) @@ -228,7 +258,10 @@ (%plain-let ([struct-type-descriptor (list-ref prototypes 0)] [constructor-proto (list-ref prototypes 1)] [predicate-proto (list-ref prototypes 2)] - [getter-proto (list-ref prototypes 3)]) + ;; TODO: Deprecate this + [getter-proto (list-ref prototypes 3)] + [getter-proto-list + (list-ref prototypes 4)]) (set! ,struct-prop-name struct-type-descriptor) (#%vtable-update-entry! struct-type-descriptor ,maybe-procedure-field ,struct-options-name) ,(if mutable? @@ -261,7 +294,9 @@ (define (new-make-getters struct-name fields) (map (lambda (field) `(set! ,(concat-symbols struct-name '- (car field)) - (lambda (this) (getter-proto this ,(list-ref field 1))))) + (list-ref getter-proto-list ,(list-ref field 1)) + ; (lambda (this) (getter-proto this ,(list-ref field 1))) + )) (enumerate 0 '() fields))) (define (new-make-setters struct-name fields) @@ -315,3 +350,111 @@ (define underlying (syntax-e expr)) (define rest (cdr underlying)) (cons '#%plain-lambda rest)) + +;; Note: Will only work if the length is even +(define (take-every-other lst) + (define count (/ (length lst) 2)) + (define indices (map (lambda (x) (+ 1 (* x 2))) (range 0 count))) + (map (lambda (x) (list-ref lst x)) indices)) + +(define gensym-offset 0) +(define (gensym-sym base) + (string->symbol (string-append (symbol->string base) + (int->string (set! gensym-offset (+ gensym-offset 1)))))) + +;; TODO: Snag define-syntax, convert it to the right format? +;; As of now, the define-syntax will get parsed and yoinked +;; into the wrong format. Add plumbing to ignore those. +(define (parse-def-syntax stx) + ;; Name of the function + (define name-expr (list-ref stx 1)) + ;; Syntax case expr + (define syntax-case-expr (last stx)) + + (define body-exprs (all-but-last (drop stx 2))) + + (define name (list-ref name-expr 0)) + (define param-name (list-ref name-expr 1)) + (define syntax-case-param (list-ref syntax-case-expr 1)) + (define syntax-case-syntax (list-ref syntax-case-expr 2)) + + (define cases (drop syntax-case-expr 3)) + + (define gensym-name (gensym-sym (concat-symbols '__generated- name))) + + ;; Expand to syntax-rules: + (define fake-syntax-rules + `(define-syntax ,gensym-name + (syntax-rules ,syntax-case-syntax + ,@(drop syntax-case-expr 3)))) + + ;; This needs to be eval'd right away so that we can actually + ;; reference the values. + (eval fake-syntax-rules) + + (define conditions (map (lambda (p) (list-ref p 1)) cases)) + + ;; List of cases, in order, for the syntax rules + (define matched-case-bindings (#%macro-case-bindings (symbol->string gensym-name))) + (define generated-function-name (gensym-sym '#%func)) + (define expressions + (transduce (map list (range 0 (length conditions))) (zipping conditions) (into-list))) + + (define expansion-func + ;; TODO: gensym this! + `(define ,generated-function-name + (lambda (#%#%index) + ,@body-exprs + (case #%#%index + ,@expressions)))) + + (define generated-match-function + `(lambda (expr) + ;; Get the bindings first + (define result (#%match-syntax-case ,(symbol->string gensym-name) expr)) + (define index (list-ref result 0)) + (define case-bindings (list-ref result 1)) + (define binding-kind (list-ref result 2)) + (parameterize ([#%syntax-bindings case-bindings]) + (parameterize ([#%syntax-binding-kind binding-kind]) + (,generated-function-name index))))) + + (eval expansion-func) + + generated-match-function) + +(#%define-syntax + (define-syntax expression) + (define unwrapped (syntax->datum expression)) + ;; Just register a syntax transformer? + (define func (parse-def-syntax unwrapped)) + (define name (list-ref (list-ref unwrapped 1) 0)) + (define originating-file (syntax-originating-file expression)) + ;; We'd like to + (define env (or originating-file "default")) + (if (equal? env "default") + + (begin + (eval `(define ,name ,func)) + ;; Register into the top environment + (register-macro-transformer! name env)) + + (with-handler (lambda (_) + + (with-handler (lambda (_) + ;; We failed to find an existing environment to install it in. + (eval `(define top-level (hash (quote ,name) ,func))) + (register-macro-transformer! name "top-level")) + ;; We failed to find an existing environment to install it in. + (eval `(set! top-level + (%proto-hash-insert% top-level (quote ,name) ,func))) + (register-macro-transformer! name "top-level")) + + ;; Does this work? + ; (eval `(define ,name ,func)) + 'void) + ;; + (eval `(set! ,(string->symbol env) + (%proto-hash-insert% ,(string->symbol env) (quote ,name) ,func))) + (register-macro-transformer! name env))) + 'void) diff --git a/crates/steel-core/src/scheme/modules/contracts.scm b/crates/steel-core/src/scheme/modules/contracts.scm index dacc1f296..26c35b029 100644 --- a/crates/steel-core/src/scheme/modules/contracts.scm +++ b/crates/steel-core/src/scheme/modules/contracts.scm @@ -58,7 +58,9 @@ ;; Given a list, splits off the last argument, returns as a pair (define (split-last lst) (define (loop accum lst) - (if (empty? (cdr lst)) (list (reverse accum) (car lst)) (loop (cons (car lst) accum) (cdr lst)))) + (if (empty? (cdr lst)) + (list (reverse accum) (car lst)) + (loop (cons (car lst) accum) (cdr lst)))) (loop '() lst)) ;;@doc @@ -81,7 +83,10 @@ ;; Call a contracted function (define (apply-contracted-function contracted-function arguments span) - (define span (if span span '(0 0 0))) + (define span + (if span + span + '(0 0 0))) (apply-function-contract (ContractedFunction-contract contracted-function) (ContractedFunction-name contracted-function) (ContractedFunction-function contracted-function) @@ -89,7 +94,10 @@ span)) (define (apply-contracted-function-one-arg contracted-function arg span) - (define span (if span span '(0 0 0))) + (define span + (if span + span + '(0 0 0))) (apply-function-contract-one-arg (ContractedFunction-contract contracted-function) (ContractedFunction-name contracted-function) (ContractedFunction-function contracted-function) @@ -97,7 +105,10 @@ span)) (define (apply-contracted-function-two-arg contracted-function arg arg2 span) - (define span (if span span '(0 0 0))) + (define span + (if span + span + '(0 0 0))) (apply-function-contract-two-arg (ContractedFunction-contract contracted-function) (ContractedFunction-name contracted-function) (ContractedFunction-function contracted-function) @@ -106,7 +117,10 @@ span)) (define (apply-contracted-function-three-arg contracted-function arg arg2 arg3 span) - (define span (if span span '(0 0 0))) + (define span + (if span + span + '(0 0 0))) (apply-function-contract-three-arg (ContractedFunction-contract contracted-function) (ContractedFunction-name contracted-function) (ContractedFunction-function contracted-function) @@ -333,40 +347,46 @@ (lambda () (apply-contracted-function contracted-function '() - (if (empty? span) (current-function-span) (car span))))] + (if (empty? span) + (current-function-span) + (car span))))] [(= 1 arity) (lambda (arg) - (apply-contracted-function-one-arg - contracted-function - arg - (if (empty? span) (current-function-span) (car span))))] + (apply-contracted-function-one-arg contracted-function + arg + (if (empty? span) + (current-function-span) + (car span))))] [(= 2 arity) (lambda (arg arg2) - (apply-contracted-function-two-arg - contracted-function - arg - arg2 - (if (empty? span) (current-function-span) (car span))))] + (apply-contracted-function-two-arg contracted-function + arg + arg2 + (if (empty? span) + (current-function-span) + (car span))))] [(= 3 arity) (lambda (arg arg2 arg3) - (apply-contracted-function-three-arg - contracted-function - arg - arg2 - arg3 - (if (empty? span) (current-function-span) (car span))))] + (apply-contracted-function-three-arg contracted-function + arg + arg2 + arg3 + (if (empty? span) + (current-function-span) + (car span))))] [else (lambda args - (apply-contracted-function - contracted-function - args - (if (empty? span) (current-function-span) (car span))))])]) + (apply-contracted-function contracted-function + args + (if (empty? span) + (current-function-span) + (car span))))])]) (attach-contract-struct! resulting-lambda-function (ContractedFunction-contract contracted-function)) resulting-lambda-function)))) @@ -450,7 +470,10 @@ [(FlatContract? x) (FlatContract-name x)] [(FunctionContract? x) (string->symbol (contract->string x))] [else - (let ([lookup (function-name x)]) (if (string? lookup) (string->symbol lookup) '#))])) + (let ([lookup (function-name x)]) + (if (string? lookup) + (string->symbol lookup) + '#))])) ;; Like listof, however requires that the list is non empty as well (define (non-empty-listof pred) diff --git a/crates/steel-core/src/scheme/modules/match.scm b/crates/steel-core/src/scheme/modules/match.scm index 96ef5d62b..52c539394 100644 --- a/crates/steel-core/src/scheme/modules/match.scm +++ b/crates/steel-core/src/scheme/modules/match.scm @@ -222,7 +222,8 @@ `(if (not (null? ,input)) ;; Save our spot in the recursion so we don't have to recompute a bunch ;; of stuff - (let ([,cdr-input-depth (cdr ,input)] [,car-input-depth (car ,input)]) + (let ([,cdr-input-depth (cdr ,input)] + [,car-input-depth (car ,input)]) ,(match-p-syntax-object (car pattern) car-input-depth @@ -339,7 +340,8 @@ `(if (not (null? ,input)) ;; Save our spot in the recursion so we don't have to recompute a bunch ;; of stuff - (let ([,car-input-depth (car ,input)] [,cdr-input-depth (cdr ,input)]) + (let ([,car-input-depth (car ,input)] + [,cdr-input-depth (cdr ,input)]) ,(match-p-syntax (car pattern) car-input-depth @@ -370,59 +372,59 @@ (match-p-syntax compile-pattern input final-body-expr 0 (hashset) #f 0 introduced-identifiers))) (defmacro (single-match-define expression) - (define unwrapped (syntax-e expression)) - (define variable (syntax->datum (second unwrapped))) - (define pattern (syntax->datum (third unwrapped))) - (define body (list-ref unwrapped 3)) - (define introduced-identifiers (mutable-vector)) - (define res (go-match pattern variable body introduced-identifiers)) - ;; I _think_ this drains the values from the vector into the list? - (define list-identifiers (reverse (mutable-vector->list introduced-identifiers))) - (define temp (gensym)) - (define final-expr - `(define-values (,@list-identifiers) - (let ([,temp ,(go-match pattern variable `(list ,@list-identifiers) (mutable-vector))]) - (if (not (equal? #f ,temp)) - ,temp - (error-with-span (quote ,(syntax-span (third unwrapped))) - "Unable to match the given expression: " - ,variable - "to any of the patterns"))))) - (syntax/loc final-expr - (syntax-span expression))) + (define unwrapped (syntax-e expression)) + (define variable (syntax->datum (second unwrapped))) + (define pattern (syntax->datum (third unwrapped))) + (define body (list-ref unwrapped 3)) + (define introduced-identifiers (mutable-vector)) + (define res (go-match pattern variable body introduced-identifiers)) + ;; I _think_ this drains the values from the vector into the list? + (define list-identifiers (reverse (mutable-vector->list introduced-identifiers))) + (define temp (gensym)) + (define final-expr + `(define-values (,@list-identifiers) + (let ([,temp ,(go-match pattern variable `(list ,@list-identifiers) (mutable-vector))]) + (if (not (equal? #f ,temp)) + ,temp + (error-with-span (quote ,(syntax-span (third unwrapped))) + "Unable to match the given expression: " + ,variable + "to any of the patterns"))))) + (syntax/loc final-expr + (syntax-span expression))) ;; Match a single pattern (defmacro (single-match expression) - (define unwrapped (syntax-e expression)) - ;; Unwrapping entirely, not what we want! We want to - ;; wrap it back up with the span of the original definition! - (define variable (syntax->datum (second unwrapped))) - (define pattern (syntax->datum (third unwrapped))) - (define body (list-ref unwrapped 3)) - ;; Keep track of all of the identifiers that this - ;; expression introduces - ;; TODO: Keep one top level around and clear each time. Then - ;; we won't keep around any garbage - (define introduced-identifiers (mutable-vector)) - (define res (go-match pattern variable body introduced-identifiers)) - (syntax/loc res - (syntax-span expression))) + (define unwrapped (syntax-e expression)) + ;; Unwrapping entirely, not what we want! We want to + ;; wrap it back up with the span of the original definition! + (define variable (syntax->datum (second unwrapped))) + (define pattern (syntax->datum (third unwrapped))) + (define body (list-ref unwrapped 3)) + ;; Keep track of all of the identifiers that this + ;; expression introduces + ;; TODO: Keep one top level around and clear each time. Then + ;; we won't keep around any garbage + (define introduced-identifiers (mutable-vector)) + (define res (go-match pattern variable body introduced-identifiers)) + (syntax/loc res + (syntax-span expression))) (defmacro (single-match-syntax expression) - (define unwrapped (syntax-e expression)) - ;; Unwrapping entirely, not what we want! We want to - ;; wrap it back up with the span of the original definition! - (define variable (syntax->datum (second unwrapped))) - (define pattern (syntax->datum (third unwrapped))) - (define body (list-ref unwrapped 3)) - ;; Keep track of all of the identifiers that this - ;; expression introduces - ;; TODO: Keep one top level around and clear each time. Then - ;; we won't keep around any garbage - (define introduced-identifiers (mutable-vector)) - (define res (go-match-syntax pattern variable body introduced-identifiers)) - (syntax/loc res - (syntax-span expression))) + (define unwrapped (syntax-e expression)) + ;; Unwrapping entirely, not what we want! We want to + ;; wrap it back up with the span of the original definition! + (define variable (syntax->datum (second unwrapped))) + (define pattern (syntax->datum (third unwrapped))) + (define body (list-ref unwrapped 3)) + ;; Keep track of all of the identifiers that this + ;; expression introduces + ;; TODO: Keep one top level around and clear each time. Then + ;; we won't keep around any garbage + (define introduced-identifiers (mutable-vector)) + (define res (go-match-syntax pattern variable body introduced-identifiers)) + (syntax/loc res + (syntax-span expression))) ;; ----------------- match! syntax -------------------- @@ -547,12 +549,8 @@ (define-syntax match-syntax (syntax-rules () - [(match-syntax expr - pat) - (let ([evald-expr expr]) (match-syntax-dispatch evald-expr pat))] - [(match-syntax expr - pat - pats ...) + [(match-syntax expr pat) (let ([evald-expr expr]) (match-syntax-dispatch evald-expr pat))] + [(match-syntax expr pat pats ...) (let ([evald-expr expr]) (match-syntax-dispatch evald-expr pat pats ...))])) ; (match (list 10 20 30 40 50) diff --git a/crates/steel-core/src/scheme/modules/parameters.scm b/crates/steel-core/src/scheme/modules/parameters.scm index 85d859a18..b9a0a3c56 100644 --- a/crates/steel-core/src/scheme/modules/parameters.scm +++ b/crates/steel-core/src/scheme/modules/parameters.scm @@ -7,10 +7,53 @@ ;;;;;; Parameters ;;;;; -(struct Parameter (getter value) - #:mutable - #:printer (lambda (obj printer-function) (simple-display "")) - #:prop:procedure 0) +; (struct Parameter (getter value) +; #:mutable +; #:printer (lambda (obj printer-function) (simple-display "")) +; #:prop:procedure 0) + +;; Bootstrapped parameters +(define ___Parameter-options___ + (hash (quote #:mutable) + #true + (quote #:name) + (quote Parameter) + (quote #:fields) + (quote (getter value)) + (quote #:prop:procedure) + 0 + (quote #:printer) + (λ (##obj2 ##printer-function2) (simple-display "")) + (quote #:transparent) + #false)) +(define Parameter (quote unintialized)) +(define struct:Parameter (quote uninitialized)) +(define Parameter? (quote uninitialized)) +(define Parameter-getter (quote uninitialized)) +(define Parameter-value (quote uninitialized)) +(define set-Parameter-getter! (quote unintialized)) +(define set-Parameter-value! (quote unintialized)) +(%plain-let + ((##prototypes2 (make-struct-type (quote Parameter) 2))) + (%plain-let ((##struct-type-descriptor3 (list-ref ##prototypes2 0)) + (##constructor-proto3 (list-ref ##prototypes2 1)) + (##predicate-proto3 (list-ref ##prototypes2 2)) + (##getter-proto3 (list-ref ##prototypes2 3)) + (##getter-proto-list3 (list-ref ##prototypes2 4))) + (begin + (set! struct:Parameter ##struct-type-descriptor3) + (#%vtable-update-entry! ##struct-type-descriptor3 0 ___Parameter-options___) + (set! Parameter + (λ (##getter4 ##value4) + (##constructor-proto3 (#%box ##getter4) (#%box ##value4)))) + (set! Parameter? ##predicate-proto3) + (set! Parameter-getter (λ (##this4) (#%unbox (##getter-proto3 ##this4 0)))) + (set! Parameter-value (λ (##this4) (#%unbox (##getter-proto3 ##this4 1)))) + (set! set-Parameter-getter! + (λ (##this4 ##value4) (#%set-box! (##getter-proto3 ##this4 0) ##value4))) + (set! set-Parameter-value! + (λ (##this4 ##value4) (#%set-box! (##getter-proto3 ##this4 1) ##value4))) + void))) (define (make-parameter value) (define param (Parameter 'uninitialized value)) @@ -34,7 +77,6 @@ body ...) (let ([old-value (var)]) - (dynamic-wind (lambda () (set-Parameter-value! var val)) (lambda () (parameterize (rest ...) @@ -130,11 +172,42 @@ ((car (car ls))) (set-tls! winders ls))))))) -(struct Continuation (func) - #:prop:procedure 0 - #:printer (lambda (obj printer) - - (simple-display "#"))) +; (struct Continuation (func) +; #:prop:procedure 0 +; #:printer (lambda (obj printer) (simple-display "#"))) + +;; Bootstrapped continuation +(define ___Continuation-options___ + (hash (quote #:printer) + (λ (##obj2 ##printer2) (simple-display "#")) + (quote #:name) + (quote Continuation) + (quote #:mutable) + #false + (quote #:fields) + (quote (func)) + (quote #:transparent) + #false + (quote #:prop:procedure) + 0)) +(define Continuation (quote unintialized)) +(define struct:Continuation (quote uninitialized)) +(define Continuation? (quote uninitialized)) +(define Continuation-func (quote uninitialized)) +(%plain-let + ((##prototypes2 (make-struct-type (quote Continuation) 1))) + (%plain-let ((##struct-type-descriptor3 (list-ref ##prototypes2 0)) + (##constructor-proto3 (list-ref ##prototypes2 1)) + (##predicate-proto3 (list-ref ##prototypes2 2)) + (##getter-proto3 (list-ref ##prototypes2 3)) + (##getter-proto-list3 (list-ref ##prototypes2 4))) + (begin + (set! struct:Continuation ##struct-type-descriptor3) + (#%vtable-update-entry! ##struct-type-descriptor3 0 ___Continuation-options___) + (set! Continuation ##constructor-proto3) + (set! Continuation? ##predicate-proto3) + (set! Continuation-func (list-ref ##getter-proto-list3 0)) + void))) (define call/cc (lambda (f) diff --git a/crates/steel-core/src/scheme/stdlib.scm b/crates/steel-core/src/scheme/stdlib.scm index 0328c7fb7..42f25e97f 100644 --- a/crates/steel-core/src/scheme/stdlib.scm +++ b/crates/steel-core/src/scheme/stdlib.scm @@ -71,6 +71,25 @@ ; ((_ (x . xs)) (cons (quasiquote x) (quasiquote xs))) ; ((_ x) (quote x)))) +(define (#%syntax-bindings) + (hash)) +(define (#%syntax-binding-kind) + (hash)) + +;; Note: The syntax-bindings and binding-kind will get updated in the kernel +(define-syntax syntax + (syntax-rules (#%syntax/raw) + + ;; HACK: This makes it so that quasisyntax is happy. + [(syntax (#%syntax/raw x ...)) + (#%expand-syntax-case (#%syntax/raw x ...) (#%syntax-bindings) (#%syntax-binding-kind))] + + ;; Don't quote things that are already quoted + [(syntax (quote x)) (#%expand-syntax-case (quote x) (#%syntax-bindings) (#%syntax-binding-kind))] + + ;; Otherwise, if its not quoted, just quote it + [(syntax x) (#%expand-syntax-case (quote x) (#%syntax-bindings) (#%syntax-binding-kind))])) + (define-syntax quasiquote (syntax-rules (unquote unquote-splicing #%unquote #%unquote-splicing #%quote) @@ -115,57 +134,65 @@ (define-syntax quasisyntax (syntax-rules (syntax unsyntax unsyntax-splicing #%unsyntax #%unsyntax-splicing #%internal-crunch) - [(quasisyntax ((syntax x) xs ...)) (cons (list 'syntax (quasisyntax x)) (quasisyntax (xs ...)))] - - [(quasisyntax (syntax x)) (list 'quote (quasisyntax x))] - - [(quasisyntax ((unsyntax x) xs ...)) - (cons (list 'unsyntax (quasisyntax x)) (quasisyntax (xs ...)))] - [(quasisyntax (unsyntax x)) (list 'unsyntax (quasisyntax x))] - - ; ((quasiquote ((#%unquote x) xs ...)) (cons x (quasiquote (xs ...)))) + [(quasisyntax #%internal-crunch ((syntax x) xs ...)) + (cons (list 'syntax (quasisyntax #%internal-crunch x)) (quasisyntax #%internal-crunch (xs ...)))] - [(quasisyntax ((#%unsyntax x) xs ...)) (cons x (quasisyntax (xs ...)))] - [(quasisyntax (#%unsyntax x)) x] + [(quasisyntax #%internal-crunch (syntax x)) (list 'quote (quasisyntax #%internal-crunch x))] - [(quasisyntax ((#%unsyntax-splicing x))) (append x '())] - [(quasisyntax ((#%unsyntax-splicing x) xs ...)) (append x (quasisyntax (xs ...)))] + [(quasisyntax #%internal-crunch ((unsyntax x) xs ...)) + (cons (list 'unsyntax (quasisyntax #%internal-crunch x)) + (quasisyntax #%internal-crunch (xs ...)))] + [(quasisyntax #%internal-crunch (unsyntax x)) (list 'unsyntax (quasisyntax #%internal-crunch x))] - ;; TODO: Do unquote-splicing as well, follow the same rules as unquote - [(quasisyntax ((unsyntax-splicing x))) - (append (list (list 'unsyntax-splicing (quasisyntax x))) '())] - [(quasisyntax ((unsyntax-splicing x) xs ...)) - (append (list (list 'unsyntax-splicing (quasisyntax x))) (quasisyntax (xs ...)))] + [(quasisyntax #%internal-crunch ((#%unsyntax x) xs ...)) + (#%syntax/raw (quote (xs ...)) + (cons x (syntax-e (quasisyntax #%internal-crunch (xs ...)))) + (#%syntax-span (xs ...)))] - [(quasisyntax #%internal-crunch ()) (list)] - ; (list - ; (#%syntax/raw - ; (quote x) + [(quasisyntax #%internal-crunch (#%unsyntax x)) x] - ; (cons (quasisyntax x) (quasisyntax #%internal-crunch (xs ...))) + [(quasisyntax #%internal-crunch ((#%unsyntax-splicing x))) + (#%syntax/raw (quote x) (append (syntax-e x) '()) (#%syntax-span x))] - ; (#%syntax-span x))) + [(quasisyntax #%internal-crunch ((#%unsyntax-splicing x) xs ...)) + (#%syntax/raw (quote (xs ...)) + (append (syntax-e x) (syntax-e (quasisyntax #%internal-crunch (xs ...)))) + (#%syntax-span (xs ...)))] + ;; TODO: Do unquote-splicing as well, follow the same rules as unquote + [(quasisyntax #%internal-crunch ((unsyntax-splicing x))) + (#%syntax/raw (quote '()) + (append (list (list 'unsyntax-splicing (quasisyntax #%internal-crunch x))) '()) + (#%syntax-span x))] + + [(quasisyntax #%internal-crunch ((unsyntax-splicing x) xs ...)) + (#%syntax/raw (quote xs ...) + (append (list (list 'unsyntax-splicing (quasisyntax #%internal-crunch x))) + (syntax-e (quasisyntax #%internal-crunch (xs ...)))) + (#%syntax-span (xs ...)))] + + [(quasisyntax #%internal-crunch ()) (#%syntax/raw '() '() '(0 0 0))] [(quasisyntax #%internal-crunch (x xs ...)) - ; (list - ; (#%syntax/raw - ; (quote x) - - (cons (quasisyntax x) (quasisyntax #%internal-crunch (xs ...)))] - - ; (#%syntax-span x))) - - [(quasisyntax (x xs ...)) - ; (list + ;; TODO: Wrap this up in a syntax/raw? (#%syntax/raw (quote (x xs ...)) - (cons (quasisyntax x) (quasisyntax #%internal-crunch (xs ...))) + (cons (quasisyntax #%internal-crunch x) + (syntax-e (quasisyntax #%internal-crunch (xs ...)))) (#%syntax-span (x xs ...)))] - ; ) - ; ((quasisyntax x) 'x))) + ;; Internal, we don't do anything special + [(quasisyntax #%internal-crunch x) + (if (empty? 'x) (#%syntax/raw '() '() (#%syntax-span x)) (#%syntax/raw 'x 'x (#%syntax-span x)))] - ; ((quasisyntax (quote ())) '()) - [(quasisyntax x) (if (empty? 'x) (list) (#%syntax/raw 'x 'x (#%syntax-span x)))])) + [(quasisyntax (x xs ...)) + (syntax (#%syntax/raw (quote (x xs ...)) + (cons (quasisyntax #%internal-crunch x) + (syntax-e (quasisyntax #%internal-crunch (xs ...)))) + (#%syntax-span (x xs ...))))] + + [(quasisyntax x) + (if (empty? 'x) + (#%syntax/raw '() '() (#%syntax-span x)) + (syntax (#%syntax/raw 'x 'x (#%syntax-span x))))])) (define-syntax or (syntax-rules () diff --git a/crates/steel-core/src/steel_vm/const_evaluation.rs b/crates/steel-core/src/steel_vm/const_evaluation.rs index ad3cfc3d3..bb465f4fe 100644 --- a/crates/steel-core/src/steel_vm/const_evaluation.rs +++ b/crates/steel-core/src/steel_vm/const_evaluation.rs @@ -684,7 +684,7 @@ impl<'a> ConsumingVisitor for ConstantEvaluator<'a> { if let ExprKind::LambdaFunction(l) = func_expr { if l.args.len() != args.len() && !l.rest { - println!("{}", l); + // println!("{}", l); let m = format!( "Anonymous function expected {} arguments, found {}", diff --git a/crates/steel-core/src/steel_vm/engine.rs b/crates/steel-core/src/steel_vm/engine.rs index 07ee941b9..eec5215bb 100644 --- a/crates/steel-core/src/steel_vm/engine.rs +++ b/crates/steel-core/src/steel_vm/engine.rs @@ -16,7 +16,10 @@ use crate::{ compiler::{ compiler::{Compiler, SerializableCompiler}, map::SymbolMap, - modules::{path_to_module_name, CompiledModule, MANGLER_PREFIX, PRELUDE_WITHOUT_BASE}, + modules::{ + intern_modules, path_to_module_name, CompiledModule, MANGLER_PREFIX, + PRELUDE_WITHOUT_BASE, + }, program::{ number_literal_to_steel, Executable, RawProgramWithSymbols, SerializableRawProgramWithSymbols, @@ -280,6 +283,12 @@ impl NonInteractiveProgramImage { bincode::serialize_into(&mut f, self).unwrap(); } + pub fn as_bytes(&self) -> Vec { + let mut out = Vec::new(); + bincode::serialize_into(&mut out, self).unwrap(); + out + } + pub fn from_bytes(bytes: &[u8]) -> Self { bincode::deserialize(&bytes).unwrap() } @@ -592,6 +601,8 @@ impl Engine { return Engine::new_kernel(sandbox); } + intern_modules(); + if matches!(option_env!("STEEL_BOOTSTRAP"), Some("false") | None) { let mut vm = Engine::new_kernel(sandbox); @@ -706,13 +717,22 @@ impl Engine { } // Execute from a statically linked non interactive program - pub fn execute_non_interactive_program_image( - program: NonInteractiveProgramImage, - ) -> Result<()> { - // This _has_ to match the as the creation of the program above + pub fn execute_non_interactive_program_image(program: &'static [u8]) -> Result<()> { + // This _has_ to match the as the creation of the program above. + // So, engine first, then non interactive program. let mut engine = Engine::new(); + let program = crate::steel_vm::engine::NonInteractiveProgramImage::from_bytes(program); + engine.sources = program.sources; + + // TODO: The constant map needs to be brought back as well. Install it here. + // it needs to get installed in the VM and the compiler. Lets just try that now. + let raw_program = SerializableRawProgramWithSymbols::into_raw_program(program.program); + + engine.virtual_machine.constant_map = raw_program.constant_map.clone(); + engine.virtual_machine.compiler.write().constant_map = raw_program.constant_map.clone(); + let results = engine.run_raw_program(raw_program); if let Err(e) = results { @@ -1566,6 +1586,29 @@ impl Engine { } } + pub fn expand_to_file + Into>>( + &mut self, + exprs: E, + path: PathBuf, + ) { + self.virtual_machine + .compiler + .write() + .fully_expand_to_file(exprs, Some(path)) + .unwrap(); + } + + pub fn load_from_expanded_file(&mut self, path: &str) { + let program = self + .virtual_machine + .compiler + .write() + .load_from_file(path) + .unwrap(); + + self.run_raw_program(program).unwrap(); + } + // TODO -> clean up this API a lot pub fn compile_and_run_raw_program_with_path + Into>>( &mut self, diff --git a/crates/steel-core/src/steel_vm/ffi.rs b/crates/steel-core/src/steel_vm/ffi.rs index 083369737..05575d801 100644 --- a/crates/steel-core/src/steel_vm/ffi.rs +++ b/crates/steel-core/src/steel_vm/ffi.rs @@ -1,3 +1,5 @@ +#![allow(non_local_definitions)] + use std::{ borrow::Cow, io::BufReader, @@ -1195,8 +1197,15 @@ impl FFIValue { } impl std::hash::Hash for FFIValue { - fn hash(&self, _state: &mut H) { - todo!() + fn hash(&self, state: &mut H) { + match self { + FFIValue::BoolV(b) => b.hash(state), + FFIValue::IntV(i) => i.hash(state), + FFIValue::Void => 0.hash(state), + FFIValue::StringV(s) => s.hash(state), + FFIValue::CharV { c } => c.hash(state), + _ => panic!("Cannot hash this value: {:?}", self), + } } } diff --git a/crates/steel-core/src/steel_vm/primitives.rs b/crates/steel-core/src/steel_vm/primitives.rs index 8aa56ebd1..e4e612803 100644 --- a/crates/steel-core/src/steel_vm/primitives.rs +++ b/crates/steel-core/src/steel_vm/primitives.rs @@ -6,7 +6,8 @@ use super::{ vm::{ get_test_mode, list_modules, set_test_mode, VmCore, CALL_CC_DEFINITION, CALL_WITH_EXCEPTION_HANDLER_DEFINITION, EVAL_DEFINITION, EVAL_FILE_DEFINITION, - EVAL_STRING_DEFINITION, EXPAND_SYNTAX_OBJECTS_DEFINITION, INSPECT_DEFINITION, + EVAL_STRING_DEFINITION, EXPAND_SYNTAX_CASE_DEFINITION, EXPAND_SYNTAX_OBJECTS_DEFINITION, + INSPECT_DEFINITION, MACRO_CASE_BINDINGS_DEFINITION, MATCH_SYNTAX_CASE_DEFINITION, }, }; use crate::{ @@ -19,6 +20,7 @@ use crate::{ primitives::{ bytevectors::bytevector_module, fs_module, fs_module_sandbox, + git::git_module, hashmaps::{hashmap_module, HM_CONSTRUCT, HM_GET, HM_INSERT}, hashsets::hashset_module, http::http_module, @@ -268,7 +270,6 @@ define_modules! { STEEL_OPTION_MODULE => build_option_structs, STEEL_THREADING_MODULE => threading_module, STEEL_TIME_MODULE => time_module, - STEEL_FFI_MODULE => ffi_module, STEEL_MUTABLE_VECTOR_MODULE => mutable_vector_module, STEEL_PRIVATE_READER_MODULE => reader_module, STEEL_TCP_MODULE => tcp_module, @@ -276,8 +277,14 @@ define_modules! { STEEL_HTTP_MODULE => http_module, STEEL_PRELUDE_MODULE => prelude, STEEL_SB_PRELUDE => sandboxed_prelude, + + STEEL_GIT_MODULE => git_module, } +#[cfg(all(feature = "dylibs", feature = "sync"))] +pub static STEEL_FFI_MODULE: once_cell::sync::Lazy = + once_cell::sync::Lazy::new(ffi_module); + thread_local! { pub static MAP_MODULE: BuiltInModule = hashmap_module(); pub static SET_MODULE: BuiltInModule = hashset_module(); @@ -329,6 +336,8 @@ thread_local! { pub static MUTABLE_VECTOR_MODULE: BuiltInModule = mutable_vector_module(); pub static PRIVATE_READER_MODULE: BuiltInModule = reader_module(); + + pub static GIT_MODULE: BuiltInModule = git_module(); } pub fn prelude() -> BuiltInModule { @@ -498,6 +507,8 @@ pub fn register_builtin_modules(engine: &mut Engine, sandbox: bool) { engine.register_value("error", ControlOperations::error()); + engine.register_value("#%error", ControlOperations::error()); + engine.register_value( "%memo-table", WeakMemoizationTable::new().into_steelval().unwrap(), @@ -537,6 +548,8 @@ pub fn register_builtin_modules(engine: &mut Engine, sandbox: bool) { .register_module(STEEL_THREADING_MODULE.clone()) .register_module(STEEL_BYTEVECTOR_MODULE.clone()); + engine.register_module(STEEL_GIT_MODULE.clone()); + if !sandbox { engine .register_module(STEEL_TCP_MODULE.clone()) @@ -590,6 +603,8 @@ pub fn register_builtin_modules(engine: &mut Engine, sandbox: bool) { .register_module(THREADING_MODULE.with(|x| x.clone())) .register_module(BYTEVECTOR_MODULE.with(|x| x.clone())); + engine.register_module(GIT_MODULE.with(|x| x.clone())); + if !sandbox { engine .register_module(TCP_MODULE.with(|x| x.clone())) @@ -1725,7 +1740,8 @@ pub fn black_box(_: &[SteelVal]) -> Result { #[steel_derive::function(name = "struct->list")] pub fn struct_to_list(value: &UserDefinedStruct) -> Result { if value.is_transparent() { - Ok(SteelVal::ListV((*value.fields).clone().into())) + // Ok(SteelVal::ListV((*value.fields).clone().into())) + Ok(SteelVal::ListV((*value.fields).iter().cloned().collect())) } else { Ok(SteelVal::BoolV(false)) } @@ -1776,10 +1792,16 @@ fn meta_module() -> BuiltInModule { .register_native_fn_definition(EVAL_DEFINITION) .register_native_fn_definition(EVAL_FILE_DEFINITION) .register_native_fn_definition(EXPAND_SYNTAX_OBJECTS_DEFINITION) + .register_native_fn_definition(MATCH_SYNTAX_CASE_DEFINITION) + .register_native_fn_definition(EXPAND_SYNTAX_CASE_DEFINITION) + .register_native_fn_definition(MACRO_CASE_BINDINGS_DEFINITION) .register_native_fn_definition(EVAL_STRING_DEFINITION) .register_native_fn_definition(CALL_WITH_EXCEPTION_HANDLER_DEFINITION) .register_value("breakpoint!", SteelVal::BuiltIn(super::vm::breakpoint)) .register_native_fn_definition(INSPECT_DEFINITION) + // TODO: Come back to this + .register_native_fn_definition(super::vm::EMIT_EXPANDED_FILE_DEFINITION) + .register_native_fn_definition(super::vm::LOAD_EXPANDED_FILE_DEFINITION) .register_value( "#%environment-length", SteelVal::BuiltIn(super::vm::environment_offset), @@ -1839,10 +1861,14 @@ fn meta_module() -> BuiltInModule { ) .register_value("get-contract-struct", SteelVal::FuncV(get_contract)) .register_fn("current-os!", || std::env::consts::OS) - .register_fn("#%build-dylib", || { - #[cfg(feature = "dylib-build")] - cargo_steel_lib::run().ok() - }) + .register_fn( + "#%build-dylib", + |_args: Vec, _env_vars: Vec<(String, String)>| { + #[cfg(feature = "dylib-build")] + cargo_steel_lib::run(_args, _env_vars).ok() + }, + ) + .register_fn("feature-dylib-build?", || cfg!(feature = "dylib-build")) .register_native_fn_definition(COMMAND_LINE_DEFINITION) .register_native_fn_definition(ERROR_OBJECT_MESSAGE_DEFINITION) .register_fn("steel-home-location", steel_home) @@ -1877,6 +1903,27 @@ fn json_module() -> BuiltInModule { module } +fn syntax_to_module_impl(ctx: &mut VmCore, args: &[SteelVal]) -> Result { + if let SteelVal::SyntaxObject(s) = &args[0] { + let span = s.syntax_loc(); + let source = span.source_id(); + + if let Some(source) = source { + let path = ctx.thread.sources.get_path(&source); + return path + .map(|x| x.to_str().unwrap().to_string()) + .into_steelval(); + } + } + + Ok(SteelVal::BoolV(false)) +} + +#[steel_derive::context(name = "syntax-originating-file", arity = "Exact(1)")] +fn syntax_to_module(ctx: &mut VmCore, args: &[SteelVal]) -> Option> { + Some(syntax_to_module_impl(ctx, args)) +} + fn syntax_module() -> BuiltInModule { let mut module = BuiltInModule::new("steel/syntax"); module @@ -1899,7 +1946,8 @@ fn syntax_module() -> BuiltInModule { println!("{}", e); } } - }); + }) + .register_native_fn_definition(SYNTAX_TO_MODULE_DEFINITION); module } diff --git a/crates/steel-core/src/steel_vm/vm.rs b/crates/steel-core/src/steel_vm/vm.rs index 203dbda94..72ceb6119 100644 --- a/crates/steel-core/src/steel_vm/vm.rs +++ b/crates/steel-core/src/steel_vm/vm.rs @@ -10,7 +10,9 @@ use crate::gc::shared::Shared; use crate::gc::shared::WeakShared; use crate::gc::shared::WeakSharedMut; use crate::gc::SharedMut; +use crate::parser::expander::BindingKind; use crate::parser::parser::Sources; +use crate::parser::replace_idents::expand_template; use crate::primitives::lists::car; use crate::primitives::lists::cdr; use crate::primitives::lists::cons; @@ -31,6 +33,7 @@ use crate::steel_vm::primitives::steel_unbox_mutable; use crate::steel_vm::primitives::THREADING_MODULE; use crate::values::closed::Heap; use crate::values::closed::MarkAndSweepContext; +use crate::values::functions::RootedInstructions; use crate::values::functions::SerializedLambda; use crate::values::structs::UserDefinedStruct; use crate::values::transducers::Reducer; @@ -59,6 +62,7 @@ use std::cell::UnsafeCell; use std::io::Read as _; use std::rc::Weak; use std::sync::atomic::AtomicBool; +use std::sync::mpsc::Sender; use std::sync::Arc; use std::sync::Mutex; use std::thread::JoinHandle; @@ -74,10 +78,12 @@ use crate::values::lists::List; use crossbeam::atomic::AtomicCell; #[cfg(feature = "profiling")] use log::{debug, log_enabled}; +use once_cell::sync::Lazy; use parking_lot::RwLock; use smallvec::SmallVec; #[cfg(feature = "profiling")] use std::time::Instant; +use steel_parser::interner::InternedString; use threads::ThreadHandle; use crate::rvals::{from_serializable_value, into_serializable_value, IntoSteelVal}; @@ -158,6 +164,12 @@ impl DehydratedStackTrace { // Transducer, // } +#[derive(Debug, Clone)] +pub struct StackFrameAttachments { + pub(crate) handler: Option, + weak_continuation_mark: Option, +} + // This should be the go to thing for handling basically everything we need // Then - do I want to always reference the last one, or just refer to the current one? // TODO: We'll need to add these functions to the GC as well @@ -165,8 +177,9 @@ impl DehydratedStackTrace { #[derive(Debug, Clone)] pub struct StackFrame { sp: usize, + // This _has_ to be a function - pub(crate) handler: Option>, + // pub(crate) handler: Option>, // This should get added to the GC as well #[cfg(not(feature = "unsafe-internals"))] pub(crate) function: Gc, @@ -177,13 +190,19 @@ pub struct StackFrame { ip: usize, - // TODO: This should just be... *const [DenseInstruction] - // Since Rc should always just be alive? - instructions: Shared<[DenseInstruction]>, + // // TODO: This should just be... *const [DenseInstruction] + // // Since Rc should always just be alive? + // instructions: Shared<[DenseInstruction]>, + + // // TODO: Delete this one! + // // continuation_mark: Option, + // weak_continuation_mark: Option, + instructions: RootedInstructions, // TODO: Delete this one! // continuation_mark: Option, - weak_continuation_mark: Option, + // weak_continuation_mark: Option, + pub(crate) attachments: Option>, } impl Eq for StackFrame {} @@ -191,7 +210,8 @@ impl Eq for StackFrame {} impl PartialEq for StackFrame { fn eq(&self, other: &Self) -> bool { self.sp == other.sp - && self.handler == other.handler + && self.attachments.as_ref().map(|x| &x.handler) + == other.attachments.as_ref().map(|x| &x.handler) && self.ip == other.ip && self.instructions == other.instructions && self.function == other.function @@ -215,12 +235,17 @@ fn check_sizes() { ); } +thread_local! { + static THE_EMPTY_INSTRUCTION_SET: Shared<[DenseInstruction]> = Shared::from([]); +} + impl StackFrame { pub fn new( stack_index: usize, function: Gc, ip: usize, - instructions: Shared<[DenseInstruction]>, + // instructions: Shared<[DenseInstruction]>, + instructions: RootedInstructions, ) -> Self { Self { sp: stack_index, @@ -230,21 +255,40 @@ impl StackFrame { function, ip, instructions, - handler: None, - - weak_continuation_mark: None, + // handler: None, + attachments: None, + // weak_continuation_mark: None, } } fn with_continuation_mark(mut self, continuation_mark: Continuation) -> Self { - self.weak_continuation_mark = Some(WeakContinuation::from_strong(&continuation_mark)); + // self.weak_continuation_mark = Some(WeakContinuation::from_strong(&continuation_mark)); + match &mut self.attachments { + Some(attachments) => { + attachments.weak_continuation_mark = + Some(WeakContinuation::from_strong(&continuation_mark)); + } + + None => { + self.attachments = Some(Box::new(StackFrameAttachments { + handler: None, + weak_continuation_mark: Some(WeakContinuation::from_strong(&continuation_mark)), + })) + } + } self } pub fn main() -> Self { let function = Gc::new(ByteCodeLambda::main(Vec::new())); - StackFrame::new(0, function, 0, Shared::from([])) + // StackFrame::new(0, function, 0, Shared::from([])) + StackFrame::new( + 0, + function, + 0, + RootedInstructions::new(THE_EMPTY_INSTRUCTION_SET.with(|x| x.clone())), + ) } #[inline(always)] @@ -262,11 +306,38 @@ impl StackFrame { #[inline(always)] pub fn set_continuation(&mut self, continuation: &Continuation) { - self.weak_continuation_mark = Some(WeakContinuation::from_strong(&continuation)); + // self.weak_continuation_mark = Some(WeakContinuation::from_strong(&continuation)); + + match &mut self.attachments { + Some(attachments) => { + attachments.weak_continuation_mark = + Some(WeakContinuation::from_strong(continuation)); + } + + None => { + self.attachments = Some(Box::new(StackFrameAttachments { + handler: None, + weak_continuation_mark: Some(WeakContinuation::from_strong(continuation)), + })) + } + } } pub fn with_handler(mut self, handler: SteelVal) -> Self { - self.handler = Some(Shared::new(handler)); + // self.handler = Some(Shared::new(handler)); + + match &mut self.attachments { + Some(attachments) => { + attachments.handler = Some(handler); + } + + None => { + self.attachments = Some(Box::new(StackFrameAttachments { + handler: Some(handler), + weak_continuation_mark: None, + })) + } + } self } } @@ -338,6 +409,8 @@ pub struct SteelThread { pub(crate) compiler: std::sync::Arc>, pub(crate) id: EngineId, + + pub(crate) safepoints_enabled: bool, } #[derive(Clone)] @@ -556,6 +629,10 @@ impl SteelThread { sources, compiler, id: EngineId::new(), + + // Only incur the cost of the actual safepoint behavior + // if multiple threads are enabled + safepoints_enabled: false, } } @@ -566,13 +643,17 @@ impl SteelThread { &mut self, mut finish: impl FnMut(&SteelThread) -> Result, ) -> Result { - if cfg!(feature = "sync") { + // TODO: + // Only need to actually enter the safepoint if another + // thread exists + + if cfg!(feature = "sync") && self.safepoints_enabled { self.synchronizer.ctx.store(Some(self as _)); } let res = finish(self); - if cfg!(feature = "sync") { + if cfg!(feature = "sync") && self.safepoints_enabled { // Just block here until we're out - this only applies if we're not the main thread and // not in garbage collection while self @@ -687,7 +768,8 @@ impl SteelThread { let spans = closure.body_exp().iter().map(|_| Span::default()).collect(); let mut vm_instance = VmCore::new_unchecked( - Shared::new([]), + // Shared::new([]), + RootedInstructions::new(THE_EMPTY_INSTRUCTION_SET.with(|x| x.clone())), constant_map, Shared::clone(&spans), self, @@ -737,7 +819,7 @@ impl SteelThread { } SteelVal::ContinuationFunction(c) => { let mut vm_instance = VmCore::new_unchecked( - Shared::new([]), + RootedInstructions::new(THE_EMPTY_INSTRUCTION_SET.with(|x| x.clone())), constant_map, Shared::new([]), self, @@ -751,7 +833,7 @@ impl SteelThread { let spans = closure.body_exp().iter().map(|_| Span::default()).collect(); let mut vm_instance = VmCore::new_unchecked( - Shared::new([]), + RootedInstructions::new(THE_EMPTY_INSTRUCTION_SET.with(|x| x.clone())), constant_map, Shared::clone(&spans), self, @@ -789,8 +871,21 @@ impl SteelThread { #[cfg(feature = "profiling")] let execution_time = Instant::now(); + // let mut vm_instance = VmCore::new( + // instructions, + // constant_map, + // Shared::clone(&spans), + // self, + // &spans, + // )?; + + let keep_alive = instructions.clone(); + + // TODO: Very important! Convert this back before we return + let raw_keep_alive = Shared::into_raw(keep_alive); + let mut vm_instance = VmCore::new( - instructions, + RootedInstructions::new(instructions), constant_map, Shared::clone(&spans), self, @@ -800,9 +895,11 @@ impl SteelThread { // This is our pseudo "dynamic unwind" // If we need to, we'll walk back on the stack and find any handlers to pop 'outer: loop { - let result = vm_instance - .vm() - .map_err(|error| error.with_stack_trace(vm_instance.snapshot_stack_trace())); + let result = vm_instance.vm().map_err(|mut error| { + error + .set_span_if_none(vm_instance.current_span()) + .with_stack_trace(vm_instance.snapshot_stack_trace()) + }); if let Err(e) = result { while let Some(mut last) = vm_instance.thread.stack_frames.pop() { @@ -815,16 +912,24 @@ impl SteelThread { // Drop the pop count along with everything else we're doing vm_instance.pop_count -= 1; - if last.weak_continuation_mark.is_some() { - vm_instance.thread.stack.truncate(last.sp); + if last + .attachments + .as_mut() + .and_then(|mut x| x.weak_continuation_mark.take()) + .is_some() + { + vm_instance.thread.stack.truncate(last.sp as _); vm_instance.ip = last.ip; vm_instance.sp = vm_instance.get_last_stack_frame_sp(); - vm_instance.instructions = Shared::clone(&last.instructions); + // vm_instance.instructions = Rc::clone(&last.instructions); + vm_instance.instructions = last.instructions.clone(); vm_instance.close_continuation_marks(&last); } - if let Some(handler) = last.handler { + if let Some(handler) = + last.attachments.as_mut().and_then(|mut x| x.handler.take()) + { // Drop the stack BACK to where it was on this level vm_instance.thread.stack.truncate(last.sp); vm_instance.thread.stack.push(e.into_steelval()?); @@ -832,7 +937,7 @@ impl SteelThread { // If we're at the top level, we need to handle this _slightly_ differently // if vm_instance.stack_frames.is_empty() { // Somehow update the main instruction group to _just_ be the new group - match handler.as_ref() { + match handler { SteelVal::Closure(closure) => { if vm_instance.thread.stack_frames.is_empty() { vm_instance.sp = last.sp; @@ -842,14 +947,20 @@ impl SteelThread { last.sp, Gc::clone(&closure), 0, - Shared::from([]), + RootedInstructions::new( + THE_EMPTY_INSTRUCTION_SET.with(|x| x.clone()), + ), )); } vm_instance.sp = last.sp; vm_instance.instructions = closure.body_exp(); - last.handler = None; + if let Some(attachments) = &mut last.attachments { + attachments.handler = None; + } else { + panic!("This shouldn't happen") + } #[cfg(not(feature = "unsafe-internals"))] { @@ -875,6 +986,8 @@ impl SteelThread { self.stack.clear(); // self.current_frame = StackFrame::main(); + unsafe { Shared::from_raw(raw_keep_alive) }; + return Err(e); } else { for frame in &vm_instance.thread.stack_frames { @@ -888,6 +1001,8 @@ impl SteelThread { // dbg!(&self.stack_frames); + unsafe { Shared::from_raw(raw_keep_alive) }; + return result; } } @@ -899,7 +1014,8 @@ pub struct OpenContinuationMark { // Lazily capture the frames we need to? pub(crate) current_frame: StackFrame, pub(crate) stack_frame_offset: usize, - instructions: Shared<[DenseInstruction]>, + // instructions: Shared<[DenseInstruction]>, + instructions: RootedInstructions, // Captured at creation, everything on the stack // from the current frame @@ -934,7 +1050,8 @@ impl ContinuationMark { continuation.ip = open.ip; continuation.sp = open.sp; continuation.pop_count = open.pop_count; - continuation.instructions = Shared::clone(&open.instructions); + // continuation.instructions = Shared::clone(&open.instructions); + continuation.instructions = open.instructions.clone(); continuation.current_frame = open.current_frame.clone(); @@ -976,11 +1093,17 @@ impl ContinuationMark { impl Continuation { #[inline(always)] pub fn close_marks(ctx: &VmCore<'_>, stack_frame: &StackFrame) -> bool { - if let Some(cont_mark) = stack_frame - .weak_continuation_mark - .as_ref() - .and_then(|x| WeakShared::upgrade(&x.inner)) - { + // if let Some(cont_mark) = stack_frame + // .weak_continuation_mark + // .as_ref() + // .and_then(|x| WeakShared::upgrade(&x.inner)) + // { + + if let Some(cont_mark) = stack_frame.attachments.as_ref().and_then(|x| { + x.weak_continuation_mark + .as_ref() + .and_then(|x| WeakShared::upgrade(&x.inner)) + }) { cont_mark.write().close(ctx); return true; @@ -1000,11 +1123,17 @@ impl Continuation { while let Some(stack_frame) = ctx.thread.stack_frames.pop() { ctx.pop_count -= 1; - if let Some(mark) = &stack_frame - .weak_continuation_mark - .as_ref() - .and_then(|x| WeakShared::upgrade(&x.inner)) - { + // if let Some(mark) = &stack_frame + // .weak_continuation_mark + // .as_ref() + // .and_then(|x| WeakShared::upgrade(&x.inner)) + // { + + if let Some(mark) = &stack_frame.attachments.as_ref().and_then(|x| { + x.weak_continuation_mark + .as_ref() + .and_then(|x| WeakShared::upgrade(&x.inner)) + }) { if Shared::ptr_eq(&mark, &this.inner) { if weak_count == 1 && strong_count > 1 { if Self::close_marks(ctx, &stack_frame) { @@ -1024,7 +1153,9 @@ impl Continuation { ctx.sp = open.sp; ctx.ip = open.ip; - ctx.instructions = Shared::clone(&open.instructions); + // ctx.instructions = Shared::clone(&open.instructions); + + ctx.instructions = open.instructions.clone(); ctx.thread.stack.truncate(open.sp); @@ -1056,7 +1187,9 @@ impl Continuation { ctx.thread.stack.truncate(stack_frame.sp); ctx.ip = stack_frame.ip; ctx.sp = ctx.get_last_stack_frame_sp(); - ctx.instructions = Shared::clone(&stack_frame.instructions); + // ctx.instructions = Shared::clone(&stack_frame.instructions); + + ctx.instructions = stack_frame.instructions.clone(); if Self::close_marks(ctx, &stack_frame) { // println!("CLOSING MARKS WHEN SETTING STATE FROM CONTINUATION"); @@ -1114,7 +1247,8 @@ impl WeakContinuation { pub struct ClosedContinuation { pub(crate) stack: Vec, pub(crate) current_frame: StackFrame, - instructions: Shared<[DenseInstruction]>, + // instructions: Shared<[DenseInstruction]>, + instructions: RootedInstructions, pub(crate) stack_frames: Vec, ip: usize, sp: usize, @@ -1293,7 +1427,8 @@ impl<'a> VmContext for VmCore<'a> { // } pub struct VmCore<'a> { - pub(crate) instructions: Shared<[DenseInstruction]>, + // pub(crate) instructions: Shared<[DenseInstruction]>, + pub(crate) instructions: RootedInstructions, pub(crate) constants: ConstantMap, pub(crate) ip: usize, pub(crate) sp: usize, @@ -1307,7 +1442,8 @@ pub struct VmCore<'a> { // impl<'a> VmCore<'a> { fn new_unchecked( - instructions: Shared<[DenseInstruction]>, + // instructions: Shared<[DenseInstruction]>, + instructions: RootedInstructions, constants: ConstantMap, spans: Shared<[Span]>, thread: &'a mut SteelThread, @@ -1326,7 +1462,8 @@ impl<'a> VmCore<'a> { } fn new( - instructions: Shared<[DenseInstruction]>, + // instructions: Shared<[DenseInstruction]>, + instructions: RootedInstructions, constants: ConstantMap, spans: Shared<[Span]>, thread: &'a mut SteelThread, @@ -1491,7 +1628,7 @@ impl<'a> VmCore<'a> { fn new_closed_continuation_from_state(&self) -> ClosedContinuation { ClosedContinuation { stack: self.thread.stack.clone(), - instructions: Shared::clone(&self.instructions), + instructions: self.instructions.clone(), current_frame: self.thread.stack_frames.last().unwrap().clone(), stack_frames: self.thread.stack_frames.clone(), ip: self.ip, @@ -1513,7 +1650,7 @@ impl<'a> VmCore<'a> { fn new_oneshot_continuation_from_state(&mut self) -> ClosedContinuation { ClosedContinuation { stack: std::mem::take(&mut self.thread.stack), - instructions: Shared::clone(&self.instructions), + instructions: self.instructions.clone(), current_frame: self.thread.current_frame.clone(), stack_frames: std::mem::take(&mut self.thread.stack_frames), ip: self.ip, @@ -1560,27 +1697,41 @@ impl<'a> VmCore<'a> { let mut marks_still_open = fxhash::FxHashSet::default(); for frame in &continuation.stack_frames { - if let Some(cont_mark) = frame - .weak_continuation_mark - .as_ref() - .and_then(|x| WeakShared::upgrade(&x.inner)) - { + // if let Some(cont_mark) = frame + // .weak_continuation_mark + // .as_ref() + // .and_then(|x| WeakShared::upgrade(&x.inner)) + // { + + if let Some(cont_mark) = frame.attachments.as_ref().and_then(|x| { + x.weak_continuation_mark + .as_ref() + .and_then(|x| WeakShared::upgrade(&x.inner)) + }) { marks_still_open.insert(Shared::as_ptr(&cont_mark) as usize); } } while let Some(frame) = self.thread.stack_frames.pop() { - if let Some(cont_mark) = frame - .weak_continuation_mark - .as_ref() - .and_then(|x| WeakShared::upgrade(&x.inner)) - { + // if let Some(cont_mark) = frame + // .weak_continuation_mark + // .as_ref() + // .and_then(|x| WeakShared::upgrade(&x.inner)) + // { + if let Some(cont_mark) = frame.attachments.as_ref().and_then(|x| { + x.weak_continuation_mark + .as_ref() + .and_then(|x| WeakShared::upgrade(&x.inner)) + }) { // Close frame if the new continuation doesn't have it if !marks_still_open.contains(&(Shared::as_ptr(&cont_mark) as usize)) { self.thread.stack.truncate(frame.sp); self.ip = frame.ip; self.sp = self.get_last_stack_frame_sp(); - self.instructions = Shared::clone(&frame.instructions); + // self.instructions = Shared::clone(&frame.instructions); + + self.instructions = frame.instructions.clone(); + self.close_continuation_marks(&frame); continue; } @@ -1604,7 +1755,8 @@ impl<'a> VmCore<'a> { // Reset state FULLY pub(crate) fn call_with_instructions_and_reset_state( &mut self, - closure: Shared<[DenseInstruction]>, + // closure: Shared<[DenseInstruction]>, + closure: RootedInstructions, ) -> Result { let old_ip = self.ip; let old_instructions = std::mem::replace(&mut self.instructions, closure); @@ -1636,16 +1788,27 @@ impl<'a> VmCore<'a> { // Drop the pop count along with everything else we're doing self.pop_count -= 1; - if last.weak_continuation_mark.is_some() { + // if last.weak_continuation_mark.is_some() { + + if last + .attachments + .as_mut() + .and_then(|mut x| x.weak_continuation_mark.take()) + .is_some() + { self.thread.stack.truncate(last.sp); self.ip = last.ip; self.sp = self.get_last_stack_frame_sp(); - self.instructions = Shared::clone(&last.instructions); + // self.instructions = Shared::clone(&last.instructions); + + self.instructions = last.instructions.clone(); self.close_continuation_marks(&last); } - if let Some(handler) = last.handler { + if let Some(handler) = + last.attachments.as_mut().and_then(|mut x| x.handler.take()) + { // Drop the stack BACK to where it was on this level self.thread.stack.truncate(last.sp); @@ -1654,7 +1817,7 @@ impl<'a> VmCore<'a> { // If we're at the top level, we need to handle this _slightly_ differently // if vm_instance.stack_frames.is_empty() { // Somehow update the main instruction group to _just_ be the new group - match handler.as_ref() { + match handler { SteelVal::Closure(closure) => { if self.thread.stack_frames.is_empty() { self.sp = last.sp; @@ -1664,14 +1827,16 @@ impl<'a> VmCore<'a> { last.sp, Gc::clone(&closure), 0, - Shared::from([]), + RootedInstructions::new( + THE_EMPTY_INSTRUCTION_SET.with(|x| x.clone()), + ), )); } self.sp = last.sp; self.instructions = closure.body_exp(); - last.handler = None; + // last.handler = None; #[cfg(not(feature = "unsafe-internals"))] { @@ -1929,7 +2094,7 @@ impl<'a> VmCore<'a> { prev_length, Gc::clone(closure), 0, - Shared::from([]), + RootedInstructions::new(THE_EMPTY_INSTRUCTION_SET.with(|x| x.clone())), // Rc::from([]), )); @@ -1951,9 +2116,9 @@ impl<'a> VmCore<'a> { closure: &Gc, arg: SteelVal, ) -> Result { - thread_local! { - static EMPTY_INSTRUCTIONS: Shared<[DenseInstruction]> = Shared::new([]); - } + // thread_local! { + // static EMPTY_INSTRUCTIONS: Shared<[DenseInstruction]> = Shared::new([]); + // } let prev_length = self.thread.stack.len(); @@ -1961,7 +2126,7 @@ impl<'a> VmCore<'a> { prev_length, Gc::clone(closure), 0, - EMPTY_INSTRUCTIONS.with(|x| x.clone()), + RootedInstructions::new(THE_EMPTY_INSTRUCTION_SET.with(|x| x.clone())), )); self.sp = prev_length; @@ -2684,7 +2849,7 @@ impl<'a> VmCore<'a> { payload_size, .. } => { - let current_arity = payload_size.to_usize(); + let mut current_arity = payload_size.to_usize(); // This is the number of (local) functions we need to pop to get back to the place we want to be at // let depth = self.instructions[self.ip + 1].payload_size.to_usize(); @@ -2710,10 +2875,46 @@ impl<'a> VmCore<'a> { self.ip = 0; - let closure_arity = last_stack_frame.function.arity(); + let mut closure_arity = last_stack_frame.function.arity(); + + // TODO: Adjust the stack for multiple arity functions + let is_multi_arity = last_stack_frame.function.is_multi_arity; + let original_arity = last_stack_frame.function.arity(); + let payload_size = current_arity; + // let new_arity = &mut closure_arity; + + // TODO: Reuse the original list allocation, if it exists. + if likely(!is_multi_arity) { + if unlikely(original_arity != payload_size) { + stop!(ArityMismatch => format!("function expected {} arguments, found {}", original_arity, payload_size); self.current_span()); + } + } else { + // println!( + // "multi closure function, multi arity, arity: {:?} - called with: {:?}", + // original_arity, payload_size + // ); + + if payload_size < original_arity - 1 { + stop!(ArityMismatch => format!("function expected at least {} arguments, found {}", original_arity, payload_size); self.current_span()); + } - if current_arity != closure_arity { - stop!(ArityMismatch => format!("tco: function expected {closure_arity} arguments, found {current_arity}"); self.current_span()); + // (define (test x . y)) + // (test 1 2 3 4 5) + // in this case, arity = 2 and payload size = 5 + // pop off the last 4, collect into a list + let amount_to_remove = 1 + payload_size - original_arity; + + let values = self + .thread + .stack + .drain(self.thread.stack.len() - amount_to_remove..) + .collect(); + + let list = SteelVal::ListV(values); + + self.thread.stack.push(list); + + current_arity = original_arity; } // HACK COME BACK TO THIS @@ -2905,21 +3106,22 @@ impl<'a> VmCore<'a> { self.current_span_for_index(self.ip) } + // TODO: Tail calls see to obfuscate the proper span information. + // These will need to be rewritten, somehow, assuming we have knowledge + // if the last function was called in tail position. fn enclosing_span(&self) -> Option { if self.thread.stack_frames.len() > 1 { let back_two = self.thread.stack_frames.len() - 2; if let [second, last] = &self.thread.stack_frames[self.thread.stack_frames.len() - 2..] { - // todo!(); - let id = second.function.id; let spans = self.thread.function_interner.spans.get(&second.function.id); spans .and_then(|x| { - if last.ip > 2 { - x.get(last.ip - 2) + if last.ip > 1 { + x.get(last.ip - 1) } else { None } @@ -2929,17 +3131,18 @@ impl<'a> VmCore<'a> { todo!() } } else { - self.thread + dbg!(self + .thread .stack_frames .last() .and_then(|frame| { - if frame.ip > 2 { - self.root_spans.get(frame.ip - 2) + if frame.ip > 1 { + self.root_spans.get(frame.ip - 1) } else { None } }) - .copied() + .copied()) } } @@ -3048,29 +3251,96 @@ impl<'a> VmCore<'a> { #[inline(always)] fn handle_call_global(&mut self, index: usize, payload_size: usize) -> Result<()> { - #[cfg(not(feature = "unsafe-internals"))] - { - let func = self.thread.global_env.repl_lookup_idx(index); - // TODO - handle this a bit more elegantly - // self.handle_function_call(func, payload_size, span) - self.handle_global_function_call(func, payload_size) - } - #[cfg(feature = "unsafe-internals")] - { - let func = self.thread.global_env.repl_lookup_idx(index); - // TODO - handle this a bit more elegantly - // self.handle_function_call(func, payload_size, span) - self.handle_global_function_call_by_reference(&func, payload_size) - } + // TODO: Lazily fetch the function. Avoid cloning where relevant. + // Boxed functions probably _should_ be rooted in the modules? + let func = self.thread.global_env.repl_lookup_idx(index); + self.handle_global_function_call(func, payload_size) + + // let stack_func = &self.thread.global_env.thread_local_bindings[index] as *const _; + + // let stack_func = &self.thread.global_env.repl_lookup_idx(idx); + + // use SteelVal::*; + + // match unsafe { &*stack_func } { + // Closure(closure) => { + // let closure = closure.clone(); + // self.handle_function_call_closure_jit(closure, payload_size) + // } + // FuncV(f) => { + // let f = *f; + // self.call_primitive_func(f, payload_size) + // } + // BoxedFunction(f) => self.call_boxed_func(f.func(), payload_size), + // MutFunc(f) => { + // let f = *f; + // self.call_primitive_mut_func(f, payload_size) + // } + // FutureFunc(f) => { + // let f = f.clone(); + // self.call_future_func(f, payload_size) + // } + // ContinuationFunction(cc) => { + // let cc = cc.clone(); + // self.call_continuation(cc) + // } + // BuiltIn(f) => { + // let f = *f; + // // self.ip -= 1; + // self.call_builtin_func(f, payload_size) + // } + // CustomStruct(s) => { + // let s = s.clone(); + // self.call_custom_struct(&s, payload_size) + // } + // other => { + // // Explicitly mark this as unlikely + // cold(); + // log::error!("{stack_func:?}"); + // log::error!("Stack: {:?}", self.thread.stack); + // stop!(BadSyntax => format!("Function application not a procedure or function type not supported: {}", other); self.current_span()); + // } + // } } #[inline(always)] fn handle_tail_call_global(&mut self, index: usize, payload_size: usize) -> Result<()> { - let func = self.thread.global_env.repl_lookup_idx(index); + let stack_func = self.thread.global_env.repl_lookup_idx(index); self.ip += 1; - self.handle_tail_call(func, payload_size) + self.handle_tail_call(stack_func, payload_size) + + // let stack_func = &self.thread.global_env.thread_local_bindings[index] as *const _; + + // use SteelVal::*; + + // match unsafe { &*stack_func } { + // FuncV(f) => self.call_primitive_func(*f, payload_size), + // MutFunc(f) => self.call_primitive_mut_func(*f, payload_size), + // BoxedFunction(f) => self.call_boxed_func(f.func(), payload_size), + // Closure(closure) => self.new_handle_tail_call_closure(closure.clone(), payload_size), + // BuiltIn(f) => self.call_builtin_func(*f, payload_size), + // CustomStruct(s) => self.call_custom_struct(&s, payload_size), + // ContinuationFunction(cc) => self.call_continuation(cc.clone()), + // stack_func => { + // // println!("{:?}", self.stack); + // // println!("{:?}", self.stack_index); + // // println!("Bad tail call"); + // // crate::core::instructions::pretty_print_dense_instructions(&self.instructions); + // stop!(BadSyntax => format!("TailCall - Application not a procedure or function type + // not supported: {stack_func}"); self.current_span()); + // } + // } } + // #[inline(always)] + // fn handle_tail_call_global(&mut self, index: usize, payload_size: usize) -> Result<()> { + // let func = self.thread.global_env.repl_lookup_idx(index); + // self.ip += 1; + + // // self.handle_tail_call(func, payload_size) + + // } + #[inline(always)] fn handle_push(&mut self, index: usize) -> Result<()> { let value = self.thread.global_env.repl_lookup_idx(index); @@ -3332,11 +3602,6 @@ impl<'a> VmCore<'a> { // TODO preallocate size let mut captures = Vec::with_capacity(ndefs); - // TODO: This shouldn't be the same size as the captures - // let mut heap_vars = Vec::with_capacity(ndefs.to_usize()); - - // let mut heap_vars = Vec::new(); - // TODO clean this up a bit // hold the spot for where we need to jump aftwards let forward_index = self.ip + forward_jump; @@ -3601,6 +3866,57 @@ impl<'a> VmCore<'a> { Ok(()) } + #[inline(always)] + fn adjust_stack_for_multi_arity_tco( + &mut self, + is_multi_arity: bool, + original_arity: usize, + payload_size: usize, + new_arity: &mut usize, + ) -> Result<()> { + if likely(!is_multi_arity) { + if unlikely(original_arity != payload_size) { + stop!(ArityMismatch => format!("function expected {} arguments, found {}", original_arity, payload_size); self.current_span()); + } + } else { + // println!( + // "multi closure function, multi arity, arity: {:?}", + // closure.arity() + // ); + + if payload_size < original_arity - 1 { + stop!(ArityMismatch => format!("function expected at least {} arguments, found {}", original_arity, payload_size); self.current_span()); + } + + // (define (test x . y)) + // (test 1 2 3 4 5) + // in this case, arity = 2 and payload size = 5 + // pop off the last 4, collect into a list + let amount_to_remove = 1 + payload_size - original_arity; + + let values = self + .thread + .stack + .drain(self.thread.stack.len() - amount_to_remove..) + .collect(); + // .split_off(self.thread.stack.len() - amount_to_remove); + + let list = SteelVal::ListV(values); + + self.thread.stack.push(list); + + *new_arity = original_arity; + + // println!("Stack after list conversion: {:?}", self.stack); + } + + // else if closure.arity() != payload_size { + // stop!(ArityMismatch => format!("function expected {} arguments, found {}", closure.arity(), payload_size); self.current_span()); + // } + + Ok(()) + } + #[inline(always)] fn adjust_stack_for_multi_arity( &mut self, @@ -3718,6 +4034,7 @@ impl<'a> VmCore<'a> { .enter_safepoint(|ctx| func(&ctx.stack[last_index..])) .map_err(|x| x.set_span_if_none(self.current_span()))?; + // TODO: Drain, and push onto another thread to drop? self.thread.stack.truncate(last_index); self.thread.stack.push(result); self.ip += 1; @@ -3805,6 +4122,7 @@ impl<'a> VmCore<'a> { let result = self .thread .enter_safepoint(move |ctx: &SteelThread| f(&ctx.stack[last_index..])) + // // TODO: Can we just apply this at the end? .map_err(|e| e.set_span_if_none(self.current_span()))?; // This is the old way... lets see if the below way improves the speed @@ -3915,7 +4233,8 @@ impl<'a> VmCore<'a> { prev_length, Gc::clone(closure), self.ip + 4, - Shared::clone(&self.instructions), + // Shared::clone(&self.instructions), + self.instructions.clone(), // Rc::clone(&self.spans), ), // .with_span(self.current_span()), ); @@ -4188,6 +4507,37 @@ impl<'a> VmCore<'a> { } } + #[inline(always)] + fn handle_global_function_call_by_ref( + &mut self, + stack_func: &SteelVal, + payload_size: usize, + ) -> Result<()> { + use SteelVal::*; + + match stack_func { + Closure(closure) => { + self.handle_function_call_closure_jit(closure.clone(), payload_size) + } + FuncV(f) => self.call_primitive_func(*f, payload_size), + BoxedFunction(f) => self.call_boxed_func(f.func(), payload_size), + MutFunc(f) => self.call_primitive_mut_func(*f, payload_size), + FutureFunc(f) => self.call_future_func(f.clone(), payload_size), + ContinuationFunction(cc) => self.call_continuation(cc.clone()), + BuiltIn(f) => { + // self.ip -= 1; + self.call_builtin_func(*f, payload_size) + } + CustomStruct(s) => self.call_custom_struct(&s, payload_size), + _ => { + // Explicitly mark this as unlikely + cold(); + log::error!("{stack_func:?}"); + log::error!("Stack: {:?}", self.thread.stack); + stop!(BadSyntax => format!("Function application not a procedure or function type not supported: {}", stack_func); self.current_span()); + } + } + } #[inline(always)] fn handle_non_instr_global_function_call( &mut self, @@ -4313,6 +4663,7 @@ impl<'a> VmCore<'a> { } } +// TODO: This is gonna cause issues assuming this was called in tail call. pub fn current_function_span(ctx: &mut VmCore, args: &[SteelVal]) -> Option> { if !args.is_empty() { builtin_stop!(ArityMismatch => format!("current-function-span requires no arguments, found {}", args.len())) @@ -4324,6 +4675,17 @@ pub fn current_function_span(ctx: &mut VmCore, args: &[SteelVal]) -> Option Option> { + if !args.is_empty() { + builtin_stop!(ArityMismatch => format!("current-function-span requires no arguments, found {}", args.len())) + } + + match ctx.enclosing_span() { + Some(s) => Some(Span::into_steelval(s)), + None => Some(Ok(SteelVal::Void)), + } +} + #[steel_derive::context(name = "inspect", arity = "Exact(1)")] pub fn inspect(ctx: &mut VmCore, args: &[SteelVal]) -> Option> { let guard = ctx.thread.sources.sources.lock().unwrap(); @@ -4509,7 +4871,8 @@ pub fn call_with_exception_handler( ctx.sp, Gc::clone(&closure), ctx.ip + 1, - Shared::clone(&ctx.instructions), + // Shared::clone(&ctx.instructions), + ctx.instructions.clone(), ) .with_handler(handler), ); @@ -4584,7 +4947,8 @@ pub fn call_cc(ctx: &mut VmCore, args: &[SteelVal]) -> Option> ctx.sp, Gc::clone(&closure), ctx.ip + 1, - Shared::clone(&ctx.instructions), + // Shared::clone(&ctx.instructions), + ctx.instructions.clone(), ) .with_continuation_mark(continuation.clone()), ); @@ -4612,6 +4976,11 @@ pub fn call_cc(ctx: &mut VmCore, args: &[SteelVal]) -> Option> fn eval_impl(ctx: &mut crate::steel_vm::vm::VmCore, args: &[SteelVal]) -> Result { let expr = crate::parser::ast::TryFromSteelValVisitorForExprKind::root(&args[0])?; + // TODO: Looks like this isn't correctly parsing / pushing down macros! + // This needs to extract macros + + // println!("EVAL => {}", expr.to_pretty(60)); + let res = ctx .thread .compiler @@ -4732,6 +5101,21 @@ fn eval_program(program: crate::compiler::program::Executable, ctx: &mut VmCore) Ok(()) } +#[steel_derive::function(name = "emit-expanded", arity = "Exact(1)")] +fn emit_expanded_file(path: String) { + let mut engine = crate::steel_vm::engine::Engine::new(); + + let mut contents = std::fs::read_to_string(&path).unwrap(); + + engine.expand_to_file(contents, std::path::PathBuf::from(path)) +} + +#[steel_derive::function(name = "load-expanded", arity = "Exact(1)")] +fn load_expanded_file(path: String) { + let mut engine = crate::steel_vm::engine::Engine::new(); + engine.load_from_expanded_file(&path) +} + #[steel_derive::context(name = "eval", arity = "Exact(1)")] fn eval(ctx: &mut crate::steel_vm::vm::VmCore, args: &[SteelVal]) -> Option> { match eval_impl(ctx, args) { @@ -4872,6 +5256,140 @@ pub(crate) fn environment_offset(ctx: &mut VmCore, args: &[SteelVal]) -> Option< Some(Ok(ctx.thread.global_env.len().into_steelval().unwrap())) } +// Should really change this to be: +// Snag values, then expand them, then convert back? The constant conversion +// back and forth will probably hamper performance significantly. That being said, +// it is entirely at compile time, so probably _okay_ +pub(crate) fn expand_syntax_case_impl(ctx: &mut VmCore, args: &[SteelVal]) -> Result { + if args.len() != 3 { + stop!(ArityMismatch => format!("#%expand-template expected 3 arguments, found: {}", args.len())) + } + + let mut bindings: fxhash::FxHashMap<_, _> = if let SteelVal::HashMapV(h) = &args[1] { + h.iter() + .map(|(k, v)| match (k, v) { + (SteelVal::SymbolV(k), e) => Ok(( + InternedString::from_str(k.as_str()), + crate::parser::ast::TryFromSteelValVisitorForExprKind::root(v)?, + )), + _ => stop!(TypeMismatch => "#%expand-template error"), + }) + .collect::>()? + } else { + stop!(TypeMismatch => "#%expand-template expected a map of bindings") + }; + + let mut binding_kind: fxhash::FxHashMap<_, _> = if let SteelVal::HashMapV(h) = &args[2] { + h.iter() + .map(|(k, v)| match (k, v) { + (SteelVal::SymbolV(k), e) => Ok(( + InternedString::from_str(k.as_str()), + if usize::from_steelval(e)? == 1 { + BindingKind::Many + } else { + BindingKind::Single + }, + )), + _ => stop!(TypeMismatch => "#%expand-template error"), + }) + .collect::>()? + } else { + stop!(TypeMismatch => "#%expand-template expected a map of bindings") + }; + + if bindings.is_empty() && binding_kind.is_empty() { + return Ok(args[0].clone()); + } + + let mut template = crate::parser::ast::TryFromSteelValVisitorForExprKind::root(&args[0])?; + + expand_template(&mut template, &mut bindings, &mut binding_kind); + + crate::parser::tryfrom_visitor::SyntaxObjectFromExprKind::try_from_expr_kind(template) +} + +#[steel_derive::context(name = "#%expand-syntax-case", arity = "Exact(3)")] +pub(crate) fn expand_syntax_case(ctx: &mut VmCore, args: &[SteelVal]) -> Option> { + Some(expand_syntax_case_impl(ctx, args)) +} + +pub(crate) fn match_syntax_case_impl(ctx: &mut VmCore, args: &[SteelVal]) -> Result { + let macro_name: InternedString = String::from_steelval(&args[0])?.into(); + let guard = ctx.thread.compiler.read(); + let macro_object = guard.macro_env.get(¯o_name).ok_or_else( + throw!(Generic => format!("unable to find macro: {}", ¯o_name); ctx.current_span()), + )?; + let expr = crate::parser::ast::TryFromSteelValVisitorForExprKind::root(&args[1])?; + + let list = expr.list().unwrap(); + + let (case, index) = macro_object.match_case_index(list)?; + + let (bindings, binding_kind) = case.gather_bindings(list.clone())?; + + let map = bindings + .into_iter() + .map(|(k, v)| { + ( + SteelVal::SymbolV(k.resolve().trim_start_matches("##").into()), + crate::parser::tryfrom_visitor::SyntaxObjectFromExprKind::try_from_expr_kind(v) + .unwrap(), + ) + }) + .collect::>(); + + let kind = binding_kind + .into_iter() + .map(|(k, v)| { + ( + SteelVal::SymbolV(k.resolve().trim_start_matches("##").into()), + match v { + crate::parser::expander::BindingKind::Single => 0.into_steelval().unwrap(), + crate::parser::expander::BindingKind::Many => 1.into_steelval().unwrap(), + }, + ) + }) + .collect::>(); + + Ok(crate::list![ + // The index of the case that matched + index.into_steelval()?, + SteelVal::HashMapV(Gc::new(map).into()), + SteelVal::HashMapV(Gc::new(kind).into()) + ]) +} + +fn macro_case_bindings_impl(ctx: &mut VmCore, args: &[SteelVal]) -> Result { + let macro_name = String::from_steelval(&args[0])?.into(); + let guard = ctx.thread.compiler.read(); + let macro_object = guard.macro_env.get(¯o_name).unwrap(); + + Ok(SteelVal::ListV( + macro_object + .cases + .iter() + .map(|x| { + SteelVal::ListV( + x.all_bindings() + .into_iter() + .map(|x| SteelVal::SymbolV(x.trim_start_matches("##").into())) + .collect(), + ) + }) + .collect(), + )) +} + +#[steel_derive::context(name = "#%macro-case-bindings", arity = "Exact(2)")] +pub(crate) fn macro_case_bindings(ctx: &mut VmCore, args: &[SteelVal]) -> Option> { + Some(macro_case_bindings_impl(ctx, args)) +} + +#[steel_derive::context(name = "#%match-syntax-case", arity = "Exact(2)")] +pub(crate) fn match_syntax_case(ctx: &mut VmCore, args: &[SteelVal]) -> Option> { + Some(match_syntax_case_impl(ctx, args)) +} + /// Applies the given `function` with arguments as the contents of the `list`. /// /// (apply function lst) -> any? @@ -6586,7 +7104,7 @@ mod handlers { #[inline(always)] fn tco_jump_handler(ctx: &mut VmCore<'_>) -> Result<()> { - // println!("At tco jump"); + // TODO: Handle multiple arity for TCO let payload_size = ctx.instructions[ctx.ip].payload_size; diff --git a/crates/steel-core/src/steel_vm/vm/threads.rs b/crates/steel-core/src/steel_vm/vm/threads.rs index 84823f76c..b48210b96 100644 --- a/crates/steel-core/src/steel_vm/vm/threads.rs +++ b/crates/steel-core/src/steel_vm/vm/threads.rs @@ -431,6 +431,8 @@ fn spawn_thread_result(ctx: &mut VmCore, args: &[SteelVal]) -> Result .map(|x| from_serializable_value(&mut serializer, x)) .collect() )), + // TODO: + // thread_local_bindings: Vec::new(), } ); @@ -523,6 +525,7 @@ fn spawn_thread_result(ctx: &mut VmCore, args: &[SteelVal]) -> Result // TODO: Fix this compiler: todo!(), id: EngineId::new(), + safepoints_enabled: false, }; #[cfg(feature = "profiling")] @@ -768,6 +771,9 @@ pub(crate) fn spawn_native_thread(ctx: &mut VmCore, args: &[SteelVal]) -> Option #[cfg(feature = "sync")] #[steel_derive::context(name = "spawn-native-thread", arity = "Exact(1)")] pub(crate) fn spawn_native_thread(ctx: &mut VmCore, args: &[SteelVal]) -> Option> { + // We are now in a world in which we have to support safe points + ctx.thread.safepoints_enabled = true; + let thread_time = std::time::Instant::now(); let mut thread = ctx.thread.clone(); let interrupt = Arc::new(AtomicBool::new(false)); diff --git a/crates/steel-core/src/tests/mod.rs b/crates/steel-core/src/tests/mod.rs index a51e16e94..c67b5c15c 100644 --- a/crates/steel-core/src/tests/mod.rs +++ b/crates/steel-core/src/tests/mod.rs @@ -137,6 +137,7 @@ test_harness_success! { string_append, structs, // TODO: @Matt 11/11/2023 + syntax_case, threads, transducer_over_streams, tree_traversal, diff --git a/crates/steel-core/src/tests/success/syntax_case.scm b/crates/steel-core/src/tests/success/syntax_case.scm new file mode 100644 index 000000000..77df0f4d8 --- /dev/null +++ b/crates/steel-core/src/tests/success/syntax_case.scm @@ -0,0 +1,19 @@ +(define-syntax (hello stx) + (define foo #'10) + (define bar #'20) + (syntax-case stx () + [(_ name place) + (begin + (when (identifier? #'name) + (displayln "Found identifier for name:" #'name)) + (when (identifier? #'place) + (displayln "Found identifier for place:" #'place)) + (with-syntax ([baz #'10]) + #`(list name place #,foo #,bar baz)))])) + +(assert! (equal? (hello 500 1000) '(500 1000 10 20 10))) + +(define test #`(40 50 60)) +(define res #`(list 10 20 30 #,@test)) + +(assert! (equal? (map syntax-e (syntax-e res)) '(list 10 20 30 40 50 60))) diff --git a/crates/steel-core/src/values/closed.rs b/crates/steel-core/src/values/closed.rs index a3bee33e0..f254834c2 100644 --- a/crates/steel-core/src/values/closed.rs +++ b/crates/steel-core/src/values/closed.rs @@ -261,8 +261,14 @@ impl<'a> BreadthFirstSearchSteelValVisitor for GlobalSlotRecycler { self.push_back(value.clone()); } - if let Some(handler) = &frame.handler { - self.push_back((*handler.as_ref()).clone()); + // if let Some(handler) = &frame.handler { + // self.push_back((*handler.as_ref()).clone()); + // } + + if let Some(handler) = + frame.attachments.as_ref().and_then(|x| x.handler.clone()) + { + self.push_back(handler); } } } @@ -1161,8 +1167,14 @@ impl<'a> BreadthFirstSearchSteelValVisitor for MarkAndSweepContext<'a> { self.push_back(value.clone()); } - if let Some(handler) = &frame.handler { - self.push_back((*handler.as_ref()).clone()); + // if let Some(handler) = &frame.handler { + // self.push_back((*handler.as_ref()).clone()); + // } + + if let Some(handler) = + frame.attachments.as_ref().and_then(|x| x.handler.clone()) + { + self.push_back(handler); } } } diff --git a/crates/steel-core/src/values/functions.rs b/crates/steel-core/src/values/functions.rs index 96e27dc10..c1cd36448 100644 --- a/crates/steel-core/src/values/functions.rs +++ b/crates/steel-core/src/values/functions.rs @@ -155,9 +155,49 @@ pub struct SerializedLambdaPrototype { pub body_exp: Vec, pub arity: usize, pub is_multi_arity: bool, - // TODO: Go ahead and create a ThreadSafeSteelVal where we will just deep clone everything, move - // it across the thread, and reconstruct on the other side. - // pub captures: Vec, +} + +#[derive(Clone, PartialEq, Eq)] +pub struct RootedInstructions { + #[cfg(feature = "rooted-instructions")] + inner: *const [DenseInstruction], + #[cfg(not(feature = "rooted-instructions"))] + inner: Shared<[DenseInstruction]>, +} + +// TODO: Come back to this +unsafe impl Send for RootedInstructions {} +unsafe impl Sync for RootedInstructions {} + +impl RootedInstructions { + pub fn new(instructions: Shared<[DenseInstruction]>) -> Self { + Self { + #[cfg(feature = "rooted-instructions")] + inner: Shared::as_ptr(&instructions), + #[cfg(not(feature = "rooted-instructions"))] + inner: instructions, + } + } +} + +impl std::fmt::Debug for RootedInstructions { + fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + write!(f, "{:?}", self.inner) + } +} + +impl std::ops::Deref for RootedInstructions { + type Target = [DenseInstruction]; + + fn deref(&self) -> &Self::Target { + #[cfg(feature = "rooted-instructions")] + unsafe { + &(*self.inner) + } + + #[cfg(not(feature = "rooted-instructions"))] + &self.inner + } } // TODO @@ -240,12 +280,22 @@ impl ByteCodeLambda { // self.heap_allocated = RefCell::new(heap_allocated); // } - pub fn body_exp(&self) -> Shared<[DenseInstruction]> { - #[cfg(feature = "dynamic")] - return Shared::clone(&self.body_exp.borrow()); + pub fn body_exp(&self) -> RootedInstructions { + // #[cfg(feature = "dynamic")] + // return Shared::clone(&self.body_exp.borrow()); - #[cfg(not(feature = "dynamic"))] - Shared::clone(&self.body_exp) + // #[cfg(not(feature = "dynamic"))] + // Shared::clone(&self.body_exp) + + #[cfg(not(feature = "rooted-instructions"))] + return RootedInstructions { + inner: Shared::clone(&self.body_exp), + }; + + #[cfg(feature = "rooted-instructions")] + return RootedInstructions { + inner: Shared::as_ptr(&self.body_exp), + }; } pub fn body_mut_exp(&mut self) -> Shared<[DenseInstruction]> { diff --git a/crates/steel-core/src/values/lists.rs b/crates/steel-core/src/values/lists.rs index a2eb98762..cad4015d9 100644 --- a/crates/steel-core/src/values/lists.rs +++ b/crates/steel-core/src/values/lists.rs @@ -1,6 +1,9 @@ use std::cell::Cell; -use im_lists::handler::{DefaultDropHandler, DropHandler}; +use im_lists::{ + handler::{DefaultDropHandler, DropHandler}, + shared::PointerFamily, +}; use crate::{ gc::Gc, @@ -51,6 +54,44 @@ thread_local! { pub static DEPTH: Cell = Cell::new(0); } +pub struct GcPointerType; + +impl PointerFamily for GcPointerType { + type Pointer = Gc; + + fn new(value: T) -> Self::Pointer { + Gc::new(value) + } + + fn strong_count(this: &Self::Pointer) -> usize { + Gc::strong_count(this) + } + + fn try_unwrap(this: Self::Pointer) -> Option { + Gc::try_unwrap(this).ok() + } + + fn get_mut(this: &mut Self::Pointer) -> Option<&mut T> { + Gc::get_mut(this) + } + + fn ptr_eq(this: &Self::Pointer, other: &Self::Pointer) -> bool { + Gc::ptr_eq(this, other) + } + + fn make_mut(ptr: &mut Self::Pointer) -> &mut T { + Gc::make_mut(ptr) + } + + fn clone(ptr: &Self::Pointer) -> Self::Pointer { + Gc::clone(ptr) + } + + fn as_ptr(this: &Self::Pointer) -> *const T { + Gc::as_ptr(this) + } +} + #[cfg(not(feature = "without-drop-protection"))] mod list_drop_handler { @@ -160,11 +201,13 @@ mod list_drop_handler { } } -#[cfg(not(feature = "sync"))] -type PointerType = im_lists::shared::RcPointer; +// #[cfg(not(feature = "sync"))] +// type PointerType = im_lists::shared::RcPointer; + +// #[cfg(feature = "sync")] +// type PointerType = im_lists::shared::ArcPointer; -#[cfg(feature = "sync")] -type PointerType = im_lists::shared::ArcPointer; +type PointerType = GcPointerType; pub type SteelList = im_lists::list::GenericList; diff --git a/crates/steel-core/src/values/port.rs b/crates/steel-core/src/values/port.rs index 9a9ab282e..48f881d6a 100644 --- a/crates/steel-core/src/values/port.rs +++ b/crates/steel-core/src/values/port.rs @@ -399,6 +399,15 @@ impl SteelPortRepr { } } + pub fn close_input_port(&mut self) -> Result<()> { + if self.is_input() { + *self = SteelPortRepr::Closed; + Ok(()) + } else { + stop!(TypeMismatch => "close-input-port expects an input port, found: {:?}", self) + } + } + pub fn write(&mut self, buf: &[u8]) -> Result { macro_rules! write_and_flush( ($br: expr) => {{ @@ -592,6 +601,10 @@ impl SteelPort { pub fn close_output_port(&self) -> Result<()> { self.port.write().close_output_port() } + + pub fn close_input_port(&self) -> Result<()> { + self.port.write().close_input_port() + } } #[cfg(not(feature = "sync"))] diff --git a/crates/steel-core/src/values/recycler.rs b/crates/steel-core/src/values/recycler.rs index 78d3159d8..abe31ad9d 100644 --- a/crates/steel-core/src/values/recycler.rs +++ b/crates/steel-core/src/values/recycler.rs @@ -1,6 +1,7 @@ use std::cell::RefCell; use std::default::Default; use std::ops::{Deref, DerefMut}; +use std::sync::atomic::{AtomicUsize, Ordering}; use smallvec::SmallVec; @@ -9,68 +10,81 @@ use crate::SteelVal; pub trait Recyclable { fn put(self); fn get() -> Self; + fn get_with_capacity(capacity: usize) -> Self; } -pub struct Recycle { - t: Option, +pub struct Recycle { + t: T, } -impl Recycle { +impl Recycle { pub fn new() -> Self { - Recycle { t: Some(T::get()) } + Recycle { t: T::get() } + } + + pub fn new_with_capacity(capacity: usize) -> Self { + Recycle { + t: T::get_with_capacity(capacity), + } } } -impl Drop for Recycle { +impl Drop for Recycle { fn drop(&mut self) { - if let Some(t) = self.t.take() { - T::put(t) - } + T::put(std::mem::take(&mut self.t)) } } -impl Deref for Recycle { +impl Deref for Recycle { type Target = T; fn deref(&self) -> &T { - self.t.as_ref().unwrap() + &self.t } } -impl DerefMut for Recycle { +impl DerefMut for Recycle { fn deref_mut(&mut self) -> &mut T { - self.t.as_mut().unwrap() + &mut self.t } } -impl Clone for Recycle { +impl Clone for Recycle { fn clone(&self) -> Self { Recycle { t: self.t.clone() } } } -impl std::fmt::Debug for Recycle { +impl std::fmt::Debug for Recycle { fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { f.debug_struct("Recycle").field("t", &self.t).finish() } } -impl std::hash::Hash for Recycle { +impl std::hash::Hash for Recycle { fn hash(&self, state: &mut H) { self.t.hash(state); } } +static RECYCLE_LIMIT: AtomicUsize = AtomicUsize::new(128); + +#[allow(unused)] +fn set_recycle_limit(value: usize) { + RECYCLE_LIMIT.store(value, Ordering::Relaxed); +} + macro_rules! impl_recyclable { ($tl:ident, $t:ty) => { - impl_recyclable!($tl, $t, Default::default()); + impl_recyclable!($tl, $t, Default::default(), Self::with_capacity); }; - ($tl:ident, $t:ty, $constructor:expr) => { + ($tl:ident, $t:ty, $constructor:expr, $constructor_capacity:expr) => { thread_local! { static $tl: RefCell> = RefCell::new(Vec::new()) } impl Recyclable for $t { + #[cfg(feature = "recycle")] fn put(mut self) { let _ = $tl.try_with(|p| { let p = p.try_borrow_mut(); @@ -79,19 +93,46 @@ macro_rules! impl_recyclable { // This _should_ be cleared, but it seems it is not! // debug_assert!(self.is_empty()); self.clear(); - if p.len() < 128 { + if p.len() < RECYCLE_LIMIT.load(Ordering::Relaxed) { p.push(self); } } }); } + #[cfg(not(feature = "recycle"))] + fn put(self) {} + fn get() -> Self { - $tl.with(|p| { - let mut p = p.borrow_mut(); - p.pop() - }) - .unwrap_or($constructor) + #[cfg(feature = "recycle")] + { + $tl.with(|p| { + let mut p = p.borrow_mut(); + p.pop() + }) + .unwrap_or($constructor) + } + + #[cfg(not(feature = "recycle"))] + { + Self::new() + } + } + + fn get_with_capacity(capacity: usize) -> Self { + #[cfg(feature = "recycle")] + { + $tl.with(|p| { + let mut p = p.borrow_mut(); + p.pop() + }) + .unwrap_or(($constructor_capacity)(capacity)) + } + + #[cfg(not(feature = "recycle"))] + { + Self::with_capacity(capacity) + } } } }; diff --git a/crates/steel-core/src/values/structs.rs b/crates/steel-core/src/values/structs.rs index 0690688b5..ca55ad677 100644 --- a/crates/steel-core/src/values/structs.rs +++ b/crates/steel-core/src/values/structs.rs @@ -5,6 +5,7 @@ use crate::steel_vm::primitives::{steel_unbox_mutable, unbox_mutable}; use crate::values::HashMap; use once_cell::sync::Lazy; use parking_lot::RwLock; +use smallvec::SmallVec; use crate::compiler::map::SymbolMap; use crate::parser::interner::InternedString; @@ -130,7 +131,9 @@ pub struct SerializableUserDefinedStruct { #[derive(Clone, Debug, Hash)] pub struct UserDefinedStruct { - pub(crate) fields: Recycle>, + // pub(crate) fields: Recycle>, + pub(crate) fields: Recycle>, + // pub(crate) fields: SmallVec<[SteelVal; 4]>, // Type Descriptor. Use this as an index into the VTable to find anything that we need. pub(crate) type_descriptor: StructTypeDescriptor, @@ -199,8 +202,13 @@ impl std::fmt::Display for UserDefinedStruct { impl UserDefinedStruct { fn new(type_descriptor: StructTypeDescriptor, raw_fields: &[SteelVal]) -> Self { - let mut fields: Recycle> = Recycle::new(); - fields.extend_from_slice(raw_fields); + // let mut fields: Recycle> = Recycle::new(); + let mut fields: Recycle> = Recycle::new(); + // fields.extend_from_slice(raw_fields); + fields.extend(raw_fields.into_iter().cloned()); + + // let fields = raw_fields.into_iter().cloned().collect(); + Self { fields, type_descriptor, @@ -282,8 +290,13 @@ impl UserDefinedStruct { type_descriptor: StructTypeDescriptor, rest: &[SteelVal], ) -> Self { - let mut fields: Recycle> = Recycle::new(); - fields.extend_from_slice(rest); + // let mut fields: Recycle> = Recycle::new_with_capacity(rest.len()); + // fields.extend_from_slice(rest); + + let mut fields: Recycle> = Recycle::new_with_capacity(rest.len()); + fields.extend(rest.into_iter().cloned()); + + // let fields = rest.into_iter().cloned().collect(); Self { fields, @@ -399,10 +412,10 @@ impl UserDefinedStruct { stop!(ArityMismatch => format!("{} expected two arguments", descriptor.name())); } - let steel_struct = &args[0].clone(); - let idx = &args[1].clone(); + let steel_struct = &args[0]; + let idx = &args[1]; - match (&steel_struct, &idx) { + match (steel_struct, idx) { (SteelVal::CustomStruct(s), SteelVal::IntV(idx)) => { if s.type_descriptor != descriptor { stop!(TypeMismatch => format!("Struct getter expected {}, found {:?}, {:?}", descriptor.name(), &s, &steel_struct)); @@ -557,8 +570,13 @@ pub fn make_struct_type(args: &[SteelVal]) -> Result { stop!(TypeMismatch => format!("make-struct-type expected an integer for the field count, found: {}", &args[0])); }; - let (struct_type_descriptor, struct_constructor, struct_predicate, getter_prototype) = - make_struct_type_inner(name.as_str(), *field_count as usize); + let ( + struct_type_descriptor, + struct_constructor, + struct_predicate, + getter_prototype, + getter_prototypes, + ) = make_struct_type_inner(name.as_str(), *field_count as usize); Ok(SteelVal::ListV( vec![ @@ -567,6 +585,7 @@ pub fn make_struct_type(args: &[SteelVal]) -> Result { struct_constructor, struct_predicate, getter_prototype, + getter_prototypes, // struct_type_descriptor, ] .into(), @@ -574,7 +593,7 @@ pub fn make_struct_type(args: &[SteelVal]) -> Result { } pub fn make_struct_singleton(name: &str) -> (SteelVal, StructTypeDescriptor) { - let (descriptor, _, _, _) = make_struct_type_inner(name, 0); + let (descriptor, _, _, _, _) = make_struct_type_inner(name, 0); let instance = UserDefinedStruct::new(descriptor, &[]); @@ -584,7 +603,7 @@ pub fn make_struct_singleton(name: &str) -> (SteelVal, StructTypeDescriptor) { fn make_struct_type_inner( name: &str, field_count: usize, -) -> (StructTypeDescriptor, SteelVal, SteelVal, SteelVal) { +) -> (StructTypeDescriptor, SteelVal, SteelVal, SteelVal, SteelVal) { let name = InternedString::from(name); // Make a slot in the VTable for this struct @@ -597,11 +616,21 @@ fn make_struct_type_inner( let getter_prototype = UserDefinedStruct::getter_prototype(struct_type_descriptor); + let mut getter_prototypes = Vec::new(); + + for i in 0..field_count { + getter_prototypes.push(UserDefinedStruct::getter_prototype_index( + struct_type_descriptor, + i, + )); + } + ( struct_type_descriptor, struct_constructor, struct_predicate, getter_prototype, + getter_prototypes.into_steelval().unwrap(), ) } diff --git a/crates/steel-language-server/Cargo.toml b/crates/steel-language-server/Cargo.toml index a31ebfaf1..92be88590 100644 --- a/crates/steel-language-server/Cargo.toml +++ b/crates/steel-language-server/Cargo.toml @@ -14,5 +14,5 @@ tower-lsp = { version = "0.20.0", features = ["proposed"] } serde = { version = "1.0.152", features = ["derive"] } dashmap = "5.1.0" log = "0.4.17" -steel-core = { path = "../steel-core", version = "0.6.0", features = ["dylibs", "markdown", "stacker", "sync"] } +steel-core = { path = "../steel-core", version = "0.6.0", features = ["dylibs", "markdown", "stacker", "sync", "anyhow"] } once_cell = "1.18.0" diff --git a/crates/steel-language-server/src/backend.rs b/crates/steel-language-server/src/backend.rs index 058c19822..ded3253a7 100644 --- a/crates/steel-language-server/src/backend.rs +++ b/crates/steel-language-server/src/backend.rs @@ -204,7 +204,7 @@ impl LanguageServer for Backend { let analysis = SemanticAnalysis::new(&mut ast); let (syntax_object_id, information) = - analysis.find_identifier_at_offset(offset, uri_to_source_id(&uri).unwrap())?; + analysis.find_identifier_at_offset(offset, uri_to_source_id(&uri)?)?; let mut syntax_object_id_to_interned_string = HashMap::new(); syntax_object_id_to_interned_string.insert(*syntax_object_id, None); @@ -225,7 +225,7 @@ impl LanguageServer for Backend { let doc = ENGINE .read() - .unwrap() + .ok()? .builtin_modules() .get_doc((*name)?.resolve())?; @@ -286,7 +286,7 @@ impl LanguageServer for Backend { .trim_end_matches(interned.resolve()) .trim_end_matches("__%#__"); - let guard = ENGINE.read().unwrap(); + let guard = ENGINE.read().ok()?; let modules = guard.modules(); let module = modules.get(&PathBuf::from(module_path_to_check))?; let module_ast = module.get_ast(); @@ -364,7 +364,7 @@ impl LanguageServer for Backend { let analysis = SemanticAnalysis::new(&mut ast); let (_syntax_object_id, information) = - analysis.find_identifier_at_offset(offset, uri_to_source_id(&uri).unwrap())?; + analysis.find_identifier_at_offset(offset, uri_to_source_id(&uri)?)?; let refers_to = information.refers_to?; @@ -389,7 +389,7 @@ impl LanguageServer for Backend { .trim_end_matches("__%#__"); resulting_span = { - let guard = ENGINE.read().unwrap(); + let guard = ENGINE.read().ok()?; // log::debug!( // "Compiled modules: {:?}", @@ -423,7 +423,7 @@ impl LanguageServer for Backend { // log::debug!("Found new definition: {:?}", maybe_definition); } - let location = source_id_to_uri(resulting_span.source_id().unwrap())?; + let location = source_id_to_uri(resulting_span.source_id()?)?; // log::debug!("Location: {:?}", location); // log::debug!("Rope length: {:?}", rope.len_chars()); @@ -434,8 +434,8 @@ impl LanguageServer for Backend { let expression = ENGINE .read() - .unwrap() - .get_source(&resulting_span.source_id().unwrap())?; + .ok()? + .get_source(&resulting_span.source_id()?)?; rope = self .document_map @@ -509,7 +509,7 @@ impl LanguageServer for Backend { if offset > 2 { let prior = rope.get_char(offset - 2); - if prior.is_some() && prior.map(char::is_whitespace).unwrap() { + if prior.is_some() && prior.map(char::is_whitespace)? { filter_character = previously_typed; } } else { @@ -525,8 +525,7 @@ impl LanguageServer for Backend { let analysis = SemanticAnalysis::new(&mut ast); // Finds the scoped contexts that we're currently inside of by the span - let contexts = - analysis.find_contexts_with_offset(offset, uri_to_source_id(&uri).unwrap()); + let contexts = analysis.find_contexts_with_offset(offset, uri_to_source_id(&uri)?); let now = std::time::Instant::now(); @@ -578,7 +577,7 @@ impl LanguageServer for Backend { completions.extend( ENGINE .read() - .unwrap() + .ok()? .in_scope_macros() .keys() .filter_map(|x| { @@ -832,15 +831,15 @@ impl Backend { fn uri_to_source_id(uri: &Url) -> Option { let id = ENGINE .read() - .unwrap() + .ok()? .get_source_id(&uri.to_file_path().unwrap()); id } fn source_id_to_uri(source_id: SourceId) -> Option { - let path = ENGINE.read().unwrap().get_path_for_source_id(&source_id)?; + let path = ENGINE.read().ok()?.get_path_for_source_id(&source_id)?; - Some(Url::from_file_path(path).unwrap()) + Some(Url::from_file_path(path).ok()?) } pub fn make_error(mut diagnostic: Diagnostic) -> Diagnostic { diff --git a/crates/steel-parser/src/ast.rs b/crates/steel-parser/src/ast.rs index c9cb44406..80044af86 100644 --- a/crates/steel-parser/src/ast.rs +++ b/crates/steel-parser/src/ast.rs @@ -58,6 +58,8 @@ define_symbols! { UNSYNTAX_SPLICING => "unsyntax-splicing", RAW_UNSYNTAX_SPLICING => "#%unsyntax-splicing", SYNTAX_QUOTE => "syntax", + DEFINE_SYNTAX => "define-syntax", + SYNTAX_RULES => "syntax-rules", } pub trait AstTools { @@ -226,6 +228,13 @@ impl ExprKind { )))) } + pub fn ident_with_span(name: &str, span: Span) -> ExprKind { + ExprKind::Atom(Atom::new(SyntaxObject::new( + TokenType::Identifier(name.into()), + span, + ))) + } + pub fn string_lit(input: String) -> ExprKind { ExprKind::Atom(Atom::new(SyntaxObject::default(TokenType::StringLiteral( Arc::new(input), @@ -351,6 +360,14 @@ impl ExprKind { } } + pub fn list_mut(&mut self) -> Option<&mut List> { + if let ExprKind::List(l) = self { + Some(l) + } else { + None + } + } + pub fn list_or_else E>(&self, err: F) -> std::result::Result<&List, E> { match self { Self::List(l) => Ok(l), @@ -766,6 +783,9 @@ pub struct LambdaFunction { pub location: SyntaxObject, pub rest: bool, pub syntax_object_id: u32, + // Helpful for the optimizer and the LSP + // to resolve keyword args ahead of time. + pub kwargs: bool, } impl Clone for LambdaFunction { @@ -776,6 +796,7 @@ impl Clone for LambdaFunction { location: self.location.clone(), rest: self.rest, syntax_object_id: SyntaxObjectId::fresh().0, + kwargs: self.kwargs, } } } @@ -836,6 +857,7 @@ impl LambdaFunction { location, rest: false, syntax_object_id: SyntaxObjectId::fresh().0, + kwargs: false, } } @@ -846,6 +868,7 @@ impl LambdaFunction { location, rest: true, syntax_object_id: SyntaxObjectId::fresh().0, + kwargs: false, } } @@ -861,6 +884,7 @@ impl LambdaFunction { location, rest, syntax_object_id: SyntaxObjectId::fresh().0, + kwargs: false, } } @@ -2110,6 +2134,43 @@ impl TryFrom> for ExprKind { parse_lambda(a, value) } + TokenType::Identifier(expr) if *expr == *DEFINE_SYNTAX => { + let syn = a.syn.clone(); + + if value.len() < 3 { + return Err(ParseError::SyntaxError( + format!("define-syntax expects 2 arguments - the name of the macro and the syntax-rules, found {}", value.len()), syn.span, None + )); + } + + // println!("{}", value.iter().map(|x| x.to_pretty(60)).join("\n\n")); + + let mut value_iter = value.into_iter(); + value_iter.next(); + + let name = value_iter.next().unwrap(); + + let syntax = value_iter.next(); + + // println!("{:?}", syntax); + + let syntax_rules = if let Some(ExprKind::SyntaxRules(s)) = syntax { + s + } else { + return Err(ParseError::SyntaxError( + "define-syntax expected a syntax-rules object".to_string(), + syn.span, + None, + )); + }; + + Ok(ExprKind::Macro(Box::new(Macro::new( + name, + syntax_rules, + syn, + )))) + } + TokenType::DefineSyntax => { let syn = a.syn.clone(); @@ -2196,6 +2257,57 @@ impl TryFrom> for ExprKind { syntax_vec, pairs, syn, )))) } + + TokenType::Identifier(expr) if *expr == *SYNTAX_RULES => { + let syn = a.syn.clone(); + + if value.len() < 3 { + return Err(ParseError::SyntaxError( + format!("syntax-rules expects a list of introduced syntax, and at least one pattern-body pair, found {} arguments", value.len()), syn.span, None + )); + } + + let mut value_iter = value.into_iter(); + value_iter.next(); + + let syntax_vec = if let Some(ExprKind::List(l)) = value_iter.next() { + l.args + } else { + return Err(ParseError::SyntaxError( + "syntax-rules expects a list of new syntax forms used in the macro".to_string(), syn.span, None)); + }; + + let mut pairs = Vec::new(); + let rest: Vec<_> = value_iter.collect(); + + for pair in rest { + if let ExprKind::List(l) = pair { + if l.args.len() != 2 { + return Err(ParseError::SyntaxError( + "syntax-rules requires only one pattern to one body" + .to_string(), + syn.span, + None, + )); + } + + let mut pair_iter = l.args.into_iter(); + let pair_object = PatternPair::new( + pair_iter.next().unwrap(), + pair_iter.next().unwrap(), + ); + pairs.push(pair_object); + } else { + return Err(ParseError::SyntaxError( + "syntax-rules requires pattern to expressions to be in a list".to_string(), syn.span, None + )); + } + } + + Ok(ExprKind::SyntaxRules(Box::new(SyntaxRules::new( + syntax_vec, pairs, syn, + )))) + } _ => Ok(ExprKind::List(List::new(value))), } } diff --git a/crates/steel-parser/src/lexer.rs b/crates/steel-parser/src/lexer.rs index bc315328e..5da164381 100644 --- a/crates/steel-parser/src/lexer.rs +++ b/crates/steel-parser/src/lexer.rs @@ -187,6 +187,21 @@ impl<'a> Lexer<'a> { self.eat(); self.eat(); } + '\'' | '`' => { + self.eat(); + break; + } + + ',' => { + self.eat(); + if Some('@') == self.chars.peek().copied() { + self.eat(); + break; + } else { + break; + } + } + '(' | '[' | ')' | ']' => break, c if c.is_whitespace() => break, _ => { @@ -343,6 +358,27 @@ impl<'a> Lexer<'a> { } } +fn strip_shebang_line(input: &str) -> (&str, usize, usize) { + if input.starts_with("#!") { + let stripped = input.trim_start_matches("#!"); + let result = match stripped.char_indices().skip_while(|x| x.1 != '\n').next() { + Some((pos, _)) => &stripped[pos..], + None => "", + }; + + let original = input.len(); + let new = result.len(); + + ( + result, + original - new, + input.as_bytes().len() - result.as_bytes().len(), + ) + } else { + (input, 0, 0) + } +} + impl<'a> Lexer<'a> { #[inline] pub fn span(&self) -> Span { @@ -356,18 +392,29 @@ impl<'a> Lexer<'a> { } pub struct TokenStream<'a> { - lexer: Lexer<'a>, + pub(crate) lexer: Lexer<'a>, skip_comments: bool, source_id: Option, } impl<'a> TokenStream<'a> { pub fn new(input: &'a str, skip_comments: bool, source_id: Option) -> Self { - Self { + let (_, char_offset, bytes_offset) = strip_shebang_line(input); + + let mut res = Self { lexer: Lexer::new(input), skip_comments, source_id, // skip_doc_comments, + }; + + res.lexer.token_start += bytes_offset; + res.lexer.token_end += bytes_offset; + + for _ in 0..char_offset { + res.lexer.chars.next(); } + + res } pub fn into_owned>(self, adapter: F) -> OwnedTokenStream<'a, T, F> { @@ -380,7 +427,7 @@ impl<'a> TokenStream<'a> { } pub struct OwnedTokenStream<'a, T, F> { - stream: TokenStream<'a>, + pub(crate) stream: TokenStream<'a>, adapter: F, _token_type: PhantomData, } @@ -488,6 +535,7 @@ impl<'a> Iterator for Lexer<'a> { self.eat(); Some(Ok(TokenType::QuasiQuote)) } + Some(',') => { self.eat(); diff --git a/crates/steel-parser/src/parser.rs b/crates/steel-parser/src/parser.rs index 4d1a24442..98b603bc8 100644 --- a/crates/steel-parser/src/parser.rs +++ b/crates/steel-parser/src/parser.rs @@ -12,8 +12,8 @@ use crate::{ self, parse_begin, parse_define, parse_if, parse_lambda, parse_let, parse_new_let, parse_require, parse_set, parse_single_argument, Atom, ExprKind, List, Macro, PatternPair, SyntaxRules, Vector, BEGIN, DEFINE, IF, LAMBDA, LAMBDA_FN, LAMBDA_SYMBOL, LET, PLAIN_LET, - QUASIQUOTE, QUOTE, RAW_UNQUOTE, RAW_UNQUOTE_SPLICING, REQUIRE, RETURN, SET, UNQUOTE, - UNQUOTE_SPLICING, + QUASIQUOTE, QUASISYNTAX, QUOTE, RAW_UNQUOTE, RAW_UNQUOTE_SPLICING, RAW_UNSYNTAX, + RAW_UNSYNTAX_SPLICING, REQUIRE, RETURN, SET, SYNTAX_QUOTE, UNQUOTE, UNQUOTE_SPLICING, }, interner::InternedString, lexer::{OwnedTokenStream, ToOwnedString, TokenStream}, @@ -338,22 +338,8 @@ fn tokentype_error_to_parse_error(t: &Token<'_, InternedString>) -> ParseError { } } -fn strip_shebang_line(input: &str) -> &str { - if input.starts_with("#!") { - let stripped = input.trim_start_matches("#!"); - match stripped.char_indices().skip_while(|x| x.1 != '\n').next() { - Some((pos, _)) => &stripped[pos..], - None => "", - } - } else { - input - } -} - impl<'a> Parser<'a> { pub fn new(input: &'a str, source_id: Option) -> Self { - let input = strip_shebang_line(input); - Parser { tokenizer: TokenStream::new(input, false, source_id).into_owned(InternString), quote_stack: Vec::new(), @@ -374,7 +360,6 @@ impl<'a> Parser<'a> { } pub fn new_flat(input: &'a str, source_id: Option) -> Self { - let input = strip_shebang_line(input); Parser { tokenizer: TokenStream::new(input, false, source_id).into_owned(InternString), quote_stack: Vec::new(), @@ -394,7 +379,6 @@ impl<'a> Parser<'a> { source_name: PathBuf, source_id: Option, ) -> Self { - let input = strip_shebang_line(input); Parser { tokenizer: TokenStream::new(input, false, source_id).into_owned(InternString), quote_stack: Vec::new(), @@ -411,7 +395,6 @@ impl<'a> Parser<'a> { // Attach comments! pub fn doc_comment_parser(input: &'a str, source_id: Option) -> Self { - let input = strip_shebang_line(input); Parser { tokenizer: TokenStream::new(input, false, source_id).into_owned(InternString), quote_stack: Vec::new(), @@ -458,6 +441,44 @@ impl<'a> Parser<'a> { vec![q, val] } + // Reader macro for #' + fn construct_syntax(&mut self, val: ExprKind, span: Span) -> ExprKind { + let q = { + let rc_val = TokenType::Identifier(*SYNTAX_QUOTE); + ExprKind::Atom(Atom::new(SyntaxObject::new(rc_val, span))) + }; + + ExprKind::List(List::new(vec![q, val])) + } + + // Reader macro for #' + fn construct_quasiquote_syntax(&mut self, val: ExprKind, span: Span) -> ExprKind { + let q = { + let rc_val = TokenType::Identifier(*QUASISYNTAX); + ExprKind::Atom(Atom::new(SyntaxObject::new(rc_val, span))) + }; + + ExprKind::List(List::new(vec![q, val])) + } + + fn construct_quasiunquote_syntax(&mut self, val: ExprKind, span: Span) -> ExprKind { + let q = { + let rc_val = TokenType::Identifier(*RAW_UNSYNTAX); + ExprKind::Atom(Atom::new(SyntaxObject::new(rc_val, span))) + }; + + ExprKind::List(List::new(vec![q, val])) + } + + fn construct_quasiunquote_syntax_splicing(&mut self, val: ExprKind, span: Span) -> ExprKind { + let q = { + let rc_val = TokenType::Identifier(*RAW_UNSYNTAX_SPLICING); + ExprKind::Atom(Atom::new(SyntaxObject::new(rc_val, span))) + }; + + ExprKind::List(List::new(vec![q, val])) + } + // Reader macro for ` fn construct_quasiquote(&mut self, val: ExprKind, span: Span) -> ExprKind { let q = { @@ -615,6 +636,45 @@ impl<'a> Parser<'a> { continue; } TokenType::Error => return Err(tokentype_error_to_parse_error(&token)), // TODO + + TokenType::QuoteSyntax => { + let quote_inner = self + .next() + .unwrap_or(Err(ParseError::UnexpectedEOF(self.source_name.clone()))) + .map(|x| self.construct_syntax(x, token.span))?; + + current_frame.push(quote_inner)? + } + + TokenType::QuasiQuoteSyntax => { + let quote_inner = self + .next() + .unwrap_or(Err(ParseError::UnexpectedEOF(self.source_name.clone()))) + .map(|x| self.construct_quasiquote_syntax(x, token.span))?; + + current_frame.push(quote_inner)? + } + + TokenType::UnquoteSyntax => { + let quote_inner = self + .next() + .unwrap_or(Err(ParseError::UnexpectedEOF(self.source_name.clone()))) + .map(|x| self.construct_quasiunquote_syntax(x, token.span))?; + + current_frame.push(quote_inner)? + } + + TokenType::UnquoteSpliceSyntax => { + let quote_inner = self + .next() + .unwrap_or(Err(ParseError::UnexpectedEOF(self.source_name.clone()))) + .map(|x| { + self.construct_quasiunquote_syntax_splicing(x, token.span) + })?; + + current_frame.push(quote_inner)? + } + TokenType::QuoteTick => { // quote_count += 1; // self.quote_stack.push(current_frame.exprs.len()); @@ -1102,6 +1162,43 @@ impl<'a> Parser<'a> { continue; } + // Just turn this into `syntax` + TokenType::QuoteSyntax => { + let value = self + .next() + .unwrap_or(Err(ParseError::UnexpectedEOF(self.source_name.clone()))) + .map(|x| self.construct_syntax(x, res.span)); + + return Some(value); + } + + TokenType::QuasiQuoteSyntax => { + let value = self + .next() + .unwrap_or(Err(ParseError::UnexpectedEOF(self.source_name.clone()))) + .map(|x| self.construct_quasiquote_syntax(x, res.span)); + + return Some(value); + } + + TokenType::UnquoteSyntax => { + let quote_inner = self + .next() + .unwrap_or(Err(ParseError::UnexpectedEOF(self.source_name.clone()))) + .map(|x| self.construct_quasiunquote_syntax(x, res.span)); + + return Some(quote_inner); + } + + TokenType::UnquoteSpliceSyntax => { + let quote_inner = self + .next() + .unwrap_or(Err(ParseError::UnexpectedEOF(self.source_name.clone()))) + .map(|x| self.construct_quasiunquote_syntax_splicing(x, res.span)); + + return Some(quote_inner); + } + TokenType::QuoteTick => { // See if this does the job self.shorthand_quote_stack.push(0); @@ -1381,6 +1478,23 @@ pub fn lower_macro_and_require_definitions(expr: ExprKind) -> Result { return Ok(ExprKind::Require(Box::new(ast::Require::new(raw, syn)))); } + let mut expr = expr; + + // TODO: Here, we should lower syntax-case itself + // to a defmacro, so that things seem to work out correctly. + + // HACK: + // If we get here, we can convert the define-syntax back into an identifier + // so that other macro expansion can occur on it. + if let Some(first) = expr + .list_mut() + .and_then(|x| x.args.first_mut().and_then(|x| x.atom_syntax_object_mut())) + { + if first.ty == TokenType::DefineSyntax { + first.ty = TokenType::Identifier("define-syntax".into()); + } + } + Ok(expr) } @@ -1389,7 +1503,6 @@ struct ASTLowerPass { } impl ASTLowerPass { - // TODO: Make this mutable references, otherwise we'll be re-boxing everything for now reason fn lower(&mut self, expr: &mut ExprKind) -> Result<()> { match expr { ExprKind::List(ref mut value) => { @@ -1414,8 +1527,12 @@ impl ASTLowerPass { self.quote_depth -= 1; } - if let Some(f) = value.first().and_then(|x| { - if let ExprKind::Atom(_) = x { + if let Some(f) = value.args.first_mut().and_then(|x| { + if let ExprKind::Atom(a) = x { + if a.syn.ty == TokenType::DefineSyntax { + a.syn.ty = TokenType::Identifier("define-syntax".into()); + } + Some(x.clone()) } else { None diff --git a/crates/xtask/Cargo.toml b/crates/xtask/Cargo.toml index 8371dbf8e..08ab55934 100644 --- a/crates/xtask/Cargo.toml +++ b/crates/xtask/Cargo.toml @@ -6,3 +6,4 @@ version.workspace = true # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] +which = "7.0.0" diff --git a/crates/xtask/build.rs b/crates/xtask/build.rs new file mode 100644 index 000000000..efdaec7b9 --- /dev/null +++ b/crates/xtask/build.rs @@ -0,0 +1,11 @@ +use std::env; + +fn main() { + export_var("HOST_PLATFORM", &env::var("HOST").unwrap()); + export_var("TARGET_PLATFORM", &env::var("TARGET").unwrap()); + println!("cargo:rerun-if-changed-env=TARGET") +} + +fn export_var(name: &str, value: &str) { + println!("cargo:rustc-env={}={}", name, value); +} diff --git a/crates/xtask/src/main.rs b/crates/xtask/src/main.rs index 4ec722ad3..3f031cde8 100644 --- a/crates/xtask/src/main.rs +++ b/crates/xtask/src/main.rs @@ -61,13 +61,19 @@ fn install_everything() -> Result<(), Box> { let mut workspace_dir = workspace_dir(); - std::process::Command::new("cargo") - .arg("install") - .arg("--path") - .arg(".") - .arg("--force") - .spawn()? - .wait()?; + // Check if cargo pgo is installed + if which::which("cargo-pgo").is_ok() { + println!("`cargo-pgo` found - building with PGO"); + install_pgo()?; + } else { + std::process::Command::new("cargo") + .arg("install") + .arg("--path") + .arg(".") + .arg("--force") + .spawn()? + .wait()?; + } println!("Successfully installed `steel`"); @@ -100,6 +106,18 @@ fn install_everything() -> Result<(), Box> { println!("Successfully installed `cargo-steel-lib`"); + println!("Installing `forge`"); + + workspace_dir.pop(); + workspace_dir.push("forge"); + + std::process::Command::new("cargo") + .arg("install") + .arg("--path") + .arg(&workspace_dir) + .spawn()? + .wait()?; + install_cogs()?; println!("Finished."); @@ -132,6 +150,48 @@ fn run_tests() -> Result<(), Box> { Ok(()) } +fn install_pgo() -> Result<(), Box> { + std::process::Command::new("cargo") + .arg("pgo") + .arg("build") + .spawn()? + .wait()?; + + let binary = format!("target/{}/release/steel", env!("TARGET_PLATFORM")); + + let benches = &[ + "r7rs-benchmarks/scheme.scm", + "r7rs-benchmarks/simplex.scm", + "r7rs-benchmarks/array1.scm", + "r7rs-benchmarks/triangl.scm", + "benchmarks/bin-trees/bin-trees.scm", + "benchmarks/fib/fib.scm", + ]; + + for _ in 0..3 { + for bench in benches { + std::process::Command::new(&binary) + .arg(bench) + .spawn()? + .wait()?; + } + } + + std::process::Command::new("cargo") + .arg("pgo") + .arg("optimize") + .spawn()? + .wait()?; + + let mut cargo_bin_location = which::which("cargo").expect("Unable to find cargo"); + cargo_bin_location.pop(); + cargo_bin_location.push("steel"); + println!("Installing to: {:?}", cargo_bin_location); + std::fs::copy(binary, cargo_bin_location).unwrap(); + + Ok(()) +} + fn main() -> Result<(), Box> { let task = std::env::args().nth(1); match task { @@ -141,6 +201,7 @@ fn main() -> Result<(), Box> { "cogs" => install_cogs()?, "docgen" => generate_docs()?, "test" => run_tests()?, + "pgo" => install_pgo()?, invalid => return Err(format!("Invalid task name: {}", invalid).into()), }, }; diff --git a/docs/src/builtins/steel_base.md b/docs/src/builtins/steel_base.md index f3278dcfa..5255a99c1 100644 --- a/docs/src/builtins/steel_base.md +++ b/docs/src/builtins/steel_base.md @@ -2021,6 +2021,7 @@ Checks if the given real number is zero. ### **child-stderr** ### **child-stdin** ### **child-stdout** +### **close-input-port** ### **close-output-port** ### **command** ### **compose** @@ -2033,6 +2034,7 @@ Checks if the given real number is zero. ### **dropping** ### **duration->seconds** ### **duration-since** +### **emit-expanded** ### **empty-stream** ### **enumerating** ### **env-var** @@ -2049,6 +2051,7 @@ Checks if the given real number is zero. ### **expand!** ### **extending** ### **f+** +### **feature-dylib-build?** ### **filtering** ### **flat-mapping** ### **flattening** @@ -2082,11 +2085,14 @@ Checks if the given real number is zero. ### **into-vector** ### **iter-next!** ### **join!** +### **kill** ### **list->string** ### **list->vector** +### **list-drop** ### **list-tail** ### **list?** ### **load** +### **load-expanded** ### **local-executor/block-on** ### **make-channels** ### **make-struct-type** @@ -2103,9 +2109,22 @@ Checks if the given real number is zero. ### **mutable-vector->string** ### **mutable-vector-pop!** ### **mutable-vector?** +### **naive-current-date-local** +### **naive-date-and-hms** +### **naive-date-day** +### **naive-date-month** +### **naive-date-year** +### **naive-date-ymd** ### **not** ### **null?** ### **odd?** +### **plist-get** +### **plist-get-kwarg** +### **plist-get-positional-arg** +### **plist-get-positional-arg-list** +### **plist-try-get** +### **plist-try-get-positional-arg** +### **plist-validate-args** ### **poll!** ### **pop-front** ### **port?** @@ -2146,6 +2165,7 @@ Checks if the given real number is zero. ### **syntax->datum** ### **syntax-e** ### **syntax-loc** +### **syntax-originating-file** ### **syntax-span** ### **syntax/loc** ### **syntax?** diff --git a/docs/src/builtins/steel_git.md b/docs/src/builtins/steel_git.md new file mode 100644 index 000000000..2bf269412 --- /dev/null +++ b/docs/src/builtins/steel_git.md @@ -0,0 +1,3 @@ +# steel/git +### **git-clone** +### **git-pull** diff --git a/docs/src/builtins/steel_lists.md b/docs/src/builtins/steel_lists.md index 766b8aaf3..23d80c2cd 100644 --- a/docs/src/builtins/steel_lists.md +++ b/docs/src/builtins/steel_lists.md @@ -268,7 +268,15 @@ error[E11]: Generic ### **cdr-null?** ### **list->string** ### **list->vector** +### **list-drop** ### **list-tail** +### **plist-get** +### **plist-get-kwarg** +### **plist-get-positional-arg** +### **plist-get-positional-arg-list** +### **plist-try-get** +### **plist-try-get-positional-arg** +### **plist-validate-args** ### **push-back** ### **transduce** ### **try-list-ref** diff --git a/docs/src/builtins/steel_meta.md b/docs/src/builtins/steel_meta.md index 8b1ec0809..99dab1176 100644 --- a/docs/src/builtins/steel_meta.md +++ b/docs/src/builtins/steel_meta.md @@ -26,12 +26,14 @@ Returns the message of an error object. ### **call/cc** ### **current-function-span** ### **current-os!** +### **emit-expanded** ### **env-var** ### **error-with-span** ### **eval** ### **eval!** ### **eval-string** ### **expand!** +### **feature-dylib-build?** ### **function-name** ### **get-contract-struct** ### **get-test-mode** @@ -39,6 +41,7 @@ Returns the message of an error object. ### **iter-next!** ### **join!** ### **load** +### **load-expanded** ### **local-executor/block-on** ### **make-struct-type** ### **maybe-get-env-var** diff --git a/docs/src/builtins/steel_ports.md b/docs/src/builtins/steel_ports.md index 5948954d3..e3bc084ed 100644 --- a/docs/src/builtins/steel_ports.md +++ b/docs/src/builtins/steel_ports.md @@ -165,6 +165,7 @@ Writes the contents of a bytevector into an output port. * buf : bytes? * port : output-port? = (current-output-port) +### **close-input-port** ### **close-output-port** ### **flush-output-port** ### **read-line-from-port** diff --git a/docs/src/builtins/steel_process.md b/docs/src/builtins/steel_process.md index 00c851443..95a80a433 100644 --- a/docs/src/builtins/steel_process.md +++ b/docs/src/builtins/steel_process.md @@ -3,7 +3,9 @@ ### **child-stdin** ### **child-stdout** ### **command** +### **kill** ### **set-current-dir!** +### **set-env-var!** ### **set-piped-stdout!** ### **spawn-process** ### **wait** diff --git a/docs/src/builtins/steel_syntax.md b/docs/src/builtins/steel_syntax.md index 16127d480..746da1409 100644 --- a/docs/src/builtins/steel_syntax.md +++ b/docs/src/builtins/steel_syntax.md @@ -3,6 +3,7 @@ ### **syntax->datum** ### **syntax-e** ### **syntax-loc** +### **syntax-originating-file** ### **syntax-span** ### **syntax/loc** ### **syntax?** diff --git a/docs/src/builtins/steel_time.md b/docs/src/builtins/steel_time.md index 4eb34e74d..9dde9fc76 100644 --- a/docs/src/builtins/steel_time.md +++ b/docs/src/builtins/steel_time.md @@ -43,3 +43,9 @@ Sleeps the thread for a given number of milliseconds. ### **duration-since** ### **instant/elapsed** ### **instant/now** +### **naive-current-date-local** +### **naive-date-and-hms** +### **naive-date-day** +### **naive-date-month** +### **naive-date-year** +### **naive-date-ymd** diff --git a/libs/steel-sqlite/Cargo.toml b/libs/steel-sqlite/Cargo.toml index 57f224165..1ce3a95ff 100644 --- a/libs/steel-sqlite/Cargo.toml +++ b/libs/steel-sqlite/Cargo.toml @@ -14,4 +14,6 @@ crate-type = ["cdylib"] abi_stable = "0.11.1" # steel-core = { path = "../../crates/steel-core", version = "0.6.0", features = ["dylibs"] } steel-core = { workspace = true } -rusqlite = { version = "0.28.0", features = ["bundled", "functions"] } +rusqlite = { version = "0.32.1", features = ["bundled", "functions", "load_extension"] } +# rusqlite = { version = "0.32.1", features = ["functions", "load_extension"] } +# rusqlite = { version = "0.32.1", features = ["load_extension"] } diff --git a/libs/steel-sqlite/sqlite.scm b/libs/steel-sqlite/sqlite.scm index 1c542f4d9..b5bf6d966 100644 --- a/libs/steel-sqlite/sqlite.scm +++ b/libs/steel-sqlite/sqlite.scm @@ -3,6 +3,7 @@ (only-in open-in-memory prepare execute + execute-batch query begin/transaction transaction/finish @@ -13,13 +14,18 @@ SqliteConnection? SqliteTransaction? SqlitePreparedStatement? - open))) + open + load-extension + version))) (provide SqliteConnection? SqliteTransaction? SqlitePreparedStatement? open-in-memory open + load-extension + version + (contract/out execute-batch (->/c SqliteConnection? string? void?)) (contract/out prepare (->/c SqliteConnection? string? any/c)) (contract/out execute (->/c SqlitePreparedStatement? list? any/c)) (contract/out query (->/c SqlitePreparedStatement? list? list?)) @@ -31,6 +37,16 @@ (contract/out run-transaction (->/c SqliteConnection? (->/c SqliteTransaction? any/c) any/c))) +(define version sqlite/version) + +;;@doc +;; Load the extension from the given path +(define load-extension sqlite/load-extension) + +;;@doc +;; Convenience method to execute a batch of statements without any parameters +(define execute-batch sqlite/execute-batch) + ;;@doc ;; Prepares a sqlite statement for further use. (define prepare sqlite/prepare) diff --git a/libs/steel-sqlite/src/lib.rs b/libs/steel-sqlite/src/lib.rs index 03749ff40..5f9b8ea79 100644 --- a/libs/steel-sqlite/src/lib.rs +++ b/libs/steel-sqlite/src/lib.rs @@ -4,7 +4,7 @@ use abi_stable::std_types::{RString, RVec}; use rusqlite::{ params_from_iter, types::{FromSql, FromSqlError, ToSqlOutput, Value}, - Connection, Statement, ToSql, Transaction, + version, Connection, LoadExtensionGuard, Statement, ToSql, Transaction, }; use steel::{ gc::Shared, @@ -242,6 +242,20 @@ impl SqliteConnection { })), }) } + + fn execute_batch(&mut self, sql: String) -> Result<(), SqliteError> { + self.connection.lock().unwrap().execute_batch(&sql)?; + Ok(()) + } + + fn load_extension(&self, extension: String) -> Result<(), SqliteError> { + unsafe { + let conn = self.connection.lock().unwrap(); + let _guard = LoadExtensionGuard::new(&conn)?; + conn.load_extension(extension, None)?; + Ok(()) + } + } } struct FFIWrapper<'a>(FFIArg<'a>); @@ -311,6 +325,8 @@ pub fn build_module() -> FFIModule { module .register_fn("prepare", SqliteConnection::prepare) + .register_fn("execute-batch", SqliteConnection::execute_batch) + .register_fn("load-extension", SqliteConnection::load_extension) .register_fn("SqliteConnection?", is_opaque_type::) .register_fn("SqliteTransaction?", is_opaque_type::) .register_fn( @@ -326,7 +342,8 @@ pub fn build_module() -> FFIModule { .register_fn("transaction/commit", SqliteTransaction::commit) .register_fn("transaction/try-commit", SqliteTransaction::try_commit) .register_fn("transaction/rollback", SqliteTransaction::rollback) - .register_fn("transaction/try-finish", SqliteTransaction::try_finish); + .register_fn("transaction/try-finish", SqliteTransaction::try_finish) + .register_fn("version", || version().to_string()); module } diff --git a/libs/steel-toml/src/lib.rs b/libs/steel-toml/src/lib.rs index 34ff05cf1..0a2d73bc7 100644 --- a/libs/steel-toml/src/lib.rs +++ b/libs/steel-toml/src/lib.rs @@ -1,5 +1,9 @@ -use abi_stable::std_types::RVec; +use std::error::Error; +use std::fmt::Display; +use abi_stable::std_types::{RHashMap, RVec}; + +use steel::rvals::Custom; use toml::Value; use steel::declare_module; @@ -13,32 +17,7 @@ impl SteelTomlValue { } } -impl steel::rvals::Custom for SteelTomlValue {} - -// fn as_native_steelval(value: &Value) -> steel::rvals::Result { -// match value { -// Value::String(s) => Ok(s.clone().into()), -// Value::Integer(i) => Ok((*i as i32).into()), -// Value::Float(f) => Ok((*f).into()), -// Value::Boolean(b) => Ok((*b).into()), -// Value::Datetime(_) => todo!(), -// Value::Array(a) => Ok(a -// .into_iter() -// .map(|x| as_native_steelval(x)) -// .collect::>>()? -// .into()), -// Value::Table(m) => Ok(SteelVal::HashMapV(steel::gc::Gc::new( -// m.into_iter() -// .map(|x| { -// let key: steel::SteelVal = x.0.clone().into(); -// let value = as_native_steelval(x.1)?; - -// Ok((key, value)) -// }) -// .collect::>>()?, -// ))), -// } -// } +impl Custom for SteelTomlValue {} fn as_ffi_value(value: &Value) -> FFIValue { match value { @@ -46,36 +25,42 @@ fn as_ffi_value(value: &Value) -> FFIValue { Value::Integer(i) => (*i as isize).into(), Value::Float(f) => (*f).into(), Value::Boolean(b) => (*b).into(), - Value::Datetime(_) => todo!(), Value::Array(a) => a.iter().map(as_ffi_value).collect::>().into(), - // Value::Table(m) => Ok(SteelVal::HashMapV(steel::gc::Gc::new( - // m.into_iter() - // .map(|x| { - // let key: steel::SteelVal = x.0.clone().into(); - // let value = as_ffi_value(x.1); + Value::Table(a) => FFIValue::HashMap( + a.into_iter() + .map(|x| (FFIValue::from(x.0.to_owned()), as_ffi_value(x.1))) + .collect::>(), + ), + // Just send back as a string if it is a datetime + _ => toml::to_string(value).unwrap().into(), + } +} - // Ok((key, value)) - // }) - // .collect::>>()?, - // ))), - _ => todo!(), +#[derive(Debug)] +struct TomlError(toml::de::Error); + +impl Error for TomlError {} +impl Display for TomlError { + fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + write!(f, "{}", self.0) } } -// impl FromSteelVal for SteelTomlValue { -// fn from_steelval(val: &SteelVal) -> steel::rvals::Result { -// todo!() -// } -// } -// thread_local! { -// static MODULE: Rc = create_module(); -// } +impl Custom for TomlError {} + +fn string_to_toml(string: &str) -> Result { + toml::from_str(string) + .map(SteelTomlValue) + .map_err(TomlError) +} declare_module!(create_module); fn create_module() -> FFIModule { let mut module = FFIModule::new("dylib/toml"); - module.register_fn("toml->value", SteelTomlValue::as_ffi_value); + module + .register_fn("string->toml", string_to_toml) + .register_fn("toml->value", SteelTomlValue::as_ffi_value); module } diff --git a/src/lib.rs b/src/lib.rs index 32037a2e0..643cc738e 100644 --- a/src/lib.rs +++ b/src/lib.rs @@ -10,11 +10,11 @@ use std::path::PathBuf; use std::process; use std::{error::Error, fs}; -use clap::Parser; +use clap::{CommandFactory, Parser}; /// Steel Interpreter #[derive(Parser, Debug)] -#[clap(author, version, about, long_about = None, trailing_var_arg = true)] +#[clap(author, version, about, long_about = None, trailing_var_arg = true, allow_hyphen_values = true, disable_help_flag = true, disable_help_subcommand = true)] pub struct Args { /// What action to perform on this file, the absence of a subcommand indicates that the given file (if any) /// will be run as the entrypoint @@ -76,6 +76,10 @@ pub fn run(clap_args: Args) -> Result<(), Box> { action: None, .. } => { + // if arguments.iter().find(|x| x.as_str() == "--help").is_some() { + // println!("{}", Args::command().render_long_help()); + // } + #[cfg(feature = "build-info")] { println!("{}", VERSION_MESSAGE); @@ -89,6 +93,15 @@ pub fn run(clap_args: Args) -> Result<(), Box> { action: None, arguments, } => { + if path + .as_os_str() + .to_str() + .map(|x| x == "--help") + .unwrap_or_default() + { + println!("{}", Args::command().render_long_help()); + } + vm.register_value( "std::env::args", steel::SteelVal::ListV( @@ -260,9 +273,7 @@ pub fn run(clap_args: Args) -> Result<(), Box> { let rust_entrypoint = r#" fn main() { - let program = steel::steel_vm::engine::NonInteractiveProgramImage::from_bytes(include_bytes!("program.bin")); - - steel::steel_vm::engine::Engine::execute_non_interactive_program_image(program); + steel::steel_vm::engine::Engine::execute_non_interactive_program_image(include_bytes!("program.bin")); } "#; @@ -287,7 +298,8 @@ version = "0.1.0" [dependencies] -steel-core = { git = "https://github.com/mattwparas/steel.git", features = ["dylibs"] } +# steel-core = { git = "https://github.com/mattwparas/steel.git", features = ["dylibs", "stacker", "sync"] } +steel-core = { path = "../crates/steel-core", features = ["dylibs", "stacker", "sync"] } [profile.release] debug = false @@ -312,7 +324,7 @@ lto = true .. } => { #[cfg(not(target_os = "redox"))] - cargo_steel_lib::run()?; + cargo_steel_lib::run(Vec::new(), Vec::new())?; #[cfg(target_os = "redox")] println!("Creating dylibs is not yet supported on Redox"); diff --git a/src/main.rs b/src/main.rs index f6c014db1..9451d4bc4 100644 --- a/src/main.rs +++ b/src/main.rs @@ -3,6 +3,13 @@ use std::error::Error; use clap::Parser; use steel_interpreter::Args; +#[cfg(feature = "mimalloc")] +use mimalloc::MiMalloc; + +#[cfg(feature = "mimalloc")] +#[global_allocator] +static GLOBAL: MiMalloc = MiMalloc; + fn main() -> Result<(), Box> { env_logger::init(); let clap_args = Args::parse();