├── bench ├── .bin │ └── keep ├── work │ ├── main.bin │ └── main.hvm ├── _results_ │ ├── TreeSum.png │ ├── ListFold.png │ ├── QuickSort.png │ ├── Composition.png │ ├── sort-bitonic.png │ ├── sort-bubble.png │ ├── sort-quick.png │ ├── sort-radix.png │ ├── LambdaArithmetic.png │ └── lambda-multiplication.png ├── benchmark.js └── gencharts.js ├── HOW.md ├── rust-toolchain.toml ├── examples ├── bugs │ ├── README.txt │ ├── fib_loop.hvm │ ├── fib_dups.hvm │ └── fib_tups.hvm ├── hello │ └── main.hvm ├── IO │ ├── log.hvm │ ├── store_and_load.hvm │ └── query_and_print.hvm ├── README.md ├── queue │ └── main.hvm ├── sort │ ├── bubble │ │ ├── main.hvm │ │ └── main.hs │ ├── quick │ │ ├── main.hvm │ │ └── main.hs │ ├── bitonic │ │ ├── main.hvm │ │ └── main.hs │ └── radix │ │ ├── main.hvm │ │ └── main.hs ├── lambda │ ├── multiplication │ │ ├── main.hvm │ │ ├── main.js │ │ ├── main.hs │ │ └── better.hvm │ ├── padic_clifford │ │ └── main.hvm │ └── varbase │ │ └── main.hvm └── callcc │ └── main.hvm ├── src ├── language │ └── mod.rs ├── runtime │ ├── rule │ │ ├── mod.rs │ │ ├── app.rs │ │ ├── op2.rs │ │ ├── dup.rs │ │ └── fun.rs │ ├── base │ │ ├── mod.rs │ │ ├── io.rs │ │ ├── debug.rs │ │ ├── precomp.rs │ │ └── reducer.rs │ ├── data │ │ ├── mod.rs │ │ ├── barrier.rs │ │ ├── u64_map.rs │ │ ├── u60.rs │ │ ├── f60.rs │ │ ├── redex_bag.rs │ │ ├── visit_queue.rs │ │ └── allocator.rs │ └── mod.rs ├── api.rs ├── main.rs ├── compiler │ └── mod.rs └── lib.rs ├── rustfmt.toml ├── .gitignore ├── BUILDING.md ├── shell.nix ├── default.nix ├── .github └── workflows │ ├── ci.yml │ ├── nix.yml │ ├── tests.yml │ └── cargo.yml ├── .vscode ├── settings.json └── launch.json ├── Cargo.toml ├── NIX.md ├── LICENSE ├── flake.nix ├── flake.lock └── guide ├── PARALLELISM.md └── README.md /bench/.bin/keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /HOW.md: -------------------------------------------------------------------------------- 1 | Moved to [guide/HOW.md](guide/HOW.md). 2 | -------------------------------------------------------------------------------- /rust-toolchain.toml: -------------------------------------------------------------------------------- 1 | [toolchain] 2 | channel = "nightly" -------------------------------------------------------------------------------- /examples/bugs/README.txt: -------------------------------------------------------------------------------- 1 | This directory includes files that were once a bug. 2 | -------------------------------------------------------------------------------- /src/language/mod.rs: -------------------------------------------------------------------------------- 1 | pub mod readback; 2 | pub mod rulebook; 3 | pub mod syntax; 4 | -------------------------------------------------------------------------------- /rustfmt.toml: -------------------------------------------------------------------------------- 1 | hard_tabs = false 2 | tab_spaces = 2 3 | use_small_heuristics = "Max" 4 | -------------------------------------------------------------------------------- /bench/work/main.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HigherOrderCO/HVM1/HEAD/bench/work/main.bin -------------------------------------------------------------------------------- /src/runtime/rule/mod.rs: -------------------------------------------------------------------------------- 1 | pub mod app; 2 | pub mod dup; 3 | pub mod op2; 4 | pub mod fun; 5 | -------------------------------------------------------------------------------- /examples/hello/main.hvm: -------------------------------------------------------------------------------- 1 | // HVM's "Hello, world!" is just a string! 2 | 3 | Main = "Hello, world!" 4 | -------------------------------------------------------------------------------- /bench/_results_/TreeSum.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HigherOrderCO/HVM1/HEAD/bench/_results_/TreeSum.png -------------------------------------------------------------------------------- /bench/_results_/ListFold.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HigherOrderCO/HVM1/HEAD/bench/_results_/ListFold.png -------------------------------------------------------------------------------- /bench/_results_/QuickSort.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HigherOrderCO/HVM1/HEAD/bench/_results_/QuickSort.png -------------------------------------------------------------------------------- /bench/_results_/Composition.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HigherOrderCO/HVM1/HEAD/bench/_results_/Composition.png -------------------------------------------------------------------------------- /bench/_results_/sort-bitonic.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HigherOrderCO/HVM1/HEAD/bench/_results_/sort-bitonic.png -------------------------------------------------------------------------------- /bench/_results_/sort-bubble.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HigherOrderCO/HVM1/HEAD/bench/_results_/sort-bubble.png -------------------------------------------------------------------------------- /bench/_results_/sort-quick.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HigherOrderCO/HVM1/HEAD/bench/_results_/sort-quick.png -------------------------------------------------------------------------------- /bench/_results_/sort-radix.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HigherOrderCO/HVM1/HEAD/bench/_results_/sort-radix.png -------------------------------------------------------------------------------- /bench/_results_/LambdaArithmetic.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HigherOrderCO/HVM1/HEAD/bench/_results_/LambdaArithmetic.png -------------------------------------------------------------------------------- /examples/bugs/fib_loop.hvm: -------------------------------------------------------------------------------- 1 | (Fib 0 x0 x1) = x0 2 | (Fib i x0 x1) = (Fib (- i 1) x1 (+ x0 x1)) 3 | 4 | (Main n) = (Fib 500000 0 1) 5 | -------------------------------------------------------------------------------- /bench/_results_/lambda-multiplication.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HigherOrderCO/HVM1/HEAD/bench/_results_/lambda-multiplication.png -------------------------------------------------------------------------------- /examples/IO/log.hvm: -------------------------------------------------------------------------------- 1 | (Sum 0) = (HVM.log Done 0) 2 | (Sum n) = (HVM.log (Call "Sum" n) (+ n (Sum (- n 1)))) 3 | 4 | (Main n) = (Sum 5) 5 | -------------------------------------------------------------------------------- /examples/IO/store_and_load.hvm: -------------------------------------------------------------------------------- 1 | Main = 2 | (HVM.store "name.txt" "Alice" 3 | (HVM.load "name.txt" λname 4 | (HVM.print name 5 | (Done)))) 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | tmp/ 3 | **/bench/*/main 4 | **/bench/*/main.c 5 | **/result 6 | **/target 7 | *.out.c 8 | *.hi 9 | *.o 10 | *.tmp 11 | *.out 12 | tests/**/*.c 13 | ~* 14 | main/ 15 | -------------------------------------------------------------------------------- /src/runtime/base/mod.rs: -------------------------------------------------------------------------------- 1 | pub mod debug; 2 | pub mod memory; 3 | pub mod precomp; 4 | pub mod program; 5 | pub mod reducer; 6 | 7 | pub use debug::{*}; 8 | pub use memory::{*}; 9 | pub use precomp::{*}; 10 | pub use program::{*}; 11 | pub use reducer::{*}; 12 | 13 | -------------------------------------------------------------------------------- /examples/IO/query_and_print.hvm: -------------------------------------------------------------------------------- 1 | (String.concat String.nil ys) = ys 2 | (String.concat (String.cons x xs) ys) = (String.cons x (String.concat xs ys)) 3 | 4 | (Main n) = 5 | (HVM.print "What is your name?" 6 | (HVM.query λname 7 | (HVM.print (String.concat "Hello, " name) 8 | (Done)))) 9 | -------------------------------------------------------------------------------- /src/runtime/data/mod.rs: -------------------------------------------------------------------------------- 1 | //pub mod allocator; 2 | 3 | pub mod f60; 4 | pub mod u60; 5 | 6 | pub mod barrier; 7 | pub mod redex_bag; 8 | pub mod u64_map; 9 | pub mod visit_queue; 10 | 11 | pub use barrier::{*}; 12 | pub use redex_bag::{*}; 13 | pub use u64_map::{*}; 14 | pub use visit_queue::{*}; 15 | -------------------------------------------------------------------------------- /BUILDING.md: -------------------------------------------------------------------------------- 1 | Building 2 | ======== 3 | 4 | Clone the repo: 5 | 6 | ```sh 7 | git clone https://github.com/HigherOrderCO/HVM.git 8 | cd HVM 9 | ``` 10 | 11 | To build and run: 12 | 13 | ```sh 14 | cargo run -- run foobar.hvm 15 | ``` 16 | 17 | To build and install the binary: 18 | 19 | ```sh 20 | cargo install --path . 21 | ``` 22 | 23 | To build with Nix [see here](./NIX.md). 24 | -------------------------------------------------------------------------------- /examples/README.md: -------------------------------------------------------------------------------- 1 | HVM Examples 2 | ============ 3 | 4 | This directory contains just a few examples and cool tricks involving the HVM. 5 | For more comprehensive examples, please visit the 6 | [Kindex](https://github.com/higherorderco/kindex) repository, which has tons of 7 | datatypes and algorithms on the [Kind](https://github.com/higherorderco/kind) 8 | language, which compiles 1-to-1 to the HVM. 9 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | (import 2 | ( 3 | let 4 | lock = builtins.fromJSON (builtins.readFile ./flake.lock); 5 | in 6 | fetchTarball { 7 | url = "https://github.com/edolstra/flake-compat/archive/${lock.nodes.flake-compat.locked.rev}.tar.gz"; 8 | sha256 = lock.nodes.flake-compat.locked.narHash; 9 | } 10 | ) 11 | { 12 | src = ./.; 13 | }) 14 | .shellNix 15 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | (import 2 | ( 3 | let 4 | lock = builtins.fromJSON (builtins.readFile ./flake.lock); 5 | in 6 | fetchTarball { 7 | url = "https://github.com/edolstra/flake-compat/archive/${lock.nodes.flake-compat.locked.rev}.tar.gz"; 8 | sha256 = lock.nodes.flake-compat.locked.narHash; 9 | } 10 | ) 11 | { 12 | src = ./.; 13 | }) 14 | .defaultNix 15 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: 3 | push: 4 | pull_request: 5 | types: [opened, review_requested, ready_for_review] 6 | jobs: 7 | cargo: 8 | if: github.event.pull_request.draft == false 9 | uses: ./.github/workflows/cargo.yml 10 | tests: 11 | needs: [cargo] 12 | uses: ./.github/workflows/tests.yml 13 | nix: 14 | needs: [cargo] 15 | uses: ./.github/workflows/nix.yml 16 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "files.exclude": { 3 | "target": true 4 | }, 5 | "cSpell.words": [ 6 | "doctest", 7 | "dynfun", 8 | "dynrule", 9 | "dynrules", 10 | "dynterm", 11 | "dynvar", 12 | "itertools", 13 | "lambolt", 14 | "oper", 15 | "pthread", 16 | "readback", 17 | "redex", 18 | "rulebook" 19 | ], 20 | "cSpell.ignoreWords": ["argm", "arit", "ctrs", "dups"], 21 | "rust-analyzer.checkOnSave.command": "clippy", 22 | "python.analysis.typeCheckingMode": "strict", 23 | } 24 | -------------------------------------------------------------------------------- /examples/bugs/fib_dups.hvm: -------------------------------------------------------------------------------- 1 | // List type 2 | (Head (Cons x xs)) = (Some x) 3 | (Head Nil) = None 4 | 5 | // Something like Rust's Option.unwrap_or 6 | (UnwrapOr (Some x) y) = x 7 | (UnwrapOr None y) = y 8 | 9 | (SumFirstTwo Nil) = 0 10 | (SumFirstTwo (Cons x xs)) = (+ x (UnwrapOr (Head xs) 0)) 11 | 12 | // Iterate a function n times on an input 13 | (Iter f x 0) = x 14 | (Iter f x n) = (f (Iter f x (- n 1))) 15 | 16 | (Fib n) = (Head (Iter λxs (Cons (SumFirstTwo xs) xs) (Cons 0 (Cons 1 Nil)) n)) 17 | 18 | (Main n) = (Fib 2000000) 19 | -------------------------------------------------------------------------------- /examples/queue/main.hvm: -------------------------------------------------------------------------------- 1 | // A cool trick involving HVM's scopeless lambdas is linear queues: 2 | 3 | // Queue.new : Queue a 4 | Queue.new = λx x 5 | 6 | // Queue.add : a -> Queue a -> Queue a 7 | (Queue.add x queue) = λk (queue λc (c x k)) 8 | 9 | // Queue.rem : Queue a -> Pair a (Queue a) 10 | (Queue.rem queue) = (queue $k λx λxs λp(p x λ$k xs)) 11 | 12 | // Output: [1, 2, 3] 13 | Main = 14 | let queue = Queue.new 15 | let queue = (Queue.add 1 queue) 16 | let queue = (Queue.add 2 queue) 17 | let queue = (Queue.add 3 queue) 18 | ((Queue.rem queue) λv0 λqueue 19 | ((Queue.rem queue) λv1 λqueue 20 | ((Queue.rem queue) λv2 λqueue 21 | [v0 v1 v2]))) 22 | -------------------------------------------------------------------------------- /examples/bugs/fib_tups.hvm: -------------------------------------------------------------------------------- 1 | // List type 2 | (Head (Cons x xs)) = (Some x) 3 | (Head Nil) = None 4 | 5 | // Something like Rust's Option.unwrap_or 6 | (UnwrapOr (Some x) y) = x 7 | (UnwrapOr None y) = y 8 | 9 | (SumFirstTwo Nil) = 0 10 | (SumFirstTwo (Cons x xs)) = (+ x (UnwrapOr (Head xs) 0)) 11 | 12 | // Iterate a function n times on an input 13 | (Iter f x 0) = x 14 | (Iter f x n) = (f (Iter f x (- n 1))) 15 | 16 | (Fib n) = (Head (Iter λxs (Cons (SumFirstTwo xs) xs) (Cons 0 (Cons 1 Nil)) n)) 17 | 18 | (Main n) = (Tuple 19 | (Fib 10000) 20 | (Fib 10000) 21 | (Fib 10000) 22 | (Fib 10000) 23 | (Fib 10000) 24 | (Fib 10000) 25 | (Fib 10000) 26 | (Fib 10000) 27 | ) 28 | -------------------------------------------------------------------------------- /.github/workflows/nix.yml: -------------------------------------------------------------------------------- 1 | name: Nix 2 | on: 3 | workflow_call: 4 | jobs: 5 | nix_build: 6 | name: 🔨 Nix Build 7 | runs-on: ubuntu-latest 8 | steps: 9 | - uses: actions/checkout@v3 10 | - uses: cachix/install-nix-action@v18 11 | with: 12 | extra_nix_config: | 13 | access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} 14 | - run: nix build .#hvm 15 | 16 | nix_flake_check: 17 | name: ❄️ Nix Flake Check 18 | runs-on: ubuntu-latest 19 | steps: 20 | - uses: actions/checkout@v3 21 | - uses: cachix/install-nix-action@v18 22 | with: 23 | extra_nix_config: | 24 | access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} 25 | - run: nix flake check 26 | -------------------------------------------------------------------------------- /examples/sort/bubble/main.hvm: -------------------------------------------------------------------------------- 1 | // Sorts a list 2 | 3 | // sort : List -> List 4 | (Sort Nil) = Nil 5 | (Sort (Cons x xs)) = (Insert x (Sort xs)) 6 | 7 | // Insert : U60 -> List -> List 8 | (Insert v Nil) = (Cons v Nil) 9 | (Insert v (Cons x xs)) = (SwapGT (> v x) v x xs) 10 | 11 | // SwapGT : U60 -> U60 -> U60 -> List -> List 12 | (SwapGT 0 v x xs) = (Cons v (Cons x xs)) 13 | (SwapGT 1 v x xs) = (StrictCons x (Insert v xs)) 14 | (StrictCons e !t) = (Cons e t) 15 | 16 | // Generates a random list 17 | (Rnd 0 s) = (Nil) 18 | (Rnd n s) = (Cons s (Rnd (- n 1) (% (+ (* s 1664525) 1013904223) 4294967296))) 19 | 20 | // Sums a list 21 | (Sum Nil) = 0 22 | (Sum (Cons x xs)) = (+ x (Sum xs)) 23 | 24 | (Main n) = (Sum (Sort (Rnd (* 30 1000) 1))) 25 | -------------------------------------------------------------------------------- /Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "hvm1" 3 | version = "1.0.12" 4 | edition = "2021" 5 | description = "A massively parallel functional runtime." 6 | repository = "https://github.com/HigherOrderCO/HVM1" 7 | license = "MIT" 8 | keywords = ["functional", "language", "runtime", "compiler", "target"] 9 | categories = ["compilers"] 10 | 11 | [lib] 12 | test = true 13 | crate-type = ["cdylib", "rlib"] 14 | 15 | [[bin]] 16 | name = "hvm1" 17 | test = false 18 | 19 | [profile.release] 20 | opt-level = 3 21 | 22 | [dependencies] 23 | HOPA = "0.1.1" 24 | backtrace = "0.3.69" 25 | sysinfo = "0.29.10" 26 | clap = { version = "3.1.8", features = ["derive"] } 27 | crossbeam = "0.8.2" 28 | highlight_error = "0.1.1" 29 | instant = { version = "0.1", features = [ "wasm-bindgen", "inaccurate" ] } 30 | itertools = "0.10" 31 | -------------------------------------------------------------------------------- /src/runtime/data/barrier.rs: -------------------------------------------------------------------------------- 1 | use std::sync::atomic::{AtomicUsize, AtomicBool, Ordering, fence}; 2 | 3 | pub struct Barrier { 4 | pub done: AtomicUsize, 5 | pub pass: AtomicUsize, 6 | pub tids: usize, 7 | } 8 | 9 | impl Barrier { 10 | pub fn new(tids: usize) -> Barrier { 11 | Barrier { 12 | done: AtomicUsize::new(0), 13 | pass: AtomicUsize::new(0), 14 | tids: tids, 15 | } 16 | } 17 | 18 | pub fn wait(&self, stop: &AtomicUsize) { 19 | let pass = self.pass.load(Ordering::Relaxed); 20 | if self.done.fetch_add(1, Ordering::SeqCst) == self.tids - 1 { 21 | self.done.store(0, Ordering::Relaxed); 22 | self.pass.store(pass + 1, Ordering::Release); 23 | } else { 24 | while stop.load(Ordering::Relaxed) != 0 && self.pass.load(Ordering::Relaxed) == pass {} 25 | fence(Ordering::Acquire); 26 | } 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /bench/work/main.hvm: -------------------------------------------------------------------------------- 1 | // Parallel QuickSort 2 | (Sort Nil) = Leaf 3 | (Sort (Cons x xs)) = 4 | ((Part x xs) λmin λmax 5 | let lft = (Sort min) 6 | let rgt = (Sort max) 7 | (Node lft x rgt)) 8 | 9 | // Partitions a list in two halves, less-than-p and greater-than-p 10 | (Part p Nil) = λt (t Nil Nil) 11 | (Part p (Cons x xs)) = (Push (> x p) x (Part p xs)) 12 | 13 | // Pushes a value to the first or second list of a pair 14 | (Push 0 x pair) = (pair λmin λmax λp (p (Cons x min) max)) 15 | (Push 1 x pair) = (pair λmin λmax λp (p min (Cons x max))) 16 | 17 | // Generates a random list 18 | (Rnd 0 s) = (Nil) 19 | (Rnd n s) = (Cons s (Rnd (- n 1) (% (+ (* s 1664525) 1013904223) 4294967296))) 20 | 21 | // Sums all elements in a concatenation tree 22 | (Sum Leaf) = 0 23 | (Sum (Node l m r)) = (+ m (+ (Sum l) (Sum r))) 24 | 25 | // Sorts and sums n random numbers 26 | (Main n) = (Sum (Sort (Rnd (<< 1 n) 1))) 27 | -------------------------------------------------------------------------------- /examples/sort/quick/main.hvm: -------------------------------------------------------------------------------- 1 | // Parallel QuickSort 2 | (Sort Nil) = Leaf 3 | (Sort (Cons x xs)) = 4 | ((Part x xs) λmin λmax 5 | let lft = (Sort min) 6 | let rgt = (Sort max) 7 | (Node lft x rgt)) 8 | 9 | // Partitions a list in two halves, less-than-p and greater-than-p 10 | (Part p Nil) = λt (t Nil Nil) 11 | (Part p (Cons x xs)) = (Push (> x p) x (Part p xs)) 12 | 13 | // Pushes a value to the first or second list of a pair 14 | (Push 0 x pair) = (pair λmin λmax λp (p (Cons x min) max)) 15 | (Push 1 x pair) = (pair λmin λmax λp (p min (Cons x max))) 16 | 17 | // Generates a random list 18 | (Rnd 0 s) = (Nil) 19 | (Rnd n s) = (Cons s (Rnd (- n 1) (% (+ (* s 1664525) 1013904223) 4294967296))) 20 | 21 | // Sums all elements in a concatenation tree 22 | (Sum Leaf) = 0 23 | (Sum (Node l m r)) = (+ m (+ (Sum l) (Sum r))) 24 | 25 | // Sorts and sums n random numbers 26 | (Main n) = (Sum (Sort (Rnd (<< 1 n) 1))) 27 | -------------------------------------------------------------------------------- /examples/sort/bubble/main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Data.Word 4 | import System.Environment 5 | 6 | data List = Nil | Cons Word64 List 7 | 8 | -- Sorts a list 9 | sort' :: List -> List 10 | sort' Nil = Nil 11 | sort' (Cons x xs) = insert x (sort' xs) 12 | 13 | insert :: Word64 -> List -> List 14 | insert v Nil = Cons v Nil 15 | insert v (Cons x xs) = swapGT (if v > x then 1 else 0) v x xs 16 | 17 | swapGT :: Word64 -> Word64 -> Word64 -> List -> List 18 | swapGT 0 v x xs = Cons v (Cons x xs) 19 | swapGT 1 v x xs = Cons x $! insert v xs 20 | 21 | -- Generates a random list 22 | rnd' :: Word64 -> Word64 -> List 23 | rnd' 0 s = Nil 24 | rnd' n s = Cons s (rnd' (n - 1) ((s * 1664525 + 1013904223) `mod` 4294967296)) 25 | 26 | -- Sums a list 27 | sum' :: List -> Word64 28 | sum' Nil = 0 29 | sum' (Cons x xs) = x + sum' xs 30 | 31 | main :: IO () 32 | main = do 33 | -- n <- read . head <$> getArgs :: IO Word64 34 | let n = 30 35 | print $ sum' (sort' (rnd' (n * 1000) 1)) 36 | -------------------------------------------------------------------------------- /NIX.md: -------------------------------------------------------------------------------- 1 | Usage (Nix) 2 | ----------- 3 | 4 | #### 1. Access/install HVM 5 | 6 | [Install Nix](https://nixos.org/manual/nix/stable/installation/installation.html) and enable [Flakes](https://nixos.wiki/wiki/Flakes#Enable_flakes) then, in a shell, run: 7 | 8 | ```sh 9 | git clone https://github.com/HigherOrderCO/HVM.git 10 | cd HVM 11 | # Start a shell that has the `hvm` command without installing it. 12 | nix shell .#hvm 13 | # Or install it to your Nix profile. 14 | nix profile install .#hvm 15 | ``` 16 | 17 | #### 2. Create an HVM file 18 | 19 | [Same as step 2 of the "Usage" section](./README.md#2-create-an-hvm-file). 20 | 21 | #### 3. Run/compile it 22 | 23 | ```sh 24 | # Interpret the main.hvm file, passing "(Main 25)" as an argument. 25 | hvm run -f main.hvm "(Main 25)" 26 | # Compile it to Rust. 27 | hvm compile main.hvm 28 | cd main 29 | # Initialise the Nix development shell. 30 | nix develop .#hvm 31 | # Compile the resulting Rust code. 32 | cargo build --release 33 | # Run the resulting binary. 34 | ./target/release/main run "(Main 25)" 35 | ``` 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 Victor Maia 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /.vscode/launch.json: -------------------------------------------------------------------------------- 1 | { 2 | // Use IntelliSense to learn about possible attributes. 3 | // Hover to view descriptions of existing attributes. 4 | // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 5 | "version": "0.2.0", 6 | "configurations": [ 7 | { 8 | "type": "lldb", 9 | "request": "launch", 10 | "name": "Debug executable 'hvm'", 11 | "cargo": { 12 | "args": [ 13 | "build", 14 | "--bin=hvm", 15 | "--package=hvm" 16 | ], 17 | "filter": { 18 | "name": "hvm", 19 | "kind": "bin" 20 | } 21 | }, 22 | "args": [], 23 | "cwd": "${workspaceFolder}" 24 | }, 25 | { 26 | "type": "lldb", 27 | "request": "launch", 28 | "name": "Debug unit tests in executable 'hvm'", 29 | "cargo": { 30 | "args": [ 31 | "test", 32 | "--no-run", 33 | "--bin=hvm", 34 | "--package=hvm" 35 | ], 36 | "filter": { 37 | "name": "hvm", 38 | "kind": "bin" 39 | } 40 | }, 41 | "args": [], 42 | "cwd": "${workspaceFolder}" 43 | } 44 | ] 45 | } 46 | -------------------------------------------------------------------------------- /src/runtime/data/u64_map.rs: -------------------------------------------------------------------------------- 1 | // std::collections::HashMap>>; 2 | 3 | pub struct U64Map { 4 | pub data: Vec> 5 | } 6 | 7 | impl U64Map { 8 | pub fn new() -> U64Map { 9 | // std::collections::HashMap::with_hasher(std::hash::BuildHasherDefault::default()); 10 | return U64Map { data: Vec::new() }; 11 | } 12 | 13 | pub fn from_hashmap(old_map: &mut std::collections::HashMap) -> U64Map { 14 | let mut new_map : U64Map = U64Map::new(); 15 | for (key, val) in old_map.drain() { 16 | new_map.insert(key, val); 17 | } 18 | return new_map; 19 | } 20 | 21 | pub fn push(&mut self, val: A) -> u64 { 22 | let key = self.data.len() as u64; 23 | self.insert(key, val); 24 | return key; 25 | } 26 | 27 | pub fn insert(&mut self, key: u64, val: A) { 28 | while self.data.len() <= key as usize { 29 | self.data.push(None); 30 | } 31 | self.data[key as usize] = Some(val); 32 | } 33 | 34 | pub fn get(&self, key: &u64) -> Option<&A> { 35 | if let Some(Some(got)) = self.data.get(*key as usize) { 36 | return Some(got); 37 | } 38 | return None; 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /examples/lambda/multiplication/main.hvm: -------------------------------------------------------------------------------- 1 | // The Scott-Encoded Bits type 2 | (End) = λe λo λi e 3 | (B0 p) = λe λo λi (o p) 4 | (B1 p) = λe λo λi (i p) 5 | 6 | // Applies `f` `xs` times to `x` 7 | (App xs f x) = 8 | let e = λf λx x 9 | let o = λpλfλx(App p λk(f (f k)) x) 10 | let i = λpλfλx(App p λk(f (f k)) (f x)) 11 | (xs e o i f x) 12 | 13 | // Increments a Bits by 1 14 | (Inc xs) = λex λox λix 15 | let e = ex 16 | let o = ix 17 | let i = λp (ox (Inc p)) 18 | (xs e o i) 19 | 20 | // Adds two Bits 21 | (Add xs ys) = (App xs λx(Inc x) ys) 22 | 23 | // Multiplies two Bits 24 | (Mul xs ys) = 25 | let e = End 26 | let o = λp (B0 (Mul p ys)) 27 | let i = λp (Add ys (B0 (Mul p ys))) 28 | (xs e o i) 29 | 30 | // Converts a Bits to an U32 31 | (ToU32 ys) = 32 | let e = 0 33 | let o = λp (+ 0 (* 2 (ToU32 p))) 34 | let i = λp (+ 1 (* 2 (ToU32 p))) 35 | (ys e o i) 36 | 37 | // Converts an U32 to a Bits 38 | (FromU32 0 i) = End 39 | (FromU32 s i) = (FromU32Put (- s 1) (% i 2) (/ i 2)) 40 | (FromU32Put s 0 i) = (B0 (FromU32 s i)) 41 | (FromU32Put s 1 i) = (B1 (FromU32 s i)) 42 | 43 | // Squares (n * 100k) 44 | (Main n) = 45 | let a = (FromU32 32 (* 100000 n)) 46 | let b = (FromU32 32 (* 100000 n)) 47 | (ToU32 (Mul a b)) 48 | -------------------------------------------------------------------------------- /.github/workflows/tests.yml: -------------------------------------------------------------------------------- 1 | name: Tests 2 | on: 3 | workflow_call: 4 | jobs: 5 | hvm-tests: 6 | name: 🔎 HVM Tests 7 | runs-on: ${{ matrix.os }} 8 | strategy: 9 | matrix: 10 | os: [macos-latest, ubuntu-latest, windows-latest] 11 | run_mode: [interpreted, compiled, single-thread] 12 | exclude: 13 | - os: windows-latest 14 | run_mode: compiled 15 | - os: windows-latest 16 | run_mode: single-thread 17 | env: 18 | # Add .exe suffix to HVM command on Windows 19 | HVM_CMD: ${{matrix.os != 'windows-latest' && './target/release/hvm' || './target/release/hvm.exe'}} 20 | steps: 21 | - uses: actions/checkout@v2 22 | - uses: actions/setup-python@v3 23 | with: 24 | python-version: "3.10" 25 | - uses: actions-rs/toolchain@v1 26 | with: 27 | profile: minimal 28 | toolchain: stable 29 | override: true 30 | 31 | - run: cargo build --release 32 | # FIXME: compiled mode of kind 2 teste don't work because compiled 33 | # code don't have sugar for strings 34 | - run: python3 -X utf8 tests/test_cli.py --hvm-cmd ${{env.HVM_CMD}} 35 | --run-mode ${{ matrix.run_mode }} --skip-test kind2 36 | -------------------------------------------------------------------------------- /examples/sort/bitonic/main.hvm: -------------------------------------------------------------------------------- 1 | // Atomic Swapper (HVM builtin) 2 | //(U60.swap 0 a b) = (Both a b) 3 | //(U60.swap n a b) = (Both b a) 4 | 5 | // Swaps distant values in parallel; corresponds to a Red Box 6 | (Warp s (Leaf a) (Leaf b)) = (U60.swap (^ (> a b) s) (Leaf a) (Leaf b)) 7 | (Warp s (Both a b) (Both c d)) = (Join (Warp s a c) (Warp s b d)) 8 | 9 | // Rebuilds the warped tree in the original order 10 | (Join (Both a b) (Both c d)) = (Both (Both a c) (Both b d)) 11 | 12 | // Recursively warps each sub-tree; corresponds to a Blue/Green Box 13 | (Flow s (Leaf a)) = (Leaf a) 14 | (Flow s (Both a b)) = (Down s (Warp s a b)) 15 | 16 | // Propagates Flow downwards 17 | (Down s (Leaf a)) = (Leaf a) 18 | (Down s (Both a b)) = (Both (Flow s a) (Flow s b)) 19 | 20 | // Bitonic Sort 21 | (Sort s (Leaf a)) = (Leaf a) 22 | (Sort s (Both a b)) = (Flow s (Both (Sort 0 a) (Sort 1 b))) 23 | 24 | // Generates a tree of depth `n` 25 | (Gen 0 x) = (Leaf x) 26 | (Gen n x) = let m = (- n 1); (Both (Gen m (* x 2)) (Gen m (+ (* x 2) 1))) 27 | 28 | // Reverses a tree 29 | (Rev (Leaf x)) = (Leaf x) 30 | (Rev (Both a b)) = (Both (Rev b) (Rev a)) 31 | 32 | // Sums a tree 33 | (Sum (Leaf x)) = x 34 | (Sum (Both a b)) = (+ (Sum a) (Sum b)) 35 | 36 | (Main n) = (Sum (Sort 0 (Rev (Gen n 0)))) 37 | -------------------------------------------------------------------------------- /examples/lambda/multiplication/main.js: -------------------------------------------------------------------------------- 1 | let End = e => o => i => e 2 | let B0 = p => e => o => i => o(p) 3 | let B1 = p => e => o => i => i(p) 4 | 5 | // Applies `f` `xs` times to `x` 6 | function app(xs, f, x) { 7 | let e = f => x => x; 8 | let o = p => f => x => app(p, (k) => f(f(k)), x); 9 | let i = p => f => x => app(p, (k) => f(f(k)), f(x)); 10 | return xs(e)(o)(i)(f)(x); 11 | } 12 | 13 | let inc = (xs) => (ex) => (ox) => (ix) => { 14 | let e = ex; 15 | let o = ix; 16 | let i = p => ox(inc(p)); 17 | return xs(e)(o)(i); 18 | } 19 | 20 | function add(xs, ys) { 21 | return app(xs, (x) => inc(x), ys) 22 | } 23 | 24 | function mul(xs, ys) { 25 | let e = End; 26 | let o = p => B0(mul(p, ys)); 27 | let i = p => add(ys, B0(mul(p, ys))); 28 | return xs(e)(o)(i); 29 | } 30 | 31 | function toU32(ys) { 32 | let e = 0; 33 | let o = p => 0 + (2 * toU32(p)); 34 | let i = p => 1 + (2 * toU32(p)); 35 | let a = ys(e)(o)(i); 36 | return a; 37 | } 38 | 39 | function fromU32(s, i) { 40 | if (s == 0) { 41 | return End; 42 | } else { 43 | function fromU32Put(s, mod, i) { 44 | if (mod == 0) { 45 | return B0(fromU32(s, i)); 46 | } else { 47 | return B1(fromU32(s, i)); 48 | } 49 | } 50 | return fromU32Put(s - 1, i % 2, (i / 2) >> 0); 51 | } 52 | } 53 | 54 | function main() { 55 | const N = process.argv[2]; 56 | let a = fromU32(32,100000 * N); 57 | let b = fromU32(32,100000 * N); 58 | console.log(toU32(mul(a, b))); 59 | } 60 | 61 | main(); 62 | -------------------------------------------------------------------------------- /examples/sort/quick/main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | module Main where 3 | 4 | import Data.Word 5 | import System.Environment 6 | 7 | data List = Nil | Cons Word64 List deriving Show 8 | data Tree = Leaf | Node Tree Word64 Tree deriving Show 9 | type Pair = forall a . (List -> List -> a) -> a 10 | 11 | -- Parallel QuickSort 12 | sort' :: List -> Tree 13 | sort' Nil = Leaf 14 | sort' (Cons x xs) = 15 | part x xs $ \min max -> 16 | let lft = sort' min 17 | rgt = sort' max 18 | in Node lft x rgt 19 | where 20 | 21 | -- Partitions a list in two halves, less-than-p and greater-than-p 22 | part :: Word64 -> List -> Pair 23 | part p Nil = \t -> t Nil Nil 24 | part p (Cons x xs) = push (if x > p then 1 else 0) x (part p xs) 25 | 26 | -- Pushes a value to the first or second list of a pair 27 | push :: Word64 -> Word64 -> Pair -> Pair 28 | push 0 x pair = pair $ \min max p -> p (Cons x min) max 29 | push 1 x pair = pair $ \min max p -> p min (Cons x max) 30 | 31 | -- Generates a random list 32 | rnd' :: Word64 -> Word64 -> List 33 | rnd' 0 s = Nil 34 | rnd' n s = Cons s (rnd' (n - 1) ((s * 1664525 + 1013904223) `mod` 4294967296)) 35 | 36 | -- Sums a list 37 | sum' :: Tree -> Word64 38 | sum' Leaf = 0 39 | sum' (Node l n r) = n + sum' l + sum' r 40 | 41 | main :: IO () 42 | main = do 43 | n <- read . head <$> getArgs :: IO Word64 44 | print $ (sum' (sort' (rnd' (2 ^ n) 1))) 45 | 46 | 47 | -- - Sorts and sums n random numbers 48 | -- (Main n) = (Sum (Sort (Rnd (<< 1 20) 1))) 49 | -------------------------------------------------------------------------------- /src/api.rs: -------------------------------------------------------------------------------- 1 | use crate::language; 2 | use crate::runtime; 3 | 4 | // Evaluates a HVM term to normal form 5 | pub fn eval( 6 | file: &str, 7 | term: &str, 8 | funs: Vec<(String, runtime::Function)>, 9 | size: usize, 10 | tids: usize, 11 | dbug: bool, 12 | ) -> Result<(String, u64, u64), String> { 13 | 14 | // Parses and reads the input file 15 | let file = language::syntax::read_file(&format!("{}\nHVM_MAIN_CALL = {}", file, term))?; 16 | 17 | // Converts the file to a Rulebook 18 | let book = language::rulebook::gen_rulebook(&file); 19 | 20 | // Creates the runtime program 21 | let mut prog = runtime::Program::new(); 22 | 23 | let begin = instant::Instant::now(); 24 | 25 | // Adds the interpreted functions (from the Rulebook) 26 | prog.add_book(&book); 27 | 28 | // Adds the extra functions 29 | for (name, fun) in funs { 30 | prog.add_function(name, fun); 31 | } 32 | 33 | // Creates the runtime heap 34 | let heap = runtime::new_heap(size, tids); 35 | let tids = runtime::new_tids(tids); 36 | 37 | // Allocates the main term 38 | runtime::link(&heap, 0, runtime::Fun(*book.name_to_id.get("HVM_MAIN_CALL").unwrap(), 0)); 39 | let host = 0; 40 | 41 | // Normalizes it 42 | let init = instant::Instant::now(); 43 | runtime::normalize(&heap, &prog, &tids, host, dbug); 44 | let time = init.elapsed().as_millis() as u64; 45 | 46 | // Reads it back to a string 47 | let code = format!("{}", language::readback::as_term(&heap, &prog, host)); 48 | 49 | // Frees used memory 50 | runtime::collect(&heap, &prog.aris, tids[0], runtime::load_ptr(&heap, host)); 51 | runtime::free(&heap, 0, 0, 1); 52 | 53 | // Returns the result, rewrite cost and time elapsed 54 | Ok((code, runtime::get_cost(&heap), time)) 55 | } 56 | -------------------------------------------------------------------------------- /src/runtime/rule/app.rs: -------------------------------------------------------------------------------- 1 | use crate::runtime::{*}; 2 | 3 | #[inline(always)] 4 | pub fn visit(ctx: ReduceCtx) -> bool { 5 | let goup = ctx.redex.insert(ctx.tid, new_redex(*ctx.host, *ctx.cont, 1)); 6 | *ctx.cont = goup; 7 | *ctx.host = get_loc(ctx.term, 0); 8 | return true; 9 | } 10 | 11 | #[inline(always)] 12 | pub fn apply(ctx: ReduceCtx) -> bool { 13 | let arg0 = load_arg(ctx.heap, ctx.term, 0); 14 | 15 | // (λx(body) a) 16 | // ------------ APP-LAM 17 | // x <- a 18 | // body 19 | if get_tag(arg0) == LAM { 20 | inc_cost(ctx.heap, ctx.tid); 21 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Var(get_loc(arg0, 0)), take_arg(ctx.heap, ctx.term, 1)); 22 | link(ctx.heap, *ctx.host, take_arg(ctx.heap, arg0, 1)); 23 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 2); 24 | free(ctx.heap, ctx.tid, get_loc(arg0, 0), 2); 25 | return true; 26 | } 27 | 28 | // ({a b} c) 29 | // --------------- APP-SUP 30 | // dup x0 x1 = c 31 | // {(a x0) (b x1)} 32 | if get_tag(arg0) == SUP { 33 | inc_cost(ctx.heap, ctx.tid); 34 | let app0 = get_loc(ctx.term, 0); 35 | let app1 = get_loc(arg0, 0); 36 | let let0 = alloc(ctx.heap, ctx.tid, 3); 37 | let par0 = alloc(ctx.heap, ctx.tid, 2); 38 | link(ctx.heap, let0 + 2, take_arg(ctx.heap, ctx.term, 1)); 39 | link(ctx.heap, app0 + 1, Dp0(get_ext(arg0), let0)); 40 | link(ctx.heap, app0 + 0, take_arg(ctx.heap, arg0, 0)); 41 | link(ctx.heap, app1 + 0, take_arg(ctx.heap, arg0, 1)); 42 | link(ctx.heap, app1 + 1, Dp1(get_ext(arg0), let0)); 43 | link(ctx.heap, par0 + 0, App(app0)); 44 | link(ctx.heap, par0 + 1, App(app1)); 45 | let done = Sup(get_ext(arg0), par0); 46 | link(ctx.heap, *ctx.host, done); 47 | return false; 48 | } 49 | 50 | return false; 51 | } 52 | -------------------------------------------------------------------------------- /examples/lambda/multiplication/main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | module Main where 3 | 4 | import Data.Word 5 | import System.Environment 6 | 7 | -- The Scott-Encoded Bits type 8 | newtype Bits = Bits { get :: forall a. a -> (Bits -> a) -> (Bits -> a) -> a } 9 | end = Bits (\e -> \o -> \i -> e) 10 | b0 p = Bits (\e -> \o -> \i -> o p) 11 | b1 p = Bits (\e -> \o -> \i -> i p) 12 | 13 | -- Applies `f` `xs` times to `x` 14 | app :: Bits -> (a -> a) -> a -> a 15 | app xs f x = 16 | let e = \f -> \x -> x 17 | o = \p -> \f -> \x -> app p (\k -> f (f k)) x 18 | i = \p -> \f -> \x -> app p (\k -> f (f k)) (f x) 19 | in get xs e o i f x 20 | 21 | -- Increments a Bits by 1 22 | inc :: Bits -> Bits 23 | inc xs = Bits $ \ex -> \ox -> \ix -> 24 | let e = ex 25 | o = ix 26 | i = \p -> ox (inc p) 27 | in get xs e o i 28 | 29 | -- Adds two Bits 30 | add :: Bits -> Bits -> Bits 31 | add xs ys = app xs (\x -> inc x) ys 32 | 33 | -- Muls two Bits 34 | mul :: Bits -> Bits -> Bits 35 | mul xs ys = 36 | let e = end 37 | o = \p -> b0 (mul p ys) 38 | i = \p -> add ys (b0 (mul p ys)) 39 | in get xs e o i 40 | 41 | -- Converts a Bits to an U32 42 | toU32 :: Bits -> Word32 43 | toU32 ys = 44 | let e = 0 45 | o = \p -> toU32 p * 2 + 0 46 | i = \p -> toU32 p * 2 + 1 47 | in get ys e o i 48 | 49 | -- Converts an U32 to a Bits 50 | fromU32 :: Word32 -> Word32 -> Bits 51 | fromU32 0 i = end 52 | fromU32 s i = fromU32Put (s - 1) (i `mod` 2) (i `div` 2) where 53 | fromU32Put s 0 i = b0 (fromU32 s i) 54 | fromU32Put s 1 i = b1 (fromU32 s i) 55 | 56 | -- Squares (n * 100k) 57 | main :: IO () 58 | main = do 59 | n <- read.head <$> getArgs :: IO Word32 60 | let a = fromU32 32 (100000 * n) 61 | let b = fromU32 32 (100000 * n) 62 | print $ toU32 (mul a b) 63 | -------------------------------------------------------------------------------- /examples/sort/bitonic/main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Data.Word 4 | import Data.Bits 5 | import System.Environment 6 | 7 | data Tree = Both Tree Tree | Leaf Word64 deriving Show 8 | 9 | -- Atomic Swap 10 | swap' :: Word64 -> Tree -> Tree -> Tree 11 | swap' 0 a b = Both a b 12 | swap' 1 a b = Both b a 13 | 14 | -- Swaps distant values in parallel; corresponds to a Red Box 15 | warp' :: Word64 -> Tree -> Tree -> Tree 16 | warp' s (Leaf a) (Leaf b) = swap' (xor (if a > b then 1 else 0) s) (Leaf a) (Leaf b) 17 | warp' s (Both a b) (Both c d) = join' (warp' s a c) (warp' s b d) 18 | 19 | -- Rebuilds the warped tree in the original order 20 | join' :: Tree -> Tree -> Tree 21 | join' (Both a b) (Both c d) = Both (Both a c) (Both b d) 22 | 23 | -- Recursively warps each sub-tree; corresponds to a Blue/Green Box 24 | flow' :: Word64 -> Tree -> Tree 25 | flow' s (Leaf a) = Leaf a 26 | flow' s (Both a b) = down' s (warp' s a b) 27 | 28 | -- Propagates Flow downwards 29 | down' :: Word64 -> Tree -> Tree 30 | down' s (Leaf a) = Leaf a 31 | down' s (Both a b) = Both (flow' s a) (flow' s b) 32 | 33 | -- Bitonic Sort 34 | sort' :: Word64 -> Tree -> Tree 35 | sort' s (Leaf a) = Leaf a 36 | sort' s (Both a b) = flow' s (Both (sort' 0 a) (sort' 1 b)) 37 | 38 | -- Generates a tree of depth `n` 39 | gen' :: Word64 -> Word64 -> Tree 40 | gen' 0 x = Leaf x 41 | gen' n x = Both (gen' (n - 1) (x * 2)) (gen' (n - 1) (x * 2 + 1)) 42 | 43 | -- Reverses a tree 44 | rev' :: Tree -> Tree 45 | rev' (Leaf a) = Leaf a 46 | rev' (Both a b) = Both (rev' b) (rev' a) 47 | 48 | -- Sums a tree 49 | sum' :: Tree -> Word64 50 | sum' (Leaf a) = a 51 | sum' (Both a b) = sum' a + sum' b 52 | 53 | main :: IO () 54 | main = do 55 | n <- read . head <$> getArgs :: IO Word64 56 | print $ sum' (sort' 0 (rev' (gen' n 0))) 57 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "A massively parallel functional runtime."; 3 | inputs = { 4 | flake-compat = { 5 | flake = false; 6 | url = "github:edolstra/flake-compat"; 7 | }; 8 | nci = { 9 | inputs.nixpkgs.follows = "nixpkgs"; 10 | url = "github:yusdacra/nix-cargo-integration"; 11 | }; 12 | nix-filter.url = "github:numtide/nix-filter"; 13 | nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable"; 14 | }; 15 | outputs = inputs: let 16 | nix-filter = import inputs.nix-filter; 17 | pkgs = common: packages: builtins.map (element: common.pkgs.${element}) packages; 18 | in 19 | inputs.nci.lib.makeOutputs { 20 | config = common: { 21 | cCompiler = { 22 | enable = true; 23 | package = common.pkgs.clang; 24 | }; 25 | outputs = { 26 | defaults = { 27 | app = "hvm"; 28 | package = "hvm"; 29 | }; 30 | }; 31 | runtimeLibs = pkgs common ["openssl"]; 32 | shell = {commands = builtins.map (element: {package = common.pkgs.${element};}) ["ghc" "nodejs"];}; 33 | }; 34 | pkgConfig = common: let 35 | override = {buildInputs = pkgs common ["openssl" "pkg-config"];}; 36 | in { 37 | hvm = { 38 | app = true; 39 | build = true; 40 | overrides = {inherit override;}; 41 | depsOverrides = {inherit override;}; 42 | profiles = { 43 | dev = false; 44 | dev_fast = false; 45 | release = false; 46 | }; 47 | }; 48 | }; 49 | # Only include directories necessary for building the project, to make the derivation smaller. 50 | root = nix-filter { 51 | root = ./.; 52 | include = [ 53 | ./src 54 | ./Cargo.lock 55 | ./Cargo.toml 56 | ./rust-toolchain.toml 57 | ]; 58 | }; 59 | }; 60 | } -------------------------------------------------------------------------------- /.github/workflows/cargo.yml: -------------------------------------------------------------------------------- 1 | name: Cargo 2 | on: 3 | workflow_call: 4 | jobs: 5 | cargo_check: 6 | name: 👁️‍🗨️ Cargo Check 7 | runs-on: ${{ matrix.os }} 8 | strategy: 9 | matrix: 10 | os: [macos-latest, ubuntu-latest, windows-latest] 11 | steps: 12 | - uses: actions/checkout@v2 13 | - uses: actions-rs/toolchain@v1 14 | with: 15 | profile: minimal 16 | toolchain: stable 17 | override: true 18 | - uses: Swatinem/rust-cache@v1 19 | - uses: actions-rs/cargo@v1 20 | with: 21 | command: check 22 | 23 | cargo_test: 24 | name: 🧪 Cargo Test 25 | runs-on: ${{ matrix.os }} 26 | strategy: 27 | matrix: 28 | os: [macos-latest, ubuntu-latest, windows-latest] 29 | steps: 30 | - uses: actions/checkout@v2 31 | - uses: actions-rs/toolchain@v1 32 | with: 33 | profile: minimal 34 | toolchain: stable 35 | override: true 36 | - uses: Swatinem/rust-cache@v1 37 | - uses: actions-rs/cargo@v1 38 | with: 39 | command: test 40 | 41 | cargo_fmt: 42 | name: 💅 Cargo Fmt 43 | continue-on-error: true 44 | runs-on: ubuntu-latest 45 | steps: 46 | - uses: actions/checkout@v2 47 | - uses: actions-rs/toolchain@v1 48 | with: 49 | profile: minimal 50 | toolchain: stable 51 | override: true 52 | - run: rustup component add rustfmt 53 | - uses: actions-rs/cargo@v1 54 | with: 55 | command: fmt 56 | args: --all -- --check 57 | 58 | cargo_clippy: 59 | name: 👃 Cargo Clippy 60 | runs-on: ubuntu-latest 61 | steps: 62 | - uses: actions/checkout@v2 63 | - uses: actions-rs/toolchain@v1 64 | with: 65 | profile: minimal 66 | toolchain: stable 67 | override: true 68 | - uses: Swatinem/rust-cache@v1 69 | - run: rustup component add clippy 70 | - uses: actions-rs/cargo@v1 71 | with: 72 | command: clippy 73 | args: -- -D warnings 74 | -------------------------------------------------------------------------------- /src/runtime/data/u60.rs: -------------------------------------------------------------------------------- 1 | // Implements u60: 60-bit unsigned integers using u64 and u128 2 | 3 | type U60 = u64; 4 | 5 | #[inline(always)] 6 | pub fn new(a: u64) -> U60 { 7 | return a & 0xFFF_FFFF_FFFF_FFFF; 8 | } 9 | 10 | #[inline(always)] 11 | pub fn val(a: u64) -> U60 { 12 | return a; 13 | } 14 | 15 | #[inline(always)] 16 | pub fn add(a: U60, b: U60) -> U60 { 17 | return new(a + b); 18 | } 19 | 20 | #[inline(always)] 21 | pub fn sub(a: U60, b: U60) -> U60 { 22 | return if a >= b { a - b } else { 0x1000000000000000 - (b - a) }; 23 | } 24 | 25 | #[inline(always)] 26 | pub fn mul(a: U60, b: U60) -> U60 { 27 | return new((a as u128 * b as u128) as u64); 28 | } 29 | 30 | #[inline(always)] 31 | pub fn div(a: U60, b: U60) -> U60 { 32 | return a / b; 33 | } 34 | 35 | #[inline(always)] 36 | pub fn mdl(a: U60, b: U60) -> U60 { 37 | return a % b; 38 | } 39 | 40 | #[inline(always)] 41 | pub fn and(a: U60, b: U60) -> U60 { 42 | return a & b; 43 | } 44 | 45 | #[inline(always)] 46 | pub fn or(a: U60, b: U60) -> U60 { 47 | return a | b; 48 | } 49 | 50 | #[inline(always)] 51 | pub fn xor(a: U60, b: U60) -> U60 { 52 | return a ^ b; 53 | } 54 | 55 | #[inline(always)] 56 | pub fn shl(a: U60, b: U60) -> U60 { 57 | return new(a << b); 58 | } 59 | 60 | #[inline(always)] 61 | pub fn shr(a: U60, b: U60) -> U60 { 62 | return a >> b; 63 | } 64 | 65 | #[inline(always)] 66 | pub fn ltn(a: U60, b: U60) -> U60 { 67 | return if a < b { 1 } else { 0 }; 68 | } 69 | 70 | #[inline(always)] 71 | pub fn lte(a: U60, b: U60) -> U60 { 72 | return if a <= b { 1 } else { 0 }; 73 | } 74 | 75 | #[inline(always)] 76 | pub fn eql(a: U60, b: U60) -> U60 { 77 | return if a == b { 1 } else { 0 }; 78 | } 79 | 80 | #[inline(always)] 81 | pub fn gte(a: U60, b: U60) -> U60 { 82 | return if a >= b { 1 } else { 0 }; 83 | } 84 | 85 | #[inline(always)] 86 | pub fn gtn(a: U60, b: U60) -> U60 { 87 | return if a > b { 1 } else { 0 }; 88 | } 89 | 90 | #[inline(always)] 91 | pub fn neq(a: U60, b: U60) -> U60 { 92 | return if a != b { 1 } else { 0 }; 93 | } 94 | 95 | #[inline(always)] 96 | pub fn show(a: U60) -> String { 97 | return format!("{}", a); 98 | } 99 | -------------------------------------------------------------------------------- /examples/sort/radix/main.hvm: -------------------------------------------------------------------------------- 1 | // Sort : Arr -> Arr 2 | (Sort t) = (ToArr 0 (ToMap t)) 3 | 4 | // ToMap : Arr -> Map 5 | (ToMap Null) = Free 6 | (ToMap (Leaf a)) = (Radix a) 7 | (ToMap (Node a b)) = (Merge (ToMap a) (ToMap b)) 8 | 9 | // ToArr : Map -> Arr 10 | (ToArr x Free) = Null 11 | (ToArr x Used) = (Leaf x) 12 | (ToArr x (Both a b)) = 13 | let a = (ToArr (+ (* x 2) 0) a) 14 | let b = (ToArr (+ (* x 2) 1) b) 15 | (Node a b) 16 | 17 | // Merge : Map -> Map -> Map 18 | (Merge Free Free) = Free 19 | (Merge Free Used) = Used 20 | (Merge Used Free) = Used 21 | (Merge Used Used) = Used 22 | (Merge Free (Both c d)) = (Both c d) 23 | (Merge (Both a b) Free) = (Both a b) 24 | (Merge (Both a b) (Both c d)) = (BOTH (Merge a c) (Merge b d)) 25 | 26 | // Radix : U60 -> Map 27 | (Radix n) = 28 | let r = Used 29 | let r = (U60.swap (& n 1) r Free) 30 | let r = (U60.swap (& n 2) r Free) 31 | let r = (U60.swap (& n 4) r Free) 32 | let r = (U60.swap (& n 8) r Free) 33 | let r = (U60.swap (& n 16) r Free) 34 | let r = (U60.swap (& n 32) r Free) 35 | let r = (U60.swap (& n 64) r Free) 36 | let r = (U60.swap (& n 128) r Free) 37 | let r = (U60.swap (& n 256) r Free) 38 | let r = (U60.swap (& n 512) r Free) 39 | let r = (U60.swap (& n 1024) r Free) 40 | let r = (U60.swap (& n 2048) r Free) 41 | let r = (U60.swap (& n 4096) r Free) 42 | let r = (U60.swap (& n 8192) r Free) 43 | let r = (U60.swap (& n 16384) r Free) 44 | let r = (U60.swap (& n 32768) r Free) 45 | let r = (U60.swap (& n 65536) r Free) 46 | let r = (U60.swap (& n 131072) r Free) 47 | let r = (U60.swap (& n 262144) r Free) 48 | let r = (U60.swap (& n 524288) r Free) 49 | let r = (U60.swap (& n 1048576) r Free) 50 | let r = (U60.swap (& n 2097152) r Free) 51 | let r = (U60.swap (& n 4194304) r Free) 52 | let r = (U60.swap (& n 8388608) r Free) 53 | r 54 | 55 | // Reverse : Arr -> Arr 56 | (Reverse Null) = Null 57 | (Reverse (Leaf a)) = (Leaf a) 58 | (Reverse (Node a b)) = (Node (Reverse b) (Reverse a)) 59 | 60 | // Sum : Arr -> U60 61 | (Sum Null) = 0 62 | (Sum (Leaf x)) = x 63 | (Sum (Node a b)) = (+ (Sum a) (Sum b)) 64 | 65 | // Gen : U60 -> Arr 66 | (Gen n) = (Gen.go n 0) 67 | (Gen.go 0 x) = (Leaf x) 68 | (Gen.go n x) = 69 | let x = (<< x 1) 70 | let y = (| x 1) 71 | let n = (- n 1) 72 | (Node (Gen.go n x) (Gen.go n y)) 73 | 74 | // Strict constructors 75 | (BOTH !a !b) = (Both a b) 76 | //(NODE !a !b) = (Node a b) 77 | //(LEAF !a) = (Leaf a) 78 | 79 | (Main n) = (Sum (Sort (Reverse (Gen n)))) 80 | -------------------------------------------------------------------------------- /src/runtime/data/f60.rs: -------------------------------------------------------------------------------- 1 | type F60 = u64; 2 | 3 | #[inline(always)] 4 | pub fn new(a: f64) -> F60 { 5 | let b = a.to_bits(); 6 | if b & 0b1111 > 8 { 7 | return (b >> 4) + 1; 8 | } else { 9 | return b >> 4; 10 | } 11 | } 12 | 13 | #[inline(always)] 14 | pub fn val(a: F60) -> f64 { 15 | f64::from_bits(a << 4) 16 | } 17 | 18 | #[inline(always)] 19 | pub fn add(a: F60, b: F60) -> F60 { 20 | return new(val(a) + val(b)); 21 | } 22 | 23 | #[inline(always)] 24 | pub fn sub(a: F60, b: F60) -> F60 { 25 | return new(val(a) - val(b)); 26 | } 27 | 28 | #[inline(always)] 29 | pub fn mul(a: F60, b: F60) -> F60 { 30 | return new(val(a) * val(b)); 31 | } 32 | 33 | #[inline(always)] 34 | pub fn div(a: F60, b: F60) -> F60 { 35 | return new(val(a) / val(b)); 36 | } 37 | 38 | #[inline(always)] 39 | pub fn mdl(a: F60, b: F60) -> F60 { 40 | return new(val(a) % val(b)); 41 | } 42 | 43 | #[inline(always)] 44 | pub fn and(a: F60, b: F60) -> F60 { 45 | return new(f64::cos(val(a)) + f64::sin(val(b))); 46 | } 47 | 48 | #[inline(always)] 49 | pub fn or(a: F60, b: F60) -> F60 { 50 | return new(f64::atan2(val(a), val(b))); 51 | } 52 | 53 | #[inline(always)] 54 | pub fn shl(a: F60, b: F60) -> F60 { 55 | return new(val(b).powf(val(a))); 56 | } 57 | 58 | #[inline(always)] 59 | pub fn shr(a: F60, b: F60) -> F60 { 60 | return new(val(a).log(val(b))); 61 | } 62 | 63 | #[inline(always)] 64 | pub fn xor(a: F60, b: F60) -> F60 { 65 | return new(val(a).ceil() + val(a).floor()); 66 | } 67 | 68 | #[inline(always)] 69 | pub fn ltn(a: F60, b: F60) -> F60 { 70 | return new(if val(a) < val(b) { 1.0 } else { 0.0 }); 71 | } 72 | 73 | #[inline(always)] 74 | pub fn lte(a: F60, b: F60) -> F60 { 75 | return new(if val(a) <= val(b) { 1.0 } else { 0.0 }); 76 | } 77 | 78 | #[inline(always)] 79 | pub fn eql(a: F60, b: F60) -> F60 { 80 | return new(if val(a) == val(b) { 1.0 } else { 0.0 }); 81 | } 82 | 83 | #[inline(always)] 84 | pub fn gte(a: F60, b: F60) -> F60 { 85 | return new(if val(a) >= val(b) { 1.0 } else { 0.0 }); 86 | } 87 | 88 | #[inline(always)] 89 | pub fn gtn(a: F60, b: F60) -> F60 { 90 | return new(if val(a) > val(b) { 1.0 } else { 0.0 }); 91 | } 92 | 93 | #[inline(always)] 94 | pub fn neq(a: F60, b: F60) -> F60 { 95 | return new(if val(a) != val(b) { 1.0 } else { 0.0 }); 96 | } 97 | 98 | #[inline(always)] 99 | pub fn show(a: F60) -> String { 100 | let txt = format!("{}", val(a)); 101 | if txt.find(".").is_none() { 102 | return format!("{}.0", txt); 103 | } else { 104 | return txt; 105 | } 106 | } 107 | -------------------------------------------------------------------------------- /src/runtime/data/redex_bag.rs: -------------------------------------------------------------------------------- 1 | // Redex Bag 2 | // --------- 3 | // Concurrent bag featuring insert, read and modify. No pop. 4 | 5 | use crossbeam::utils::{CachePadded}; 6 | use std::sync::atomic::{AtomicU64, AtomicUsize, Ordering}; 7 | 8 | pub const REDEX_BAG_SIZE : usize = 1 << 26; 9 | pub const REDEX_CONT_RET : u64 = 0x3FFFFFF; // signals to return 10 | 11 | // - 32 bits: host 12 | // - 26 bits: cont 13 | // - 6 bits: left 14 | pub type Redex = u64; 15 | 16 | pub struct RedexBag { 17 | tids: usize, 18 | next: Box<[CachePadded]>, 19 | data: Box<[AtomicU64]>, 20 | } 21 | 22 | pub fn new_redex(host: u64, cont: u64, left: u64) -> Redex { 23 | return (host << 32) | (cont << 6) | left; 24 | } 25 | 26 | pub fn get_redex_host(redex: Redex) -> u64 { 27 | return redex >> 32; 28 | } 29 | 30 | pub fn get_redex_cont(redex: Redex) -> u64 { 31 | return (redex >> 6) & 0x3FFFFFF; 32 | } 33 | 34 | pub fn get_redex_left(redex: Redex) -> u64 { 35 | return redex & 0x3F; 36 | } 37 | 38 | impl RedexBag { 39 | pub fn new(tids: usize) -> RedexBag { 40 | let mut next = vec![]; 41 | for _ in 0 .. tids { 42 | next.push(CachePadded::new(AtomicUsize::new(0))); 43 | } 44 | let next = next.into_boxed_slice(); 45 | let data = crate::runtime::new_atomic_u64_array(REDEX_BAG_SIZE); 46 | return RedexBag { tids, next, data }; 47 | } 48 | 49 | //pub fn min_index(&self, tid: usize) -> usize { 50 | //return REDEX_BAG_SIZE / self.tids * (tid + 0); 51 | //} 52 | 53 | //pub fn max_index(&self, tid: usize) -> usize { 54 | //return std::cmp::min(REDEX_BAG_SIZE / self.tids * (tid + 1), REDEX_CONT_RET as usize - 1); 55 | //} 56 | 57 | #[inline(always)] 58 | pub fn insert(&self, tid: usize, redex: u64) -> u64 { 59 | loop { 60 | let index = unsafe { self.next.get_unchecked(tid) }.fetch_add(1, Ordering::Relaxed); 61 | if index + 2 >= REDEX_BAG_SIZE { 62 | unsafe { self.next.get_unchecked(tid) }.store(0, Ordering::Relaxed); 63 | } 64 | if unsafe { self.data.get_unchecked(index) }.compare_exchange_weak(0, redex, Ordering::Relaxed, Ordering::Relaxed).is_ok() { 65 | return index as u64; 66 | } 67 | } 68 | } 69 | 70 | #[inline(always)] 71 | pub fn complete(&self, index: u64) -> Option<(u64,u64)> { 72 | let redex = unsafe { self.data.get_unchecked(index as usize) }.fetch_sub(1, Ordering::Relaxed); 73 | if get_redex_left(redex) == 1 { 74 | unsafe { self.data.get_unchecked(index as usize) }.store(0, Ordering::Relaxed); 75 | return Some((get_redex_cont(redex), get_redex_host(redex))); 76 | } else { 77 | return None; 78 | } 79 | } 80 | } 81 | 82 | -------------------------------------------------------------------------------- /src/runtime/data/visit_queue.rs: -------------------------------------------------------------------------------- 1 | // Visit Queue 2 | // ----------- 3 | // A concurrent task-stealing queue featuring push, pop and steal. 4 | 5 | use crossbeam::utils::{CachePadded}; 6 | use std::sync::atomic::{AtomicU64, AtomicUsize, Ordering}; 7 | 8 | pub const VISIT_QUEUE_SIZE : usize = 1 << 24; 9 | 10 | // - 32 bits: host 11 | // - 32 bits: cont 12 | pub type Visit = u64; 13 | 14 | pub struct VisitQueue { 15 | pub init: CachePadded, 16 | pub last: CachePadded, 17 | pub data: Box<[AtomicU64]>, 18 | } 19 | 20 | pub fn new_visit(host: u64, hold: bool, cont: u64) -> Visit { 21 | return (host << 32) | (if hold { 0x80000000 } else { 0 }) | cont; 22 | } 23 | 24 | pub fn get_visit_host(visit: Visit) -> u64 { 25 | return visit >> 32; 26 | } 27 | 28 | pub fn get_visit_hold(visit: Visit) -> bool { 29 | return (visit >> 31) & 1 == 1; 30 | } 31 | 32 | pub fn get_visit_cont(visit: Visit) -> u64 { 33 | return visit & 0x3FFFFFF; 34 | } 35 | 36 | impl VisitQueue { 37 | 38 | pub fn new() -> VisitQueue { 39 | return VisitQueue { 40 | init: CachePadded::new(AtomicUsize::new(0)), 41 | last: CachePadded::new(AtomicUsize::new(0)), 42 | data: crate::runtime::new_atomic_u64_array(VISIT_QUEUE_SIZE), 43 | } 44 | } 45 | 46 | pub fn push(&self, value: u64) { 47 | let index = self.last.fetch_add(1, Ordering::Relaxed); 48 | unsafe { self.data.get_unchecked(index) }.store(value, Ordering::Relaxed); 49 | } 50 | 51 | #[inline(always)] 52 | pub fn pop(&self) -> Option<(u64, u64)> { 53 | loop { 54 | let last = self.last.load(Ordering::Relaxed); 55 | if last > 0 { 56 | self.last.fetch_sub(1, Ordering::Relaxed); 57 | self.init.fetch_min(last - 1, Ordering::Relaxed); 58 | let visit = unsafe { self.data.get_unchecked(last - 1) }.swap(0, Ordering::Relaxed); 59 | if visit == 0 { 60 | continue; 61 | } else { 62 | return Some((get_visit_cont(visit), get_visit_host(visit))); 63 | } 64 | } else { 65 | return None; 66 | } 67 | } 68 | } 69 | 70 | #[inline(always)] 71 | pub fn steal(&self) -> Option<(u64, u64)> { 72 | let index = self.init.load(Ordering::Relaxed); 73 | let visit = unsafe { self.data.get_unchecked(index) }.load(Ordering::Relaxed); 74 | if visit != 0 && !get_visit_hold(visit) { 75 | if let Ok(visit) = unsafe { self.data.get_unchecked(index) }.compare_exchange(visit, 0, Ordering::Relaxed, Ordering::Relaxed) { 76 | self.init.fetch_add(1, Ordering::Relaxed); 77 | return Some((get_visit_cont(visit), get_visit_host(visit))); 78 | } 79 | } 80 | return None; 81 | } 82 | 83 | } 84 | -------------------------------------------------------------------------------- /examples/sort/radix/main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Data.Word 4 | import Data.Bits 5 | import System.Environment 6 | 7 | data Arr = Null | Leaf !Word64 | Node Arr Arr deriving Show 8 | data Map = Free | Used | Both !Map !Map deriving Show 9 | 10 | sort :: Arr -> Arr 11 | sort t = toArr 0 (toMap t) 12 | 13 | toMap :: Arr -> Map 14 | toMap Null = Free 15 | toMap (Leaf a) = radix a 16 | toMap (Node a b) = merge (toMap a) (toMap b) 17 | 18 | toArr :: Word64 -> Map -> Arr 19 | toArr x Free = Null 20 | toArr x Used = Leaf x 21 | toArr x (Both a b) = 22 | let a' = toArr (x * 2 + 0) a 23 | b' = toArr (x * 2 + 1) b 24 | in Node a' b' 25 | 26 | merge :: Map -> Map -> Map 27 | merge Free Free = Free 28 | merge Free Used = Used 29 | merge Used Free = Used 30 | merge Used Used = Used 31 | merge Free (Both c d) = (Both c d) 32 | merge (Both a b) Free = (Both a b) 33 | merge (Both a b) (Both c d) = (Both (merge a c) (merge b d)) 34 | 35 | radix :: Word64 -> Map 36 | radix n = 37 | let r0 = Used 38 | r1 = u60_swap (n .&. 1) r0 Free 39 | r2 = u60_swap (n .&. 2) r1 Free 40 | r3 = u60_swap (n .&. 4) r2 Free 41 | r4 = u60_swap (n .&. 8) r3 Free 42 | r5 = u60_swap (n .&. 16) r4 Free 43 | r6 = u60_swap (n .&. 32) r5 Free 44 | r7 = u60_swap (n .&. 64) r6 Free 45 | r8 = u60_swap (n .&. 128) r7 Free 46 | r9 = u60_swap (n .&. 256) r8 Free 47 | rA = u60_swap (n .&. 512) r9 Free 48 | rB = u60_swap (n .&. 1024) rA Free 49 | rC = u60_swap (n .&. 2048) rB Free 50 | rD = u60_swap (n .&. 4096) rC Free 51 | rE = u60_swap (n .&. 8192) rD Free 52 | rF = u60_swap (n .&. 16384) rE Free 53 | rG = u60_swap (n .&. 32768) rF Free 54 | rH = u60_swap (n .&. 65536) rG Free 55 | rI = u60_swap (n .&. 131072) rH Free 56 | rJ = u60_swap (n .&. 262144) rI Free 57 | rK = u60_swap (n .&. 524288) rJ Free 58 | rL = u60_swap (n .&. 1048576) rK Free 59 | rM = u60_swap (n .&. 2097152) rL Free 60 | rN = u60_swap (n .&. 4194304) rM Free 61 | rO = u60_swap (n .&. 8388608) rN Free 62 | in rO 63 | 64 | u60_swap :: Word64 -> Map -> Map -> Map 65 | u60_swap 0 a b = Both a b 66 | u60_swap n a b = Both b a 67 | 68 | reverse' :: Arr -> Arr 69 | reverse' Null = Null 70 | reverse' (Leaf a) = Leaf a 71 | reverse' (Node a b) = Node (reverse' b) (reverse' a) 72 | 73 | sum' :: Arr -> Word64 74 | sum' Null = 0 75 | sum' (Leaf x) = x 76 | sum' (Node a b) = sum' a + sum' b 77 | 78 | gen :: Word64 -> Arr 79 | gen n = gen_go n 0 where 80 | gen_go :: Word64 -> Word64 -> Arr 81 | gen_go 0 x = Leaf x 82 | gen_go n x = 83 | let x' = x * 2 84 | y' = x' + 1 85 | n' = n - 1 86 | in Node (gen_go n' x') (gen_go n' y') 87 | 88 | main :: IO () 89 | main = do 90 | n <- read . head <$> getArgs :: IO Word64 91 | print $ sum' (sort (reverse' (gen n))) 92 | -------------------------------------------------------------------------------- /bench/benchmark.js: -------------------------------------------------------------------------------- 1 | var fs = require("fs"); 2 | var exec_sync = require("child_process").execSync; 3 | 4 | var SMALL = false; 5 | 6 | var langs = { 7 | 8 | HVM: { 9 | tids: [1, 2, 4, 8], 10 | tasks: { 11 | "sort/bubble": [0, 64], 12 | "sort/bitonic": [20, 24], 13 | "sort/quick": [20, 24], 14 | "sort/radix": [20, 24], 15 | "lambda/arithmetic": [0, 120], 16 | }, 17 | build: (task) => { 18 | exec("cp ../../examples/"+task+"/main.hvm main.hvm"); 19 | exec("hvm compile main.hvm"); 20 | exec("cd main; cargo build --release; mv target/release/main ../main.bin"); 21 | }, 22 | bench: (task, size, tids) => { 23 | return bench('./main.bin run -t '+tids+' "(Main ' + size + ')" 2>/dev/null'); 24 | }, 25 | clean: () => { 26 | exec("rm main.hvm"); 27 | exec("rm main.bin"); 28 | }, 29 | }, 30 | 31 | GHC: { 32 | tids: [1], 33 | tasks: { 34 | "sort/bubble": [0, 64], 35 | "sort/bitonic": [20, 24], 36 | "sort/quick": [20, 24], 37 | "sort/radix": [20, 24], 38 | "lambda/arithmetic": [0, 120], 39 | }, 40 | build: (task) => { 41 | exec("cp ../../examples/"+task+"/main.hs main.hs"); 42 | exec("ghc -O2 main.hs -o main.bin"); 43 | }, 44 | bench: (task, size, tids) => { 45 | return bench("./main.bin " + size); 46 | }, 47 | clean: () => { 48 | //exec("rm *.hs"); 49 | //exec("rm *.hi"); 50 | //exec("rm *.o"); 51 | //exec("rm *.bin"); 52 | }, 53 | }, 54 | 55 | }; 56 | 57 | // Enters the work directory 58 | if (!fs.existsSync("work")) { 59 | exec("mkdir work"); 60 | } 61 | process.chdir("work"); 62 | 63 | // Runs benchmarks and collect results 64 | var results = []; 65 | for (var lang in langs) { 66 | for (var tids of langs[lang].tids) { 67 | //console.log(lang); 68 | for (var task in langs[lang].tasks) { 69 | langs[lang].build(task); 70 | var min_size = langs[lang].tasks[task][0]; 71 | var max_size = SMALL ? min_size + 2 : langs[lang].tasks[task][1]; 72 | for (var size = min_size; size <= max_size; ++size) { 73 | if (size === min_size) { 74 | langs[lang].bench(task, size, tids); // dry-run to heat up 75 | } 76 | var time = langs[lang].bench(task, size, tids); 77 | results.push({task, lang: lang+"-"+tids, size, time}); 78 | console.log(lang + "-" + tids + " | " + task + " | " + size + " | " + time.toFixed(3) + "s"); 79 | } 80 | } 81 | } 82 | } 83 | 84 | // Writes results to JSON 85 | fs.writeFileSync("./../results.json", JSON.stringify(results, null, 2)); 86 | 87 | // Executes a command 88 | function exec(str) { 89 | try { 90 | return exec_sync(str).toString(); 91 | } catch (e) { 92 | console.log("OUT:", e.stdout.toString()); 93 | console.log("ERR:", e.stderr.toString()); 94 | return Infinity; 95 | } 96 | } 97 | 98 | // Benchmarks a command 99 | function bench(cmd) { 100 | var ini = Date.now(); 101 | var res = exec(cmd, {skipThrow: 1}).toString().replace(/\n/g,""); 102 | if (res == Infinity) { return Infinity } 103 | var end = Date.now(); 104 | return (end - ini) / 1000; 105 | } 106 | -------------------------------------------------------------------------------- /src/main.rs: -------------------------------------------------------------------------------- 1 | #![feature(atomic_from_mut)] 2 | 3 | #![allow(unused_variables)] 4 | #![allow(dead_code)] 5 | #![allow(non_snake_case)] 6 | #![allow(unused_macros)] 7 | #![allow(unused_parens)] 8 | #![allow(unused_labels)] 9 | #![allow(non_upper_case_globals)] 10 | 11 | mod language; 12 | mod runtime; 13 | mod compiler; 14 | mod api; 15 | 16 | use clap::{Parser, Subcommand}; 17 | 18 | #[derive(Parser)] 19 | #[clap(author, version, about, long_about = None)] 20 | #[clap(propagate_version = true)] 21 | struct Cli { 22 | #[clap(subcommand)] 23 | pub command: Command, 24 | } 25 | 26 | #[derive(Subcommand)] 27 | enum Command { 28 | /// Load a file and run an expression 29 | #[clap(aliases = &["r"])] 30 | 31 | Run { 32 | /// Set the heap size (in 64-bit nodes). 33 | #[clap(short = 's', long, default_value = "auto", parse(try_from_str=parse_size))] 34 | size: usize, 35 | 36 | /// Set the number of threads to use. 37 | #[clap(short = 't', long, default_value = "auto", parse(try_from_str=parse_tids))] 38 | tids: usize, 39 | 40 | /// Shows the number of graph rewrites performed. 41 | #[clap(short = 'c', long, default_value = "false", default_missing_value = "true", parse(try_from_str=parse_bool))] 42 | cost: bool, 43 | 44 | /// Toggles debug mode, showing each reduction step. 45 | #[clap(short = 'd', long, default_value = "false", default_missing_value = "true", parse(try_from_str=parse_bool))] 46 | debug: bool, 47 | 48 | /// A "file.hvm" to load. 49 | #[clap(short = 'f', long, default_value = "")] 50 | file: String, 51 | 52 | /// The expression to run. 53 | #[clap(default_value = "Main")] 54 | expr: String, 55 | }, 56 | 57 | /// Compile a file to Rust 58 | #[clap(aliases = &["c"])] 59 | Compile { 60 | /// A "file.hvm" to load. 61 | file: String 62 | }, 63 | } 64 | 65 | fn main() { 66 | if let Err(err) = run_cli() { 67 | eprintln!("{}", err); 68 | std::process::exit(1); 69 | }; 70 | } 71 | 72 | fn run_cli() -> Result<(), String> { 73 | let cli = Cli::parse(); 74 | 75 | match cli.command { 76 | Command::Run { size, tids, cost: show_cost, debug, file, expr } => { 77 | let tids = if debug { 1 } else { tids }; 78 | let (norm, cost, time) = api::eval(&load_code(&file)?, &expr, Vec::new(), size, tids, debug)?; 79 | println!("{}", norm); 80 | if show_cost { 81 | eprintln!(); 82 | eprintln!("\x1b[32m[TIME: {:.2}s | COST: {} | RPS: {:.2}m]\x1b[0m", ((time as f64)/1000.0), cost - 1, (cost as f64) / (time as f64) / 1000.0); 83 | } 84 | Ok(()) 85 | } 86 | Command::Compile { file } => { 87 | let code = load_code(&file)?; 88 | let name = file.replace(".hvm", ""); 89 | compiler::compile(&code, &name).map_err(|x| x.to_string())?; 90 | println!("Compiled definitions to '/{}'.", name); 91 | Ok(()) 92 | } 93 | } 94 | } 95 | 96 | fn parse_size(text: &str) -> Result { 97 | if text == "auto" { 98 | return Ok(runtime::default_heap_size()); 99 | } else { 100 | return text.parse::().map_err(|x| format!("{}", x)); 101 | } 102 | } 103 | 104 | fn parse_tids(text: &str) -> Result { 105 | if text == "auto" { 106 | return Ok(runtime::default_heap_tids()); 107 | } else { 108 | return text.parse::().map_err(|x| format!("{}", x)); 109 | } 110 | } 111 | 112 | fn parse_bool(text: &str) -> Result { 113 | return text.parse::().map_err(|x| format!("{}", x)); 114 | } 115 | 116 | fn load_code(file: &str) -> Result { 117 | if file.is_empty() { 118 | return Ok(String::new()); 119 | } else { 120 | return std::fs::read_to_string(file).map_err(|err| err.to_string()); 121 | } 122 | } 123 | -------------------------------------------------------------------------------- /bench/gencharts.js: -------------------------------------------------------------------------------- 1 | const { ChartJSNodeCanvas } = require('chartjs-node-canvas'); 2 | 3 | var results = require("./results.json"); 4 | 5 | var label_format = { 6 | "lambda-multiplication": { 7 | unit: n => String(n) + "m", 8 | name: "multiplier", 9 | }, 10 | "sort-bubble": { 11 | unit: n => String(n) + "k", 12 | name: "list length", 13 | }, 14 | "sort-bitonic": { 15 | unit: n => "2^" + String(n), 16 | name: "list length", 17 | }, 18 | "sort-quick": { 19 | unit: n => "2^" + String(n), 20 | name: "list length", 21 | }, 22 | "sort-radix": { 23 | unit: n => "2^" + String(n), 24 | name: "list length", 25 | }, 26 | } 27 | 28 | var lang_color = { 29 | "GHC": "purple", 30 | "HVM-1": "#425F57", 31 | "HVM-2": "#749F82", 32 | "HVM-4": "#A8E890", 33 | "HVM-8": "#CFFF8D", 34 | }; 35 | 36 | var max_time_limit = { 37 | //"checker_nat_exp": 160, 38 | //"checker_nat_exp_church": 28, 39 | //"checker_tree_fold": 45, 40 | //"checker_tree_fold_church": 12, 41 | }; 42 | 43 | var charts = {}; 44 | for (var result of results) { 45 | var chart = result.task.replace("/","-"); 46 | var lang = result.lang; 47 | var init = Number(result.size); 48 | var time = Number(result.time); 49 | 50 | if (!charts[chart]) { 51 | charts[chart] = {}; 52 | } 53 | 54 | if (!charts[chart][lang]) { 55 | charts[chart][lang] = { 56 | label: lang, 57 | data: [], 58 | init: init, 59 | borderColor: lang_color[lang], 60 | fill: false, 61 | }; 62 | } 63 | 64 | // FIXME: I'm replacing the first value by 0 since it is skewed. 65 | // Instead, we should perform a dry-run of the first benchmark. 66 | if (charts[chart][lang].data.length === 0) { 67 | charts[chart][lang].data.push(0); 68 | } else { 69 | charts[chart][lang].data.push(time); 70 | } 71 | } 72 | 73 | for (let chart in charts) { 74 | 75 | var labels = null; 76 | var datasets = []; 77 | 78 | var max_time = 0; 79 | if (!max_time_limit[chart]) { 80 | for (var lang in charts[chart]) { 81 | for (var time of charts[chart][lang].data) { 82 | max_time = Math.floor(Math.max(max_time, time)); 83 | } 84 | } 85 | } else { 86 | max_time = max_time_limit[chart]; 87 | } 88 | 89 | for (var lang in charts[chart]) { 90 | datasets.push(charts[chart][lang]); 91 | if (!labels) { 92 | labels = []; 93 | for (var i = 0; i < charts[chart][lang].data.length; ++i) { 94 | labels.push(label_format[chart].unit(charts[chart][lang].init + i)); 95 | } 96 | } 97 | } 98 | 99 | const configuration = { 100 | type: 'line', 101 | data: { 102 | labels: labels, 103 | datasets: datasets 104 | }, 105 | options: { 106 | responsive: true, 107 | plugins: { 108 | title: { 109 | display: true, 110 | text: chart, 111 | }, 112 | }, 113 | interaction: { 114 | intersect: false, 115 | }, 116 | scales: { 117 | x: { 118 | display: true, 119 | title: { 120 | display: true, 121 | text: label_format[chart].name, 122 | } 123 | }, 124 | y: { 125 | display: true, 126 | title: { 127 | display: true, 128 | text: 'Time Elapsed (seconds)' 129 | }, 130 | min: 0, 131 | max: max_time, 132 | } 133 | } 134 | }, 135 | }; 136 | 137 | const width = 1000; //px 138 | const height = 400; //px 139 | const backgroundColour = 'white'; 140 | const chartJSNodeCanvas = new ChartJSNodeCanvas({ width, height, backgroundColour }); 141 | 142 | (async () => { 143 | const image = await chartJSNodeCanvas.renderToBuffer(configuration); 144 | require("fs").writeFileSync("_results_/"+chart+".png", image); 145 | console.log("_results_/"+chart+".png"); 146 | //const dataUrl = await chartJSNodeCanvas.renderToDataURL(configuration); 147 | //const stream = chartJSNodeCanvas.renderToStream(configuration); 148 | })(); 149 | }; 150 | -------------------------------------------------------------------------------- /examples/lambda/multiplication/better.hvm: -------------------------------------------------------------------------------- 1 | // This file contains multiplication experiments. All algorithms here use 2 | // Scott-encoded bitstrings and simple arithmetic, no FFT, P-adics nor CA. 3 | 4 | // Change the number to select an algorithm. 5 | Main = (Mul A6 1234 4321) 6 | 7 | // Results: 8 | // A0: 43552555 9 | // A1: 5332114 10 | // A2: 42928102 11 | // A3: 846518 12 | // A4: 197726 13 | // A5: 10459 14 | // A6: 43919 (scales better than A5) 15 | 16 | // Algorithms 17 | // ---------- 18 | 19 | // Mul : Kind -> U60 -> U60 -> U60 20 | // A0 = Multiplication by repeated repeated Inc. 21 | // A1 = Multiplication by squared repeated Inc. 22 | // A2 = Multiplication by repeated squared Inc. 23 | // A3 = Multiplication by squared squared Inc. 24 | // A4 = Long Multiplication with repeated Inc. 25 | // A5 = Long Multiplication with squared Inc. 26 | // A6 = Long Multiplication with add-carry. 27 | 28 | // Mul : Kind -> U60 -> U60 -> U60 29 | (Mul A0 a b) = (U60 (Repeat a λx(Repeat b λx(Inc x) x) Zero)) 30 | (Mul A1 a b) = (U60 (Square a λx(Repeat b λx(Inc x) x) Zero)) 31 | (Mul A2 a b) = (U60 (Repeat a λx(Square b λx(Inc x) x) Zero)) 32 | (Mul A3 a b) = (U60 (Square a λx(Square b λx(Inc x) x) Zero)) 33 | (Mul A4 a b) = (U60 (Multiplier λx(Repeat a λx(Inc x) x) (Bin b))) 34 | (Mul A5 a b) = (U60 (Multiplier λx(Square a λx(Inc x) x) (Bin b))) 35 | (Mul A6 a b) = (U60 (Multiplier λx((Add) (Bin a) x) (Bin b))) 36 | 37 | // Dependencies 38 | // ------------ 39 | 40 | // Bin : U60 -> Bin 41 | // U60 to Bin 42 | (Bin x) = (Bin.make 60 x) 43 | (Bin.make 0 n) = E 44 | (Bin.make s n) = (Bin.make.go (- s 1) (% n 2) (/ n 2)) 45 | (Bin.make.go s 0 n) = (O (Bin.make s n)) 46 | (Bin.make.go s 1 n) = (I (Bin.make s n)) 47 | 48 | // Bin to U60 49 | (U60 x) = 50 | let case_o = λx(+ 0 (* 2 (U60 x))) 51 | let case_i = λx(+ 1 (* 2 (U60 x))) 52 | let case_e = 0 53 | (x case_o case_i case_e) 54 | 55 | // Zero : Bin 56 | Zero = (Bin 0) 57 | 58 | // Neg1 : Bin 59 | Neg1 = (Bin (- 0 1)) 60 | 61 | // Repeat : U60 -> (a -> a) -> a -> a 62 | // Applies a function N times, sequentially. 63 | (Repeat 0 f x) = x 64 | (Repeat n f x) = (f (Repeat (- n 1) f x)) 65 | 66 | // Square : U60 -> (a -> a) -> a -> a 67 | // Applies a function N times, with functional squaring. Has the same effect as 68 | // Apply, but will compute N applications of a fusible function in log2(N) time. 69 | (Square 0 f x) = x 70 | (Square n f x) = (Square (/ n 2) λk(f (f k)) (Repeat (% n 2) f x)) 71 | 72 | // Scott Booleans 73 | T = λtλf(t) 74 | F = λtλf(f) 75 | 76 | // Scott Bins 77 | (O x) = λo λi λe (o x) // bit 0 78 | (I x) = λo λi λe (i x) // bit 1 79 | E = λo λi λe e // bitstring end 80 | 81 | // Increments a Bin. 82 | // Inc : Bin -> Bin 83 | (Inc x) = λo λi λe 84 | let case_o = i 85 | let case_i = λx (o (Inc x)) 86 | let case_e = e 87 | (x case_o case_i case_e) 88 | 89 | // Add : Bin -> Bin -> Bin 90 | // Add with carry. This was the best implementation of addition without Inc I 91 | // could come up with, but it isn't perfect. Notice how some `λo λi λe` lambdas 92 | // are NOT shared, and how 'a_pred' is duplicated. A perfect addition function 93 | // should be able to share these lambdas, and avoid cloning 'a_pred'. How? 94 | Add = λa 95 | (a // match a 96 | λa_pred // (O a_pred) => 97 | λb λo λi λe 98 | (b // match b 99 | λb_pred // (O b_pred) => 100 | (o ((Add) a_pred b_pred)) 101 | λb_pred 102 | // (I b_pred) => 103 | (i ((Add) a_pred b_pred)) 104 | // E => 105 | e) 106 | λa_pred // (I a_pred) => 107 | λb λo λi λe 108 | (b // match b 109 | λb_pred // (O b_pred) => 110 | (i ((Add) a_pred b_pred)) 111 | λb_pred // (I b_pred) => 112 | (o (Inc ((Add) a_pred b_pred))) 113 | e) 114 | // E => 115 | λb (b)) 116 | 117 | // Multiplier: Bin -> (Bin -> Bin) -> Bin 118 | // Multiplier (auxiliar function) 119 | (Multiplier adder b) = (b 120 | λb λadder (O (Multiplier adder b)) 121 | λb λadder (adder (O (Multiplier adder b))) 122 | λadder E 123 | adder) 124 | -------------------------------------------------------------------------------- /examples/lambda/padic_clifford/main.hvm: -------------------------------------------------------------------------------- 1 | // This file implements λ-encoded Clifford Algebra geometric product using 2 | // 2-adic elements. This is one of the cleanest and most elegant implementation 3 | // of numbers in a pure functional language that features negative numbers and 4 | // fractions without the need to explicitly implement them. Although this looks 5 | // pretty, some bits still look ugly and unnatural, like Adic ADD and MUL. Most 6 | // of the functions here fuse perfectly, but these 2 do not. 7 | 8 | // Adics 9 | // ===== 10 | 11 | (O x) = λo λi (o x) // bit 0 12 | (I x) = λo λi (i x) // bit 1 13 | 14 | // Integers 15 | P0 = (O P0) // +0 16 | P1 = (Inc P0) // +1 17 | P2 = (Inc P1) // +2 18 | P3 = (Inc P2) // +3 19 | P4 = (Inc P3) // +4 20 | P5 = (Inc P4) // +5 21 | P6 = (Inc P5) // +6 22 | P7 = (Inc P6) // +7 23 | P8 = (Inc P7) // +8 24 | P9 = (Inc P8) // +9 25 | 26 | // Integers 27 | M1 = (I M1) // -1 28 | M2 = (Dec M1) // -2 29 | M3 = (Dec M2) // -3 30 | M4 = (Dec M3) // -4 31 | M5 = (Dec M4) // -5 32 | M6 = (Dec M5) // -6 33 | M7 = (Dec M6) // -7 34 | M8 = (Dec M7) // -8 35 | M9 = (Dec M8) // -9 36 | 37 | // Fractions 38 | M1D3 = (I (O M1D3)) // -1/3 39 | P1D3 = (Neg M1D3) // +1/3 40 | 41 | // Inc : Adic -> Adic 42 | // Increments an Adic. 43 | (Inc x) = λo λi 44 | let case_o = i 45 | let case_i = λx(o (Inc x)) 46 | (x case_o case_i) 47 | 48 | // Dec : Adic -> Adic 49 | // Decrements an Adic. 50 | (Dec x) = λ o λi 51 | let case_o = λx(i (Dec x)) 52 | let case_i = o 53 | (x case_o case_i) 54 | 55 | // Add : Adic -> Adic -> Adic 56 | // Adic addition with carry. 57 | (Add a b) = (a 58 | λap λb λo λi (b 59 | λbp (o (Add ap bp)) 60 | λbp (i (Add ap bp))) 61 | λap λb λo λi (b 62 | λbp (i (Add ap bp)) 63 | λbp (o (Inc (Add ap bp)))) 64 | b) 65 | 66 | // Mul : Adic -> Adic -> Adic 67 | // Adic long multiplication. 68 | (Mul a b) = (a 69 | λap λb (O (Mul ap b)) 70 | λap λb (Add b (O (Mul ap b))) 71 | b) 72 | 73 | // Neg : Adic -> Adic 74 | // Negates a number. 75 | (Neg a) = (Mul a M1) 76 | 77 | // Adic : U60 -> Adic 78 | // U60 to Adic. 79 | (Adic x) = (Adic.go 60 x) 80 | (Adic.go 0 n) = P0 81 | (Adic.go s n) = (Adic.go.next (- s 1) (% n 2) (/ n 2)) 82 | (Adic.go.next s 0 n) = (O (Adic.go s n)) 83 | (Adic.go.next s 1 n) = (I (Adic.go s n)) 84 | 85 | // U60 : Adic -> U64 86 | // Adic to U60. 87 | (U60 x) = (U60.go 60 x) 88 | (U60.go 0 n) = 0 89 | (U60.go s x) = 90 | let case_o = λx(+ 0 (* 2 (U60.go (- s 1) x))) 91 | let case_i = λx(+ 1 (* 2 (U60.go (- s 1) x))) 92 | (x case_o case_i) 93 | 94 | // U60 : Adic -> String 95 | // Adic to String. 96 | (Show x) = (Show.go 60 x) 97 | (Show.go 0 n) = String.nil 98 | (Show.go s x) = 99 | let case_o = λx(String.cons '0' (Show.go (- s 1) x)) 100 | let case_i = λx(String.cons '1' (Show.go (- s 1) x)) 101 | (x case_o case_i) 102 | 103 | // Clifford Algebra 104 | // ================ 105 | 106 | (T a0 a1) = λt (t a0 a1) // tree branch 107 | 108 | // CNeg : Nat -> Clif -> Clif 109 | (CNeg 0 a) = (Neg a) 110 | (CNeg d a) = λt (a λa0 λa1 (t (CNeg (- d 1) a0) (CNeg (- d 1) a1))) 111 | 112 | // CCon : Nat -> Clif -> Clif 113 | (CCon 0 a) = a 114 | (CCon d a) = λt (a λa0 λa1 (t (CCon (- d 1) a0) (CCon (- d 1) (CNeg (- d 1) a1)))) 115 | 116 | // CAdd : Nat -> Clif -> Clif -> Clif 117 | (CAdd 0 a b) = (Add a b) 118 | (CAdd d a b) = λt (a λa0 λa1 (b λb0 λb1 (t (CAdd (- d 1) a0 b0) (CAdd (- d 1) a1 b1)))) 119 | 120 | // CMul : Nat -> Clif -> Clif -> Clif 121 | (CMul 0 a b) = (Mul a b) 122 | (CMul d a b) = λt (a λa0 λa1 (b λb0 λb1 (t 123 | (CAdd (- d 1) (CMul (- d 1) a0 b0) (CMul (- d 1) a1 (CCon (- d 1) b1))) 124 | (CAdd (- d 1) (CMul (- d 1) a0 b1) (CMul (- d 1) a1 (CCon (- d 1) b0)))))) 125 | 126 | // CGet : Nat -> Clif -> Clif 127 | (CGet 0 a) = [(U60 a)] 128 | (CGet d a) = (a λa0 λa1 (List.concat (CGet (- d 1) a0) (CGet (- d 1) a1))) 129 | 130 | // Utils 131 | // ===== 132 | 133 | (List.concat (List.cons x xs) ys) = (List.cons x (List.concat xs ys)) 134 | (List.concat List.nil ys) = ys 135 | 136 | // Tests 137 | // ===== 138 | 139 | Main = 140 | let d = 2 141 | let f = λa λb (CMul d a b) 142 | let a = (T (T P1 P2) (T P3 P4)) // (1 + 2X + 3Y + 4XY) 143 | let b = (T (T P4 P3) (T P2 P1)) // (4 + 3X + 2Y + 4XY) 144 | let c = (f a b) 145 | (CGet d c) 146 | -------------------------------------------------------------------------------- /src/runtime/data/allocator.rs: -------------------------------------------------------------------------------- 1 | use crossbeam::utils::{CachePadded}; 2 | use std::sync::atomic::{AtomicU64, AtomicUsize, Ordering}; 3 | 4 | // Allocator 5 | // --------- 6 | 7 | pub struct AllocatorNext { 8 | pub cell: AtomicU64, 9 | pub area: AtomicU64, 10 | } 11 | 12 | pub struct Allocator { 13 | pub tids: usize, 14 | pub data: Box<[AtomicU64]>, 15 | pub used: Box<[AtomicU64]>, 16 | pub next: Box<[CachePadded]>, 17 | } 18 | 19 | pub const PAGE_SIZE : usize = 4096; 20 | 21 | impl Allocator { 22 | 23 | pub fn new(tids: usize) -> Allocator { 24 | let mut next = vec![]; 25 | for i in 0 .. tids { 26 | let cell = AtomicU64::new(u64::MAX); 27 | let area = AtomicU64::new((crate::runtime::HEAP_SIZE / PAGE_SIZE / tids * i) as u64); 28 | next.push(CachePadded::new(AllocatorNext { cell, area })); 29 | } 30 | let data = crate::runtime::new_atomic_u64_array(crate::runtime::HEAP_SIZE); 31 | let used = crate::runtime::new_atomic_u64_array(crate::runtime::HEAP_SIZE / PAGE_SIZE); 32 | let next = next.into_boxed_slice(); 33 | Allocator { tids, data, used, next } 34 | } 35 | 36 | pub fn alloc(&self, tid: usize, arity: u64) -> u64 { 37 | unsafe { 38 | let lvar = &heap.lvar[tid]; 39 | if arity == 0 { 40 | 0 41 | } else { 42 | let mut length = 0; 43 | loop { 44 | // Loads value on cursor 45 | let val = self.data.get_unchecked(*lvar.next.as_mut_ptr() as usize).load(Ordering::Relaxed); 46 | // If it is empty, increment length; otherwise, reset it 47 | length = if val == 0 { length + 1 } else { 0 }; 48 | // Moves the cursor forward 49 | *lvar.next.as_mut_ptr() += 1; 50 | // If it is out of bounds, warp around 51 | if *lvar.next.as_mut_ptr() >= *lvar.amax.as_mut_ptr() { 52 | length = 0; 53 | *lvar.next.as_mut_ptr() = *lvar.amin.as_mut_ptr(); 54 | } 55 | // If length equals arity, allocate that space 56 | if length == arity { 57 | return *lvar.next.as_mut_ptr() - length; 58 | } 59 | } 60 | } 61 | } 62 | } 63 | 64 | pub fn free(&self, tid: usize, loc: u64, arity: u64) { 65 | for i in 0 .. arity { 66 | unsafe { self.data.get_unchecked((loc + i) as usize) }.store(0, Ordering::Relaxed); 67 | } 68 | } 69 | 70 | pub fn arena_alloc(&self, tid: usize, arity: u64) -> u64 { 71 | let next = unsafe { self.next.get_unchecked(tid) }; 72 | // Attempts to allocate on this thread's owned area 73 | let aloc = next.cell.fetch_add(arity, Ordering::Relaxed); 74 | let area = aloc / PAGE_SIZE as u64; 75 | if aloc != u64::MAX && (aloc + arity) / PAGE_SIZE as u64 == area { 76 | unsafe { self.used.get_unchecked(area as usize) }.fetch_add(arity, Ordering::Relaxed); 77 | //println!("[{}] old_alloc {} at {}, used={} ({} {})", tid, arity, aloc, self.used[area as usize].load(Ordering::Relaxed), area, (aloc + arity) / PAGE_SIZE as u64); 78 | return aloc; 79 | } 80 | // If we can't, attempt to allocate on a new area 81 | let mut area = next.area.load(Ordering::Relaxed) % ((crate::runtime::HEAP_SIZE / PAGE_SIZE) as u64); 82 | loop { 83 | if unsafe { self.used.get_unchecked(area as usize) }.compare_exchange_weak(0, arity, Ordering::Relaxed, Ordering::Relaxed).is_ok() { 84 | let aloc = area * PAGE_SIZE as u64; 85 | next.cell.store(aloc + arity, Ordering::Relaxed); 86 | next.area.store((area + 1) % ((crate::runtime::HEAP_SIZE / PAGE_SIZE) as u64), Ordering::Relaxed); 87 | //println!("[{}] new_alloc {} at {}, used={}", tid, arity, aloc, self.used[area as usize].load(Ordering::Relaxed)); 88 | return aloc; 89 | } else { 90 | area = (area + 1) % ((crate::runtime::HEAP_SIZE / PAGE_SIZE) as u64); 91 | } 92 | } 93 | } 94 | 95 | pub fn arena_free(&self, tid: usize, loc: u64, arity: u64) { 96 | //for i in 0 .. arity { unsafe { self.data.get_unchecked((loc + i) as usize) }.store(0, Ordering::Relaxed); } 97 | let area = loc / PAGE_SIZE as u64; 98 | let used = unsafe { self.used.get_unchecked(area as usize) }.fetch_sub(arity, Ordering::Relaxed); 99 | //println!("[{}] free {} at {}, used={}", tid, arity, loc, self.used[area as usize].load(Ordering::Relaxed)); 100 | } 101 | 102 | } 103 | -------------------------------------------------------------------------------- /src/compiler/mod.rs: -------------------------------------------------------------------------------- 1 | #![allow(unreachable_code)] 2 | #![allow(clippy::identity_op)] 3 | 4 | mod compile; 5 | 6 | pub fn compile(code: &str, name: &str) -> std::io::Result<()> { 7 | 8 | let cargo_rs = include_str!("./../../Cargo.toml") 9 | .replace("name = \"hvm\"", &format!("name = \"{}\"", name)) 10 | .replace("name = \"hvm\"", &format!("name = \"{}\"", name)); 11 | 12 | // hvm 13 | std::fs::create_dir(format!("./{}",name)).ok(); 14 | std::fs::write(format!("./{}/Cargo.toml",name), cargo_rs)?; 15 | std::fs::write(format!("./{}/rust-toolchain.toml",name), include_str!("./../../rust-toolchain.toml"))?; 16 | 17 | // hvm/src 18 | std::fs::create_dir(format!("./{}/src",name)).ok(); 19 | std::fs::write(format!("./{}/src/main.rs",name), include_str!("./../main.rs"))?; 20 | std::fs::write(format!("./{}/src/lib.rs",name), include_str!("./../lib.rs"))?; 21 | std::fs::write(format!("./{}/src/api.rs",name), include_str!("./../api.rs"))?; 22 | 23 | // hvm/src/compiler 24 | std::fs::create_dir(format!("./{}/src/compiler",name)).ok(); 25 | std::fs::write(format!("./{}/src/compiler/mod.rs",name) , include_str!("./../compiler/mod.rs"))?; 26 | std::fs::write(format!("./{}/src/compiler/compile.rs",name) , include_str!("./../compiler/compile.rs"))?; 27 | 28 | // hvm/src/language 29 | std::fs::create_dir(format!("./{}/src/language",name)).ok(); 30 | std::fs::write(format!("./{}/src/language/mod.rs",name) , include_str!("./../language/mod.rs"))?; 31 | std::fs::write(format!("./{}/src/language/readback.rs",name) , include_str!("./../language/readback.rs"))?; 32 | std::fs::write(format!("./{}/src/language/rulebook.rs",name) , include_str!("./../language/rulebook.rs"))?; 33 | std::fs::write(format!("./{}/src/language/syntax.rs",name) , include_str!("./../language/syntax.rs"))?; 34 | 35 | // hvm/src/runtime 36 | std::fs::create_dir(format!("./{}/src/runtime",name)).ok(); 37 | std::fs::write(format!("./{}/src/runtime/mod.rs",name), include_str!("./../runtime/mod.rs"))?; 38 | 39 | // hvm/src/runtime/base 40 | let (precomp_rs, reducer_rs) = compile::build_code(code).unwrap(); 41 | std::fs::create_dir(format!("./{}/src/runtime/base",name)).ok(); 42 | std::fs::write(format!("./{}/src/runtime/base/mod.rs",name) , include_str!("./../runtime/base/mod.rs"))?; 43 | std::fs::write(format!("./{}/src/runtime/base/debug.rs",name) , include_str!("./../runtime/base/debug.rs"))?; 44 | std::fs::write(format!("./{}/src/runtime/base/memory.rs",name) , include_str!("./../runtime/base/memory.rs"))?; 45 | std::fs::write(format!("./{}/src/runtime/base/precomp.rs",name) , precomp_rs)?; 46 | std::fs::write(format!("./{}/src/runtime/base/program.rs",name) , include_str!("./../runtime/base/program.rs"))?; 47 | std::fs::write(format!("./{}/src/runtime/base/reducer.rs",name) , reducer_rs)?; 48 | 49 | // hvm/src/runtime/data 50 | std::fs::create_dir(format!("./{}/src/runtime/data",name)).ok(); 51 | std::fs::write(format!("./{}/src/runtime/data/mod.rs",name) , include_str!("./../runtime/data/mod.rs"))?; 52 | std::fs::write(format!("./{}/src/runtime/data/f60.rs",name) , include_str!("./../runtime/data/f60.rs"))?; 53 | std::fs::write(format!("./{}/src/runtime/data/allocator.rs",name) , include_str!("./../runtime/data/allocator.rs"))?; 54 | std::fs::write(format!("./{}/src/runtime/data/barrier.rs",name) , include_str!("./../runtime/data/barrier.rs"))?; 55 | std::fs::write(format!("./{}/src/runtime/data/redex_bag.rs",name) , include_str!("./../runtime/data/redex_bag.rs"))?; 56 | std::fs::write(format!("./{}/src/runtime/data/u60.rs",name) , include_str!("./../runtime/data/u60.rs"))?; 57 | std::fs::write(format!("./{}/src/runtime/data/u64_map.rs",name) , include_str!("./../runtime/data/u64_map.rs"))?; 58 | std::fs::write(format!("./{}/src/runtime/data/visit_queue.rs",name) , include_str!("./../runtime/data/visit_queue.rs"))?; 59 | 60 | // hvm/src/runtime/rule 61 | std::fs::create_dir(format!("./{}/src/runtime/rule",name)).ok(); 62 | std::fs::write(format!("./{}/src/runtime/rule/mod.rs",name) , include_str!("./../runtime/rule/mod.rs"))?; 63 | std::fs::write(format!("./{}/src/runtime/rule/app.rs",name) , include_str!("./../runtime/rule/app.rs"))?; 64 | std::fs::write(format!("./{}/src/runtime/rule/dup.rs",name) , include_str!("./../runtime/rule/dup.rs"))?; 65 | std::fs::write(format!("./{}/src/runtime/rule/fun.rs",name) , include_str!("./../runtime/rule/fun.rs"))?; 66 | std::fs::write(format!("./{}/src/runtime/rule/op2.rs",name) , include_str!("./../runtime/rule/op2.rs"))?; 67 | 68 | return Ok(()); 69 | } 70 | -------------------------------------------------------------------------------- /src/runtime/rule/op2.rs: -------------------------------------------------------------------------------- 1 | use crate::runtime::{*}; 2 | 3 | #[inline(always)] 4 | pub fn visit(ctx: ReduceCtx) -> bool { 5 | let goup = ctx.redex.insert(ctx.tid, new_redex(*ctx.host, *ctx.cont, 2)); 6 | ctx.visit.push(new_visit(get_loc(ctx.term, 1), ctx.hold, goup)); 7 | *ctx.cont = goup; 8 | *ctx.host = get_loc(ctx.term, 0); 9 | return true; 10 | } 11 | 12 | #[inline(always)] 13 | pub fn apply(ctx: ReduceCtx) -> bool { 14 | let arg0 = load_arg(ctx.heap, ctx.term, 0); 15 | let arg1 = load_arg(ctx.heap, ctx.term, 1); 16 | 17 | // (OP a b) 18 | // -------- OP2-U60 19 | // op(a, b) 20 | if get_tag(arg0) == U60 && get_tag(arg1) == U60 { 21 | //operate(ctx.heap, ctx.tid, ctx.term, arg0, arg1, *ctx.host); 22 | 23 | inc_cost(ctx.heap, ctx.tid); 24 | let a = get_num(arg0); 25 | let b = get_num(arg1); 26 | let c = match get_ext(ctx.term) { 27 | ADD => u60::add(a, b), 28 | SUB => u60::sub(a, b), 29 | MUL => u60::mul(a, b), 30 | DIV => u60::div(a, b), 31 | MOD => u60::mdl(a, b), 32 | AND => u60::and(a, b), 33 | OR => u60::or(a, b), 34 | XOR => u60::xor(a, b), 35 | SHL => u60::shl(a, b), 36 | SHR => u60::shr(a, b), 37 | LTN => u60::ltn(a, b), 38 | LTE => u60::lte(a, b), 39 | EQL => u60::eql(a, b), 40 | GTE => u60::gte(a, b), 41 | GTN => u60::gtn(a, b), 42 | NEQ => u60::neq(a, b), 43 | _ => 0, 44 | }; 45 | let done = U6O(c); 46 | link(ctx.heap, *ctx.host, done); 47 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 2); 48 | 49 | return false; 50 | } 51 | 52 | // (OP a b) 53 | // -------- OP2-F60 54 | // op(a, b) 55 | else if get_tag(arg0) == F60 && get_tag(arg1) == F60 { 56 | //operate(ctx.heap, ctx.tid, ctx.term, arg0, arg1, *ctx.host); 57 | 58 | inc_cost(ctx.heap, ctx.tid); 59 | let a = get_num(arg0); 60 | let b = get_num(arg1); 61 | let c = match get_ext(ctx.term) { 62 | ADD => f60::add(a, b), 63 | SUB => f60::sub(a, b), 64 | MUL => f60::mul(a, b), 65 | DIV => f60::div(a, b), 66 | MOD => f60::mdl(a, b), 67 | AND => f60::and(a, b), 68 | OR => f60::or(a, b), 69 | XOR => f60::xor(a, b), 70 | SHL => f60::shl(a, b), 71 | SHR => f60::shr(a, b), 72 | LTN => f60::ltn(a, b), 73 | LTE => f60::lte(a, b), 74 | EQL => f60::eql(a, b), 75 | GTE => f60::gte(a, b), 76 | GTN => f60::gtn(a, b), 77 | NEQ => f60::neq(a, b), 78 | _ => 0, 79 | }; 80 | let done = F6O(c); 81 | link(ctx.heap, *ctx.host, done); 82 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 2); 83 | 84 | return false; 85 | } 86 | 87 | // (+ {a0 a1} b) 88 | // --------------------- OP2-SUP-0 89 | // dup b0 b1 = b 90 | // {(+ a0 b0) (+ a1 b1)} 91 | else if get_tag(arg0) == SUP { 92 | inc_cost(ctx.heap, ctx.tid); 93 | let op20 = get_loc(ctx.term, 0); 94 | let op21 = get_loc(arg0, 0); 95 | let let0 = alloc(ctx.heap, ctx.tid, 3); 96 | let par0 = alloc(ctx.heap, ctx.tid, 2); 97 | link(ctx.heap, let0 + 2, arg1); 98 | link(ctx.heap, op20 + 1, Dp0(get_ext(arg0), let0)); 99 | link(ctx.heap, op20 + 0, take_arg(ctx.heap, arg0, 0)); 100 | link(ctx.heap, op21 + 0, take_arg(ctx.heap, arg0, 1)); 101 | link(ctx.heap, op21 + 1, Dp1(get_ext(arg0), let0)); 102 | link(ctx.heap, par0 + 0, Op2(get_ext(ctx.term), op20)); 103 | link(ctx.heap, par0 + 1, Op2(get_ext(ctx.term), op21)); 104 | let done = Sup(get_ext(arg0), par0); 105 | link(ctx.heap, *ctx.host, done); 106 | return false; 107 | } 108 | 109 | // (+ a {b0 b1}) 110 | // --------------- OP2-SUP-1 111 | // dup a0 a1 = a 112 | // {(+ a0 b0) (+ a1 b1)} 113 | else if get_tag(arg1) == SUP { 114 | inc_cost(ctx.heap, ctx.tid); 115 | let op20 = get_loc(ctx.term, 0); 116 | let op21 = get_loc(arg1, 0); 117 | let let0 = alloc(ctx.heap, ctx.tid, 3); 118 | let par0 = alloc(ctx.heap, ctx.tid, 2); 119 | link(ctx.heap, let0 + 2, arg0); 120 | link(ctx.heap, op20 + 0, Dp0(get_ext(arg1), let0)); 121 | link(ctx.heap, op20 + 1, take_arg(ctx.heap, arg1, 0)); 122 | link(ctx.heap, op21 + 1, take_arg(ctx.heap, arg1, 1)); 123 | link(ctx.heap, op21 + 0, Dp1(get_ext(arg1), let0)); 124 | link(ctx.heap, par0 + 0, Op2(get_ext(ctx.term), op20)); 125 | link(ctx.heap, par0 + 1, Op2(get_ext(ctx.term), op21)); 126 | let done = Sup(get_ext(arg1), par0); 127 | link(ctx.heap, *ctx.host, done); 128 | return false; 129 | } 130 | 131 | return false; 132 | } 133 | -------------------------------------------------------------------------------- /examples/callcc/main.hvm: -------------------------------------------------------------------------------- 1 | // The main effects of call/cc are: 2 | // 1. create a "hole" where it was called 3 | // 2. create a function 'k' which fills that hole when applied 4 | // For example, consider the following Scheme expression: 5 | // 6 | // (+ 10 (call/cc (lambda (k) (+ (k 42) 1729)))) 7 | // 8 | // To evaluate it, the entire `(call/cc ...)` part is replaced by a hole: 9 | // 10 | // (+ 10 _) 11 | // 12 | // Then, Scheme creates an internal function, `k`, which, when called `(k arg)`, 13 | // will replace the hole `_` by `arg`. That function is sent to the user's 14 | // callback `(lambda (k) ...)`, allowing they to decide when and how to fill 15 | // that hole. In the example above, the user calls `(k 42)`, so the result is: 16 | // 17 | // (+ 10 42) 18 | // 19 | // And the remaining of the expression, `(+ _ 1729)`, will be garbage collected. 20 | // 21 | // This ability can be used for various useful purposes, such as exceptions. 22 | // It's impossible to implement this behavior on the pure lambda calculus. On 23 | // interaction combinators, call/cc can be implemented by manipulating some 24 | // edges. For example, consider the graph below: 25 | // 26 | // result garbage 27 | // | | 28 | // + @ 29 | // / \_____, / \________, 30 | // | | _____λ | 31 | // 10 | | | ,--λ <-(very illegal) 32 | // | | + | | 33 | // | | / \ | * 34 | // | | @ 1729 | 35 | // | |_/ \ | 36 | // | 42 | 37 | // | | 38 | // |__________________| 39 | // 40 | // After some reductions, an intermediate result will be: 41 | // 42 | // result garbage 43 | // | | 44 | // [+] [+] 45 | // / \ / \ 46 | // 10 42 * 1729 47 | // 48 | // Here, the user-defined callback `(λ (k) (+ (k 42) 1729))` received a 49 | // continuation `k` and applied it to `42`, "filling" the hole `(+ 10 _)`, 50 | // giving us the correct result. We could implement continuations on the HVM by 51 | // including a `call/cc` syntax, and then doing the transformation above when 52 | // converting from text to graphs. Meanwhile, it is possible to implement an 53 | // uglier version of it as a library, using scopeless λs. Here is an example: 54 | 55 | // Creates a program capable of performing call/cc. 56 | (CC.lang program) = 57 | let callcc = λcallback (λ$garbage($hole) (callback λ$hole(0))) 58 | let result = (program callcc) 59 | let garbage = $garbage 60 | (Seq garbage result) 61 | 62 | // Helper function for strictness annotation 63 | (Seq 0 b) = b 64 | (Seq a b) = b 65 | 66 | // Notice the call/cc function receives the user-defined callback. It then gives 67 | // the user an internal function that, when called, will fill the hole, and 68 | // return it on the position where call/cc was called. The value returned by the 69 | // callback itself is then moved to the garbage, which is collected. 70 | 71 | // Example usage 72 | Main = (CC.lang λcallcc 73 | (+ 10 (callcc λk(+ (k 42) 1729)))) 74 | 75 | // The result is `(Pair (Result 52) (Garbage 1729))`, as expected. 76 | // Reference: http://www.madore.org/~david/computers/callcc.html 77 | 78 | // ----------------------------------------------------------------------------- 79 | 80 | // Note: to be really useful, we must also be able to use a continuation more 81 | // than once. For example, consider the following Scheme program: 82 | // > (define k 0) 83 | // > (+ 10 (call/cc (λ (k_) (set! cont k_)))) 84 | // > (k 3) 85 | // > (k 4) 86 | // Its result is to output `13` and `14`, which is the continuation filled with 87 | // `3` and `4`. In theory, we should also be able to achieve that on HVM as: 88 | 89 | //Main = (CC.lang λcallcc [ 90 | //(+ 10 (callcc λ$k (3))) 91 | //($k 3) 92 | //($k 4) 93 | //]) 94 | 95 | // Notice that, while we're not able to move k_ out of the closure by setting a 96 | // global variable, we can still do it by using scopeless lambdas. Sadly, using 97 | // a global variable like `$k` more than once is not supported by the graph 98 | // builder yet. We can kind of hack our way into having it though: 99 | 100 | //Main = (CC.lang λcallcc [ 101 | //(+ 10 (callcc λ$k (λfλa(f a a) λ$k0λ$k1(3) $k))) 102 | //($k0 3) 103 | //($k1 4) 104 | //]) 105 | 106 | // Which correctly computes 13 and 14 by filling the `(+ 10 _)` continuation. 107 | // Note that this is *terribly* ugly as it accumulates results in a list of 108 | // superpositions and the garbage. Of course a proper callcc library would 109 | // support multiple calls, collecting intermediate garbage and results and 110 | // displaying or returning them appropriately. The point of this is to 111 | // illustrate how the ability to "freeze" a "call stack" and instantiate is 112 | // already present on HVM "for free". There is no need to implement anything new 113 | // on the evaluator, and everything can be done as a library with proper syntax. 114 | -------------------------------------------------------------------------------- /examples/lambda/varbase/main.hvm: -------------------------------------------------------------------------------- 1 | // This file contains some implementations of var-base numbers. That is, binary 2 | // numbers are represented as sequences of binary digits and decimal numbers are 3 | // represented as sequences of decimal digits. Var-base numbers, instead, are 4 | // represented as sequences of digits that can vary in base. For example, on 5 | // base [2,3,10] numbers, the first digit is binary, the second digit is 6 | // ternary, and the third digit is decimal. This library includes arithmetic for 7 | // these var-base numbers. This is extremely useful because it allows one to 8 | // perform modular arithmetic without needing a "mod" function. For example, if 9 | // you operate on base [2,3,7] numbers, these operations will be "mod 42" 10 | // naturally. This can be useful to implement fusible algorithms that involve 11 | // modulus; for example, modular exponentiation. Note: this file is incomplete 12 | // and has some buts and issues. We must adjust it... 13 | 14 | // ~ 15 | // ~ 16 | // ~ 17 | // ~ 18 | // ~ 19 | 20 | // Applies `f` `n` times to `x`, directly 21 | (Repeat 0 f x) = x 22 | (Repeat n f x) = (f (Repeat (- n 1) f x)) 23 | 24 | // Given a base-list, applies `f` `n` times to `x`, 25 | // in such a way that is optimized for that base-list 26 | (Apply List.nil n f x) = x 27 | (Apply (List.cons b bs) n f x) = (Apply bs (/ n b) λk(Repeat b f k) (Repeat (% n b) f x)) 28 | 29 | // Given a base-list, applies `f` `n` times to `x`, 30 | // in such a way that is optimized for that base-list 31 | (Times List.nil n f x) = x 32 | (Times (List.cons b bs) n f x) = ((TimesGo b b bs n) f x) 33 | (TimesGo 0 b bs n) = (n λfλx(x)) 34 | (TimesGo i b bs n) = ((TimesGo (- i 1) b bs n) λpλfλx(Times bs p λk(Repeat b f k) (Repeat (- i 1) f x))) 35 | 36 | // Given a base, ends a digit-string 37 | (E base) = λend (EGo base end) 38 | (EGo 0 end) = end 39 | (EGo base end) = λctr (EGo (- base 1) end) 40 | 41 | // Given a base, appends `digit` to a digit-string 42 | (D base digit pred) = λend (DGo base digit pred λx(x)) 43 | (DGo 0 n pred ctr) = (ctr pred) 44 | (DGo base 0 pred ctr) = λctr (DGo (- base 1) (- 0 1) pred ctr) 45 | (DGo base n pred ctr) = λera (DGo (- base 1) (- n 1) pred ctr) 46 | 47 | // Given a base-list, converts a digit-string to a list 48 | (ToList List.nil xs) = List.nil 49 | (ToList (List.cons b bs) xs) = (ToListGo b bs xs) 50 | (ToListGo 0 bs xs) = (xs List.nil) 51 | (ToListGo b bs xs) = ((ToListGo (- b 1) bs xs) λp(List.cons (- b 1) (ToList bs p))) 52 | 53 | // Given a base-list, converts a digit-string to a number 54 | (ToU32 bases xs) = (ToU32Go bases (ToList bases xs) 1) 55 | (ToU32Go List.nil List.nil m) = 0 56 | (ToU32Go (List.cons b bs) (List.cons x xs) m) = (+ (* x m) (ToU32Go bs xs (* m b))) 57 | 58 | // Given a base-list, returns the number 0 59 | (Zero List.nil ) = End 60 | (Zero (List.cons b bs)) = (D b 0 (Zero bs)) 61 | 62 | // Giben a base-list, and a u32 `i`, returns the number `n` 63 | (Number bases i) = (Apply bases i λx(Inc bases x) (Zero bases)) 64 | 65 | // Given a base, applies a function to the predecessor 66 | // (Inj [3] f λeλaλbλc(a pred)) == λeλaλbλc(a (f pred)) 67 | (Inj base f xs) = λen (InjGo base f (xs λf(en))) 68 | (InjGo 0 f xs) = (xs f) 69 | (InjGo b f xs) = λv (InjGo (- b 1) f (xs λpλf(v (f p)))) 70 | 71 | // Given a base-list, increments a digit-string 72 | (Inc List.nil xs) = List.nil 73 | (Inc (List.cons b bs) xs) = λen λn0 (IncMake (- b 1) bs (xs en) λp(n0 (Inc bs p))) 74 | (IncMake 0 bs xs ic) = (xs ic) 75 | (IncMake n bs xs ic) = λv (IncMake (- n 1) bs (xs v) ic) 76 | 77 | // Given a base-list, increments `b` a total of `a` times 78 | // This is equivalent to addition, and is fast due to fusion 79 | (Add bases a b) = (Times bases a λx(Inc bases x) b) 80 | 81 | // Given a base-list, creates an adder for two digit-strings, with carry bits 82 | (AdderCarry List.nil xs) = λys(ys) 83 | (AdderCarry (List.cons b bs) xs) = (AdderCarryGo b b bs xs) 84 | (AdderCarryGo 0 b bs xs) = (xs λys(ys)) 85 | (AdderCarryGo i b bs xs) = ((AdderCarryGo (- i 1) b bs xs) (λxs λys (Repeat (- i 1) λx(Inc (List.cons b bs) x) (Inj b (AdderCarry bs xs) ys)))) 86 | 87 | // Given a base-list, adds two bit-strings, with carry bits 88 | (AddCarry bases xs ys) = ((AdderCarry bases xs) ys) 89 | 90 | // FIXME: this is wrong, only works if all bases are the same 91 | (Mul bases xs ys) = (MulGo bases xs λk(Add bases ys k)) 92 | (MulGo List.nil xs add) = End 93 | (MulGo (List.cons b bs) xs add) = (MulDo b b bs xs add) 94 | (MulDo b 0 bs xs add) = (xs End) 95 | (MulDo b i bs xs add) = ((MulDo b (- i 1) bs xs add) λp(Repeat (- i 1) add (D b 0 (MulGo bs p add)))) 96 | 97 | (Main x) = 98 | let bases = [2 2 2 2 2 2 2 2 , 2 2 2 2 2 2 2 2 , 2 2 2 2 2 2 2 2 , 2 2 2 2 2 2 2 2] 99 | let to_list = λx(ToList bases x) 100 | let to_u32 = λx(ToU32 bases x) 101 | let times = λnλfλx(Times bases n f x) 102 | let apply = λnλfλx(Apply bases n f x) 103 | let zero = (Zero bases) 104 | let inc = λx(Inc bases x) 105 | let add = λaλb(Add bases a b) 106 | let addc = λaλb(AddCarry bases a b) 107 | let mul_a = λaλb(Times bases a (add b) zero) // mul by repeated add by repeated inc 108 | let mul_b = λaλb(Times bases a (addc b) zero) // mul by repeated add with carry 109 | let mul_c = λaλb(Mul bases a b) // mul using the incorrect algorithm 110 | let num = λi(Number bases i) 111 | (to_u32 (mul_c (num 12345) (num 54321))) 112 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "all-cabal-json": { 4 | "flake": false, 5 | "locked": { 6 | "lastModified": 1665552503, 7 | "narHash": "sha256-r14RmRSwzv5c+bWKUDaze6pXM7nOsiz1H8nvFHJvufc=", 8 | "owner": "nix-community", 9 | "repo": "all-cabal-json", 10 | "rev": "d7c0434eebffb305071404edcf9d5cd99703878e", 11 | "type": "github" 12 | }, 13 | "original": { 14 | "owner": "nix-community", 15 | "ref": "hackage", 16 | "repo": "all-cabal-json", 17 | "type": "github" 18 | } 19 | }, 20 | "crane": { 21 | "flake": false, 22 | "locked": { 23 | "lastModified": 1661875961, 24 | "narHash": "sha256-f1h/2c6Teeu1ofAHWzrS8TwBPcnN+EEu+z1sRVmMQTk=", 25 | "owner": "ipetkov", 26 | "repo": "crane", 27 | "rev": "d9f394e4e20e97c2a60c3ad82c2b6ef99be19e24", 28 | "type": "github" 29 | }, 30 | "original": { 31 | "owner": "ipetkov", 32 | "repo": "crane", 33 | "type": "github" 34 | } 35 | }, 36 | "devshell": { 37 | "flake": false, 38 | "locked": { 39 | "lastModified": 1667210711, 40 | "narHash": "sha256-IoErjXZAkzYWHEpQqwu/DeRNJGFdR7X2OGbkhMqMrpw=", 41 | "owner": "numtide", 42 | "repo": "devshell", 43 | "rev": "96a9dd12b8a447840cc246e17a47b81a4268bba7", 44 | "type": "github" 45 | }, 46 | "original": { 47 | "owner": "numtide", 48 | "repo": "devshell", 49 | "type": "github" 50 | } 51 | }, 52 | "dream2nix": { 53 | "inputs": { 54 | "alejandra": [ 55 | "nci", 56 | "nixpkgs" 57 | ], 58 | "all-cabal-json": "all-cabal-json", 59 | "crane": "crane", 60 | "devshell": [ 61 | "nci", 62 | "devshell" 63 | ], 64 | "flake-utils-pre-commit": [ 65 | "nci", 66 | "nixpkgs" 67 | ], 68 | "ghc-utils": "ghc-utils", 69 | "gomod2nix": [ 70 | "nci", 71 | "nixpkgs" 72 | ], 73 | "mach-nix": [ 74 | "nci", 75 | "nixpkgs" 76 | ], 77 | "nixpkgs": [ 78 | "nci", 79 | "nixpkgs" 80 | ], 81 | "poetry2nix": [ 82 | "nci", 83 | "nixpkgs" 84 | ], 85 | "pre-commit-hooks": [ 86 | "nci", 87 | "nixpkgs" 88 | ] 89 | }, 90 | "locked": { 91 | "lastModified": 1668243825, 92 | "narHash": "sha256-EjgLCV5fI20dVVbpB5Gy+UV5LF2EZXwRTCuIyn3s7AM=", 93 | "owner": "nix-community", 94 | "repo": "dream2nix", 95 | "rev": "86d6c6a42e1436664a04490491414adf2c2e08be", 96 | "type": "github" 97 | }, 98 | "original": { 99 | "owner": "nix-community", 100 | "repo": "dream2nix", 101 | "type": "github" 102 | } 103 | }, 104 | "flake-compat": { 105 | "flake": false, 106 | "locked": { 107 | "lastModified": 1648199409, 108 | "narHash": "sha256-JwPKdC2PoVBkG6E+eWw3j6BMR6sL3COpYWfif7RVb8Y=", 109 | "owner": "edolstra", 110 | "repo": "flake-compat", 111 | "rev": "64a525ee38886ab9028e6f61790de0832aa3ef03", 112 | "type": "github" 113 | }, 114 | "original": { 115 | "owner": "edolstra", 116 | "repo": "flake-compat", 117 | "type": "github" 118 | } 119 | }, 120 | "ghc-utils": { 121 | "flake": false, 122 | "locked": { 123 | "lastModified": 1662774800, 124 | "narHash": "sha256-1Rd2eohGUw/s1tfvkepeYpg8kCEXiIot0RijapUjAkE=", 125 | "ref": "refs/heads/master", 126 | "rev": "bb3a2d3dc52ff0253fb9c2812bd7aa2da03e0fea", 127 | "revCount": 1072, 128 | "type": "git", 129 | "url": "https://gitlab.haskell.org/bgamari/ghc-utils" 130 | }, 131 | "original": { 132 | "type": "git", 133 | "url": "https://gitlab.haskell.org/bgamari/ghc-utils" 134 | } 135 | }, 136 | "nci": { 137 | "inputs": { 138 | "devshell": "devshell", 139 | "dream2nix": "dream2nix", 140 | "nixpkgs": [ 141 | "nixpkgs" 142 | ], 143 | "rust-overlay": "rust-overlay" 144 | }, 145 | "locked": { 146 | "lastModified": 1668390517, 147 | "narHash": "sha256-AyLXLqFhqnAqxobdsVrz6ss8oWn7lN8JTZKfyAwOOto=", 148 | "owner": "yusdacra", 149 | "repo": "nix-cargo-integration", 150 | "rev": "774b49912e6ae219e20bbb39258f8a283f6a251c", 151 | "type": "github" 152 | }, 153 | "original": { 154 | "owner": "yusdacra", 155 | "repo": "nix-cargo-integration", 156 | "rev": "774b49912e6ae219e20bbb39258f8a283f6a251c", 157 | "type": "github" 158 | } 159 | }, 160 | "nixpkgs": { 161 | "locked": { 162 | "lastModified": 1668087632, 163 | "narHash": "sha256-T/cUx44aYDuLMFfaiVpMdTjL4kpG7bh0VkN6JEM78/E=", 164 | "owner": "nixos", 165 | "repo": "nixpkgs", 166 | "rev": "5f588eb4a958f1a526ed8da02d6ea1bea0047b9f", 167 | "type": "github" 168 | }, 169 | "original": { 170 | "owner": "nixos", 171 | "ref": "nixos-unstable", 172 | "repo": "nixpkgs", 173 | "type": "github" 174 | } 175 | }, 176 | "root": { 177 | "inputs": { 178 | "flake-compat": "flake-compat", 179 | "nci": "nci", 180 | "nixpkgs": "nixpkgs" 181 | } 182 | }, 183 | "rust-overlay": { 184 | "flake": false, 185 | "locked": { 186 | "lastModified": 1668307432, 187 | "narHash": "sha256-UUEsHnKvlnrSFdDwnlacPojFZg+75wOxCGngGmEEeTw=", 188 | "owner": "oxalica", 189 | "repo": "rust-overlay", 190 | "rev": "3a7faa4395868f3a183b49cf9090624e3361b541", 191 | "type": "github" 192 | }, 193 | "original": { 194 | "owner": "oxalica", 195 | "repo": "rust-overlay", 196 | "type": "github" 197 | } 198 | } 199 | }, 200 | "root": "root", 201 | "version": 7 202 | } 203 | -------------------------------------------------------------------------------- /src/runtime/rule/dup.rs: -------------------------------------------------------------------------------- 1 | use crate::runtime::{*}; 2 | 3 | #[inline(always)] 4 | pub fn visit(ctx: ReduceCtx) -> bool { 5 | let goup = ctx.redex.insert(ctx.tid, new_redex(*ctx.host, *ctx.cont, 1)); 6 | *ctx.cont = goup; 7 | *ctx.host = get_loc(ctx.term, 2); 8 | return true; 9 | } 10 | 11 | #[inline(always)] 12 | pub fn apply(ctx: ReduceCtx) -> bool { 13 | 14 | let arg0 = load_arg(ctx.heap, ctx.term, 2); 15 | let tcol = get_ext(ctx.term); 16 | 17 | // dup r s = λx(f) 18 | // --------------- DUP-LAM 19 | // dup f0 f1 = f 20 | // r <- λx0(f0) 21 | // s <- λx1(f1) 22 | // x <- {x0 x1} 23 | if get_tag(arg0) == LAM { 24 | inc_cost(ctx.heap, ctx.tid); 25 | let let0 = alloc(ctx.heap, ctx.tid, 3); 26 | let par0 = alloc(ctx.heap, ctx.tid, 2); 27 | let lam0 = alloc(ctx.heap, ctx.tid, 2); 28 | let lam1 = alloc(ctx.heap, ctx.tid, 2); 29 | link(ctx.heap, let0 + 2, take_arg(ctx.heap, arg0, 1)); 30 | link(ctx.heap, par0 + 1, Var(lam1)); 31 | link(ctx.heap, par0 + 0, Var(lam0)); 32 | link(ctx.heap, lam0 + 1, Dp0(get_ext(ctx.term), let0)); 33 | link(ctx.heap, lam1 + 1, Dp1(get_ext(ctx.term), let0)); 34 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Var(get_loc(arg0, 0)), Sup(get_ext(ctx.term), par0)); 35 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp0(tcol, get_loc(ctx.term, 0)), Lam(lam0)); 36 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp1(tcol, get_loc(ctx.term, 0)), Lam(lam1)); 37 | let done = Lam(if get_tag(ctx.term) == DP0 { lam0 } else { lam1 }); 38 | link(ctx.heap, *ctx.host, done); 39 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 40 | free(ctx.heap, ctx.tid, get_loc(arg0, 0), 2); 41 | return true; 42 | } 43 | 44 | // dup x y = {a b} 45 | // --------------- DUP-SUP 46 | // if equal: | else: 47 | // x <- a | x <- {xA xB} 48 | // y <- b | y <- {yA yB} 49 | // | dup xA yA = a 50 | // | dup xB yB = b 51 | else if get_tag(arg0) == SUP { 52 | 53 | if tcol == get_ext(arg0) { 54 | inc_cost(ctx.heap, ctx.tid); 55 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp0(tcol, get_loc(ctx.term, 0)), take_arg(ctx.heap, arg0, 0)); 56 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp1(tcol, get_loc(ctx.term, 0)), take_arg(ctx.heap, arg0, 1)); 57 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 58 | free(ctx.heap, ctx.tid, get_loc(arg0, 0), 2); 59 | return true; 60 | 61 | } else { 62 | inc_cost(ctx.heap, ctx.tid); 63 | let par0 = alloc(ctx.heap, ctx.tid, 2); 64 | let let0 = alloc(ctx.heap, ctx.tid, 3); 65 | let par1 = get_loc(arg0, 0); 66 | let let1 = alloc(ctx.heap, ctx.tid, 3); 67 | link(ctx.heap, let0 + 2, take_arg(ctx.heap, arg0, 0)); 68 | link(ctx.heap, let1 + 2, take_arg(ctx.heap, arg0, 1)); 69 | link(ctx.heap, par1 + 0, Dp1(tcol, let0)); 70 | link(ctx.heap, par1 + 1, Dp1(tcol, let1)); 71 | link(ctx.heap, par0 + 0, Dp0(tcol, let0)); 72 | link(ctx.heap, par0 + 1, Dp0(tcol, let1)); 73 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp0(tcol, get_loc(ctx.term, 0)), Sup(get_ext(arg0), par0)); 74 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp1(tcol, get_loc(ctx.term, 0)), Sup(get_ext(arg0), par1)); 75 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 76 | return true; 77 | } 78 | } 79 | 80 | // dup x y = N 81 | // ----------- DUP-U60 82 | // x <- N 83 | // y <- N 84 | // ~ 85 | else if get_tag(arg0) == U60 { 86 | inc_cost(ctx.heap, ctx.tid); 87 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp0(tcol, get_loc(ctx.term, 0)), arg0); 88 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp1(tcol, get_loc(ctx.term, 0)), arg0); 89 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 90 | return true; 91 | } 92 | 93 | // dup x y = N 94 | // ----------- DUP-F60 95 | // x <- N 96 | // y <- N 97 | // ~ 98 | else if get_tag(arg0) == F60 { 99 | inc_cost(ctx.heap, ctx.tid); 100 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp0(tcol, get_loc(ctx.term, 0)), arg0); 101 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp1(tcol, get_loc(ctx.term, 0)), arg0); 102 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 103 | return true; 104 | } 105 | 106 | // dup x y = (K a b c ...) 107 | // ----------------------- DUP-CTR 108 | // dup a0 a1 = a 109 | // dup b0 b1 = b 110 | // dup c0 c1 = c 111 | // ... 112 | // x <- (K a0 b0 c0 ...) 113 | // y <- (K a1 b1 c1 ...) 114 | else if get_tag(arg0) == CTR { 115 | inc_cost(ctx.heap, ctx.tid); 116 | let fnum = get_ext(arg0); 117 | let fari = arity_of(&ctx.prog.aris, arg0); 118 | if fari == 0 { 119 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp0(tcol, get_loc(ctx.term, 0)), Ctr(fnum, 0)); 120 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp1(tcol, get_loc(ctx.term, 0)), Ctr(fnum, 0)); 121 | link(ctx.heap, *ctx.host, Ctr(fnum, 0)); 122 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 123 | } else { 124 | let ctr0 = get_loc(arg0, 0); 125 | let ctr1 = alloc(ctx.heap, ctx.tid, fari); 126 | for i in 0 .. fari - 1 { 127 | let leti = alloc(ctx.heap, ctx.tid, 3); 128 | link(ctx.heap, leti + 2, take_arg(ctx.heap, arg0, i)); 129 | link(ctx.heap, ctr0 + i, Dp0(get_ext(ctx.term), leti)); 130 | link(ctx.heap, ctr1 + i, Dp1(get_ext(ctx.term), leti)); 131 | } 132 | let leti = alloc(ctx.heap, ctx.tid, 3); 133 | link(ctx.heap, leti + 2, take_arg(ctx.heap, arg0, fari - 1)); 134 | link(ctx.heap, ctr0 + fari - 1, Dp0(get_ext(ctx.term), leti)); 135 | link(ctx.heap, ctr1 + fari - 1, Dp1(get_ext(ctx.term), leti)); 136 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp0(tcol, get_loc(ctx.term, 0)), Ctr(fnum, ctr0)); 137 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp1(tcol, get_loc(ctx.term, 0)), Ctr(fnum, ctr1)); 138 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 139 | } 140 | return true; 141 | } 142 | 143 | // dup x y = * 144 | // ----------- DUP-ERA 145 | // x <- * 146 | // y <- * 147 | else if get_tag(arg0) == ERA { 148 | inc_cost(ctx.heap, ctx.tid); 149 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp0(tcol, get_loc(ctx.term, 0)), Era()); 150 | atomic_subst(ctx.heap, &ctx.prog.aris, ctx.tid, Dp1(tcol, get_loc(ctx.term, 0)), Era()); 151 | link(ctx.heap, *ctx.host, Era()); 152 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 153 | return true; 154 | } 155 | 156 | else { 157 | return false; 158 | } 159 | } 160 | -------------------------------------------------------------------------------- /src/runtime/base/io.rs: -------------------------------------------------------------------------------- 1 | //#[cfg(not(target_arch = "wasm32"))] 2 | //pub fn run_io(heap: &Heap, prog: &Program, tids: &[usize], host: u64) { 3 | //fn read_input() -> String { 4 | //let mut input = String::new(); 5 | //stdin().read_line(&mut input).expect("string"); 6 | //if let Some('\n') = input.chars().next_back() { input.pop(); } 7 | //if let Some('\r') = input.chars().next_back() { input.pop(); } 8 | //return input; 9 | //} 10 | //use std::io::{stdin,stdout,Write}; 11 | //loop { 12 | //let term = reduce(heap, prog, tids, host); // FIXME: add parallelism 13 | //match get_tag(term) { 14 | //CTR => { 15 | //let fid = get_ext(term); 16 | //// IO.done a : (IO a) 17 | //if fid == IO_DONE { 18 | //let done = load_arg(heap, term, 0); 19 | //free(heap, 0, get_loc(term, 0), 1); 20 | //link(heap, host, done); 21 | //println!(""); 22 | //println!(""); 23 | //break; 24 | //} 25 | //// IO.do_input (String -> IO a) : (IO a) 26 | //if fid == IO_DO_INPUT { 27 | //let cont = load_arg(heap, term, 0); 28 | //let text = make_string(heap, tids[0], &read_input()); 29 | //let app0 = alloc(heap, tids[0], 2); 30 | //link(heap, app0 + 0, cont); 31 | //link(heap, app0 + 1, text); 32 | //free(heap, 0, get_loc(term, 0), 1); 33 | //let done = App(app0); 34 | //link(heap, host, done); 35 | //} 36 | //// IO.do_output String (Wrd -> IO a) : (IO a) 37 | //if fid == IO_DO_OUTPUT { 38 | //if let Some(show) = readback_string(heap, prog, tids, get_loc(term, 0)) { 39 | //print!("{}", show); 40 | //stdout().flush().ok(); 41 | //let cont = load_arg(heap, term, 1); 42 | //let app0 = alloc(heap, tids[0], 2); 43 | //link(heap, app0 + 0, cont); 44 | //link(heap, app0 + 1, Wrd(0)); 45 | //free(heap, 0, get_loc(term, 0), 2); 46 | //let text = load_arg(heap, term, 0); 47 | //collect(heap, prog, 0, text); 48 | //let done = App(app0); 49 | //link(heap, host, done); 50 | //} else { 51 | //println!("Runtime type error: attempted to print a non-string."); 52 | //println!("{}", crate::language::readback::as_code(heap, prog, get_loc(term, 0))); 53 | //std::process::exit(0); 54 | //} 55 | //} 56 | //// IO.do_fetch String (String -> IO a) : (IO a) 57 | //if fid == IO_DO_FETCH { 58 | //if let Some(url) = readback_string(heap, prog, tids, get_loc(term, 0)) { 59 | //let body = reqwest::blocking::get(url).unwrap().text().unwrap(); // FIXME: treat 60 | //let cont = load_arg(heap, term, 2); 61 | //let app0 = alloc(heap, tids[0], 2); 62 | //let text = make_string(heap, tids[0], &body); 63 | //link(heap, app0 + 0, cont); 64 | //link(heap, app0 + 1, text); 65 | //free(heap, 0, get_loc(term, 0), 3); 66 | //let opts = load_arg(heap, term, 1); // FIXME: use options 67 | //collect(heap, prog, 0, opts); 68 | //let done = App(app0); 69 | //link(heap, host, done); 70 | //} else { 71 | //println!("Runtime type error: attempted to print a non-string."); 72 | //println!("{}", crate::language::readback::as_code(heap, prog, get_loc(term, 0))); 73 | //std::process::exit(0); 74 | //} 75 | //} 76 | //// IO.do_store String String (Wrd -> IO a) : (IO a) 77 | //if fid == IO_DO_STORE { 78 | //if let Some(key) = readback_string(heap, prog, tids, get_loc(term, 0)) { 79 | //if let Some(val) = readback_string(heap, prog, tids, get_loc(term, 1)) { 80 | //std::fs::write(key, val).ok(); // TODO: Handle errors 81 | //let cont = load_arg(heap, term, 2); 82 | //let app0 = alloc(heap, tids[0], 2); 83 | //link(heap, app0 + 0, cont); 84 | //link(heap, app0 + 1, Wrd(0)); 85 | //free(heap, 0, get_loc(term, 0), 2); 86 | //let key = load_arg(heap, term, 0); 87 | //collect(heap, prog, 0, key); 88 | //free(heap, 0, get_loc(term, 1), 2); 89 | //let val = load_arg(heap, term, 1); 90 | //collect(heap, prog, 0, val); 91 | //let done = App(app0); 92 | //link(heap, host, done); 93 | //} else { 94 | //println!("Runtime type error: attempted to store a non-string."); 95 | //println!("{}", crate::language::readback::as_code(heap, prog, get_loc(term, 1))); 96 | //std::process::exit(0); 97 | //} 98 | //} else { 99 | //println!("Runtime type error: attempted to store to a non-string key."); 100 | //println!("{}", crate::language::readback::as_code(heap, prog, get_loc(term, 0))); 101 | //std::process::exit(0); 102 | //} 103 | //} 104 | //// IO.do_load String (String -> IO a) : (IO a) 105 | //if fid == IO_DO_LOAD { 106 | //if let Some(key) = readback_string(heap, prog, tids, get_loc(term, 0)) { 107 | //let file = std::fs::read(key).unwrap(); // TODO: Handle errors 108 | //let file = std::str::from_utf8(&file).unwrap(); 109 | //let cont = load_arg(heap, term, 1); 110 | //let text = make_string(heap, tids[0], file); 111 | //let app0 = alloc(heap, tids[0], 2); 112 | //link(heap, app0 + 0, cont); 113 | //link(heap, app0 + 1, text); 114 | //free(heap, 0, get_loc(term, 0), 2); 115 | //let done = App(app0); 116 | //link(heap, host, done); 117 | //} else { 118 | //println!("Runtime type error: attempted to read from a non-string key."); 119 | //println!("{}", crate::language::readback::as_code(heap, prog, get_loc(term, 0))); 120 | //std::process::exit(0); 121 | //} 122 | //} 123 | //break; 124 | //} 125 | //_ => { 126 | //break; 127 | //} 128 | //} 129 | //} 130 | //} 131 | 132 | 133 | //pub fn make_string(heap: &Heap, tid: usize, text: &str) -> Ptr { 134 | //let mut term = Ctr(STRING_NIL, 0); 135 | //for chr in text.chars().rev() { // TODO: reverse 136 | //let ctr0 = alloc(heap, tid, 2); 137 | //link(heap, ctr0 + 0, Wrd(chr as u64)); 138 | //link(heap, ctr0 + 1, term); 139 | //term = Ctr(STRING_CONS, ctr0); 140 | //} 141 | //return term; 142 | //} 143 | -------------------------------------------------------------------------------- /guide/PARALLELISM.md: -------------------------------------------------------------------------------- 1 | Functional Parallelism 2 | ====================== 3 | 4 | Introduction 5 | ------------ 6 | 7 | HVM, or High-order Virtual Machine, is a massively parallel runtime that lets 8 | programmers write high-performance applications via the functional paradigm. 9 | Before the HVM, developing multi-threaded software was hard and costly, since 10 | the complexity of thread-safe synchronization demanded significant expertise and 11 | time. Even though CPUs and GPUs have been shipping with increasingly more cores 12 | over the years, programming languages have failed to catch up with that trend, 13 | wasting a huge potential. HVM bridges that gap, decreasing the cost of parallel 14 | software development drastically. This guide will teach you how to make full 15 | use of this capacity. 16 | 17 | Bubble Sort 18 | ----------- 19 | 20 | Let's get started with a simple algorithm: Bubble Sort. 21 | 22 | ```javascript 23 | // sort : List -> List 24 | (Sort Nil) = Nil 25 | (Sort (Cons x xs)) = (Insert x (Sort xs)) 26 | 27 | // Insert : U60 -> List -> List 28 | (Insert v Nil) = (Cons v Nil) 29 | (Insert v (Cons x xs)) = (GoDown (> v x) v x xs) 30 | 31 | // GoDown : U60 -> U60 -> U60 -> List -> List 32 | (GoDown 0 v x xs) = (Cons v (Cons x xs)) 33 | (GoDown 1 v x xs) = (Cons x (Insert v xs)) 34 | ``` 35 | 36 | Complete file: [examples/sort/bubble/main.hvm](../examples/sort/bubble/main.hvm) 37 | 38 | ![bubble-sort](../bench/_results_/sort-bubble.png) 39 | 40 | A Bubble Sort is **inherently sequential**, so HVM can't parallelize it. 41 | 42 | TODO: explain the lines 43 | 44 | TODO: comment on TIME, COST and RPS 45 | 46 | Quick Sort 47 | ---------- 48 | 49 | A naive Quick Sort would be sequential. 50 | 51 | ```javascript 52 | (Sort Nil) = Nil 53 | (Sort (Cons x xs)) = 54 | let min = (Sort (Filter λn(< n x) xs)) 55 | let max = (Sort (Filter λn(> n x) xs)) 56 | (Concat min (Cons x max)) 57 | ``` 58 | 59 | Solutions: 60 | 61 | 1. Avoid cloning with a single-pass partition 62 | 63 | 2. Avoid Concat by returning a tree instead 64 | 65 | Improved algorithm: 66 | 67 | ```javascript 68 | // Parallel QuickSort 69 | (Sort Nil) = Leaf 70 | (Sort (Cons x xs)) = 71 | ((Part x xs) λmin λmax 72 | let lft = (Sort min) 73 | let rgt = (Sort max) 74 | (Node lft x rgt)) 75 | 76 | // Partitions a list in two halves, less-than-p and greater-than-p 77 | (Part p Nil) = λt (t Nil Nil) 78 | (Part p (Cons x xs)) = (Push (> x p) x (Part p xs)) 79 | 80 | // Pushes a value to the first or second list of a pair 81 | (Push 0 x pair) = (pair λmin λmax λp (p (Cons x min) max)) 82 | (Push 1 x pair) = (pair λmin λmax λp (p min (Cons x max))) 83 | ``` 84 | 85 | Complete file: [examples/sort/quick/main.hvm](../examples/sort/quick/main.hvm) 86 | 87 | Benchmark: 88 | 89 | ![quick-sort](../bench/_results_/sort-quick.png) 90 | 91 | TODO: comment on TIME, COST and RPS 92 | 93 | Bitonic Sort 94 | ------------ 95 | 96 | The Bitonic Sort algorithm is possibly the most popular choice to implement 97 | sorting in parallel architectures such as CUDA or OpenMP. While it has worse 98 | asymptotics than Quick Sort, it minimizes parallel delay. It can also be drawn 99 | as a pretty sorting network: 100 | 101 | ![bitonic sorting network](https://i.imgur.com/iis9lau.png) 102 | 103 | Implementing it in CUDA or similar requires careful orchestration of threads in 104 | order to perform the swaps in synchronism. 105 | [Here](https://people.cs.rutgers.edu/~venugopa/parallel_summer2012/cuda_bitonic.html) 106 | is an example implementation. While this is doable, it is definitely not the 107 | kind of code a functional programmer would like to write for a living. What is 108 | less known, though, is that the Bitonic Sort has a very elegant presentation in 109 | the functional paradigm: 110 | 111 | ```javascript 112 | // Atomic Swapper 113 | (Swap 0 a b) = (Both a b) 114 | (Swap n a b) = (Both b a) 115 | 116 | // Swaps distant values in parallel; corresponds to a Red Box 117 | (Warp s (Leaf a) (Leaf b)) = (Swap (^ (> a b) s) (Leaf a) (Leaf b)) 118 | (Warp s (Both a b) (Both c d)) = (Join (Warp s a c) (Warp s b d)) 119 | 120 | // Rebuilds the warped tree in the original order 121 | (Join (Both a b) (Both c d)) = (Both (Both a c) (Both b d)) 122 | 123 | // Recursively warps each sub-tree; corresponds to a Blue/Green Box 124 | (Flow s (Leaf a)) = (Leaf a) 125 | (Flow s (Both a b)) = (Down s (Warp s a b)) 126 | 127 | // Propagates Flow downwards 128 | (Down s (Leaf a)) = (Leaf a) 129 | (Down s (Both a b)) = (Both (Flow s a) (Flow s b)) 130 | 131 | // Bitonic Sort 132 | (Sort s (Leaf a)) = (Leaf a) 133 | (Sort s (Both a b)) = (Flow s (Both (Sort 0 a) (Sort 1 b))) 134 | ``` 135 | 136 | Complete file: [examples/sort/bitonic/main.hvm](../examples/sort/bitonic/main.hvm) 137 | 138 | Benchmark: 139 | 140 | ![bitonic-sort](../bench/_results_/sort-bitonic.png) 141 | 142 | The RPS was greatly increased w.r.t the Quick Sort version, and its performance 143 | scales quasi-linearly with the number of cores! In other words, we achieved 144 | perfect parallelism, and we can expect this algorithm to scale horizontally. 145 | Each time you double the number of cores, the run time would almost halve. 146 | 147 | Sadly, the raw total cost increased a lot too, so, in this case, the run time is 148 | slightly inferior than Quick Sort in a 8-core CPU. The Bitonic Sort could possibly 149 | gain the edge if more cores were added, and there could be missing optimizatios 150 | on my algorithm. Regardless, it is a great example on how we achieved massive 151 | parallelism with minimal effort. 152 | 153 | Radix Sort 154 | ---------- 155 | 156 | Finally, I'll present a last algorithm that can also parallelize perfectly. The 157 | idea is pretty simple: we'll convert each number into an immutable tree, and 158 | merge all the trees in parallel. The resulting tree will then contain all 159 | numbers in ascending order. This is the algorithm: 160 | 161 | ```javascript 162 | // Sort : Arr -> Arr 163 | (Sort t) = (ToArr 0 (ToMap t)) 164 | 165 | // ToMap : Arr -> Map 166 | (ToMap Null) = Free 167 | (ToMap (Leaf a)) = (Radix a) 168 | (ToMap (Node a b)) = (Merge (ToMap a) (ToMap b)) 169 | 170 | // ToArr : Map -> Arr 171 | (ToArr x Free) = Null 172 | (ToArr x Used) = (Leaf x) 173 | (ToArr x (Both a b)) = 174 | let a = (ToArr (+ (* x 2) 0) a) 175 | let b = (ToArr (+ (* x 2) 1) b) 176 | (Node a b) 177 | 178 | // Merge : Map -> Map -> Map 179 | (Merge Free Free) = Free 180 | (Merge Free Used) = Used 181 | (Merge Used Free) = Used 182 | (Merge Used Used) = Used 183 | (Merge Free (Both c d)) = (Both c d) 184 | (Merge (Both a b) Free) = (Both a b) 185 | (Merge (Both a b) (Both c d)) = (Both (Merge a c) (Merge b d)) 186 | ``` 187 | 188 | Complete file: [examples/sort/radix/main.hvm](../examples/sort/radix/main.hvm) 189 | 190 | Benchmark: 191 | 192 | ![radix-sort](../bench/_results_/sort-radix.png) 193 | 194 | Now this is an algorithm! It has the parallelization of the Bitonic Sort, and 195 | the complexity of the Quick Sort, without the worst cases. Of all algorithms I 196 | tested so far, it seems to be the best performing on HVM. 197 | 198 | ... 199 | 200 | TODO: review and continue this GUIDE. Good night! :) 201 | -------------------------------------------------------------------------------- /src/runtime/rule/fun.rs: -------------------------------------------------------------------------------- 1 | use crate::runtime::{*}; 2 | use std::sync::atomic::{Ordering}; 3 | 4 | #[inline(always)] 5 | pub fn visit(ctx: ReduceCtx, sidxs: &[u64]) -> bool { 6 | let len = sidxs.len() as u64; 7 | if len == 0 { 8 | return false; 9 | } else { 10 | let mut vlen = 0; 11 | let vbuf = unsafe { ctx.heap.vbuf.get_unchecked(ctx.tid) }; 12 | for sidx in sidxs { 13 | if !is_whnf(load_arg(ctx.heap, ctx.term, *sidx)) { 14 | unsafe { vbuf.get_unchecked(vlen) }.store(get_loc(ctx.term, *sidx), Ordering::Relaxed); 15 | vlen += 1; 16 | } 17 | } 18 | if vlen == 0 { 19 | return false; 20 | } else { 21 | let goup = ctx.redex.insert(ctx.tid, new_redex(*ctx.host, *ctx.cont, vlen as u64)); 22 | for i in 0 .. vlen - 1 { 23 | ctx.visit.push(new_visit(unsafe { vbuf.get_unchecked(i).load(Ordering::Relaxed) }, ctx.hold, goup)); 24 | } 25 | *ctx.cont = goup; 26 | *ctx.host = unsafe { vbuf.get_unchecked(vlen - 1).load(Ordering::Relaxed) }; 27 | return true; 28 | } 29 | } 30 | //OLD_VISITER: 31 | //let len = sidxs.len() as u64; 32 | //if len == 0 { 33 | //return false; 34 | //} else { 35 | //let goup = ctx.redex.insert(ctx.tid, new_redex(*ctx.host, *ctx.cont, sidxs.len() as u64)); 36 | //for (i, arg_idx) in sidxs.iter().enumerate() { 37 | //if i < sidxs.len() - 1 { 38 | //ctx.visit.push(new_visit(get_loc(ctx.term, *arg_idx), goup)); 39 | //} else { 40 | //*ctx.cont = goup; 41 | //*ctx.host = get_loc(ctx.term, *arg_idx); 42 | //return true; 43 | //} 44 | //} 45 | //return true; 46 | //} 47 | } 48 | 49 | #[inline(always)] 50 | pub fn apply(ctx: ReduceCtx, fid: u64, visit: &VisitObj, apply: &ApplyObj) -> bool { 51 | // Reduces function superpositions 52 | for (n, is_strict) in visit.strict_map.iter().enumerate() { 53 | let n = n as u64; 54 | if *is_strict && get_tag(load_arg(ctx.heap, ctx.term, n)) == SUP { 55 | superpose(ctx.heap, &ctx.prog.aris, ctx.tid, *ctx.host, ctx.term, load_arg(ctx.heap, ctx.term, n), n); 56 | return true; 57 | } 58 | } 59 | 60 | // For each rule condition vector 61 | let mut matched; 62 | for (r, rule) in apply.rules.iter().enumerate() { 63 | // Check if the rule matches 64 | matched = true; 65 | 66 | // Tests each rule condition (ex: `get_tag(args[0]) == SUCC`) 67 | for (i, cond) in rule.cond.iter().enumerate() { 68 | let i = i as u64; 69 | match get_tag(*cond) { 70 | U60 => { 71 | let same_tag = get_tag(load_arg(ctx.heap, ctx.term, i)) == U60; 72 | let same_val = get_num(load_arg(ctx.heap, ctx.term, i)) == get_num(*cond); 73 | matched = matched && same_tag && same_val; 74 | } 75 | F60 => { 76 | let same_tag = get_tag(load_arg(ctx.heap, ctx.term, i)) == F60; 77 | let same_val = get_num(load_arg(ctx.heap, ctx.term, i)) == get_num(*cond); 78 | matched = matched && same_tag && same_val; 79 | } 80 | CTR => { 81 | let same_tag = get_tag(load_arg(ctx.heap, ctx.term, i)) == CTR || get_tag(load_arg(ctx.heap, ctx.term, i)) == FUN; 82 | let same_ext = get_ext(load_arg(ctx.heap, ctx.term, i)) == get_ext(*cond); 83 | matched = matched && same_tag && same_ext; 84 | } 85 | //FUN => { 86 | //let same_tag = get_tag(load_arg(ctx.heap, ctx.term, i)) == CTR || get_tag(load_arg(ctx.heap, ctx.term, i)) == FUN; 87 | //let same_ext = get_ext(load_arg(ctx.heap, ctx.term, i)) == get_ext(*cond); 88 | //matched = matched && same_tag && same_ext; 89 | //} 90 | VAR => { 91 | // If this is a strict argument, then we're in a default variable 92 | if unsafe { *visit.strict_map.get_unchecked(i as usize) } { 93 | 94 | // This is a Kind2-specific optimization. 95 | if rule.hoas && r != apply.rules.len() - 1 { 96 | 97 | // Matches number literals 98 | let is_num 99 | = get_tag(load_arg(ctx.heap, ctx.term, i)) == U60 100 | || get_tag(load_arg(ctx.heap, ctx.term, i)) == F60; 101 | 102 | // Matches constructor labels 103 | let is_ctr 104 | = get_tag(load_arg(ctx.heap, ctx.term, i)) == CTR 105 | && arity_of(&ctx.prog.aris, load_arg(ctx.heap, ctx.term, i)) == 0; 106 | 107 | // Matches HOAS numbers and constructors 108 | let is_hoas_ctr_num 109 | = get_tag(load_arg(ctx.heap, ctx.term, i)) == CTR 110 | && get_ext(load_arg(ctx.heap, ctx.term, i)) >= KIND_TERM_CT0 111 | && get_ext(load_arg(ctx.heap, ctx.term, i)) <= KIND_TERM_F60; 112 | 113 | matched = matched && (is_num || is_ctr || is_hoas_ctr_num); 114 | 115 | // Only match default variables on CTRs and NUMs 116 | } else { 117 | let is_ctr = get_tag(load_arg(ctx.heap, ctx.term, i)) == CTR; 118 | let is_u60 = get_tag(load_arg(ctx.heap, ctx.term, i)) == U60; 119 | let is_f60 = get_tag(load_arg(ctx.heap, ctx.term, i)) == F60; 120 | matched = matched && (is_ctr || is_u60 || is_f60); 121 | } 122 | } 123 | } 124 | _ => {} 125 | } 126 | } 127 | 128 | // If all conditions are satisfied, the rule matched, so we must apply it 129 | if matched { 130 | // Increments the gas count 131 | inc_cost(ctx.heap, ctx.tid); 132 | 133 | // Builds the right-hand side ctx.term 134 | let done = alloc_body(ctx.heap, ctx.prog, ctx.tid, ctx.term, &rule.vars, &rule.body); 135 | 136 | // Links the *ctx.host location to it 137 | link(ctx.heap, *ctx.host, done); 138 | 139 | // Collects unused variables 140 | for var @ RuleVar { param: _, field: _, erase } in rule.vars.iter() { 141 | if *erase { 142 | collect(ctx.heap, &ctx.prog.aris, ctx.tid, get_var(ctx.heap, ctx.term, var)); 143 | } 144 | } 145 | 146 | // free the matched ctrs 147 | for (i, arity) in &rule.free { 148 | free(ctx.heap, ctx.tid, get_loc(load_arg(ctx.heap, ctx.term, *i as u64), 0), *arity); 149 | } 150 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), arity_of(&ctx.prog.aris, fid)); 151 | 152 | return true; 153 | } 154 | } 155 | 156 | return false; 157 | } 158 | 159 | #[inline(always)] 160 | pub fn superpose(heap: &Heap, aris: &Aris, tid: usize, host: u64, term: Ptr, argn: Ptr, n: u64) -> Ptr { 161 | inc_cost(heap, tid); 162 | let arit = arity_of(aris, term); 163 | let func = get_ext(term); 164 | let fun0 = get_loc(term, 0); 165 | let fun1 = alloc(heap, tid, arit); 166 | let par0 = get_loc(argn, 0); 167 | for i in 0 .. arit { 168 | if i != n { 169 | let leti = alloc(heap, tid, 3); 170 | let argi = take_arg(heap, term, i); 171 | link(heap, fun0 + i, Dp0(get_ext(argn), leti)); 172 | link(heap, fun1 + i, Dp1(get_ext(argn), leti)); 173 | link(heap, leti + 2, argi); 174 | } else { 175 | link(heap, fun0 + i, take_arg(heap, argn, 0)); 176 | link(heap, fun1 + i, take_arg(heap, argn, 1)); 177 | } 178 | } 179 | link(heap, par0 + 0, Fun(func, fun0)); 180 | link(heap, par0 + 1, Fun(func, fun1)); 181 | let done = Sup(get_ext(argn), par0); 182 | link(heap, host, done); 183 | done 184 | } 185 | -------------------------------------------------------------------------------- /src/runtime/base/debug.rs: -------------------------------------------------------------------------------- 1 | use crate::runtime::{*}; 2 | use std::collections::{hash_map, HashMap}; 3 | use std::sync::atomic::{AtomicU64, Ordering}; 4 | 5 | // Debug 6 | // ----- 7 | 8 | pub fn show_ptr(x: Ptr) -> String { 9 | if x == 0 { 10 | String::from("~") 11 | } else { 12 | let tag = get_tag(x); 13 | let ext = get_ext(x); 14 | let val = get_val(x); 15 | let tgs = match tag { 16 | DP0 => "Dp0", 17 | DP1 => "Dp1", 18 | VAR => "Var", 19 | ARG => "Arg", 20 | ERA => "Era", 21 | LAM => "Lam", 22 | APP => "App", 23 | SUP => "Sup", 24 | CTR => "Ctr", 25 | FUN => "Fun", 26 | OP2 => "Op2", 27 | U60 => "U60", 28 | F60 => "F60", 29 | _ => "?", 30 | }; 31 | format!("{}({:07x}, {:08x})", tgs, ext, val) 32 | } 33 | } 34 | 35 | pub fn show_heap(heap: &Heap) -> String { 36 | let mut text: String = String::new(); 37 | for idx in 0 .. heap.node.len() { 38 | let ptr = load_ptr(heap, idx as u64); 39 | if ptr != 0 { 40 | text.push_str(&format!("{:04x} | ", idx)); 41 | text.push_str(&show_ptr(ptr)); 42 | text.push('\n'); 43 | } 44 | } 45 | text 46 | } 47 | 48 | pub fn show_at(heap: &Heap, prog: &Program, host: u64, tlocs: &[AtomicU64]) -> String { 49 | let mut lets: HashMap = HashMap::new(); 50 | let mut kinds: HashMap = HashMap::new(); 51 | let mut names: HashMap = HashMap::new(); 52 | let mut count: u64 = 0; 53 | fn find_lets( 54 | heap: &Heap, 55 | prog: &Program, 56 | host: u64, 57 | lets: &mut HashMap, 58 | kinds: &mut HashMap, 59 | names: &mut HashMap, 60 | count: &mut u64, 61 | ) { 62 | let term = load_ptr(heap, host); 63 | if term == 0 { 64 | return; 65 | } 66 | match get_tag(term) { 67 | LAM => { 68 | names.insert(get_loc(term, 0), format!("{}", count)); 69 | *count += 1; 70 | find_lets(heap, prog, get_loc(term, 1), lets, kinds, names, count); 71 | } 72 | APP => { 73 | find_lets(heap, prog, get_loc(term, 0), lets, kinds, names, count); 74 | find_lets(heap, prog, get_loc(term, 1), lets, kinds, names, count); 75 | } 76 | SUP => { 77 | find_lets(heap, prog, get_loc(term, 0), lets, kinds, names, count); 78 | find_lets(heap, prog, get_loc(term, 1), lets, kinds, names, count); 79 | } 80 | DP0 => { 81 | if let hash_map::Entry::Vacant(e) = lets.entry(get_loc(term, 0)) { 82 | names.insert(get_loc(term, 0), format!("{}", count)); 83 | *count += 1; 84 | kinds.insert(get_loc(term, 0), get_ext(term)); 85 | e.insert(get_loc(term, 0)); 86 | find_lets(heap, prog, get_loc(term, 2), lets, kinds, names, count); 87 | } 88 | } 89 | DP1 => { 90 | if let hash_map::Entry::Vacant(e) = lets.entry(get_loc(term, 0)) { 91 | names.insert(get_loc(term, 0), format!("{}", count)); 92 | *count += 1; 93 | kinds.insert(get_loc(term, 0), get_ext(term)); 94 | e.insert(get_loc(term, 0)); 95 | find_lets(heap, prog, get_loc(term, 2), lets, kinds, names, count); 96 | } 97 | } 98 | OP2 => { 99 | find_lets(heap, prog, get_loc(term, 0), lets, kinds, names, count); 100 | find_lets(heap, prog, get_loc(term, 1), lets, kinds, names, count); 101 | } 102 | CTR | FUN => { 103 | let arity = arity_of(&prog.aris, term); 104 | for i in 0..arity { 105 | find_lets(heap, prog, get_loc(term, i), lets, kinds, names, count); 106 | } 107 | } 108 | _ => {} 109 | } 110 | } 111 | fn go( 112 | heap: &Heap, 113 | prog: &Program, 114 | host: u64, 115 | names: &HashMap, 116 | tlocs: &[AtomicU64], 117 | ) -> String { 118 | let term = load_ptr(heap, host); 119 | let done; 120 | if term == 0 { 121 | done = format!("<>"); 122 | } else { 123 | done = match get_tag(term) { 124 | DP0 => { 125 | if let Some(name) = names.get(&get_loc(term, 0)) { 126 | format!("a{}", name) 127 | } else { 128 | format!("a^{}", get_loc(term, 0)) 129 | } 130 | } 131 | DP1 => { 132 | if let Some(name) = names.get(&get_loc(term, 0)) { 133 | format!("b{}", name) 134 | } else { 135 | format!("b^{}", get_loc(term, 0)) 136 | } 137 | } 138 | VAR => { 139 | if let Some(name) = names.get(&get_loc(term, 0)) { 140 | format!("x{}", name) 141 | } else { 142 | format!("x^{}", get_loc(term, 0)) 143 | } 144 | } 145 | LAM => { 146 | let name = format!("x{}", names.get(&get_loc(term, 0)).unwrap_or(&String::from(""))); 147 | format!("λ{} {}", name, go(heap, prog, get_loc(term, 1), names, tlocs)) 148 | } 149 | APP => { 150 | let func = go(heap, prog, get_loc(term, 0), names, tlocs); 151 | let argm = go(heap, prog, get_loc(term, 1), names, tlocs); 152 | format!("({} {})", func, argm) 153 | } 154 | SUP => { 155 | //let kind = get_ext(term); 156 | let func = go(heap, prog, get_loc(term, 0), names, tlocs); 157 | let argm = go(heap, prog, get_loc(term, 1), names, tlocs); 158 | format!("{{{} {}}}", func, argm) 159 | } 160 | OP2 => { 161 | let oper = get_ext(term); 162 | let val0 = go(heap, prog, get_loc(term, 0), names, tlocs); 163 | let val1 = go(heap, prog, get_loc(term, 1), names, tlocs); 164 | let symb = match oper { 165 | 0x0 => "+", 166 | 0x1 => "-", 167 | 0x2 => "*", 168 | 0x3 => "/", 169 | 0x4 => "%", 170 | 0x5 => "&", 171 | 0x6 => "|", 172 | 0x7 => "^", 173 | 0x8 => "<<", 174 | 0x9 => ">>", 175 | 0xA => "<", 176 | 0xB => "<=", 177 | 0xC => "=", 178 | 0xD => ">=", 179 | 0xE => ">", 180 | 0xF => "!=", 181 | _ => "", 182 | }; 183 | format!("({} {} {})", symb, val0, val1) 184 | } 185 | U60 => { 186 | format!("{}", u60::val(get_val(term))) 187 | } 188 | F60 => { 189 | format!("{}", f60::val(get_val(term))) 190 | } 191 | CTR | FUN => { 192 | let func = get_ext(term); 193 | let arit = arity_of(&prog.aris, term); 194 | let args: Vec = (0..arit).map(|i| go(heap, prog, get_loc(term, i), names, tlocs)).collect(); 195 | let name = &prog.nams.get(&func).unwrap_or(&String::from("")).clone(); 196 | format!("({}{})", name, args.iter().map(|x| format!(" {}", x)).collect::()) 197 | } 198 | ERA => "*".to_string(), 199 | _ => format!("", get_tag(term)), 200 | }; 201 | } 202 | for (tid, tid_loc) in tlocs.iter().enumerate() { 203 | if host == tid_loc.load(Ordering::Relaxed) { 204 | return format!("<{}>{}", tid, done); 205 | } 206 | } 207 | return done; 208 | } 209 | find_lets(heap, prog, host, &mut lets, &mut kinds, &mut names, &mut count); 210 | let mut text = go(heap, prog, host, &names, tlocs); 211 | for (_key, pos) in itertools::sorted(lets.iter()) { 212 | // todo: reverse 213 | let what = String::from("?h"); 214 | //let kind = kinds.get(&pos).unwrap_or(&0); 215 | let name = names.get(&pos).unwrap_or(&what); 216 | let nam0 = if load_ptr(heap, pos + 0) == Era() { String::from("*") } else { format!("a{}", name) }; 217 | let nam1 = if load_ptr(heap, pos + 1) == Era() { String::from("*") } else { format!("b{}", name) }; 218 | text.push_str(&format!("\ndup {} {} = {};", nam0, nam1, go(heap, prog, pos + 2, &names, tlocs))); 219 | } 220 | text 221 | } 222 | 223 | pub fn validate_heap(heap: &Heap) { 224 | for idx in 0 .. heap.node.len() { 225 | // If it is an ARG, it must be pointing to a VAR/DP0/DP1 that points to it 226 | let arg = load_ptr(heap, idx as u64); 227 | if get_tag(arg) == ARG { 228 | let var = load_ptr(heap, get_loc(arg, 0)); 229 | let oks = match get_tag(var) { 230 | VAR => { get_loc(var, 0) == idx as u64 } 231 | DP0 => { get_loc(var, 0) == idx as u64 } 232 | DP1 => { get_loc(var, 0) == idx as u64 - 1 } 233 | _ => { false } 234 | }; 235 | if !oks { 236 | panic!("Invalid heap state, due to arg at '{:04x}' of:\n{}", idx, show_heap(heap)); 237 | } 238 | } 239 | } 240 | } 241 | -------------------------------------------------------------------------------- /src/runtime/mod.rs: -------------------------------------------------------------------------------- 1 | #![allow(clippy::identity_op)] 2 | #![allow(dead_code)] 3 | #![allow(non_snake_case)] 4 | #![allow(unused_attributes)] 5 | #![allow(unused_imports)] 6 | 7 | pub mod base; 8 | pub mod data; 9 | pub mod rule; 10 | 11 | use sysinfo::{System, SystemExt, RefreshKind}; 12 | 13 | pub use base::{*}; 14 | pub use data::{*}; 15 | pub use rule::{*}; 16 | 17 | use crate::language; 18 | 19 | pub const CELLS_PER_KB: usize = 0x80; 20 | pub const CELLS_PER_MB: usize = 0x20000; 21 | pub const CELLS_PER_GB: usize = 0x8000000; 22 | 23 | // If unspecified, allocates `max(16 GB, 75% free_sys_mem)` memory 24 | pub fn default_heap_size() -> usize { 25 | use sysinfo::SystemExt; 26 | let available_memory = System::new_with_specifics(RefreshKind::new().with_memory()).free_memory(); 27 | let heap_size = (available_memory * 3 / 4) / 8; 28 | let heap_size = std::cmp::min(heap_size as usize, 16 * CELLS_PER_GB); 29 | return heap_size as usize; 30 | } 31 | 32 | // If unspecified, spawns 1 thread for each available core 33 | pub fn default_heap_tids() -> usize { 34 | return std::thread::available_parallelism().unwrap().get(); 35 | } 36 | 37 | pub struct Runtime { 38 | pub heap: Heap, 39 | pub prog: Program, 40 | pub book: language::rulebook::RuleBook, 41 | pub tids: Box<[usize]>, 42 | pub dbug: bool, 43 | } 44 | 45 | impl Runtime { 46 | 47 | /// Creates a new, empty runtime 48 | pub fn new(size: usize, tids: usize, dbug: bool) -> Runtime { 49 | Runtime { 50 | heap: new_heap(size, tids), 51 | prog: Program::new(), 52 | book: language::rulebook::new_rulebook(), 53 | tids: new_tids(tids), 54 | dbug: dbug, 55 | } 56 | } 57 | 58 | /// Creates a runtime from source code, given a max number of nodes 59 | pub fn from_code_with(code: &str, size: usize, tids: usize, dbug: bool) -> Result { 60 | let file = language::syntax::read_file(code)?; 61 | let heap = new_heap(size, tids); 62 | let prog = Program::new(); 63 | let book = language::rulebook::gen_rulebook(&file); 64 | let tids = new_tids(tids); 65 | return Ok(Runtime { heap, prog, book, tids, dbug }); 66 | } 67 | 68 | ////fn get_area(&mut self) -> runtime::Area { 69 | ////return runtime::get_area(&mut self.heap, 0) 70 | ////} 71 | 72 | /// Creates a runtime from a source code 73 | //#[cfg(not(target_arch = "wasm32"))] 74 | pub fn from_code(code: &str) -> Result { 75 | Runtime::from_code_with(code, default_heap_size(), default_heap_tids(), false) 76 | } 77 | 78 | ///// Extends a runtime with new definitions 79 | //pub fn define(&mut self, _code: &str) { 80 | //todo!() 81 | //} 82 | 83 | /// Allocates a new term, returns its location 84 | pub fn alloc_code(&mut self, code: &str) -> Result { 85 | Ok(self.alloc_term(&*language::syntax::read_term(code)?)) 86 | } 87 | 88 | /// Given a location, returns the pointer stored on it 89 | pub fn load_ptr(&self, host: u64) -> Ptr { 90 | load_ptr(&self.heap, host) 91 | } 92 | 93 | /// Given a location, evaluates a term to head normal form 94 | pub fn reduce(&mut self, host: u64) { 95 | reduce(&self.heap, &self.prog, &self.tids, host, false, self.dbug); 96 | } 97 | 98 | /// Given a location, evaluates a term to full normal form 99 | pub fn normalize(&mut self, host: u64) { 100 | reduce(&self.heap, &self.prog, &self.tids, host, true, self.dbug); 101 | } 102 | 103 | /// Evaluates a code, allocs and evaluates to full normal form. Returns its location. 104 | pub fn normalize_code(&mut self, code: &str) -> u64 { 105 | let host = self.alloc_code(code).ok().unwrap(); 106 | self.normalize(host); 107 | return host; 108 | } 109 | 110 | /// Evaluates a code to normal form. Returns its location. 111 | pub fn eval_to_loc(&mut self, code: &str) -> u64 { 112 | return self.normalize_code(code); 113 | } 114 | 115 | /// Evaluates a code to normal form. 116 | pub fn eval(&mut self, code: &str) -> String { 117 | let host = self.normalize_code(code); 118 | return self.show(host); 119 | } 120 | 121 | //// /// Given a location, runs side-effective actions 122 | ////#[cfg(not(target_arch = "wasm32"))] 123 | ////pub fn run_io(&mut self, host: u64) { 124 | ////runtime::run_io(&mut self.heap, &self.prog, &[0], host) 125 | ////} 126 | 127 | /// Given a location, recovers the lambda Term stored on it, as code 128 | pub fn show(&self, host: u64) -> String { 129 | language::readback::as_code(&self.heap, &self.prog, host) 130 | } 131 | 132 | /// Given a location, recovers the linear Term stored on it, as code 133 | pub fn show_linear(&self, host: u64) -> String { 134 | language::readback::as_linear_code(&self.heap, &self.prog, host) 135 | } 136 | 137 | /// Return the total number of graph rewrites computed 138 | pub fn get_rewrites(&self) -> u64 { 139 | get_cost(&self.heap) 140 | } 141 | 142 | /// Returns the name of a given id 143 | pub fn get_name(&self, id: u64) -> String { 144 | self.prog.nams.get(&id).unwrap_or(&"?".to_string()).clone() 145 | } 146 | 147 | /// Returns the arity of a given id 148 | pub fn get_arity(&self, id: u64) -> u64 { 149 | *self.prog.aris.get(&id).unwrap_or(&u64::MAX) 150 | } 151 | 152 | /// Returns the name of a given id 153 | pub fn get_id(&self, name: &str) -> u64 { 154 | *self.book.name_to_id.get(name).unwrap_or(&u64::MAX) 155 | } 156 | 157 | //// WASM re-exports 158 | 159 | pub fn DP0() -> u64 { 160 | return DP0; 161 | } 162 | 163 | pub fn DP1() -> u64 { 164 | return DP1; 165 | } 166 | 167 | pub fn VAR() -> u64 { 168 | return VAR; 169 | } 170 | 171 | pub fn ARG() -> u64 { 172 | return ARG; 173 | } 174 | 175 | pub fn ERA() -> u64 { 176 | return ERA; 177 | } 178 | 179 | pub fn LAM() -> u64 { 180 | return LAM; 181 | } 182 | 183 | pub fn APP() -> u64 { 184 | return APP; 185 | } 186 | 187 | pub fn SUP() -> u64 { 188 | return SUP; 189 | } 190 | 191 | pub fn CTR() -> u64 { 192 | return CTR; 193 | } 194 | 195 | pub fn FUN() -> u64 { 196 | return FUN; 197 | } 198 | 199 | pub fn OP2() -> u64 { 200 | return OP2; 201 | } 202 | 203 | pub fn U60() -> u64 { 204 | return U60; 205 | } 206 | 207 | pub fn F60() -> u64 { 208 | return F60; 209 | } 210 | 211 | pub fn ADD() -> u64 { 212 | return ADD; 213 | } 214 | 215 | pub fn SUB() -> u64 { 216 | return SUB; 217 | } 218 | 219 | pub fn MUL() -> u64 { 220 | return MUL; 221 | } 222 | 223 | pub fn DIV() -> u64 { 224 | return DIV; 225 | } 226 | 227 | pub fn MOD() -> u64 { 228 | return MOD; 229 | } 230 | 231 | pub fn AND() -> u64 { 232 | return AND; 233 | } 234 | 235 | pub fn OR() -> u64 { 236 | return OR; 237 | } 238 | 239 | pub fn XOR() -> u64 { 240 | return XOR; 241 | } 242 | 243 | pub fn SHL() -> u64 { 244 | return SHL; 245 | } 246 | 247 | pub fn SHR() -> u64 { 248 | return SHR; 249 | } 250 | 251 | pub fn LTN() -> u64 { 252 | return LTN; 253 | } 254 | 255 | pub fn LTE() -> u64 { 256 | return LTE; 257 | } 258 | 259 | pub fn EQL() -> u64 { 260 | return EQL; 261 | } 262 | 263 | pub fn GTE() -> u64 { 264 | return GTE; 265 | } 266 | 267 | pub fn GTN() -> u64 { 268 | return GTN; 269 | } 270 | 271 | pub fn NEQ() -> u64 { 272 | return NEQ; 273 | } 274 | 275 | pub fn CELLS_PER_KB() -> usize { 276 | return CELLS_PER_KB; 277 | } 278 | 279 | pub fn CELLS_PER_MB() -> usize { 280 | return CELLS_PER_MB; 281 | } 282 | 283 | pub fn CELLS_PER_GB() -> usize { 284 | return CELLS_PER_GB; 285 | } 286 | 287 | pub fn get_tag(lnk: Ptr) -> u64 { 288 | return get_tag(lnk); 289 | } 290 | 291 | pub fn get_ext(lnk: Ptr) -> u64 { 292 | return get_ext(lnk); 293 | } 294 | 295 | pub fn get_val(lnk: Ptr) -> u64 { 296 | return get_val(lnk); 297 | } 298 | 299 | pub fn get_num(lnk: Ptr) -> u64 { 300 | return get_num(lnk); 301 | } 302 | 303 | pub fn get_loc(lnk: Ptr, arg: u64) -> u64 { 304 | return get_loc(lnk, arg); 305 | } 306 | 307 | pub fn Var(pos: u64) -> Ptr { 308 | return Var(pos); 309 | } 310 | 311 | pub fn Dp0(col: u64, pos: u64) -> Ptr { 312 | return Dp0(col, pos); 313 | } 314 | 315 | pub fn Dp1(col: u64, pos: u64) -> Ptr { 316 | return Dp1(col, pos); 317 | } 318 | 319 | pub fn Arg(pos: u64) -> Ptr { 320 | return Arg(pos); 321 | } 322 | 323 | pub fn Era() -> Ptr { 324 | return Era(); 325 | } 326 | 327 | pub fn Lam(pos: u64) -> Ptr { 328 | return Lam(pos); 329 | } 330 | 331 | pub fn App(pos: u64) -> Ptr { 332 | return App(pos); 333 | } 334 | 335 | pub fn Sup(col: u64, pos: u64) -> Ptr { 336 | return Sup(col, pos); 337 | } 338 | 339 | pub fn Op2(ope: u64, pos: u64) -> Ptr { 340 | return Op2(ope, pos); 341 | } 342 | 343 | pub fn U6O(val: u64) -> Ptr { 344 | return U6O(val); 345 | } 346 | 347 | pub fn F6O(val: u64) -> Ptr { 348 | return F6O(val); 349 | } 350 | 351 | pub fn Ctr(fun: u64, pos: u64) -> Ptr { 352 | return Ctr(fun, pos); 353 | } 354 | 355 | pub fn Fun(fun: u64, pos: u64) -> Ptr { 356 | return Fun(fun, pos); 357 | } 358 | 359 | pub fn link(&mut self, loc: u64, lnk: Ptr) -> Ptr { 360 | return link(&self.heap, loc, lnk); 361 | } 362 | 363 | pub fn alloc(&mut self, size: u64) -> u64 { 364 | return alloc(&self.heap, 0, size); // FIXME tid? 365 | } 366 | 367 | pub fn free(&mut self, loc: u64, size: u64) { 368 | return free(&self.heap, 0, loc, size); // FIXME tid? 369 | } 370 | 371 | pub fn collect(&mut self, term: Ptr) { 372 | return collect(&self.heap, &self.prog.aris, 0, term); // FIXME tid? 373 | } 374 | 375 | } 376 | 377 | // Methods that aren't compiled to JS 378 | impl Runtime { 379 | /// Allocates a new term, returns its location 380 | pub fn alloc_term(&mut self, term: &language::syntax::Term) -> u64 { 381 | alloc_term(&self.heap, &self.prog, 0, &self.book, term) // FIXME tid? 382 | } 383 | 384 | /// Given a location, recovers the Core stored on it 385 | pub fn readback(&self, host: u64) -> Box { 386 | language::readback::as_term(&self.heap, &self.prog, host) 387 | } 388 | 389 | /// Given a location, recovers the Term stored on it 390 | pub fn linear_readback(&self, host: u64) -> Box { 391 | language::readback::as_linear_term(&self.heap, &self.prog, host) 392 | } 393 | } 394 | -------------------------------------------------------------------------------- /src/lib.rs: -------------------------------------------------------------------------------- 1 | #![feature(atomic_from_mut)] 2 | 3 | #![allow(unused_variables)] 4 | #![allow(dead_code)] 5 | #![allow(non_snake_case)] 6 | #![allow(unused_macros)] 7 | #![allow(unused_parens)] 8 | #![allow(unused_labels)] 9 | #![allow(non_upper_case_globals)] 10 | 11 | pub mod language; 12 | pub mod runtime; 13 | 14 | pub use language::{*}; 15 | pub use runtime::{*}; 16 | 17 | pub use runtime::{Ptr, 18 | DP0, DP1, VAR, ARG, 19 | ERA, LAM, APP, SUP, 20 | CTR, FUN, OP2, U60, F60, 21 | ADD, SUB, MUL, DIV, 22 | MOD, AND, OR , XOR, 23 | SHL, SHR, LTN, LTE, 24 | EQL, GTE, GTN, NEQ, 25 | get_tag, 26 | get_ext, 27 | get_val, 28 | get_num, 29 | get_loc, 30 | CELLS_PER_KB, 31 | CELLS_PER_MB, 32 | CELLS_PER_GB, 33 | }; 34 | 35 | pub use language::syntax::{ 36 | Term, 37 | Term::Var, // TODO: add `global: bool` 38 | Term::Dup, 39 | Term::Let, 40 | Term::Lam, 41 | Term::App, 42 | Term::Ctr, 43 | Term::U6O, 44 | Term::F6O, 45 | Term::Op2, 46 | }; 47 | 48 | //// Helps with WASM debugging 49 | //macro_rules! log { 50 | //( $( $t:tt )* ) => { 51 | //web_sys::console::log_1(&format!( $( $t )* ).into()); 52 | //} 53 | //} 54 | 55 | //#[wasm_bindgen] 56 | //pub fn make_call(func: &str, args: &[&str]) -> Result { 57 | //// TODO: redundant with `make_main_call` 58 | //let args = args.iter().map(|par| language::syntax::read_term(par).unwrap()).collect(); 59 | //let name = func.to_string(); 60 | //Ok(language::syntax::Term::Ctr { name, args }) 61 | //} 62 | 63 | ////#[cfg(test)] 64 | ////mod tests { 65 | ////use crate::eval_code; 66 | ////use crate::make_call; 67 | 68 | ////#[test] 69 | ////fn test() { 70 | ////let code = " 71 | ////(Fn 0) = 0 72 | ////(Fn 1) = 1 73 | ////(Fn n) = (+ (Fn (- n 1)) (Fn (- n 2))) 74 | ////(Main) = (Fn 20) 75 | ////"; 76 | 77 | ////let (norm, _cost, _size, _time) = eval_code(&make_call("Main", &[]).unwrap(), code, false, 4 << 30).unwrap(); 78 | ////assert_eq!(norm, "6765"); 79 | ////} 80 | ////} 81 | 82 | //#[wasm_bindgen] 83 | //#[derive(Clone, Debug)] 84 | //pub struct Reduced { 85 | //norm: String, 86 | //cost: u64, 87 | //size: u64, 88 | //time: u64, 89 | //} 90 | 91 | //#[wasm_bindgen] 92 | //impl Reduced { 93 | //pub fn get_norm(&self) -> String { 94 | //return self.norm.clone(); 95 | //} 96 | 97 | //pub fn get_cost(&self) -> u64 { 98 | //return self.cost; 99 | //} 100 | 101 | //pub fn get_size(&self) -> u64 { 102 | //return self.size; 103 | //} 104 | 105 | //pub fn get_time(&self) -> u64 { 106 | //return self.time; 107 | //} 108 | //} 109 | 110 | //#[wasm_bindgen] 111 | //impl Runtime { 112 | 113 | ///// Creates a new, empty runtime 114 | //pub fn new(size: usize) -> Runtime { 115 | //Runtime { 116 | //heap: runtime::new_heap(size, runtime::available_parallelism()), 117 | //prog: runtime::new_program(), 118 | //book: language::rulebook::new_rulebook(), 119 | //} 120 | //} 121 | 122 | ///// Creates a runtime from source code, given a max number of nodes 123 | //pub fn from_code_with_size(code: &str, size: usize) -> Result { 124 | //let file = language::syntax::read_file(code)?; 125 | //let heap = runtime::new_heap(size, runtime::available_parallelism()); 126 | //let prog = runtime::new_program(); 127 | //let book = language::rulebook::gen_rulebook(&file); 128 | //return Ok(Runtime { heap, prog, book }); 129 | //} 130 | 131 | ////fn get_area(&mut self) -> runtime::Area { 132 | ////return runtime::get_area(&mut self.heap, 0) 133 | ////} 134 | 135 | ///// Creates a runtime from a source code 136 | //#[cfg(not(target_arch = "wasm32"))] 137 | //pub fn from_code(code: &str) -> Result { 138 | //Runtime::from_code_with_size(code, 4 * CELLS_PER_GB) 139 | //} 140 | 141 | //#[cfg(target_arch = "wasm32")] 142 | //pub fn from_code(code: &str) -> Result { 143 | //Runtime::from_code_with_size(code, 256 * CELLS_PER_MB) 144 | //} 145 | 146 | ///// Extends a runtime with new definitions 147 | //pub fn define(&mut self, _code: &str) { 148 | //todo!() 149 | //} 150 | 151 | ///// Allocates a new term, returns its location 152 | //pub fn alloc_code(&mut self, code: &str) -> Result { 153 | //Ok(self.alloc_term(&*language::syntax::read_term(code)?)) 154 | //} 155 | 156 | ///// Given a location, returns the pointer stored on it 157 | //pub fn load_ptr(&self, host: u64) -> Ptr { 158 | //runtime::load_ptr(&self.heap, host) 159 | //} 160 | 161 | ///// Given a location, evaluates a term to head normal form 162 | //pub fn reduce(&mut self, host: u64) { 163 | //runtime::reduce(&self.heap, &self.prog, &[0], host); // FIXME: add parallelism 164 | //} 165 | 166 | ///// Given a location, evaluates a term to full normal form 167 | //pub fn normalize(&mut self, host: u64) { 168 | //runtime::normalize(&self.heap, &self.prog, &[0], host, false); 169 | //} 170 | 171 | ///// Evaluates a code, allocs and evaluates to full normal form. Returns its location. 172 | //pub fn normalize_code(&mut self, code: &str) -> u64 { 173 | //let host = self.alloc_code(code).ok().unwrap(); 174 | //self.normalize(host); 175 | //return host; 176 | //} 177 | 178 | ///// Evaluates a code to normal form. Returns its location. 179 | //pub fn eval_to_loc(&mut self, code: &str) -> u64 { 180 | //return self.normalize_code(code); 181 | //} 182 | 183 | ///// Evaluates a code to normal form. 184 | //pub fn eval(&mut self, code: &str) -> String { 185 | //let host = self.normalize_code(code); 186 | //return self.show(host); 187 | //} 188 | 189 | //// /// Given a location, runs side-effective actions 190 | ////#[cfg(not(target_arch = "wasm32"))] 191 | ////pub fn run_io(&mut self, host: u64) { 192 | ////runtime::run_io(&mut self.heap, &self.prog, &[0], host) 193 | ////} 194 | 195 | ///// Given a location, recovers the lambda Term stored on it, as code 196 | //pub fn show(&self, host: u64) -> String { 197 | //language::readback::as_code(&self.heap, &self.prog, host) 198 | //} 199 | 200 | ///// Given a location, recovers the linear Term stored on it, as code 201 | //pub fn show_linear(&self, host: u64) -> String { 202 | //language::readback::as_linear_code(&self.heap, &self.prog, host) 203 | //} 204 | 205 | ///// Return the total number of graph rewrites computed 206 | //pub fn get_rewrites(&self) -> u64 { 207 | //runtime::get_cost(&self.heap) 208 | //} 209 | 210 | ///// Returns the name of a given id 211 | //pub fn get_name(&self, id: u64) -> String { 212 | //self.book.id_to_name.get(&id).unwrap_or(&"?".to_string()).clone() 213 | //} 214 | 215 | ///// Returns the arity of a given id 216 | //pub fn get_arity(&self, id: u64) -> u64 { 217 | //*self.book.id_to_arit.get(&id).unwrap_or(&u64::MAX) 218 | //} 219 | 220 | ///// Returns the name of a given id 221 | //pub fn get_id(&self, name: &str) -> u64 { 222 | //*self.book.name_to_id.get(name).unwrap_or(&u64::MAX) 223 | //} 224 | 225 | //// WASM re-exports 226 | 227 | //pub fn DP0() -> u64 { 228 | //return DP0; 229 | //} 230 | 231 | //pub fn DP1() -> u64 { 232 | //return DP1; 233 | //} 234 | 235 | //pub fn VAR() -> u64 { 236 | //return VAR; 237 | //} 238 | 239 | //pub fn ARG() -> u64 { 240 | //return ARG; 241 | //} 242 | 243 | //pub fn ERA() -> u64 { 244 | //return ERA; 245 | //} 246 | 247 | //pub fn LAM() -> u64 { 248 | //return LAM; 249 | //} 250 | 251 | //pub fn APP() -> u64 { 252 | //return APP; 253 | //} 254 | 255 | //pub fn SUP() -> u64 { 256 | //return SUP; 257 | //} 258 | 259 | //pub fn CTR() -> u64 { 260 | //return CTR; 261 | //} 262 | 263 | //pub fn FUN() -> u64 { 264 | //return FUN; 265 | //} 266 | 267 | //pub fn OP2() -> u64 { 268 | //return OP2; 269 | //} 270 | 271 | //pub fn NUM() -> u64 { 272 | //return NUM; 273 | //} 274 | 275 | //pub fn ADD() -> u64 { 276 | //return ADD; 277 | //} 278 | 279 | //pub fn SUB() -> u64 { 280 | //return SUB; 281 | //} 282 | 283 | //pub fn MUL() -> u64 { 284 | //return MUL; 285 | //} 286 | 287 | //pub fn DIV() -> u64 { 288 | //return DIV; 289 | //} 290 | 291 | //pub fn MOD() -> u64 { 292 | //return MOD; 293 | //} 294 | 295 | //pub fn AND() -> u64 { 296 | //return AND; 297 | //} 298 | 299 | //pub fn OR() -> u64 { 300 | //return OR; 301 | //} 302 | 303 | //pub fn XOR() -> u64 { 304 | //return XOR; 305 | //} 306 | 307 | //pub fn SHL() -> u64 { 308 | //return SHL; 309 | //} 310 | 311 | //pub fn SHR() -> u64 { 312 | //return SHR; 313 | //} 314 | 315 | //pub fn LTN() -> u64 { 316 | //return LTN; 317 | //} 318 | 319 | //pub fn LTE() -> u64 { 320 | //return LTE; 321 | //} 322 | 323 | //pub fn EQL() -> u64 { 324 | //return EQL; 325 | //} 326 | 327 | //pub fn GTE() -> u64 { 328 | //return GTE; 329 | //} 330 | 331 | //pub fn GTN() -> u64 { 332 | //return GTN; 333 | //} 334 | 335 | //pub fn NEQ() -> u64 { 336 | //return NEQ; 337 | //} 338 | 339 | //pub fn CELLS_PER_KB() -> usize { 340 | //return CELLS_PER_KB; 341 | //} 342 | 343 | //pub fn CELLS_PER_MB() -> usize { 344 | //return CELLS_PER_MB; 345 | //} 346 | 347 | //pub fn CELLS_PER_GB() -> usize { 348 | //return CELLS_PER_GB; 349 | //} 350 | 351 | //pub fn get_tag(lnk: Ptr) -> u64 { 352 | //return get_tag(lnk); 353 | //} 354 | 355 | //pub fn get_ext(lnk: Ptr) -> u64 { 356 | //return get_ext(lnk); 357 | //} 358 | 359 | //pub fn get_val(lnk: Ptr) -> u64 { 360 | //return get_val(lnk); 361 | //} 362 | 363 | //pub fn get_num(lnk: Ptr) -> u64 { 364 | //return get_num(lnk); 365 | //} 366 | 367 | //pub fn get_loc(lnk: Ptr, arg: u64) -> u64 { 368 | //return get_loc(lnk, arg); 369 | //} 370 | 371 | //pub fn Var(pos: u64) -> Ptr { 372 | //return runtime::Var(pos); 373 | //} 374 | 375 | //pub fn Dp0(col: u64, pos: u64) -> Ptr { 376 | //return runtime::Dp0(col, pos); 377 | //} 378 | 379 | //pub fn Dp1(col: u64, pos: u64) -> Ptr { 380 | //return runtime::Dp1(col, pos); 381 | //} 382 | 383 | //pub fn Arg(pos: u64) -> Ptr { 384 | //return runtime::Arg(pos); 385 | //} 386 | 387 | //pub fn Era() -> Ptr { 388 | //return runtime::Era(); 389 | //} 390 | 391 | //pub fn Lam(pos: u64) -> Ptr { 392 | //return runtime::Lam(pos); 393 | //} 394 | 395 | //pub fn App(pos: u64) -> Ptr { 396 | //return runtime::App(pos); 397 | //} 398 | 399 | //pub fn Sup(col: u64, pos: u64) -> Ptr { 400 | //return runtime::Sup(col, pos); 401 | //} 402 | 403 | //pub fn Op2(ope: u64, pos: u64) -> Ptr { 404 | //return runtime::Op2(ope, pos); 405 | //} 406 | 407 | //pub fn Num(val: u64) -> Ptr { 408 | //return runtime::Num(val); 409 | //} 410 | 411 | //pub fn Ctr(fun: u64, pos: u64) -> Ptr { 412 | //return runtime::Ctr(fun, pos); 413 | //} 414 | 415 | //pub fn Fun(fun: u64, pos: u64) -> Ptr { 416 | //return runtime::Fun(fun, pos); 417 | //} 418 | 419 | //pub fn link(&mut self, loc: u64, lnk: Ptr) -> Ptr { 420 | //return runtime::link(&self.heap, loc, lnk); 421 | //} 422 | 423 | //pub fn alloc(&mut self, size: u64) -> u64 { 424 | //return runtime::alloc(&self.heap, 0, size); // FIXME tid? 425 | //} 426 | 427 | //pub fn free(&mut self, loc: u64, size: u64) { 428 | //return runtime::free(&self.heap, 0, loc, size); // FIXME tid? 429 | //} 430 | 431 | //pub fn collect(&mut self, term: Ptr) { 432 | //return runtime::collect(&self.heap, &self.prog.arit, 0, term); // FIXME tid? 433 | //} 434 | 435 | //} 436 | 437 | // Methods that aren't compiled to JS 438 | //impl Runtime { 439 | ///// Allocates a new term, returns its location 440 | //pub fn alloc_term(&mut self, term: &language::syntax::Term) -> u64 { 441 | //runtime::alloc_term(&self.heap, 0, &self.book, term) // FIXME tid? 442 | //} 443 | 444 | ///// Given a location, recovers the Term stored on it 445 | //pub fn readback(&self, host: u64) -> Box { 446 | //language::readback::as_term(&self.heap, &self.prog, host) 447 | //} 448 | 449 | ///// Given a location, recovers the Term stored on it 450 | //pub fn linear_readback(&self, host: u64) -> Box { 451 | //language::readback::as_linear_term(&self.heap, &self.prog, host) 452 | //} 453 | //} 454 | 455 | //pub fn example() -> Result<(), String> { 456 | //let mut rt = Runtime::from_code_with_size(" 457 | //(Double Zero) = Zero 458 | //(Double (Succ x)) = (Succ (Succ (Double x))) 459 | //", 10000).unwrap(); 460 | //let loc = rt.normalize_code("(Double (Succ (Succ Zero)))"); 461 | //println!("{}", rt.show(loc)); 462 | //return Ok(()); 463 | //} 464 | 465 | ////#[cfg(test)] 466 | ////mod tests { 467 | ////use crate::eval_code; 468 | ////use crate::make_call; 469 | 470 | ////#[test] 471 | ////fn test() { 472 | ////let code = " 473 | ////(Fn 0) = 0 474 | ////(Fn 1) = 1 475 | ////(Fn n) = (+ (Fn (- n 1)) (Fn (- n 2))) 476 | ////(Main) = (Fn 20) 477 | ////"; 478 | 479 | ////let (norm, _cost, _size, _time) = language::rulebook::eval_code(&make_call("Main", &[]).unwrap(), code, false, 32 << 20).unwrap(); 480 | ////assert_eq!(norm, "6765"); 481 | ////} 482 | ////} 483 | //// 484 | 485 | 486 | -------------------------------------------------------------------------------- /src/runtime/base/precomp.rs: -------------------------------------------------------------------------------- 1 | use crate::runtime::{*}; 2 | use std::sync::atomic::{AtomicBool, Ordering}; 3 | 4 | // Precomps 5 | // -------- 6 | 7 | pub struct PrecompFuns { 8 | pub visit: VisitFun, 9 | pub apply: ApplyFun, 10 | } 11 | 12 | pub struct Precomp { 13 | pub id: u64, 14 | pub name: &'static str, 15 | pub smap: &'static [bool], 16 | pub funs: Option, 17 | } 18 | 19 | pub const STRING_NIL : u64 = 0; 20 | pub const STRING_CONS : u64 = 1; 21 | pub const BOTH : u64 = 2; 22 | pub const KIND_TERM_CT0 : u64 = 3; 23 | pub const KIND_TERM_CT1 : u64 = 4; 24 | pub const KIND_TERM_CT2 : u64 = 5; 25 | pub const KIND_TERM_CT3 : u64 = 6; 26 | pub const KIND_TERM_CT4 : u64 = 7; 27 | pub const KIND_TERM_CT5 : u64 = 8; 28 | pub const KIND_TERM_CT6 : u64 = 9; 29 | pub const KIND_TERM_CT7 : u64 = 10; 30 | pub const KIND_TERM_CT8 : u64 = 11; 31 | pub const KIND_TERM_CT9 : u64 = 12; 32 | pub const KIND_TERM_CTA : u64 = 13; 33 | pub const KIND_TERM_CTB : u64 = 14; 34 | pub const KIND_TERM_CTC : u64 = 15; 35 | pub const KIND_TERM_CTD : u64 = 16; 36 | pub const KIND_TERM_CTE : u64 = 17; 37 | pub const KIND_TERM_CTF : u64 = 18; 38 | pub const KIND_TERM_CTG : u64 = 19; 39 | pub const KIND_TERM_U60 : u64 = 20; 40 | pub const KIND_TERM_F60 : u64 = 21; 41 | pub const U60_IF : u64 = 22; 42 | pub const U60_SWAP : u64 = 23; 43 | pub const HVM_LOG : u64 = 24; 44 | pub const HVM_QUERY : u64 = 25; 45 | pub const HVM_PRINT : u64 = 26; 46 | pub const HVM_SLEEP : u64 = 27; 47 | pub const HVM_STORE : u64 = 28; 48 | pub const HVM_LOAD : u64 = 29; 49 | //[[CODEGEN:PRECOMP-IDS]]// 50 | 51 | pub const PRECOMP : &[Precomp] = &[ 52 | Precomp { 53 | id: STRING_NIL, 54 | name: "String.nil", 55 | smap: &[false; 0], 56 | funs: None, 57 | }, 58 | Precomp { 59 | id: STRING_CONS, 60 | name: "String.cons", 61 | smap: &[false; 2], 62 | funs: None, 63 | }, 64 | Precomp { 65 | id: BOTH, 66 | name: "Both", 67 | smap: &[false; 2], 68 | funs: None, 69 | }, 70 | Precomp { 71 | id: KIND_TERM_CT0, 72 | name: "Kind.Term.ct0", 73 | smap: &[false; 2], 74 | funs: None, 75 | }, 76 | Precomp { 77 | id: KIND_TERM_CT1, 78 | name: "Kind.Term.ct1", 79 | smap: &[false; 3], 80 | funs: None, 81 | }, 82 | Precomp { 83 | id: KIND_TERM_CT2, 84 | name: "Kind.Term.ct2", 85 | smap: &[false; 4], 86 | funs: None, 87 | }, 88 | Precomp { 89 | id: KIND_TERM_CT3, 90 | name: "Kind.Term.ct3", 91 | smap: &[false; 5], 92 | funs: None, 93 | }, 94 | Precomp { 95 | id: KIND_TERM_CT4, 96 | name: "Kind.Term.ct4", 97 | smap: &[false; 6], 98 | funs: None, 99 | }, 100 | Precomp { 101 | id: KIND_TERM_CT5, 102 | name: "Kind.Term.ct5", 103 | smap: &[false; 7], 104 | funs: None, 105 | }, 106 | Precomp { 107 | id: KIND_TERM_CT6, 108 | name: "Kind.Term.ct6", 109 | smap: &[false; 8], 110 | funs: None, 111 | }, 112 | Precomp { 113 | id: KIND_TERM_CT7, 114 | name: "Kind.Term.ct7", 115 | smap: &[false; 9], 116 | funs: None, 117 | }, 118 | Precomp { 119 | id: KIND_TERM_CT8, 120 | name: "Kind.Term.ct8", 121 | smap: &[false; 10], 122 | funs: None, 123 | }, 124 | Precomp { 125 | id: KIND_TERM_CT9, 126 | name: "Kind.Term.ct9", 127 | smap: &[false; 11], 128 | funs: None, 129 | }, 130 | Precomp { 131 | id: KIND_TERM_CTA, 132 | name: "Kind.Term.ctA", 133 | smap: &[false; 12], 134 | funs: None, 135 | }, 136 | Precomp { 137 | id: KIND_TERM_CTB, 138 | name: "Kind.Term.ctB", 139 | smap: &[false; 13], 140 | funs: None, 141 | }, 142 | Precomp { 143 | id: KIND_TERM_CTC, 144 | name: "Kind.Term.ctC", 145 | smap: &[false; 14], 146 | funs: None, 147 | }, 148 | Precomp { 149 | id: KIND_TERM_CTD, 150 | name: "Kind.Term.ctD", 151 | smap: &[false; 15], 152 | funs: None, 153 | }, 154 | Precomp { 155 | id: KIND_TERM_CTE, 156 | name: "Kind.Term.ctE", 157 | smap: &[false; 16], 158 | funs: None, 159 | }, 160 | Precomp { 161 | id: KIND_TERM_CTF, 162 | name: "Kind.Term.ctF", 163 | smap: &[false; 17], 164 | funs: None, 165 | }, 166 | Precomp { 167 | id: KIND_TERM_CTG, 168 | name: "Kind.Term.ctG", 169 | smap: &[false; 18], 170 | funs: None, 171 | }, 172 | Precomp { 173 | id: KIND_TERM_U60, 174 | name: "Kind.Term.u60", 175 | smap: &[false; 2], 176 | funs: None, 177 | }, 178 | Precomp { 179 | id: KIND_TERM_F60, 180 | name: "Kind.Term.f60", 181 | smap: &[false; 2], 182 | funs: None, 183 | }, 184 | Precomp { 185 | id: U60_IF, 186 | name: "U60.if", 187 | smap: &[true, false, false], 188 | funs: Some(PrecompFuns { 189 | visit: u60_if_visit, 190 | apply: u60_if_apply, 191 | }), 192 | }, 193 | Precomp { 194 | id: U60_SWAP, 195 | name: "U60.swap", 196 | smap: &[true, false, false], 197 | funs: Some(PrecompFuns { 198 | visit: u60_swap_visit, 199 | apply: u60_swap_apply, 200 | }), 201 | }, 202 | Precomp { 203 | id: HVM_LOG, 204 | name: "HVM.log", 205 | smap: &[false; 2], 206 | funs: Some(PrecompFuns { 207 | visit: hvm_log_visit, 208 | apply: hvm_log_apply, 209 | }), 210 | }, 211 | Precomp { 212 | id: HVM_QUERY, 213 | name: "HVM.query", 214 | smap: &[false; 1], 215 | funs: Some(PrecompFuns { 216 | visit: hvm_query_visit, 217 | apply: hvm_query_apply, 218 | }), 219 | }, 220 | Precomp { 221 | id: HVM_PRINT, 222 | name: "HVM.print", 223 | smap: &[false; 2], 224 | funs: Some(PrecompFuns { 225 | visit: hvm_print_visit, 226 | apply: hvm_print_apply, 227 | }), 228 | }, 229 | Precomp { 230 | id: HVM_SLEEP, 231 | name: "HVM.sleep", 232 | smap: &[false; 2], 233 | funs: Some(PrecompFuns { 234 | visit: hvm_sleep_visit, 235 | apply: hvm_sleep_apply, 236 | }), 237 | }, 238 | Precomp { 239 | id: HVM_STORE, 240 | name: "HVM.store", 241 | smap: &[false; 3], 242 | funs: Some(PrecompFuns { 243 | visit: hvm_store_visit, 244 | apply: hvm_store_apply, 245 | }), 246 | }, 247 | Precomp { 248 | id: HVM_LOAD, 249 | name: "HVM.load", 250 | smap: &[false; 2], 251 | funs: Some(PrecompFuns { 252 | visit: hvm_load_visit, 253 | apply: hvm_load_apply, 254 | }), 255 | }, 256 | //[[CODEGEN:PRECOMP-ELS]]// 257 | ]; 258 | 259 | pub const PRECOMP_COUNT : u64 = PRECOMP.len() as u64; 260 | 261 | // Ul0.if (cond: Term) (if_t: Term) (if_f: Term) 262 | // --------------------------------------------- 263 | 264 | #[inline(always)] 265 | pub fn u60_if_visit(ctx: ReduceCtx) -> bool { 266 | if is_whnf(load_arg(ctx.heap, ctx.term, 0)) { 267 | return false; 268 | } else { 269 | let goup = ctx.redex.insert(ctx.tid, new_redex(*ctx.host, *ctx.cont, 1)); 270 | *ctx.cont = goup; 271 | *ctx.host = get_loc(ctx.term, 0); 272 | return true; 273 | } 274 | } 275 | 276 | #[inline(always)] 277 | pub fn u60_if_apply(ctx: ReduceCtx) -> bool { 278 | let arg0 = load_arg(ctx.heap, ctx.term, 0); 279 | let arg1 = load_arg(ctx.heap, ctx.term, 1); 280 | let arg2 = load_arg(ctx.heap, ctx.term, 2); 281 | if get_tag(arg0) == SUP { 282 | fun::superpose(ctx.heap, &ctx.prog.aris, ctx.tid, *ctx.host, ctx.term, arg0, 0); 283 | } 284 | if (get_tag(arg0) == U60) { 285 | if (get_num(arg0) == 0) { 286 | inc_cost(ctx.heap, ctx.tid); 287 | let done = arg2; 288 | link(ctx.heap, *ctx.host, done); 289 | collect(ctx.heap, &ctx.prog.aris, ctx.tid, arg1); 290 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 291 | return true; 292 | } else { 293 | inc_cost(ctx.heap, ctx.tid); 294 | let done = arg1; 295 | link(ctx.heap, *ctx.host, done); 296 | collect(ctx.heap, &ctx.prog.aris, ctx.tid, arg2); 297 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 298 | return true; 299 | } 300 | } 301 | return false; 302 | } 303 | 304 | // U60.swap (cond: Term) (pair: Term) 305 | // ---------------------------------- 306 | 307 | #[inline(always)] 308 | pub fn u60_swap_visit(ctx: ReduceCtx) -> bool { 309 | if is_whnf(load_arg(ctx.heap, ctx.term, 0)) { 310 | return false; 311 | } else { 312 | let goup = ctx.redex.insert(ctx.tid, new_redex(*ctx.host, *ctx.cont, 1)); 313 | *ctx.cont = goup; 314 | *ctx.host = get_loc(ctx.term, 0); 315 | return true; 316 | } 317 | } 318 | 319 | #[inline(always)] 320 | pub fn u60_swap_apply(ctx: ReduceCtx) -> bool { 321 | let arg0 = load_arg(ctx.heap, ctx.term, 0); 322 | let arg1 = load_arg(ctx.heap, ctx.term, 1); 323 | let arg2 = load_arg(ctx.heap, ctx.term, 2); 324 | if get_tag(arg0) == SUP { 325 | fun::superpose(ctx.heap, &ctx.prog.aris, ctx.tid, *ctx.host, ctx.term, arg0, 0); 326 | } 327 | if (get_tag(arg0) == U60) { 328 | if (get_num(arg0) == 0) { 329 | inc_cost(ctx.heap, ctx.tid); 330 | let ctr_0 = alloc(ctx.heap, ctx.tid, 2); 331 | link(ctx.heap, ctr_0 + 0, arg1); 332 | link(ctx.heap, ctr_0 + 1, arg2); 333 | let done = Ctr(BOTH, ctr_0); 334 | link(ctx.heap, *ctx.host, done); 335 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 336 | return true; 337 | } else { 338 | inc_cost(ctx.heap, ctx.tid); 339 | let ctr_0 = alloc(ctx.heap, ctx.tid, 2); 340 | link(ctx.heap, ctr_0 + 0, arg2); 341 | link(ctx.heap, ctr_0 + 1, arg1); 342 | let done = Ctr(BOTH, ctr_0); 343 | link(ctx.heap, *ctx.host, done); 344 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 345 | return true; 346 | } 347 | } 348 | return false; 349 | } 350 | 351 | // HVM.log (term: Term) 352 | // -------------------- 353 | 354 | fn hvm_log_visit(ctx: ReduceCtx) -> bool { 355 | return false; 356 | } 357 | 358 | fn hvm_log_apply(ctx: ReduceCtx) -> bool { 359 | normalize(ctx.heap, ctx.prog, &[ctx.tid], get_loc(ctx.term, 0), false); 360 | let code = crate::language::readback::as_code(ctx.heap, ctx.prog, get_loc(ctx.term, 0)); 361 | println!("{}", code); 362 | link(ctx.heap, *ctx.host, load_arg(ctx.heap, ctx.term, 1)); 363 | collect(ctx.heap, &ctx.prog.aris, ctx.tid, load_ptr(ctx.heap, get_loc(ctx.term, 0))); 364 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 2); 365 | return true; 366 | } 367 | 368 | // HVM.query (cont: String -> Term) 369 | // -------------------------------- 370 | 371 | fn hvm_query_visit(ctx: ReduceCtx) -> bool { 372 | return false; 373 | } 374 | 375 | fn hvm_query_apply(ctx: ReduceCtx) -> bool { 376 | fn read_input() -> String { 377 | use std::io::{stdin,stdout,Write}; 378 | let mut input = String::new(); 379 | stdin().read_line(&mut input).expect("string"); 380 | if let Some('\n') = input.chars().next_back() { input.pop(); } 381 | if let Some('\r') = input.chars().next_back() { input.pop(); } 382 | return input; 383 | } 384 | let cont = load_arg(ctx.heap, ctx.term, 0); 385 | let text = make_string(ctx.heap, ctx.tid, &read_input()); 386 | let app0 = alloc(ctx.heap, ctx.tid, 2); 387 | link(ctx.heap, app0 + 0, cont); 388 | link(ctx.heap, app0 + 1, text); 389 | free(ctx.heap, 0, get_loc(ctx.term, 0), 1); 390 | let done = App(app0); 391 | link(ctx.heap, *ctx.host, done); 392 | return true; 393 | } 394 | 395 | // HVM.print (text: String) (cont: Term) 396 | // ----------------------------------------------- 397 | 398 | fn hvm_print_visit(ctx: ReduceCtx) -> bool { 399 | return false; 400 | } 401 | 402 | fn hvm_print_apply(ctx: ReduceCtx) -> bool { 403 | //normalize(ctx.heap, ctx.prog, &[ctx.tid], get_loc(ctx.term, 0), false); 404 | if let Some(text) = crate::language::readback::as_string(ctx.heap, ctx.prog, &[ctx.tid], get_loc(ctx.term, 0)) { 405 | println!("{}", text); 406 | } 407 | link(ctx.heap, *ctx.host, load_arg(ctx.heap, ctx.term, 1)); 408 | collect(ctx.heap, &ctx.prog.aris, ctx.tid, load_ptr(ctx.heap, get_loc(ctx.term, 0))); 409 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 2); 410 | return true; 411 | } 412 | 413 | // HVM.sleep (time: U60) (cont: Term) 414 | // ---------------------------------- 415 | 416 | fn hvm_sleep_visit(ctx: ReduceCtx) -> bool { 417 | return false; 418 | } 419 | 420 | fn hvm_sleep_apply(ctx: ReduceCtx) -> bool { 421 | let time = reduce(ctx.heap, ctx.prog, &[ctx.tid], get_loc(ctx.term, 0), true, false); 422 | std::thread::sleep(std::time::Duration::from_nanos(get_num(time))); 423 | link(ctx.heap, *ctx.host, load_ptr(ctx.heap, get_loc(ctx.term, 1))); 424 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 2); 425 | return true; 426 | } 427 | 428 | // HVM.store (key: String) (val: String) (cont: Term) 429 | // -------------------------------------------------- 430 | 431 | fn hvm_store_visit(ctx: ReduceCtx) -> bool { 432 | return false; 433 | } 434 | 435 | fn hvm_store_apply(ctx: ReduceCtx) -> bool { 436 | if let Some(key) = crate::language::readback::as_string(ctx.heap, ctx.prog, &[ctx.tid], get_loc(ctx.term, 0)) { 437 | if let Some(val) = crate::language::readback::as_string(ctx.heap, ctx.prog, &[ctx.tid], get_loc(ctx.term, 1)) { 438 | if std::fs::write(key, val).is_ok() { 439 | //let app0 = alloc(ctx.heap, ctx.tid, 2); 440 | //link(ctx.heap, app0 + 0, cont); 441 | //link(ctx.heap, app0 + 1, U6O(0)); 442 | //free(ctx.heap, 0, get_loc(ctx.term, 0), 2); 443 | let done = load_arg(ctx.heap, ctx.term, 2); 444 | link(ctx.heap, *ctx.host, done); 445 | collect(ctx.heap, &ctx.prog.aris, ctx.tid, load_arg(ctx.heap, ctx.term, 0)); 446 | collect(ctx.heap, &ctx.prog.aris, ctx.tid, load_arg(ctx.heap, ctx.term, 1)); 447 | free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 3); 448 | return true; 449 | } 450 | } 451 | } 452 | println!("Runtime failure on: {}", show_at(ctx.heap, ctx.prog, *ctx.host, &[])); 453 | std::process::exit(0); 454 | } 455 | 456 | // HVM.load (key: String) (cont: String -> Term) 457 | // --------------------------------------------- 458 | 459 | fn hvm_load_visit(ctx: ReduceCtx) -> bool { 460 | return false; 461 | } 462 | 463 | fn hvm_load_apply(ctx: ReduceCtx) -> bool { 464 | if let Some(key) = crate::language::readback::as_string(ctx.heap, ctx.prog, &[ctx.tid], get_loc(ctx.term, 0)) { 465 | if let Ok(file) = std::fs::read(key) { 466 | if let Ok(file) = std::str::from_utf8(&file) { 467 | let cont = load_arg(ctx.heap, ctx.term, 1); 468 | let text = make_string(ctx.heap, ctx.tid, file); 469 | let app0 = alloc(ctx.heap, ctx.tid, 2); 470 | link(ctx.heap, app0 + 0, cont); 471 | link(ctx.heap, app0 + 1, text); 472 | free(ctx.heap, 0, get_loc(ctx.term, 0), 2); 473 | let done = App(app0); 474 | link(ctx.heap, *ctx.host, done); 475 | return true; 476 | } 477 | } 478 | } 479 | println!("Runtime failure on: {}", show_at(ctx.heap, ctx.prog, *ctx.host, &[])); 480 | std::process::exit(0); 481 | } 482 | 483 | //[[CODEGEN:PRECOMP-FNS]]// 484 | -------------------------------------------------------------------------------- /guide/README.md: -------------------------------------------------------------------------------- 1 | HVM Guide 2 | ========= 3 | 4 | Installation 5 | ------------ 6 | 7 | First, install [install Rust nightly](https://www.rust-lang.org/tools/install): 8 | 9 | ``` 10 | curl --proto '=https' --tlsv1.2 -sSf https://sh.rustup.rs | sh 11 | rustup install nightly 12 | ``` 13 | 14 | Then, install HVM: 15 | 16 | ```bash 17 | cargo +nightly install --force --git https://github.com/HigherOrderCO/HVM.git 18 | ``` 19 | 20 | This will install HVM's command-line interface. Make sure it worked with: 21 | 22 | ```bash 23 | hvm --version 24 | ``` 25 | 26 | You should see `hvm 1.0.VERSION`. 27 | 28 | Basic Usage 29 | ----------- 30 | 31 | In its simplest form, HVM is just a machine that receives a functional expression and 32 | outputs its normal form. You can ask it to compute an expression with `hvm run`: 33 | 34 | ```bash 35 | hvm run "(+ 2 3)" 36 | ``` 37 | 38 | This will add `2` and `3`, and output `5`. Expressions can include lambdas, 39 | which are created with `@`. For example: 40 | 41 | ```bash 42 | hvm run "(@x(* x 2) 21)" 43 | ``` 44 | 45 | Here, `@x(* x 2)` creates an anonymous function that receives `x` and doubles 46 | it. That function is applied to `21`, so the final output is `42`. Since lambdas 47 | are so powerful, HVM's expressions are Turing-complete, so, in theory, we could 48 | solve any problem with expressions alone. But to make use of HVM's full 49 | potential, we need to write programs. 50 | 51 | First program 52 | ------------- 53 | 54 | HVM allows you to extend its machine with user-supplied functions, which are 55 | defined in files, using an equational style that resembles other functional 56 | languages like Haskell. For example, the function below computes the 57 | [BMI](https://en.wikipedia.org/wiki/Body_mass_index) of a person: 58 | 59 | ```javascript 60 | (BMI weight height) = (/ weight (* height height)) 61 | ``` 62 | 63 | Save this file as `BMI.hvm` and enter: 64 | 65 | ```javascript 66 | hvm run -f BMI.hvm "(BMI 62.0 1.70)" 67 | ``` 68 | 69 | The `-f` option tells HVM to load all the functions defined on `BMI.hvm` before 70 | running the expression. The command above outputs `21.453287197231816`, which is 71 | my BMI. Note that function names must start with an uppercase letter: that's how 72 | HVM differentiates global functions from lambda-bound variables. 73 | 74 | A sequential function 75 | --------------------- 76 | 77 | Functions can have multiple equations, pattern-match on arguments, and recurse. 78 | For example, the function below sums a range of numbers recursively: 79 | 80 | ```javascript 81 | (Sum 1 a b) = 0 82 | (Sum 0 a b) = (+ a (Sum (== a b) (+ a 1) b)) 83 | ``` 84 | 85 | Internally, HVM breaks down its computations into parallel atomic operations, 86 | called *graph rewrites*. Since each graph rewrite is a lightweight const-time 87 | operation, the total cost of a computation can be measured precisely by the 88 | number of graph rewrites. You can ask HVM to display it with the `-c` option. 89 | Save the program above as `summation.hvm` and run: 90 | 91 | ```bash 92 | time hvm run -c true -f summation.hvm "(Sum 0 0 5000000)" 93 | ``` 94 | 95 | This will make HVM output: 96 | 97 | ``` 98 | 12500002500000 99 | 100 | [TIME: 0.96s | COST: 35000007 | RPS: 36.38m] 101 | ``` 102 | 103 | There are 4 relevant values here. First, `12500002500000` is the output, i.e., 104 | the summation from 0 to 5 million. Second, `0.96s` is the time this computation 105 | took to complete. Third, `35000007` is the total number of atomic operations 106 | that HVM applied to reach this result. Last, `36.38m` is the number of rewrites 107 | per second, i.e., HVM's performance. 108 | 109 | The advantage of using `COST` instead of `TIME` to measure the complexity of an 110 | algorithm is that it is machine-agnostic, making it more reliable. With a cost 111 | of about 35 million rewrites, this was a fairly heavy computation. Sadly, we 112 | only achieved 36.38 million rewrites per second, which isn't stellar. Why? 113 | 114 | The problem is HVM is greedy for parallelism, yet, the algorithm above is 115 | **inherently sequential**. To understand why, let's see how `Sum` unfolds, 116 | omitting the halting argument: 117 | 118 | ``` 119 | (Sum 0 100) 120 | --------- 121 | (+ 0 (Sum 1 100)) 122 | ---------------- 123 | (+ 0 (+ 1 (Sum 2 100))) 124 | ----------------------- 125 | (+ 0 (+ 1 (+ 2 ... (Sum 98 100))))) 126 | ---------------------------------- 127 | (+ 0 (+ 1 (+ 2 ... (+ 98 (Sum 99 100))))) 128 | ----------------------------------------- 129 | (+ 0 (+ 1 (+ 2 ... (+ 98 (+ 99 100))))) 130 | -------------------------------- 131 | (+ 0 (+ 1 (+ 2 ... (+ 98 199)))) 132 | ------------------------- 133 | (+ 0 (+ 1 (+ 2 ... 297))) 134 | ---------------------- 135 | (+ 0 (+ 1 (+ 2 5047))) 136 | ---------------------- 137 | (+ 0 (+ 1 5049)) 138 | ---------------- 139 | (+ 0 5050) 140 | ---------- 141 | 5050 142 | ``` 143 | 144 | As you can see, HVM must recurse it all the way down to the base case, before it 145 | is able to perform the first addition. Then, additions are performed upwards, 146 | one after the other, in order. There is no room for parallelism in the function 147 | we wrote, so, HVM can't help us here. 148 | 149 | A parallel function 150 | ------------------- 151 | 152 | We can improve the program above using a divide-and-conquer approach: 153 | 154 | ```javascript 155 | // Sums all the numbers in the (a .. b) range. 156 | (Sum 1 a b) = a 157 | (Sum 0 a b) = 158 | let m = (/ (+ a b) 2) 159 | let n = (+ m 1) 160 | let l = (Sum (== a m) a m) 161 | let r = (Sum (== n b) n b) 162 | (+ l r) 163 | ``` 164 | 165 | The idea is that `Sum` now receives the range it must add. Then, on each 166 | recursive iteration, it splits the range in two halves. When the range length is 167 | 1, it halts. Omitting the halting argument, below is how it unfolds: 168 | 169 | ``` 170 | (Sum 0 100) 171 | ----------- 172 | (+ (Sum 0 50) (Sum 51 100)) 173 | --------------------------- 174 | (+ (+ (Sum 0 25) (Sum 26 50)) (+ (Sum 51 75) (Sum 76 100))) 175 | ----------------------------------------------------------- 176 | (+ (+ (+ ... ...) (+ ... ...)) (+ (+ ... ...) (+ ... ...)))) 177 | ------------------------------------------------------------ 178 | (+ (+ (+ 78 247) (+ 416 534)) (+ (+ 741 834) (+ 1066 1134))) 179 | ------------------------------------------------------------ 180 | (+ (+ 325 950) (+ 1575 2200)) 181 | ----------------------------- 182 | (+ 1275 3775) 183 | ------------- 184 | 5050 185 | ``` 186 | 187 | The way this function branches generates independent additions: it is 188 | **inherently parallel**. That allows HVM's built-in parallelism to kick in, 189 | significantly boosting the performance. If we run it: 190 | 191 | ``` 192 | time hvm run -c true -f summation.hvm "(Sum 0 0 5000000)" 193 | ``` 194 | 195 | It will output: 196 | 197 | ``` 198 | 12500002500000 199 | 200 | [TIME: 0.28s | COST: 75000001 | RPS: 268.82m] 201 | ``` 202 | 203 | The RPS becomes 268 million rewrites per second! That's an almost perfect 7.38x 204 | improvement, in a 8-core CPU. In general, one can improve a function's 205 | performance proportionally to the number of cores by just writing its recursion 206 | in a parallel-aware manner. No need for manual thread spawning, no kernels, 207 | mutexes, locks, atomics nor any other overwhelmingly complex, error-prone 208 | synchronization primitives. 209 | 210 | While the function above could be parallelized with some effort in other 211 | languages; for example, using Haskell's `par`; this becomes considerably harder 212 | as the recursion schemes become more complex. For example, the Fibonacci 213 | function doesn't recurse in a regular way: some branches are much deeper than 214 | others. As such, using all available parallelism with `par` alone would be very 215 | hard. On HVM, you just write the function as it is, and HVM will smoothly 216 | distribute the workload evenly across all available cores. 217 | 218 | ```javascript 219 | (Fib 0) = 1 220 | (Fib 1) = 1 221 | (Fib n) = (+ (Fib (- n 1)) (Fib (- n 2))) 222 | ``` 223 | 224 | To learn more about parallel algorithm design on HVM, check [PARALLELISM](PARALLELISM.md). 225 | 226 | Constructors 227 | ------------ 228 | 229 | If you do not write an equation for a function you use, it is considered a 230 | constructor. That means you do not need to define datatypes with a `data` syntax 231 | (as in Haskell). You can use any name starting with an uppercase, and it will 232 | just work. For example, the program below extracts the first element of a pair: 233 | 234 | ```javascript 235 | (First (Pair x y)) = x 236 | 237 | Main = (First (Pair 1 2)) 238 | ``` 239 | 240 | Notice that `Pair` is considered a constructor, because we didn't write an 241 | equation to reduce it to some other expression. Another example would be 242 | representing booleans: 243 | 244 | ```javascript 245 | (And True True) = True 246 | (And True False) = False 247 | (And False True) = False 248 | (And False False) = False 249 | 250 | Main = (And True False) 251 | ``` 252 | 253 | HVM also has two pre-defined constructors, `String.cons` and `String.nil`, which 254 | are meant to be used as UTF-32 strings. This just affects pretty printing. For 255 | example: 256 | 257 | ```javascript 258 | Main = (String.cons 104 (String.cons 105 String.nil)) 259 | ``` 260 | 261 | If you run this, it will output the string `"hi"`, because `[104,105]` is the 262 | UTF-32 encoding for it. HVM also has syntax sugars for Strings, so the program 263 | above is equivalent to both programs below: 264 | 265 | ```javascript 266 | Main = (String.cons 'h' (String.cons 'i' String.nil)) 267 | ``` 268 | 269 | ```javascript 270 | Main = "hi" 271 | ``` 272 | 273 | HVM also has a syntax sugar for `List.cons` and `List.nil`, which are printed as 274 | `[]` lists. For example: 275 | 276 | ```javascript 277 | Main = (List.cons 1 (List.cons 2 (List.cons 3 List.nil))) 278 | ``` 279 | 280 | Running this will output `[1, 2, 3]`. As you can guess, you can also write `[1, 281 | 2, 3]` instead of `List.cons`. Both are equivalent. 282 | 283 | Compiling a program 284 | ------------------- 285 | 286 | The command we've used so far, `hvm run`, evaluates programs using an 287 | interpreter. To run an application in production, you must compile it. To do so, 288 | use the `compile` command, as follows: 289 | 290 | ``` 291 | hvm compile summation.hvm 292 | ``` 293 | 294 | This will generate a Rust repository with a fresh new copy of HVM, plus all the 295 | functions defined on `summation.hvm` **precompiled** on the reduction engine. 296 | You can then publish that project on `cargo` and use it from inside other Rust 297 | projects (more on that later), or you can install `summation` as an executable 298 | in your system and run it from the command line. It will work exactly like the 299 | `hvm` command, except you'll be able to call `Sum` without loading a file: 300 | 301 | ``` 302 | cd summation 303 | cargo install --path . 304 | summation run -c true "(Sum 0 0 100000000)" 305 | ``` 306 | 307 | Moreover, it will be much faster. On my computer, the command below outputs: 308 | 309 | ``` 310 | 5000000050000000 311 | 312 | [TIME: 0.82s | COST: 1500000001 | RPS: 1818.18m] 313 | ``` 314 | 315 | That's another massive 6.7x increase in performance. With parallelism and 316 | compilation, we're now 49.97x faster than before. 317 | 318 | Builtin Functions 319 | ----------------- 320 | 321 | HVM has some useful pre-compiled functions. 322 | 323 | ### HVM.log (term: Term) (cont: Term) 324 | 325 | Prints an arbitrary term to the terminal. It is very useful for debugging. Example: 326 | 327 | ```javascript 328 | (Sum 0) = (HVM.log Done 0) 329 | (Sum n) = (HVM.log (Call "Sum" n) (+ n (Sum (- n 1)))) 330 | 331 | Main = (Sum 4) 332 | ``` 333 | 334 | Will output: 335 | 336 | ```javascript 337 | (Call "Sum" 4) 338 | (Call "Sum" 3) 339 | (Call "Sum" 2) 340 | (Call "Sum" 1) 341 | (Done) 342 | 10 343 | ``` 344 | 345 | Note that `10` is the result, and the other lines are the logged expressions. 346 | 347 | ### HVM.print (text: String) (cont: Term) 348 | 349 | Prints a string to the terminal. The difference from `HVM.log` is that the text 350 | is expected to be a string. Example: 351 | 352 | ```javascript 353 | Main = (HVM.print "Hello" (+ 2 3)) 354 | ``` 355 | 356 | This will output: 357 | 358 | ``` 359 | Hello 360 | 5 361 | ``` 362 | 363 | ### HVM.query (cont: String -> Term) 364 | 365 | Reads an user input from the terminal as a String. Example: 366 | 367 | ```javascript 368 | (String.concat String.nil ys) = ys 369 | (String.concat (String.cons x xs) ys) = (String.cons x (String.concat xs ys)) 370 | 371 | Main = 372 | (HVM.print "What is your name?" 373 | (HVM.query λname 374 | (HVM.print (String.concat "Hello, " name) 375 | (Done)))) 376 | ``` 377 | 378 | This will ask your name, then greet you. 379 | 380 | ### HVM.store (key: String) (val: String) (cont: Term) 381 | 382 | Saves a text file on the working directory. Example: 383 | 384 | ```javascript 385 | Main = 386 | (HVM.store "name.txt" "Alice" 387 | (Done)) 388 | ``` 389 | 390 | This will save `name.txt` with the contents `Alice`. 391 | 392 | ### HVM.load (key: String) (cont: String -> Term) 393 | 394 | Loads a text file from the working directory. Example: 395 | 396 | ```javascript 397 | Main = 398 | (HVM.load "name.txt" λname 399 | (HVM.print name 400 | (Done))) 401 | ``` 402 | 403 | This will print the contents of `name.txt`. 404 | 405 | Extending HVM 406 | ------------- 407 | 408 | HVM's built-in effects may not be sufficient for your needs, but it is possible 409 | to extend HVM with new effects via its Rust API. For example, in the snippet 410 | below, we extend HVM with a custom "MyPrint" IO: 411 | 412 | ```rust 413 | // File to foad definitions from 414 | let file = "file.hvm"; 415 | 416 | // Term to evaluate 417 | let term = "(MyPrint \"cats are life\" (Done))"; 418 | 419 | // Extends HVM with our custom MyPrint IO function 420 | let funs = vec![ 421 | ("MyPrint".toString(), hvm::runtime::Function::Compiled { 422 | arity: 2, 423 | visit: |ctx| false, 424 | apply: |ctx| { 425 | 426 | // Loads argument locations 427 | let arg0 = runtime::get_loc(ctx.term, 0); 428 | let arg1 = runtime::get_loc(ctx.term, 1); 429 | 430 | // Converts the argument #0 to a Rust string 431 | if let Some(text) = crate::language::readback::as_string(ctx.heap, ctx.prog, &[ctx.tid], arg0) { 432 | // Prints it 433 | println!("{}", text); 434 | } 435 | 436 | // Sets the returned result to be the argument #1 437 | hvm::runtime::link(ctx.heap, *ctx.host, arg1); 438 | 439 | // Collects the argument #0 440 | hvm::runtime::collect(ctx.heap, &ctx.prog.arit, ctx.tid, hvm::runtime::load_ptr(ctx.heap, arg0)); 441 | 442 | // Frees the memory used by this function call 443 | hvm::runtime::free(ctx.heap, ctx.tid, get_loc(ctx.term, 0), 2); 444 | 445 | // Tells HVM the returned value must be reduced 446 | return true; 447 | }, 448 | }) 449 | ]; 450 | 451 | // Alloc 2 GB for the heap 452 | let size = 2 * runtime::CELLS_PER_GB; 453 | 454 | // Use 2 threads 455 | let tids = 2; 456 | 457 | // Don't show step-by-step 458 | let dbug = false; 459 | 460 | // Evaluate the expression above with "MyPrint" available 461 | hvm::runtime::eval(file, term, funs, size, tids, dbug); 462 | ``` 463 | 464 | *To learn how to design the `apply` function, first learn HVM's memory model 465 | (documented on 466 | [runtime/base/memory.rs](https://github.com/HigherOrderCO/HVM/blob/master/src/runtime/base/memory.rs)), 467 | and then consult some of the precompiled IO functions 468 | [here](https://github.com/HigherOrderCO/HVM/blob/master/src/runtime/base/precomp.rs). 469 | You can also use this API to extend HVM with new compute primitives, but to make 470 | this efficient, you'll need to use the `visit` function too. You can see some 471 | examples by compiling a `.hvm` file to Rust, and then checking the `precomp.rs` 472 | file on the generated project.* 473 | 474 | TODO: this section is a draft, must finish it. 475 | 476 | To be continued... 477 | ------------------ 478 | 479 | This guide is a work-in-progress and will be expanded soon. 480 | -------------------------------------------------------------------------------- /src/runtime/base/reducer.rs: -------------------------------------------------------------------------------- 1 | pub use crate::runtime::{*}; 2 | use crossbeam::utils::{Backoff}; 3 | use std::collections::HashSet; 4 | use std::sync::atomic::{AtomicBool, AtomicUsize, AtomicU64, Ordering}; 5 | 6 | pub struct ReduceCtx<'a> { 7 | pub heap : &'a Heap, 8 | pub prog : &'a Program, 9 | pub tid : usize, 10 | pub hold : bool, 11 | pub term : Ptr, 12 | pub visit : &'a VisitQueue, 13 | pub redex : &'a RedexBag, 14 | pub cont : &'a mut u64, 15 | pub host : &'a mut u64, 16 | } 17 | 18 | // HVM's reducer is a finite stack machine with 4 possible states: 19 | // - visit: visits a node and add its children to the visit stack ~> visit, apply, blink 20 | // - apply: reduces a node, applying a rewrite rule ~> visit, apply, blink, halt 21 | // - blink: pops the visit stack and enters visit mode ~> visit, blink, steal 22 | // - steal: attempt to steal work from the global pool ~> visit, steal, halt 23 | // Since Rust doesn't have `goto`, the loop structure below is used. 24 | // It allows performing any allowed state transition with a jump. 25 | // main { 26 | // work { 27 | // visit { ... } 28 | // apply { ... } 29 | // complete 30 | // } 31 | // blink { ... } 32 | // steal { ... } 33 | // } 34 | 35 | pub fn is_whnf(term: Ptr) -> bool { 36 | match get_tag(term) { 37 | ERA => true, 38 | LAM => true, 39 | SUP => true, 40 | CTR => true, 41 | U60 => true, 42 | F60 => true, 43 | _ => false, 44 | } 45 | } 46 | 47 | pub fn reduce(heap: &Heap, prog: &Program, tids: &[usize], root: u64, full: bool, debug: bool) -> Ptr { 48 | // Halting flag 49 | let stop = &AtomicUsize::new(1); 50 | let barr = &Barrier::new(tids.len()); 51 | let locs = &tids.iter().map(|x| AtomicU64::new(u64::MAX)).collect::>(); 52 | 53 | // Spawn a thread for each worker 54 | std::thread::scope(|s| { 55 | for tid in tids { 56 | s.spawn(move || { 57 | reducer(heap, prog, tids, stop, barr, locs, root, *tid, full, debug); 58 | //println!("[{}] done", tid); 59 | }); 60 | } 61 | }); 62 | 63 | // Return whnf term ptr 64 | return load_ptr(heap, root); 65 | } 66 | 67 | pub fn reducer( 68 | heap: &Heap, 69 | prog: &Program, 70 | tids: &[usize], 71 | stop: &AtomicUsize, 72 | barr: &Barrier, 73 | locs: &[AtomicU64], 74 | root: u64, 75 | tid: usize, 76 | full: bool, 77 | debug: bool, 78 | ) { 79 | 80 | // State Stacks 81 | let redex = &heap.rbag; 82 | let visit = &heap.vstk[tid]; 83 | let bkoff = &Backoff::new(); 84 | let hold = tids.len() <= 1; 85 | let seen = &mut HashSet::new(); 86 | 87 | // State Vars 88 | let (mut cont, mut host) = if tid == tids[0] { 89 | (REDEX_CONT_RET, root) 90 | } else { 91 | (0, u64::MAX) 92 | }; 93 | 94 | // Debug Printer 95 | let print = |tid: usize, host: u64| { 96 | barr.wait(stop); 97 | locs[tid].store(host, Ordering::SeqCst); 98 | barr.wait(stop); 99 | if tid == tids[0] { 100 | println!("{}\n----------------", show_at(heap, prog, root, locs)); 101 | } 102 | barr.wait(stop); 103 | }; 104 | 105 | // State Machine 106 | 'main: loop { 107 | 'init: { 108 | if host == u64::MAX { 109 | break 'init; 110 | } 111 | 'work: loop { 112 | 'visit: loop { 113 | let term = load_ptr(heap, host); 114 | if debug { 115 | print(tid, host); 116 | } 117 | match get_tag(term) { 118 | APP => { 119 | if app::visit(ReduceCtx { heap, prog, tid, hold, term, visit, redex, cont: &mut cont, host: &mut host }) { 120 | continue 'visit; 121 | } else { 122 | break 'work; 123 | } 124 | } 125 | DP0 | DP1 => { 126 | match acquire_lock(heap, tid, term) { 127 | Err(locker_tid) => { 128 | continue 'work; 129 | } 130 | Ok(_) => { 131 | // If the term changed, release lock and try again 132 | if term != load_ptr(heap, host) { 133 | release_lock(heap, tid, term); 134 | continue 'visit; 135 | } else { 136 | if dup::visit(ReduceCtx { heap, prog, tid, hold, term, visit, redex, cont: &mut cont, host: &mut host }) { 137 | continue 'visit; 138 | } else { 139 | break 'work; 140 | } 141 | } 142 | } 143 | } 144 | } 145 | OP2 => { 146 | if op2::visit(ReduceCtx { heap, prog, tid, hold, term, visit, redex, cont: &mut cont, host: &mut host }) { 147 | continue 'visit; 148 | } else { 149 | break 'work; 150 | } 151 | } 152 | FUN | CTR => { 153 | let fid = get_ext(term); 154 | //[[CODEGEN:FAST-VISIT]]// 155 | match &prog.funs.get(&fid) { 156 | Some(Function::Interpreted { smap: fn_smap, visit: fn_visit, apply: fn_apply }) => { 157 | if fun::visit(ReduceCtx { heap, prog, tid, hold, term, visit, redex, cont: &mut cont, host: &mut host }, &fn_visit.strict_idx) { 158 | continue 'visit; 159 | } else { 160 | break 'visit; 161 | } 162 | } 163 | Some(Function::Compiled { smap: fn_smap, visit: fn_visit, apply: fn_apply }) => { 164 | if fn_visit(ReduceCtx { heap, prog, tid, hold, term, visit, redex, cont: &mut cont, host: &mut host }) { 165 | continue 'visit; 166 | } else { 167 | break 'visit; 168 | } 169 | } 170 | None => { 171 | break 'visit; 172 | } 173 | } 174 | } 175 | _ => { 176 | break 'visit; 177 | } 178 | } 179 | } 180 | 'call: loop { 181 | 'apply: loop { 182 | let term = load_ptr(heap, host); 183 | if debug { 184 | print(tid, host); 185 | } 186 | // Apply rewrite rules 187 | match get_tag(term) { 188 | APP => { 189 | if app::apply(ReduceCtx { heap, prog, tid, hold, term, visit, redex, cont: &mut cont, host: &mut host }) { 190 | continue 'work; 191 | } else { 192 | break 'apply; 193 | } 194 | } 195 | DP0 | DP1 => { 196 | if dup::apply(ReduceCtx { heap, prog, tid, hold, term, visit, redex, cont: &mut cont, host: &mut host }) { 197 | release_lock(heap, tid, term); 198 | continue 'work; 199 | } else { 200 | release_lock(heap, tid, term); 201 | break 'apply; 202 | } 203 | } 204 | OP2 => { 205 | if op2::apply(ReduceCtx { heap, prog, tid, hold, term, visit, redex, cont: &mut cont, host: &mut host }) { 206 | continue 'work; 207 | } else { 208 | break 'apply; 209 | } 210 | } 211 | FUN | CTR => { 212 | let fid = get_ext(term); 213 | //[[CODEGEN:FAST-APPLY]]// 214 | match &prog.funs.get(&fid) { 215 | Some(Function::Interpreted { smap: fn_smap, visit: fn_visit, apply: fn_apply }) => { 216 | if fun::apply(ReduceCtx { heap, prog, tid, hold, term, visit, redex, cont: &mut cont, host: &mut host }, fid, fn_visit, fn_apply) { 217 | continue 'work; 218 | } else { 219 | break 'apply; 220 | } 221 | } 222 | Some(Function::Compiled { smap: fn_smap, visit: fn_visit, apply: fn_apply }) => { 223 | if fn_apply(ReduceCtx { heap, prog, tid, hold, term, visit, redex, cont: &mut cont, host: &mut host }) { 224 | continue 'work; 225 | } else { 226 | break 'apply; 227 | } 228 | } 229 | None => { 230 | break 'apply; 231 | } 232 | } 233 | } 234 | _ => { 235 | break 'apply; 236 | } 237 | } 238 | } 239 | // If root is on WHNF, halt 240 | if cont == REDEX_CONT_RET { 241 | //println!("done {}", show_at(heap, prog, host, &[])); 242 | stop.fetch_sub(1, Ordering::Relaxed); 243 | if full && !seen.contains(&host) { 244 | seen.insert(host); 245 | let term = load_ptr(heap, host); 246 | match get_tag(term) { 247 | LAM => { 248 | stop.fetch_add(1, Ordering::Relaxed); 249 | visit.push(new_visit(get_loc(term, 1), hold, cont)); 250 | } 251 | APP => { 252 | stop.fetch_add(2, Ordering::Relaxed); 253 | visit.push(new_visit(get_loc(term, 0), hold, cont)); 254 | visit.push(new_visit(get_loc(term, 1), hold, cont)); 255 | } 256 | SUP => { 257 | stop.fetch_add(2, Ordering::Relaxed); 258 | visit.push(new_visit(get_loc(term, 0), hold, cont)); 259 | visit.push(new_visit(get_loc(term, 1), hold, cont)); 260 | } 261 | DP0 => { 262 | stop.fetch_add(1, Ordering::Relaxed); 263 | visit.push(new_visit(get_loc(term, 2), hold, cont)); 264 | } 265 | DP1 => { 266 | stop.fetch_add(1, Ordering::Relaxed); 267 | visit.push(new_visit(get_loc(term, 2), hold, cont)); 268 | } 269 | CTR | FUN => { 270 | let arit = arity_of(&prog.aris, term); 271 | if arit > 0 { 272 | stop.fetch_add(arit as usize, Ordering::Relaxed); 273 | for i in 0 .. arit { 274 | visit.push(new_visit(get_loc(term, i), hold, cont)); 275 | } 276 | } 277 | } 278 | _ => {} 279 | } 280 | } 281 | break 'work; 282 | } 283 | // Otherwise, try reducing the parent redex 284 | if let Some((new_cont, new_host)) = redex.complete(cont) { 285 | cont = new_cont; 286 | host = new_host; 287 | continue 'call; 288 | } 289 | // Otherwise, visit next pointer 290 | break 'work; 291 | } 292 | } 293 | 'blink: loop { 294 | // If available, visit a new location 295 | if let Some((new_cont, new_host)) = visit.pop() { 296 | cont = new_cont; 297 | host = new_host; 298 | continue 'main; 299 | } 300 | // Otherwise, we have nothing to do 301 | else { 302 | break 'blink; 303 | } 304 | } 305 | } 306 | 'steal: loop { 307 | if debug { 308 | //println!("[{}] steal delay={}", tid, delay.len()); 309 | print(tid, u64::MAX); 310 | } 311 | //println!("[{}] steal", tid); 312 | if stop.load(Ordering::Relaxed) == 0 { 313 | //println!("[{}] stop", tid); 314 | break 'main; 315 | } else { 316 | for victim_tid in tids { 317 | if *victim_tid != tid { 318 | if let Some((new_cont, new_host)) = heap.vstk[*victim_tid].steal() { 319 | cont = new_cont; 320 | host = new_host; 321 | //println!("stolen"); 322 | continue 'main; 323 | } 324 | } 325 | } 326 | bkoff.snooze(); 327 | continue 'steal; 328 | } 329 | } 330 | } 331 | } 332 | 333 | pub fn normalize(heap: &Heap, prog: &Program, tids: &[usize], host: u64, debug: bool) -> Ptr { 334 | let mut cost = get_cost(heap); 335 | loop { 336 | reduce(heap, prog, tids, host, true, debug); 337 | let new_cost = get_cost(heap); 338 | if new_cost != cost { 339 | cost = new_cost; 340 | } else { 341 | break; 342 | } 343 | } 344 | load_ptr(heap, host) 345 | } 346 | 347 | //pub fn normal(heap: &Heap, prog: &Program, tids: &[usize], host: u64, seen: &mut im::HashSet, debug: bool) -> Ptr { 348 | //let term = load_ptr(heap, host); 349 | //if seen.contains(&host) { 350 | //term 351 | //} else { 352 | ////let term = reduce2(heap, lvars, prog, host); 353 | //let term = reduce(heap, prog, tids, host, debug); 354 | //seen.insert(host); 355 | //let mut rec_locs = vec![]; 356 | //match get_tag(term) { 357 | //LAM => { 358 | //rec_locs.push(get_loc(term, 1)); 359 | //} 360 | //APP => { 361 | //rec_locs.push(get_loc(term, 0)); 362 | //rec_locs.push(get_loc(term, 1)); 363 | //} 364 | //SUP => { 365 | //rec_locs.push(get_loc(term, 0)); 366 | //rec_locs.push(get_loc(term, 1)); 367 | //} 368 | //DP0 => { 369 | //rec_locs.push(get_loc(term, 2)); 370 | //} 371 | //DP1 => { 372 | //rec_locs.push(get_loc(term, 2)); 373 | //} 374 | //CTR | FUN => { 375 | //let arity = arity_of(&prog.aris, term); 376 | //for i in 0 .. arity { 377 | //rec_locs.push(get_loc(term, i)); 378 | //} 379 | //} 380 | //_ => {} 381 | //} 382 | //let rec_len = rec_locs.len(); // locations where we must recurse 383 | //let thd_len = tids.len(); // number of available threads 384 | //let rec_loc = &rec_locs; 385 | ////println!("~ rec_len={} thd_len={} {}", rec_len, thd_len, show_term(heap, prog, ask_lnk(heap,host), host)); 386 | //if rec_len > 0 { 387 | //std::thread::scope(|s| { 388 | //// If there are more threads than rec_locs, splits threads for each rec_loc 389 | //if thd_len >= rec_len { 390 | ////panic!("b"); 391 | //let spt_len = thd_len / rec_len; 392 | //let mut tids = tids; 393 | //for (rec_num, rec_loc) in rec_loc.iter().enumerate() { 394 | //let (rec_tids, new_tids) = tids.split_at(if rec_num == rec_len - 1 { tids.len() } else { spt_len }); 395 | ////println!("~ rec_loc {} gets {} threads", rec_loc, rec_lvars.len()); 396 | ////let new_loc; 397 | ////if thd_len == rec_len { 398 | ////new_loc = alloc(heap, rec_tids[0], 1); 399 | ////move_ptr(heap, *rec_loc, new_loc); 400 | ////} else { 401 | ////new_loc = *rec_loc; 402 | ////} 403 | ////let new_loc = *rec_loc; 404 | //let mut seen = seen.clone(); 405 | //s.spawn(move || { 406 | //let ptr = normal(heap, prog, rec_tids, *rec_loc, &mut seen, debug); 407 | ////if thd_len == rec_len { 408 | ////move_ptr(heap, new_loc, *rec_loc); 409 | ////} 410 | //link(heap, *rec_loc, ptr); 411 | //}); 412 | //tids = new_tids; 413 | //} 414 | //// Otherwise, splits rec_locs for each thread 415 | //} else { 416 | ////panic!("c"); 417 | //for (thd_num, tid) in tids.iter().enumerate() { 418 | //let min_idx = thd_num * rec_len / thd_len; 419 | //let max_idx = if thd_num < thd_len - 1 { (thd_num + 1) * rec_len / thd_len } else { rec_len }; 420 | ////println!("~ thread {} gets rec_locs {} to {}", thd_num, min_idx, max_idx); 421 | //let mut seen = seen.clone(); 422 | //s.spawn(move || { 423 | //for idx in min_idx .. max_idx { 424 | //let loc = rec_loc[idx]; 425 | //let lnk = normal(heap, prog, std::slice::from_ref(tid), loc, &mut seen, debug); 426 | //link(heap, loc, lnk); 427 | //} 428 | //}); 429 | //} 430 | //} 431 | //}); 432 | //} 433 | //term 434 | //} 435 | //} 436 | 437 | //pub fn normalize(heap: &Heap, prog: &Program, tids: &[usize], host: u64, debug: bool) -> Ptr { 438 | //let mut cost = get_cost(heap); 439 | //loop { 440 | //normal(heap, prog, tids, host, &mut im::HashSet::new(), debug); 441 | //let new_cost = get_cost(heap); 442 | //if new_cost != cost { 443 | //cost = new_cost; 444 | //} else { 445 | //break; 446 | //} 447 | //} 448 | //load_ptr(heap, host) 449 | //} 450 | --------------------------------------------------------------------------------