├── .gitignore ├── CLAUDE.md ├── Makefile ├── README.md ├── examples ├── test_0.ic ├── test_1.ic ├── test_2.ic ├── test_3.ic ├── test_4.ic └── test_5.ic ├── haskell ├── main.hs └── main_debug.hs └── src ├── collapse.c ├── collapse.h ├── ic.c ├── ic.h ├── ic.metal ├── ic_metal.mm ├── main.c ├── parse.c ├── parse.h ├── show.c └── show.h /.gitignore: -------------------------------------------------------------------------------- 1 | .tmp/ 2 | bin/ 3 | obj/ 4 | 5 | # Compiled Object files 6 | *.o 7 | *.ko 8 | *.obj 9 | *.elf 10 | 11 | # Compiled Dynamic libraries 12 | *.so 13 | *.dylib 14 | *.dll 15 | 16 | # Compiled Static libraries 17 | *.a 18 | *.la 19 | *.lai 20 | *.lib 21 | 22 | # Backups 23 | *.bak 24 | 25 | # Executables 26 | *.exe 27 | *.out 28 | *.app 29 | *.i*86 30 | *.x86_64 31 | *.hex 32 | 33 | # Debug files 34 | *.dSYM/ 35 | *.su 36 | *.idb 37 | *.pdb 38 | 39 | # Editor files 40 | .vscode/ 41 | .idea/ 42 | *.swp 43 | *~ 44 | 45 | # OS specific files 46 | .DS_Store 47 | .DS_Store? 48 | ._* 49 | .Spotlight-V100 50 | .Trashes 51 | ehthumbs.db 52 | Thumbs.db 53 | 54 | old.c 55 | task.txt 56 | .fill.tmp 57 | GOAL 58 | up.sh 59 | -------------------------------------------------------------------------------- /CLAUDE.md: -------------------------------------------------------------------------------- 1 | # IC Project Guide 2 | 3 | ## Important Files 4 | - `README.md` - Project Spec (ALWAYS READ IT) 5 | - `src/main.c` - Program entry point (CLI) 6 | - `src/ic.h` - The complete IC runtime 7 | - `src/parse.[c|h]` - Term parsing 8 | - `src/show.[c|h]` - Term stringification 9 | 10 | ## Build Commands 11 | - Build the project: `make` 12 | - Clean build artifacts: `make clean` 13 | - Run with custom test term: `./bin/main "(λf.λx.(f (f (f x))) λb.(b λt.λf.f λt.λf.t) λt.λf.t)"` 14 | 15 | ## Code Style 16 | - Use C99 standard with portable implementation 17 | - Functions and variables should use `snake_case` 18 | - Constants should be in `UPPER_CASE` 19 | - Use 2 space indentation 20 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | CC = gcc 2 | CFLAGS = -w -std=c99 -O3 -march=native -mtune=native -flto 3 | 4 | # Check for 64-bit mode flag 5 | ifdef USE_64BIT 6 | CFLAGS += -DIC_64BIT 7 | endif 8 | SRC_DIR = src 9 | OBJ_DIR = obj 10 | BIN_DIR = bin 11 | 12 | # Metal GPU acceleration is the only supported GPU backend 13 | 14 | # Check if we're on macOS for Metal support 15 | UNAME := $(shell uname) 16 | ifeq ($(UNAME), Darwin) 17 | # Check if xcrun exists (required for Metal) 18 | METAL_CHECK := $(shell which xcrun 2>/dev/null || echo "") 19 | ifneq ($(METAL_CHECK),) 20 | # Compile Metal on macOS 21 | METAL_CFLAGS = -DHAVE_METAL 22 | METAL_LDFLAGS = -framework Metal -framework Foundation -lc++ 23 | METAL_SRCS = $(SRC_DIR)/ic_metal.mm $(SRC_DIR)/ic.metal 24 | METAL_OBJS = $(OBJ_DIR)/ic_metal.o 25 | HAS_METAL = 1 26 | 27 | # Use clang for Objective-C++ compilation 28 | CXX = clang++ 29 | OBJCXX = clang++ 30 | OBJCXXFLAGS = -fobjc-arc -O3 -std=c++14 31 | 32 | # Metal compiler 33 | METAL_COMPILER = xcrun -sdk macosx metal 34 | METAL_COMPILER_FLAGS = -O 35 | METAL_OUTPUT = $(BIN_DIR)/ic.metallib 36 | else 37 | # No Metal available 38 | METAL_SRCS = 39 | METAL_OBJS = 40 | METAL_CFLAGS = 41 | METAL_LDFLAGS = 42 | HAS_METAL = 0 43 | endif 44 | else 45 | # Not macOS, no Metal 46 | METAL_SRCS = 47 | METAL_OBJS = 48 | METAL_CFLAGS = 49 | METAL_LDFLAGS = 50 | HAS_METAL = 0 51 | endif 52 | 53 | # Main source files 54 | SRCS = $(SRC_DIR)/main.c \ 55 | $(SRC_DIR)/ic.c \ 56 | $(SRC_DIR)/collapse.c \ 57 | $(SRC_DIR)/show.c \ 58 | $(SRC_DIR)/parse.c 59 | 60 | # Parser is now included in the main source files 61 | # Objects 62 | OBJS = $(SRCS:$(SRC_DIR)/%.c=$(OBJ_DIR)/%.o) 63 | 64 | # Executable 65 | TARGET = $(BIN_DIR)/main 66 | TARGET_LN = $(BIN_DIR)/ic 67 | 68 | # Directories 69 | DIRS = $(OBJ_DIR) $(BIN_DIR) 70 | 71 | .PHONY: all clean status metal-status 64bit 72 | 73 | all: $(DIRS) $(TARGET) $(TARGET_LN) 74 | 75 | $(DIRS): 76 | mkdir -p $@ 77 | 78 | # Build target with Metal or CPU-only 79 | ifeq ($(HAS_METAL),1) 80 | $(TARGET): $(OBJS) $(METAL_OBJS) $(METAL_OUTPUT) 81 | $(CC) $(CFLAGS) -o $@ $(OBJS) $(METAL_OBJS) $(METAL_LDFLAGS) 82 | else 83 | $(TARGET): $(OBJS) 84 | $(CC) $(CFLAGS) -o $@ $^ 85 | endif 86 | 87 | $(TARGET_LN): $(TARGET) 88 | ln -sf main $(TARGET_LN) 89 | 90 | # Compile Metal shader library 91 | $(METAL_OUTPUT): $(SRC_DIR)/ic.metal | $(BIN_DIR) 92 | $(METAL_COMPILER) $(METAL_COMPILER_FLAGS) -o $@ $< 93 | 94 | # Compile C files 95 | ifeq ($(HAS_METAL),1) 96 | $(OBJ_DIR)/%.o: $(SRC_DIR)/%.c 97 | $(CC) $(CFLAGS) $(METAL_CFLAGS) -c -o $@ $< 98 | else 99 | $(OBJ_DIR)/%.o: $(SRC_DIR)/%.c 100 | $(CC) $(CFLAGS) -c -o $@ $< 101 | endif 102 | 103 | # Compile Metal Objective-C++ 104 | ifeq ($(HAS_METAL),1) 105 | $(OBJ_DIR)/ic_metal.o: $(SRC_DIR)/ic_metal.mm 106 | $(OBJCXX) $(OBJCXXFLAGS) $(METAL_CFLAGS) -c -o $@ $< 107 | endif 108 | 109 | clean: 110 | rm -rf $(OBJ_DIR) $(BIN_DIR) 111 | 112 | # Show GPU acceleration status 113 | status: 114 | ifeq ($(HAS_METAL),1) 115 | @echo "Metal supported on this system. Building with Metal GPU support." 116 | else 117 | @echo "No GPU acceleration available. Building CPU-only version." 118 | endif 119 | 120 | metal-status: $(TARGET) 121 | @echo "Testing Metal availability..." 122 | @./$(TARGET) eval-gpu "λx.x" 2>&1 | grep -i "Metal" || true 123 | 124 | # 64-bit build target 125 | 64bit: 126 | $(MAKE) USE_64BIT=1 127 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Interaction Calculus 2 | 3 | The Interaction Calculus is a minimal term rewriting system inspired by the 4 | Lambda Calculus (λC), but with some key differences that make it inherently more 5 | efficient, in a way that closely resembles Lamping's optimal λ-calculus 6 | evaluator, and more expressive, in some ways. In particular: 7 | 8 | 1. Vars are affine: they can only occur up to one time. 9 | 10 | 2. Vars are global: they can occur anywhere in the program. 11 | 12 | 3. It features first-class *superpositions* and *duplications*. 13 | 14 | Global lambdas allow the IC to express concepts that aren't possible on the 15 | traditional λC, including continuations, linear HOAS, and mutable references. 16 | Superpositions and duplications allow the IC to be optimally evaluated, making 17 | some computations exponentially faster. Finally, being fully affine makes its 18 | garbage collector very efficient, and greatly simplifies parallelism. 19 | 20 | The [HVM](https://github.com/HigherOrderCO/HVM3) is a fast, fully featured 21 | implementation of this calculus. 22 | 23 | **This repo now includes a reference implementation in C, which is also quite fast!** 24 | 25 | **Now it also includes a single-file implementation in Haskell, great for learning!** 26 | 27 | ## Usage 28 | 29 | This repository includes a reference implementation of the Interaction Calculus 30 | in plain C, with some additional features, like native numbers. To install it: 31 | 32 | ``` 33 | make clean 34 | make 35 | ``` 36 | 37 | Then, run one of the examples: 38 | 39 | ``` 40 | ./bin/ic run examples/test_0.ic 41 | ``` 42 | 43 | For learning, edit the Haskell file: it is simpler, and has a step debugger. 44 | 45 | ## Specification 46 | 47 | An IC term is defined by the following grammar: 48 | 49 | ```haskell 50 | Term ::= 51 | | VAR: Name 52 | | ERA: "*" 53 | | LAM: "λ" Name "." Term 54 | | APP: "(" Term " " Term ")" 55 | | SUP: "&" Label "{" Term "," Term "}" 56 | | DUP: "!" "&" Label "{" Name "," Name "}" "=" Term ";" Term 57 | ``` 58 | 59 | Where: 60 | - VAR represents a variable. 61 | - ERA represents an erasure. 62 | - LAM represents a lambda. 63 | - APP represents a application. 64 | - SUP represents a superposition. 65 | - DUP represents a duplication. 66 | 67 | Lambdas are curried, and work like their λC counterpart, except with a relaxed 68 | scope, and with affine usage. Applications eliminate lambdas, like in λC, 69 | through the beta-reduce (APP-LAM) interaction. 70 | 71 | Superpositions work like pairs. Duplications eliminate superpositions through 72 | the DUP-SUP interaction, which works exactly like a pair projection. 73 | 74 | What makes SUPs and DUPs unique is how they interact with LAMs and APPs. When a 75 | SUP is applied to an argument, it reduces through the APP-SUP interaction, and 76 | when a LAM is projected, it reduces through the DUP-LAM interaction. This gives 77 | a computational behavior for every possible interaction: there are no runtime 78 | errors on the Interaction Calculus. 79 | 80 | The 'Label' is just a numeric value. It affects the DUP-SUP interaction. 81 | 82 | The core interaction rules are listed below: 83 | 84 | ```haskell 85 | (* a) 86 | ----- APP-ERA 87 | * 88 | 89 | (λx.f a) 90 | -------- APP-LAM 91 | x <- a 92 | f 93 | 94 | (&L{a,b} c) 95 | ----------------- APP-SUP 96 | ! &L{c0,c1} = c; 97 | &L{(a c0),(b c1)} 98 | 99 | ! &L{r,s} = *; 100 | K 101 | -------------- DUP-ERA 102 | r <- * 103 | s <- * 104 | K 105 | 106 | ! &L{r,s} = λx.f; 107 | K 108 | ----------------- DUP-LAM 109 | r <- λx0.f0 110 | s <- λx1.f1 111 | x <- &L{x0,x1} 112 | ! &L{f0,f1} = f; 113 | K 114 | 115 | ! &L{x,y} = &L{a,b}; 116 | K 117 | -------------------- DUP-SUP (if equal labels) 118 | x <- a 119 | y <- b 120 | K 121 | 122 | ! &L{x,y} = &R{a,b}; 123 | K 124 | -------------------- DUP-SUP (if different labels) 125 | x <- &R{a0,b0} 126 | y <- &R{a1,b1} 127 | ! &L{a0,a1} = a; 128 | ! &L{b0,b1} = b; 129 | K 130 | ``` 131 | 132 | Where `x <- t` stands for a global substitution of `x` by `t`. 133 | 134 | Since variables are affine, substitutions can be implemented efficiently by just 135 | inserting an entry in a global substitution map (`sub[var] = value`). There is 136 | no need to traverse the target term, or to handle name capture, as long as fresh 137 | variable names are globally unique. It can also be implemented in a concurrent 138 | setup with a single atomic-swap. 139 | 140 | Below is a pseudocode implementation of these interaction rules: 141 | 142 | ```python 143 | def app_lam(app, lam): 144 | sub[lam.nam] = app.arg 145 | return lam.bod 146 | 147 | def app_sup(app, sup): 148 | x0 = fresh() 149 | x1 = fresh() 150 | a0 = App(sup.lft, Var(x0)) 151 | a1 = App(sup.rgt, Var(x1)) 152 | return Dup(sup.lab, x0, x1, app.arg, Sup(a0, a1)) 153 | 154 | def dup_lam(dup, lam): 155 | x0 = fresh() 156 | x1 = fresh() 157 | f0 = fresh() 158 | f1 = fresh() 159 | sub[dup.lft] = Lam(x0, Var(f0)) 160 | sub[dup.rgt] = Lam(x1, Var(f1)) 161 | sub[lam.nam] = Sup(dup.lab, Var(x0), Var(x1)) 162 | return Dup(dup.lab, f0, f1, lam.bod, dup.bod) 163 | 164 | def dup_sup(dup, sup): 165 | if dup.lab == sup.lab: 166 | sub[dup.lft] = sup.lft 167 | sub[dup.rgt] = sup.rgt 168 | return dup.bod 169 | else: 170 | a0 = fresh() 171 | a1 = fresh() 172 | b0 = fresh() 173 | b1 = fresh() 174 | sub[dup.lft] = Sup(sup.lab, Var(a0), Var(b0)) 175 | sub[dup.rgt] = Sup(sup.lab, Var(a1), Var(b1)) 176 | return Dup(dup.lab, a0, a1, sup.lft, Dup(dup.lab, b0, b1, sup.rgt, dup.bod)) 177 | ``` 178 | 179 | Terms can be reduced to weak head normal form, which means reducing until the 180 | outermost constructor is a value (LAM, SUP, etc.), or until no more reductions 181 | are possible. Example: 182 | 183 | ```python 184 | def whnf(term): 185 | while True: 186 | match term: 187 | case Var(nam): 188 | if nam in sub: 189 | term = sub[nam] 190 | else: 191 | return term 192 | case App(fun, arg): 193 | fun = whnf(fun) 194 | match fun.tag: 195 | case Lam: term = app_lam(term, fun) 196 | case Sup: term = app_sup(term, fun) 197 | case _ : return App(fun, arg) 198 | case Dup(lft, rgt, val, bod): 199 | val = whnf(val) 200 | match val.tag: 201 | case Lam: term = dup_lam(term, val) 202 | case Sup: term = dup_sup(term, val) 203 | case _ : return Dup(lft, rgt, val, bod) 204 | case _: 205 | return term 206 | ``` 207 | 208 | Terms can be reduced to full normal form by recursively taking the whnf: 209 | 210 | ```python 211 | def normal(term): 212 | term = whnf(term) 213 | match term: 214 | case Lam(nam, bod): 215 | bod_nf = normal(bod) 216 | return Lam(nam, bod_nf) 217 | case App(fun, arg): 218 | fun_nf = normal(fun) 219 | arg_nf = normal(arg) 220 | return App(fun_nf, arg_nf) 221 | ... 222 | case _: 223 | return term 224 | ``` 225 | 226 | Below are some normalization examples. 227 | 228 | Example 0: (simple λ-term) 229 | 230 | ``` 231 | (λx.λt.(t x) λy.y) 232 | ------------------ APP-LAM 233 | λt.(t λy.y) 234 | ``` 235 | 236 | Example 1: (larger λ-term) 237 | 238 | ``` 239 | (λb.λt.λf.((b f) t) λT.λF.T) 240 | ---------------------------- APP-LAM 241 | λt.λf.((λT.λF.T f) t) 242 | ----------------------- APP-LAM 243 | λt.λf.(λF.t f) 244 | -------------- APP-LAM 245 | λt.λf.t 246 | ``` 247 | 248 | Example 2: (global scopes) 249 | 250 | ``` 251 | {x,(λx.λy.y λk.k)} 252 | ------------------ APP-LAM 253 | {λk.k,λy.y} 254 | ``` 255 | 256 | Example 3: (superposition) 257 | 258 | ``` 259 | !{a,b} = {λx.x,λy.y}; (a b) 260 | --------------------------- DUP-SUP 261 | (λx.x λy.y) 262 | ----------- APP-LAM 263 | λy.y 264 | ``` 265 | 266 | Example 4: (overlap) 267 | 268 | ``` 269 | ({λx.x,λy.y} λz.z) 270 | ------------------ APP-SUP 271 | ! {x0,x1} = λz.z; {(λx.x x0),(λy.y x1)} 272 | --------------------------------------- DUP-LAM 273 | ! {f0,f1} = {r,s}; {(λx.x λr.f0),(λy.y λs.f1)} 274 | ---------------------------------------------- DUP-SUP 275 | {(λx.x λr.r),(λy.y λs.s)} 276 | ------------------------- APP-LAM 277 | {λr.r,(λy.y λs.s)} 278 | ------------------ APP-LAM 279 | {λr.r,λs.s} 280 | ``` 281 | 282 | Example 5: (default test term) 283 | 284 | The following term can be used to test all interactions: 285 | 286 | ``` 287 | ((λf.λx.!{f0,f1}=f;(f0 (f1 x)) λB.λT.λF.((B F) T)) λa.λb.a) 288 | ----------------------------------------------------------- 16 interactions 289 | λa.λb.a 290 | ``` 291 | 292 | ## Collapsing 293 | 294 | An Interaction Calculus term can be collapsed to a superposed tree of pure 295 | Lambda Calculus terms without SUPs and DUPs, by extending the evaluator with the 296 | following collapse interactions: 297 | 298 | ```haskell 299 | λx.* 300 | ------ ERA-LAM 301 | x <- * 302 | * 303 | 304 | (f *) 305 | ----- ERA-APP 306 | * 307 | 308 | λx.&L{f0,f1} 309 | ----------------- SUP-LAM 310 | x <- &L{x0,x1} 311 | &L{λx0.f0,λx1.f1} 312 | 313 | (f &L{x0,x1}) 314 | ------------------- SUP-APP 315 | !&L{f0,f1} = f; 316 | &L{(f0 x0),(f1 x1)} 317 | 318 | !&L{x0,x1} = x; K 319 | ----------------- DUP-VAR 320 | x0 <- x 321 | x1 <- x 322 | K 323 | 324 | !&L{a0,a1} = (f x); K 325 | --------------------- DUP-APP 326 | a0 <- (f0 x0) 327 | a1 <- (f1 x1) 328 | !&L{f0,f1} = f; 329 | !&L{x0,x1} = x; 330 | K 331 | ``` 332 | 333 | ## DUP Permutations 334 | 335 | These interactions move a nested DUP out of a redex position. 336 | 337 | ``` 338 | (!&L{k0,k1}=k;f x) 339 | ------------------ APP-DUP 340 | !&L{k0,k1}=k;(f x) 341 | 342 | ! &L{x0,x1} = (!$R{y0,y1}=Y;X); T 343 | ------------------------------------- DUP-DUP 344 | ! &L{x0,x1} = X; ! &L{y0,y1} = Y; T 345 | ``` 346 | 347 | They're only needed in implementations that store a DUP's body. 348 | 349 | ## Labeled Lambdas 350 | 351 | Another possible extension of IC is to include labels on lams/apps: 352 | 353 | ```haskell 354 | | LAM: "&" Label "λ" Name "." Term 355 | | APP: "&" Label "(" Term " " Term ")" 356 | ``` 357 | 358 | The APP-LAM rule must, then, be extended with: 359 | 360 | ```haskell 361 | &L(&Rλx.bod arg) 362 | ----------------------- APP-LAM (if different labels) 363 | x <- &Lλy.z 364 | &Rλz.&L(body &R(arg y)) 365 | ``` 366 | 367 | ## IC = Lambda Calculus U Interaction Combinators 368 | 369 | Consider the conventional Lambda Calculus, with pairs. It has two computational rules: 370 | 371 | - Lambda Application : `(λx.body arg)` 372 | 373 | - Pair Projection : `let {a,b} = {fst,snd} in cont` 374 | 375 | When compiling the Lambda Calculus to Interaction Combinators: 376 | 377 | - `lams` and `apps` can be represented as constructor nodes (γ) 378 | 379 | - `pars` and `lets` can be represented as duplicator nodes (δ) 380 | 381 | As such, lambda applications and pair projections are just annihilations: 382 | 383 | ``` 384 | Lambda Application Pair Projection 385 | 386 | (λx.body arg) let {a,b} = {fst,snd} in cont 387 | ---------------- ----------------------------- 388 | x <- arg a <- fst 389 | body b <- snd 390 | cont 391 | 392 | ret arg ret arg b a b a 393 | | | | | | | | | 394 | |___| | | |___| | | 395 | app \ / \ / let \#/ \ / 396 | | ==> \/ | ==> \/ 397 | | /\ | /\ 398 | lam /_\ / \ pair /#\ / \ 399 | | | | | | | | | 400 | | | | | | | | | 401 | x body x body fst snd fst snd 402 | 403 | "The application of a lambda "The projection of a pair just 404 | substitutes the lambda's var substitutes the projected vars 405 | by the application's arg, and by each element of the pair, and 406 | returns the lambda body." returns the continuation." 407 | ``` 408 | 409 | But annihilations only happen when identical nodes interact. On interaction 410 | nets, it is possible for different nodes to interact, which triggers another rule, 411 | the commutation. That rule could be seen as handling the following expressions: 412 | 413 | - Lambda Projection : `let {a b} = (λx body) in cont` 414 | 415 | - Pair Application : `({fst snd} arg)` 416 | 417 | But how could we "project" a lambda or "apply" a pair? On the Lambda Calculus, these 418 | cases are undefined and stuck, and should be type errors. Yet, by interpreting the 419 | effects of the commutation rule on the interaction combinator point of view, we 420 | can propose a reasonable reduction for these lambda expressions: 421 | 422 | ``` 423 | Lambda Application Pair Application 424 | 425 | let {a,b} = (λx.body) in cont ({fst,snd} arg) 426 | ------------------------------ --------------- 427 | a <- λx0.b0 let {x0,x1} = arg in 428 | b <- λx1.b1 {(fst x0),(snd x1)} 429 | x <- {x0,x1} 430 | let {b0,b1} = body in 431 | cont 432 | 433 | ret arg ret arg ret arg ret arg 434 | | | | | | | | | 435 | |___| | | |___| | | 436 | let \#/ /_\ /_\ app \ / /#\ /#\ 437 | | ==> | \/ | | ==> | \/ | 438 | | |_ /\ _| | |_ /\ _| 439 | lam /_\ \#/ \#/ pair /#\ \ / \ / 440 | | | | | | | | | 441 | | | | | | | | | 442 | x body x body var body var body 443 | 444 | "The projection of a lambda "The application of a pair is a pair 445 | substitutes the projected vars of the first element and the second 446 | by a copies of the lambda that element applied to projections of the 447 | return its projected body, with application argument." 448 | the bound variable substituted 449 | by the new lambda vars paired." 450 | ``` 451 | 452 | This, in a way, completes the lambda calculus; i.e., previously "stuck" 453 | expressions now have a meaningful computation. That system, as written, is 454 | Turing complete, yet, it is very limited, since it isn't capable of cloning 455 | pairs, or cloning cloned lambdas. There is a simple way to greatly increase its 456 | expressivity, though: by decorating lets with labels, and upgrading the pair 457 | projection rule to: 458 | 459 | ```haskell 460 | let &i{a,b} = &j{fst,snd} in cont 461 | --------------------------------- 462 | if i == j: 463 | a <- fst 464 | b <- snd 465 | cont 466 | else: 467 | a <- &j{a0,a1} 468 | b <- &j{b0,b1} 469 | let &i{a0,a1} = fst in 470 | let &i{b0,b1} = snd in 471 | cont 472 | ``` 473 | 474 | That is, it may correspond to either an Interaction Combinator annihilation or 475 | commutation, depending on the value of the labels `&i` and `&j`. This makes IC 476 | capable of cloning pairs, cloning cloned lambdas, computing nested loops, 477 | performing Church-encoded arithmetic up to exponentiation, expressing arbitrary 478 | recursive functions such as the Y-combinators and so on. In other words, with 479 | this simple extension, IC becomes extraordinarily powerful and expressive, 480 | giving us a new foundation for symbolic computing, that is, in many ways, very 481 | similar to the λ-Calculus, yet, with key differences that make it more 482 | efficient in some senses, and capable of expressing new things (like call/cc, 483 | O(1) queues, linear HOAS), but unable to express others (like `λx.(x x)`). 484 | 485 | ## IC32: a 32-Bit Runtime 486 | 487 | IC32 is implemented in portable C. 488 | 489 | Each Term is represented as a 32-bit word, split into the following fields: 490 | 491 | - sub (1-bit): true if this is a substitution 492 | - tag (5-bit): the tag identifying the term type and label 493 | - val (26-bit): the value, typically a pointer to a node in memory 494 | 495 | The tag field can be one of the following: 496 | 497 | - `VAR`: 0x00 498 | - `LAM`: 0x01 499 | - `APP`: 0x02 500 | - `ERA`: 0x03 501 | - `NUM`: 0x04 502 | - `SUC`: 0x05 503 | - `SWI`: 0x06 504 | - `TMP`: 0x07 505 | - `SP0`: 0x08 506 | - `SP1`: 0x09 507 | - `SP2`: 0x0A 508 | - `SP3`: 0x0B 509 | - `SP4`: 0x0C 510 | - `SP5`: 0x0D 511 | - `SP6`: 0x0E 512 | - `SP7`: 0x0F 513 | - `CX0`: 0x10 514 | - `CX1`: 0x11 515 | - `CX2`: 0x12 516 | - `CX3`: 0x13 517 | - `CX4`: 0x14 518 | - `CX5`: 0x15 519 | - `CX6`: 0x16 520 | - `CX7`: 0x17 521 | - `CY0`: 0x18 522 | - `CY1`: 0x19 523 | - `CY2`: 0x1A 524 | - `CY3`: 0x1B 525 | - `CY4`: 0x1C 526 | - `CY5`: 0x1D 527 | - `CY6`: 0x1E 528 | - `CY7`: 0x1F 529 | 530 | The val field depends on the variant: 531 | 532 | - `VAR`: points to a Lam node ({bod: Term}) or a substitution. 533 | - `LAM`: points to a Lam node ({bod: Term}). 534 | - `APP`: points to an App node ({fun: Term, arg: Term}). 535 | - `ERA`: unused. 536 | - `NUM`: stores an unsigned integer. 537 | - `SUC`: points to a Suc node ({num: Term}) 538 | - `SWI`: points to a Swi node ({num: Term, ifZ: Term, ifS: Term}) 539 | - `SP{L}`: points to a Sup node ({lft: Term, rgt: Term}). 540 | - `CX{L}`: points to a Dup node ({val: Term}) or a substitution. 541 | - `CY{L}`: points to a Dup node ({val: Term}) or a substitution. 542 | 543 | A node is a consecutive block of its child terms. For example, the SUP term 544 | points to the memory location where its two child terms are stored. 545 | 546 | Variable terms (`VAR`, `CX{L}`, and `CY{L}`) point to the location where the 547 | substitution will be placed. As an optimization, that location is always the 548 | location of the corresponding binder node (like a Lam or Dup). When the 549 | interaction occurs, we replace the binder node by the substituted term, with the 550 | 'sub' bit set. Then, when we access it from a variable, we retrieve that term, 551 | clearing the bit. 552 | 553 | On SUPs and DUPs, the 'L' stands for the label of the corresponding node. 554 | 555 | Note that there is no explicit DUP term. That's because Dup nodes are special: 556 | they aren't part of the AST, and they don't store a body; they "float" on the 557 | heap. In other words, `λx. !&0{x0,x1}=x; &0{x0,x1}` and `!&0{x0,x1}=x; λx. 558 | &0{x0,x1}` are both valid, and stored identically in memory. As such, the only 559 | way to access a Dup node is via its bound variables, `CX{L}` and `CY{L}`. 560 | 561 | Before the interaction, the Dup node stores just the duplicated value (no body). 562 | After a collapse is triggered (when we access it via a `CX{L}` or `CY{L}` 563 | variable), the first half of the duplicated term is returned, and the other half 564 | is stored where the Dup node was, allowing the other variable to get it as a 565 | substitution. For example, the DUP-SUP interaction could be implemented as: 566 | 567 | ```python 568 | def dup_sup(dup, sup): 569 | dup_lab = dup.tag & 0x3 570 | sup_lab = sup.tag & 0x3 571 | if dup_lab == sup_lab: 572 | tm0 = heap[sup.loc + 0] 573 | tm1 = heap[sup.loc + 1] 574 | heap[dup.loc] = as_sub(tm1 if (dup.tag & 0x4) == 0 else tm0) 575 | return (tm0 if (dup.tag & 0x4) == 0 else tm1) 576 | else: 577 | co0_loc = alloc(1) 578 | co1_loc = alloc(1) 579 | su0_loc = alloc(2) 580 | su1_loc = alloc(2) 581 | su0_val = Term(SP0 + sup_lab, su0_loc) 582 | su1_val = Term(SP0 + sup_lab, su1_loc) 583 | heap[co0_loc] = heap[sup.loc + 0] 584 | heap[co1_loc] = heap[sup.loc + 1] 585 | heap[su0_loc + 0] = Term(CX0 + dup_lab, co0_loc) 586 | heap[su0_loc + 1] = Term(CX0 + dup_lab, co1_loc) 587 | heap[su1_loc + 0] = Term(CY0 + dup_lab, co0_loc) 588 | heap[su1_loc + 1] = Term(CY0 + dup_lab, co1_loc) 589 | heap[dup.loc] = as_sub(su1_val if (dup.tag & 0x4) == 0 else su0_val) 590 | return (su0_val if (dup.tag & 0x4) == 0 else su1_val) 591 | ``` 592 | 593 | The NUM, SUC and SWI terms extend the IC with unboxed unsigned integers. 594 | 595 | ## Parsing IC32 596 | 597 | On IC32, all bound variables have global range. For example, consider the term: 598 | 599 | λt.((t x) λx.λy.y) 600 | 601 | Here, the `x` variable appears before its binder, `λx`. Since runtime variables 602 | must point to their bound λ's, linking them correctly requires caution. A way to 603 | do it is to store two structures at parse-time: 604 | 605 | 1. lcs: an array from names to locations 606 | 2. vrs: a map from names to var terms 607 | 608 | Whenever we parse a name, we add the current location to the 'uses' array, and 609 | whenever we parse a binder (lams, lets, etc.), we add a variable term pointing 610 | to it to the 'vars' map. Then, once the parsing is done, we run iterate through 611 | the 'uses' array, and write, to each location, the corresponding term. Below 612 | are some example parsers using this strategy: 613 | 614 | ```python 615 | def parse_var(loc): 616 | nam = parse_name() 617 | uses.push((nam,loc)) 618 | 619 | def parse_lam(loc): 620 | lam = alloc(1) 621 | consume("λ") 622 | nam = parse_name() 623 | consume(".") 624 | vars[nam] = Term(VAR, 0, lam) 625 | parse_term(lam) 626 | heap[loc] = Term(LAM, 0, lam) 627 | 628 | def parse_app(loc): 629 | app = alloc(2) 630 | consume("(") 631 | parse_term(app + 0) 632 | consume(" ") 633 | parse_term(app + 1) 634 | consume(")") 635 | heap[loc] = Term(APP, 0, app) 636 | 637 | def parse_sup(loc): 638 | sup = alloc(2) 639 | consume("&") 640 | lab = parse_uint() 641 | consume("{") 642 | lft = parse_term(sup + 0) 643 | consume(",") 644 | rgt = parse_term(sup + 1) 645 | consume("}") 646 | heap[loc] = Term(SUP, lab, sup) 647 | 648 | def parse_dup(loc): 649 | dup = alloc(1) 650 | consume("!") 651 | consume("&") 652 | lab = parse_uint() 653 | consume("{") 654 | co0 = parse_name() 655 | consume(",") 656 | co1 = parse_name() 657 | consume("}") 658 | consume("=") 659 | val = parse_term(dup) 660 | bod = parse_term(loc) 661 | vars[co0] = Term(DP0, lab, loc) 662 | vars[co1] = Term(DP1, lab, loc) 663 | ``` 664 | 665 | ## Stringifying IC32 666 | 667 | Converting IC32 terms to strings faces two challenges: 668 | 669 | First, IC32 terms and nodes don't store variable names. As such, we must 670 | generate fresh, unique variable names during stringification, and maintain a 671 | mapping from each binder's memory location to its assigned name. 672 | 673 | Second, on IC32, Dup nodes aren't part of the main program's AST. Instead, 674 | they "float" on the heap, and are only reachable via DP0 and DP1 variables. 675 | Because of that, by stringifying a term naively, Col nodes will be missing. 676 | 677 | To solve these, we proceed as follows: 678 | 679 | 1. Before stringifying, we pass through the full term, and assign a id to each 680 | variable binder we find (on lam, let, dup, etc.) 681 | 682 | 2. We also register every Dup node we found, avoiding duplicates (remember the 683 | same dup node is pointed to by up to 2 variables, DP0 and DP1) 684 | 685 | Then, to stringify the term, we first stringify each DUP node, and then we 686 | stringify the actual term. As such, the result will always be in the form: 687 | 688 | ```haskell 689 | ! &{x0 x1} = t0 690 | ! &{x2 x3} = t1 691 | ! &{x4 x5} = t2 692 | ... 693 | term 694 | ``` 695 | 696 | With no Dup nodes inside the ASTs of t0, t1, t2 ... and term. 697 | -------------------------------------------------------------------------------- /examples/test_0.ic: -------------------------------------------------------------------------------- 1 | !P19 = λf. 2 | !&0{f0,f1} = f; 3 | !&0{f0,f1} = λx.(f0 (f1 x)); 4 | !&0{f0,f1} = λx.(f0 (f1 x)); 5 | !&0{f0,f1} = λx.(f0 (f1 x)); 6 | !&0{f0,f1} = λx.(f0 (f1 x)); 7 | !&0{f0,f1} = λx.(f0 (f1 x)); 8 | !&0{f0,f1} = λx.(f0 (f1 x)); 9 | !&0{f0,f1} = λx.(f0 (f1 x)); 10 | !&0{f0,f1} = λx.(f0 (f1 x)); 11 | !&0{f0,f1} = λx.(f0 (f1 x)); 12 | !&0{f0,f1} = λx.(f0 (f1 x)); 13 | !&0{f0,f1} = λx.(f0 (f1 x)); 14 | !&0{f0,f1} = λx.(f0 (f1 x)); 15 | !&0{f0,f1} = λx.(f0 (f1 x)); 16 | !&0{f0,f1} = λx.(f0 (f1 x)); 17 | !&0{f0,f1} = λx.(f0 (f1 x)); 18 | !&0{f0,f1} = λx.(f0 (f1 x)); 19 | !&0{f0,f1} = λx.(f0 (f1 x)); 20 | !&0{f0,f1} = λx.(f0 (f1 x)); 21 | λx.(f0 (f1 x)); 22 | 23 | (P19 λnx.((nx λt0.λf0.f0) λt1.λf1.t1) λT.λF.T) 24 | -------------------------------------------------------------------------------- /examples/test_1.ic: -------------------------------------------------------------------------------- 1 | λf. λx. !&0{f0,f1}=f; (f0 (f1 x)) 2 | 3 | //&2{&1{&0{λa.a,λb.b},&0{λc.c,λd.d}},&1{&0{λe.e,λf.f},&0{λg.g,λh.h}}} 4 | 5 | 6 | // _ O _ 7 | // / \ 8 | // _O_ _O_ 9 | // / | | \ 10 | // O O O O 11 | // / \ / \ / \ / \ 12 | // O O O O O O O O 13 | -------------------------------------------------------------------------------- /examples/test_2.ic: -------------------------------------------------------------------------------- 1 | λt.(t λ$x.$y λ$y.$x) 2 | 3 | // λx. !&0{x0,x1}=x; &0{(x0 λa.λb.a),(x1 λt.λf.f)} 4 | 5 | // !&0{x0,x1}=&0{k0,k1}; &0{λk0.(x0 λa.a),λk1.(x1 λb.b)} 6 | 7 | // !&0{x0,x1}=x; λx.&0{(x0 λa.a),(x1 λb.b)} 8 | // ----------------------------------------------------- 9 | // !&0{x0,x1}=&0{k0,k1}; &0{λk0.(x0 λa.a),λk1.(x1 λb.b)} 10 | 11 | // λx.&L{f0,f1} 12 | // ----------------- SUP-LAM 13 | // x <- &L{x0,x1} 14 | // &L{λx0.f0,λx1.f1} 15 | 16 | // CORRECT: 17 | // λt.(t &0{λa.a,λb.b}) 18 | // !&0{t0,t1} = t; λt.&0{(t0 λa.a),(t1 λb.b)} 19 | // !&0{t0,t1} = !&0{T0,T1}; &0{λT0.(t0 λa.a),λT1.(t1 λb.b)} 20 | // &0{λT0.(T0 λa.a),λT1.(T1 λb.b)} 21 | -------------------------------------------------------------------------------- /examples/test_3.ic: -------------------------------------------------------------------------------- 1 | λf.λx.(f (f (f x))) 2 | 3 | //! &0{a3,b4} = x0; (λx0.λx1.((x1 x0) b4) λx2.x2) 4 | 5 | //!P19 = λf. 6 | //!&0{f00x,f00y} = f; 7 | //!&0{f01x,f01y} = λk01.(f00x (f00y k01)); 8 | //!&0{f02x,f02y} = λk02.(f01x (f01y k02)); 9 | //!&0{f03x,f03y} = λk03.(f02x (f02y k03)); 10 | //!&0{f04x,f04y} = λk04.(f03x (f03y k04)); 11 | //!&0{f05x,f05y} = λk05.(f04x (f04y k05)); 12 | //!&0{f06x,f06y} = λk06.(f05x (f05y k06)); 13 | //!&0{f07x,f07y} = λk07.(f06x (f06y k07)); 14 | //!&0{f08x,f08y} = λk08.(f07x (f07y k08)); 15 | //!&0{f09x,f09y} = λk09.(f08x (f08y k09)); 16 | //!&0{f10x,f10y} = λk10.(f09x (f09y k10)); 17 | //!&0{f11x,f11y} = λk11.(f10x (f10y k11)); 18 | //!&0{f12x,f12y} = λk12.(f11x (f11y k12)); 19 | //!&0{f13x,f13y} = λk13.(f12x (f12y k13)); 20 | //!&0{f14x,f14y} = λk14.(f13x (f13y k14)); 21 | //!&0{f15x,f15y} = λk15.(f14x (f14y k15)); 22 | //!&0{f16x,f16y} = λk16.(f15x (f15y k16)); 23 | //!&0{f17x,f17y} = λk17.(f16x (f16y k17)); 24 | //!&0{f18x,f18y} = λk18.(f17x (f17y k18)); 25 | //λk19.(f18x (f18y k19)); 26 | 27 | //((P19 λnx.((nx λt0.λf0.t0) λt1.λf1.f1)) λT.λF.T) 28 | -------------------------------------------------------------------------------- /examples/test_4.ic: -------------------------------------------------------------------------------- 1 | !Y = λf. !&1{f0,f1}=λx.!&1{x0,x1}=x;(f (x0 x1)); (f0 f1); 2 | 3 | !true = λt. λf. t; 4 | !false = λt. λf. f; 5 | 6 | !not = λb. (b false true); 7 | 8 | !neg = (Y λneg. λxs. (xs 9 | λp.λo.λi.λe.(i (neg p)) 10 | λp.λo.λi.λe.(o (neg p)) 11 | λo.λi.λe.e)); 12 | 13 | !xs = 14 | λo.λi.λe.(o 15 | λo.λi.λe.(o 16 | λo.λi.λe.(o 17 | λo.λi.λe.(o 18 | λo.λi.λe.e)))); 19 | 20 | (neg (neg (neg xs))) 21 | -------------------------------------------------------------------------------- /examples/test_5.ic: -------------------------------------------------------------------------------- 1 | // Test switch on superposition - test SUP-SWI-S interaction 2 | λx.?x{0:0;+:&0{1,2};} 3 | 4 | //!&0{a2,b3} = 0; 5 | //&0{λa.?a{0:a2;+:1;},λb.?b{0:b3;+:2;}} 6 | 7 | 8 | //!&0{a2,b3} = 0; 9 | //&0{ 10 | //λa.?b{0:a2;+:1;}, 11 | //λb.?b{0:b3;+:2;} 12 | //} 13 | 14 | 15 | 16 | // ! &0{a1,b2} = 0; 17 | // ! &0{x0,x1} = x; 18 | // λx.&0{?x0{0:a1;+:1;},?x1{0:b2;+:2;}} 19 | 20 | 21 | 22 | 23 | // ! &0{a1,b2} = 0; 24 | // ! &0{x0,x1} = &0{k0,k1}; 25 | // &0{λk0.?x0{0:a1;+:1;},λk1.?x1{0:b2;+:2;}} 26 | 27 | 28 | 29 | 30 | 31 | 32 | -------------------------------------------------------------------------------- /haskell/main.hs: -------------------------------------------------------------------------------- 1 | -- Welcome to the Interaction Calculus Haskell reference implementation! :D This 2 | -- file is very simple, and great for learning. It represents IC terms as native 3 | -- Haskell ADTs, which is possible thanks to the DUP-DUP permutations. 4 | 5 | {-# LANGUAGE MultilineStrings #-} 6 | 7 | import Control.Monad (when) 8 | import Control.Monad.IO.Class (liftIO) 9 | import Data.Char (chr, ord) 10 | import Data.IORef 11 | import Data.Maybe (isJust) 12 | import Data.Word 13 | import Debug.Trace 14 | import System.IO.Unsafe (unsafePerformIO) 15 | import Text.Parsec hiding (State) 16 | import qualified Data.IntMap.Strict as IntMap 17 | import qualified Data.Map as Map 18 | import qualified Text.Parsec as Parsec 19 | 20 | type Name = Word64 21 | 22 | data Term 23 | = Var Name -- Name 24 | | Let Name Term Term -- "! " Name " = " Term "; " Term 25 | | Era -- "*" 26 | | Sup Name Term Term -- "&" Name "{" Term "," Term "}" 27 | | Dup Name Name Name Term Term -- "! &" Name "{" Name "," Name "}" "=" Term ";" Term 28 | | Lam Name Name Term -- "&" Label "λ" Name "." Term 29 | | App Name Term Term -- "&" Label "(" Term " " Term ")" 30 | 31 | -- Globals 32 | -- ------- 33 | 34 | {-# NOINLINE gSUBST #-} 35 | gSUBST :: IORef (IntMap.IntMap Term) 36 | gSUBST = unsafePerformIO $ newIORef IntMap.empty 37 | 38 | {-# NOINLINE gFRESH #-} 39 | gFRESH :: IORef Name 40 | gFRESH = unsafePerformIO $ newIORef 0 41 | 42 | {-# NOINLINE gINTERS #-} 43 | gINTERS :: IORef Word64 44 | gINTERS = unsafePerformIO $ newIORef 0 45 | 46 | -- Helper functions for global substitution 47 | set :: Name -> Term -> IO () 48 | set name term = do 49 | subMap <- readIORef gSUBST 50 | writeIORef gSUBST (IntMap.insert (fromIntegral name) term subMap) 51 | 52 | get :: Name -> IO (Maybe Term) 53 | get name = do 54 | subMap <- readIORef gSUBST 55 | let result = IntMap.lookup (fromIntegral name) subMap 56 | when (isJust result) $ do 57 | let newMap = IntMap.delete (fromIntegral name) subMap 58 | writeIORef gSUBST newMap 59 | return result 60 | 61 | fresh :: IO Name 62 | fresh = do 63 | n <- readIORef gFRESH 64 | writeIORef gFRESH (n + 1) 65 | return n 66 | 67 | incInters :: IO () 68 | incInters = do 69 | n <- readIORef gINTERS 70 | writeIORef gINTERS (n + 1) 71 | 72 | -- Evaluator 73 | -- --------- 74 | 75 | app_era :: Term -> Term -> IO Term 76 | app_era Era _ = do 77 | incInters 78 | return Era 79 | app_era _ _ = error "app_era: expected Era as first argument" 80 | 81 | app_lam :: Term -> Term -> Name -> IO Term 82 | app_lam (Lam lam_lab nam bod) arg app_lab = do 83 | incInters 84 | if lam_lab == app_lab then do 85 | set nam arg 86 | whnf bod 87 | else do 88 | y <- fresh 89 | z <- fresh 90 | set nam (Lam app_lab y (Var z)) 91 | whnf $ Lam lam_lab z (App app_lab bod (App lam_lab arg (Var y))) 92 | app_lam _ _ _ = error "app_lam: expected Lam as first argument" 93 | 94 | app_sup :: Term -> Term -> Name -> IO Term 95 | app_sup (Sup lab lft rgt) arg app_lab = do 96 | incInters 97 | c0 <- fresh 98 | c1 <- fresh 99 | let a0 = App app_lab lft (Var c0) 100 | let a1 = App app_lab rgt (Var c1) 101 | whnf (Dup lab c0 c1 arg (Sup lab a0 a1)) 102 | app_sup _ _ _ = error "app_sup: expected Sup as first argument" 103 | 104 | app_dup :: Term -> IO Term 105 | app_dup (App app_lab f (Dup dup_lab x y val bod)) = do 106 | incInters 107 | whnf (Dup dup_lab x y val (App app_lab f bod)) 108 | app_dup term = error "app_dup: expected App with Dup" 109 | 110 | dup_era :: Term -> Term -> IO Term 111 | dup_era (Dup lab r s _ k) Era = do 112 | incInters 113 | set r Era 114 | set s Era 115 | whnf k 116 | dup_era _ _ = error "dup_era: expected Dup and Era" 117 | 118 | dup_lam :: Term -> Term -> IO Term 119 | dup_lam (Dup lab r s _ k) (Lam lam_lab x f) = do 120 | incInters 121 | x0 <- fresh 122 | x1 <- fresh 123 | f0 <- fresh 124 | f1 <- fresh 125 | set r (Lam lam_lab x0 (Var f0)) 126 | set s (Lam lam_lab x1 (Var f1)) 127 | set x (Sup lab (Var x0) (Var x1)) 128 | whnf (Dup lab f0 f1 f k) 129 | dup_lam _ _ = error "dup_lam: expected Dup and Lam" 130 | 131 | dup_sup :: Term -> Term -> IO Term 132 | dup_sup (Dup dupLab x y _ k) (Sup supLab a b) = do 133 | incInters 134 | if dupLab == supLab then do 135 | set x a 136 | set y b 137 | whnf k 138 | else do 139 | a0 <- fresh 140 | a1 <- fresh 141 | b0 <- fresh 142 | b1 <- fresh 143 | set x (Sup supLab (Var a0) (Var b0)) 144 | set y (Sup supLab (Var a1) (Var b1)) 145 | whnf (Dup dupLab a0 a1 a (Dup dupLab b0 b1 b k)) 146 | dup_sup _ _ = error "dup_sup: expected Dup and Sup" 147 | 148 | dup_dup :: Term -> Term -> IO Term 149 | dup_dup (Dup labL x0 x1 _ t) (Dup labR y0 y1 y x) = do 150 | incInters 151 | whnf (Dup labL x0 x1 x (Dup labL y0 y1 y t)) 152 | dup_dup _ _ = error "dup_dup: expected Dup with inner Dup" 153 | 154 | whnf :: Term -> IO Term 155 | whnf term = case term of 156 | Var n -> do 157 | sub <- get n 158 | case sub of 159 | Just s -> do 160 | whnf s 161 | Nothing -> return (Var n) 162 | Let x v b -> do 163 | set x v 164 | whnf b 165 | App app_lab f a -> do 166 | f' <- whnf f 167 | case f' of 168 | Lam {} -> app_lam f' a app_lab 169 | Sup {} -> app_sup f' a app_lab 170 | Era -> app_era f' a 171 | Dup {} -> app_dup (App app_lab f' a) 172 | _ -> return (App app_lab f' a) 173 | Dup dup_lab r s v k -> do 174 | v' <- whnf v 175 | case v' of 176 | Lam {} -> dup_lam (Dup dup_lab r s v' k) v' 177 | Sup {} -> dup_sup (Dup dup_lab r s v' k) v' 178 | Era -> dup_era (Dup dup_lab r s v' k) v' 179 | Dup {} -> dup_dup (Dup dup_lab r s v' k) v' 180 | _ -> return (Dup dup_lab r s v' k) 181 | _ -> return term 182 | 183 | normal :: Term -> IO Term 184 | normal term = do 185 | term_whnf <- whnf term 186 | case term_whnf of 187 | Var n -> do 188 | return (Var n) 189 | Era -> do 190 | return Era 191 | Lam lab n body -> do 192 | body_norm <- normal body 193 | return (Lam lab n body_norm) 194 | App lab fun arg -> do 195 | fun_norm <- normal fun 196 | arg_norm <- normal arg 197 | return (App lab fun_norm arg_norm) 198 | Sup lab lft rgt -> do 199 | lft_norm <- normal lft 200 | rgt_norm <- normal rgt 201 | return (Sup lab lft_norm rgt_norm) 202 | Dup lab r s v k -> do 203 | v_norm <- normal v 204 | k_norm <- normal k 205 | return (Dup lab r s v_norm k_norm) 206 | 207 | -- Stringifier 208 | -- ----------- 209 | 210 | name :: Name -> String 211 | name k = all !! fromIntegral (k+1) where 212 | all :: [String] 213 | all = [""] ++ concatMap (\str -> map (: str) ['a'..'z']) all 214 | 215 | instance Show Term where 216 | show (Var n) = name n 217 | show (Let x t1 t2) = "! " ++ name x ++ " = " ++ show t1 ++ "; " ++ show t2 218 | show Era = "*" 219 | show (Sup l t1 t2) 220 | | l == 0 = "{" ++ show t1 ++ "," ++ show t2 ++ "}" 221 | | l == 1 = "<" ++ show t1 ++ "," ++ show t2 ++ ">" 222 | | otherwise = "&" ++ show (fromIntegral l :: Int) ++ "{" ++ show t1 ++ "," ++ show t2 ++ "}" 223 | show (Dup l x y t1 t2) 224 | | l == 0 = "! {" ++ name x ++ "," ++ name y ++ "} = " ++ show t1 ++ "; " ++ show t2 225 | | l == 1 = "! <" ++ name x ++ "," ++ name y ++ "> = " ++ show t1 ++ "; " ++ show t2 226 | | otherwise = "! &" ++ show (fromIntegral l :: Int) ++ "{" ++ name x ++ "," ++ name y ++ "} = " ++ show t1 ++ "; " ++ show t2 227 | show (Lam lab x t) 228 | | lab == 0 = "λ" ++ name x ++ "." ++ show t 229 | | lab == 1 = "Λ" ++ name x ++ "." ++ show t 230 | | otherwise = "&" ++ show (fromIntegral lab :: Int) ++ " λ" ++ name x ++ "." ++ show t 231 | show (App lab t1 t2) 232 | | lab == 0 = "(" ++ show t1 ++ " " ++ show t2 ++ ")" 233 | | lab == 1 = "[" ++ show t1 ++ " " ++ show t2 ++ "]" 234 | | otherwise = "&" ++ show (fromIntegral lab :: Int) ++ " (" ++ show t1 ++ " " ++ show t2 ++ ")" 235 | 236 | -- Parser 237 | -- ------ 238 | 239 | type ParserST = Map.Map String Name 240 | type LocalCtx = Map.Map String Name 241 | type Parser a = ParsecT String ParserST IO a 242 | 243 | whiteSpace :: Parser () 244 | whiteSpace = skipMany (space <|> comment) where 245 | comment = do 246 | try (string "//") 247 | skipMany (noneOf "\n\r") 248 | (newline <|> (eof >> return '\n')) 249 | 250 | lexeme :: Parser a -> Parser a 251 | lexeme p = p <* whiteSpace 252 | 253 | symbol :: String -> Parser String 254 | symbol s = lexeme (string s) 255 | 256 | parseNatural :: Parser Integer 257 | parseNatural = lexeme $ read <$> many1 digit 258 | 259 | isGlobal :: String -> Bool 260 | isGlobal name = take 1 name == "$" 261 | 262 | getGlobalName :: String -> Parser Name 263 | getGlobalName gname = do 264 | globalMap <- getState 265 | case Map.lookup gname globalMap of 266 | Just n -> return n 267 | Nothing -> do 268 | n <- liftIO fresh 269 | putState (Map.insert gname n globalMap) 270 | return n 271 | 272 | bindVar :: String -> LocalCtx -> Parser (Name, LocalCtx) 273 | bindVar name ctx 274 | | isGlobal name = do 275 | n <- getGlobalName name 276 | return (n, ctx) 277 | | otherwise = do 278 | n <- liftIO fresh 279 | let ctx' = Map.insert name n ctx 280 | return (n, ctx') 281 | 282 | getVar :: String -> LocalCtx -> Parser Name 283 | getVar name ctx 284 | | isGlobal name = getGlobalName name 285 | | otherwise = case Map.lookup name ctx of 286 | Just n -> return n 287 | Nothing -> fail $ "Unbound local variable: " ++ name 288 | 289 | parseVarName :: Parser String 290 | parseVarName = lexeme $ try (do 291 | char '$' 292 | name <- many1 (alphaNum <|> char '_') 293 | return ("$" ++ name) 294 | ) <|> many1 (alphaNum <|> char '_') 295 | 296 | -- Term parsers 297 | parseTerm :: LocalCtx -> Parser Term 298 | parseTerm ctx 299 | = try (parseApp ctx) 300 | <|> try (parseLet ctx) 301 | <|> try (parseLam ctx) 302 | <|> try (parseSup ctx) 303 | <|> try (parseDup ctx) 304 | <|> parseSimpleTerm ctx 305 | 306 | parseSimpleTerm :: LocalCtx -> Parser Term 307 | parseSimpleTerm ctx 308 | = parseVar ctx 309 | <|> parseEra 310 | <|> between (symbol "(") (symbol ")") (parseTerm ctx) 311 | 312 | parseVar :: LocalCtx -> Parser Term 313 | parseVar ctx = do 314 | name <- parseVarName 315 | n <- getVar name ctx 316 | return $ Var n 317 | 318 | parseLam :: LocalCtx -> Parser Term 319 | parseLam ctx = try (parseLamWithLabel ctx) <|> parseSimpleLam ctx <|> parseCapitalLam ctx 320 | 321 | parseSimpleLam :: LocalCtx -> Parser Term 322 | parseSimpleLam ctx = do 323 | symbol "λ" 324 | name <- parseVarName 325 | (n, ctx') <- bindVar name ctx 326 | symbol "." 327 | body <- parseTerm ctx' 328 | return $ Lam 0 n body 329 | 330 | parseCapitalLam :: LocalCtx -> Parser Term 331 | parseCapitalLam ctx = do 332 | symbol "Λ" 333 | name <- parseVarName 334 | (n, ctx') <- bindVar name ctx 335 | symbol "." 336 | body <- parseTerm ctx' 337 | return $ Lam 1 n body 338 | 339 | parseLamWithLabel :: LocalCtx -> Parser Term 340 | parseLamWithLabel ctx = do 341 | symbol "&" 342 | lab <- fromIntegral <$> parseNatural 343 | symbol "λ" 344 | name <- parseVarName 345 | (n, ctx') <- bindVar name ctx 346 | symbol "." 347 | body <- parseTerm ctx' 348 | return $ Lam lab n body 349 | 350 | parseApp :: LocalCtx -> Parser Term 351 | parseApp ctx = try (parseAppWithLabel ctx) <|> parseSimpleApp ctx <|> parseSquareApp ctx 352 | 353 | parseSimpleApp :: LocalCtx -> Parser Term 354 | parseSimpleApp ctx = between (symbol "(") (symbol ")") $ do 355 | f <- parseTerm ctx 356 | whiteSpace 357 | a <- parseTerm ctx 358 | return $ App 0 f a 359 | 360 | parseSquareApp :: LocalCtx -> Parser Term 361 | parseSquareApp ctx = between (symbol "[") (symbol "]") $ do 362 | f <- parseTerm ctx 363 | whiteSpace 364 | a <- parseTerm ctx 365 | return $ App 1 f a 366 | 367 | parseAppWithLabel :: LocalCtx -> Parser Term 368 | parseAppWithLabel ctx = do 369 | symbol "&" 370 | lab <- fromIntegral <$> parseNatural 371 | between (symbol "(") (symbol ")") $ do 372 | f <- parseTerm ctx 373 | whiteSpace 374 | a <- parseTerm ctx 375 | return $ App lab f a 376 | 377 | parseSup :: LocalCtx -> Parser Term 378 | parseSup ctx = try (parseSupWithLabel ctx) <|> parseSimpleSup ctx <|> parseAngleSup ctx 379 | 380 | parseSimpleSup :: LocalCtx -> Parser Term 381 | parseSimpleSup ctx = between (symbol "{") (symbol "}") $ do 382 | a <- parseTerm ctx 383 | symbol "," 384 | b <- parseTerm ctx 385 | return $ Sup 0 a b 386 | 387 | parseAngleSup :: LocalCtx -> Parser Term 388 | parseAngleSup ctx = between (symbol "<") (symbol ">") $ do 389 | a <- parseTerm ctx 390 | symbol "," 391 | b <- parseTerm ctx 392 | return $ Sup 1 a b 393 | 394 | parseSupWithLabel :: LocalCtx -> Parser Term 395 | parseSupWithLabel ctx = do 396 | symbol "&" 397 | l <- fromIntegral <$> parseNatural 398 | between (symbol "{") (symbol "}") $ do 399 | a <- parseTerm ctx 400 | symbol "," 401 | b <- parseTerm ctx 402 | return $ Sup l a b 403 | 404 | parseDup :: LocalCtx -> Parser Term 405 | parseDup ctx = try (parseDupWithLabel ctx) <|> parseSimpleDup ctx <|> parseAngleDup ctx 406 | 407 | parseSimpleDup :: LocalCtx -> Parser Term 408 | parseSimpleDup ctx = do 409 | symbol "!" 410 | (name1, name2) <- between (symbol "{") (symbol "}") $ do 411 | a <- parseVarName 412 | symbol "," 413 | b <- parseVarName 414 | return (a, b) 415 | symbol "=" 416 | val <- parseTerm ctx 417 | symbol ";" 418 | (n1, ctx') <- bindVar name1 ctx 419 | (n2, ctx'') <- bindVar name2 ctx' 420 | body <- parseTerm ctx'' 421 | return $ Dup 0 n1 n2 val body 422 | 423 | parseAngleDup :: LocalCtx -> Parser Term 424 | parseAngleDup ctx = do 425 | symbol "!" 426 | (name1, name2) <- between (symbol "<") (symbol ">") $ do 427 | a <- parseVarName 428 | symbol "," 429 | b <- parseVarName 430 | return (a, b) 431 | symbol "=" 432 | val <- parseTerm ctx 433 | symbol ";" 434 | (n1, ctx') <- bindVar name1 ctx 435 | (n2, ctx'') <- bindVar name2 ctx' 436 | body <- parseTerm ctx'' 437 | return $ Dup 1 n1 n2 val body 438 | 439 | parseDupWithLabel :: LocalCtx -> Parser Term 440 | parseDupWithLabel ctx = do 441 | symbol "!" 442 | symbol "&" 443 | l <- fromIntegral <$> parseNatural 444 | (name1, name2) <- between (symbol "{") (symbol "}") $ do 445 | a <- parseVarName 446 | symbol "," 447 | b <- parseVarName 448 | return (a, b) 449 | symbol "=" 450 | val <- parseTerm ctx 451 | symbol ";" 452 | (n1, ctx') <- bindVar name1 ctx 453 | (n2, ctx'') <- bindVar name2 ctx' 454 | body <- parseTerm ctx'' 455 | return $ Dup l n1 n2 val body 456 | 457 | parseLet :: LocalCtx -> Parser Term 458 | parseLet ctx = do 459 | symbol "!" 460 | name <- parseVarName 461 | symbol "=" 462 | t1 <- parseTerm ctx 463 | symbol ";" 464 | (n, ctx') <- bindVar name ctx 465 | t2 <- parseTerm ctx' 466 | return $ Let n t1 t2 467 | 468 | parseEra :: Parser Term 469 | parseEra = do 470 | symbol "*" 471 | return Era 472 | 473 | parseIC :: String -> IO (Either ParseError (Term, Map.Map String Name)) 474 | parseIC input = runParserT parser Map.empty "" input where 475 | parser = do 476 | whiteSpace 477 | term <- parseTerm Map.empty 478 | state <- getState 479 | return (term, state) 480 | 481 | doParseIC :: String -> IO Term 482 | doParseIC input = do 483 | result <- parseIC input 484 | case result of 485 | Left err -> error $ show err 486 | Right (term, _) -> return term 487 | 488 | -- Tests 489 | -- ----- 490 | 491 | test_term :: String -> IO () 492 | test_term input = do 493 | term <- doParseIC input 494 | norm <- normal term 495 | inters <- readIORef gINTERS 496 | print norm 497 | putStrLn $ "- WORK: " ++ show inters 498 | 499 | test_ic :: IO () 500 | test_ic = do 501 | 502 | -- (Λt.[t λx.x] λy.y) 503 | test_term $ """ 504 | !F = λf. 505 | !{f0,f1} = f; 506 | !{f0,f1} = λx.(f0 (f1 x)); 507 | !{f0,f1} = λx.(f0 (f1 x)); 508 | !{f0,f1} = λx.(f0 (f1 x)); 509 | !{f0,f1} = λx.(f0 (f1 x)); 510 | !{f0,f1} = λx.(f0 (f1 x)); 511 | !{f0,f1} = λx.(f0 (f1 x)); 512 | !{f0,f1} = λx.(f0 (f1 x)); 513 | !{f0,f1} = λx.(f0 (f1 x)); 514 | λx.(f0 (f1 x)); 515 | ((F λnx.((nx λt0.λf0.f0) λt1.λf1.t1)) λT.λF.T) 516 | """ 517 | inters <- readIORef gINTERS 518 | putStrLn $ "- WORK: " ++ show inters 519 | 520 | main :: IO () 521 | main = test_ic 522 | -------------------------------------------------------------------------------- /haskell/main_debug.hs: -------------------------------------------------------------------------------- 1 | {- README.md -} 2 | 3 | {-# LANGUAGE MultilineStrings #-} 4 | 5 | -- This is like main.hs, but includes a step-by-step debugger. 6 | 7 | import Control.Monad (when) 8 | import Control.Monad.IO.Class (liftIO) 9 | import Data.Char (chr, ord) 10 | import Data.IORef 11 | import Data.Word 12 | import Debug.Trace 13 | import System.IO.Unsafe (unsafePerformIO) 14 | import Text.Parsec hiding (State) 15 | import qualified Data.IntMap.Strict as IntMap 16 | import qualified Data.Map as Map 17 | import qualified Text.Parsec as Parsec 18 | import Data.Maybe (isJust) 19 | 20 | type Name = Word64 21 | 22 | data Term 23 | = Var Name -- Name 24 | | Let Name Term Term -- "! " Name " = " Term "; " Term 25 | | Era -- "*" 26 | | Sup Name Term Term -- "&" Name "{" Term "," Term "}" 27 | | Dup Name Name Name Term Term -- "! &" Name "{" Name "," Name "}" "=" Term ";" Term 28 | | Lam Name Name Term -- "&" Label "λ" Name "." Term 29 | | App Name Term Term -- "&" Label "(" Term " " Term ")" 30 | 31 | -- Globals 32 | -- ------- 33 | 34 | {-# NOINLINE gSUBST #-} 35 | gSUBST :: IORef (IntMap.IntMap Term) 36 | gSUBST = unsafePerformIO $ newIORef IntMap.empty 37 | 38 | {-# NOINLINE gFRESH #-} 39 | gFRESH :: IORef Name 40 | gFRESH = unsafePerformIO $ newIORef 0 41 | 42 | {-# NOINLINE gINTERS #-} 43 | gINTERS :: IORef Word64 44 | gINTERS = unsafePerformIO $ newIORef 0 45 | 46 | {-# NOINLINE gSTOP #-} 47 | gSTOP :: IORef Bool 48 | gSTOP = unsafePerformIO $ newIORef False 49 | 50 | -- Helper functions for global substitution 51 | set :: Name -> Term -> IO () 52 | set name term = do 53 | subMap <- readIORef gSUBST 54 | writeIORef gSUBST (IntMap.insert (fromIntegral name) term subMap) 55 | 56 | get :: Name -> IO (Maybe Term) 57 | get name = do 58 | subMap <- readIORef gSUBST 59 | let result = IntMap.lookup (fromIntegral name) subMap 60 | when (isJust result) $ do 61 | let newMap = IntMap.delete (fromIntegral name) subMap 62 | writeIORef gSUBST newMap 63 | return result 64 | 65 | fresh :: IO Name 66 | fresh = do 67 | n <- readIORef gFRESH 68 | writeIORef gFRESH (n + 1) 69 | return n 70 | 71 | incInters :: IO () 72 | incInters = do 73 | n <- readIORef gINTERS 74 | writeIORef gINTERS (n + 1) 75 | 76 | markReduction :: IO () 77 | markReduction = writeIORef gSTOP True 78 | 79 | hasReduced :: IO Bool 80 | hasReduced = readIORef gSTOP 81 | 82 | resetReduction :: IO () 83 | resetReduction = writeIORef gSTOP False 84 | 85 | -- Function to display the substitution map 86 | showSubst :: IO String 87 | showSubst = do 88 | subMap <- readIORef gSUBST 89 | if IntMap.null subMap 90 | then return "" 91 | else do 92 | let entries = IntMap.toList subMap 93 | let showEntry (k, v) = name (fromIntegral k) ++ " <- " ++ show v 94 | return $ unlines (map showEntry entries) 95 | 96 | -- Evaluator 97 | -- --------- 98 | 99 | app_era :: Term -> Term -> IO Term 100 | app_era Era _ = do 101 | incInters 102 | markReduction 103 | return Era 104 | app_era _ _ = error "app_era: expected Era as first argument" 105 | 106 | app_lam :: Term -> Term -> Name -> IO Term 107 | app_lam (Lam lam_lab nam bod) arg app_lab = do 108 | incInters 109 | markReduction 110 | if lam_lab == app_lab then do 111 | set nam arg 112 | return bod 113 | else do 114 | y <- fresh 115 | z <- fresh 116 | f <- fresh 117 | x <- fresh 118 | v <- fresh 119 | set nam (Lam app_lab y (Var z)) 120 | return $ 121 | (Let f bod 122 | (Let x (App lam_lab arg (Var y)) 123 | (Let v (App app_lab (Var f) (Var x)) 124 | (Lam lam_lab z (Var v))))) 125 | app_lam _ _ _ = error "app_lam: expected Lam as first argument" 126 | 127 | app_sup :: Term -> Term -> Name -> IO Term 128 | app_sup (Sup lab lft rgt) arg app_lab = do 129 | incInters 130 | markReduction 131 | c0 <- fresh 132 | c1 <- fresh 133 | let a0 = App app_lab lft (Var c0) 134 | let a1 = App app_lab rgt (Var c1) 135 | return (Dup lab c0 c1 arg (Sup lab a0 a1)) 136 | app_sup _ _ _ = error "app_sup: expected Sup as first argument" 137 | 138 | app_dup :: Term -> IO Term 139 | app_dup (App app_lab f (Dup dup_lab x y val bod)) = do 140 | incInters 141 | markReduction 142 | return (Dup dup_lab x y val (App app_lab f bod)) 143 | app_dup term = error "app_dup: expected App with Dup" 144 | 145 | dup_era :: Term -> Term -> IO Term 146 | dup_era (Dup lab r s _ k) Era = do 147 | incInters 148 | markReduction 149 | set r Era 150 | set s Era 151 | return k 152 | dup_era _ _ = error "dup_era: expected Dup and Era" 153 | 154 | dup_lam :: Term -> Term -> IO Term 155 | dup_lam (Dup lab r s _ k) (Lam lam_lab x f) = do 156 | incInters 157 | markReduction 158 | x0 <- fresh 159 | x1 <- fresh 160 | f0 <- fresh 161 | f1 <- fresh 162 | set r (Lam lam_lab x0 (Var f0)) 163 | set s (Lam lam_lab x1 (Var f1)) 164 | set x (Sup lab (Var x0) (Var x1)) 165 | return (Dup lab f0 f1 f k) 166 | dup_lam _ _ = error "dup_lam: expected Dup and Lam" 167 | 168 | dup_sup :: Term -> Term -> IO Term 169 | dup_sup (Dup dupLab x y _ k) (Sup supLab a b) = do 170 | incInters 171 | markReduction 172 | if dupLab == supLab then do 173 | set x a 174 | set y b 175 | return k 176 | else do 177 | a0 <- fresh 178 | a1 <- fresh 179 | b0 <- fresh 180 | b1 <- fresh 181 | set x (Sup supLab (Var a0) (Var b0)) 182 | set y (Sup supLab (Var a1) (Var b1)) 183 | return (Dup dupLab a0 a1 a (Dup dupLab b0 b1 b k)) 184 | dup_sup _ _ = error "dup_sup: expected Dup and Sup" 185 | 186 | dup_dup :: Term -> Term -> IO Term 187 | dup_dup (Dup labL x0 x1 _ t) (Dup labR y0 y1 y x) = do 188 | incInters 189 | markReduction 190 | return (Dup labL x0 x1 x (Dup labL y0 y1 y t)) 191 | dup_dup _ _ = error "dup_dup: expected Dup with inner Dup" 192 | 193 | whnf :: Term -> IO Term 194 | whnf term = case term of 195 | Var n -> do 196 | sub <- get n 197 | case sub of 198 | Just s -> do 199 | markReduction 200 | whnf s 201 | Nothing -> return (Var n) 202 | Let x v b -> do 203 | print "LET" 204 | v' <- whnf v 205 | didReduce <- hasReduced 206 | if didReduce then 207 | return (Let x v' b) 208 | else do 209 | set x v' 210 | markReduction 211 | whnf b 212 | App app_lab f a -> do 213 | f' <- whnf f 214 | didReduce <- hasReduced 215 | if didReduce then 216 | return (App app_lab f' a) 217 | else do 218 | print "APP" 219 | case f' of 220 | Lam {} -> app_lam f' a app_lab 221 | Sup {} -> app_sup f' a app_lab 222 | Era -> app_era f' a 223 | Dup {} -> app_dup (App app_lab f' a) 224 | _ -> return (App app_lab f' a) 225 | Dup dup_lab r s v k -> do 226 | print "DUP" 227 | v' <- whnf v 228 | didReduce <- hasReduced 229 | if didReduce then 230 | return (Dup dup_lab r s v' k) 231 | else 232 | case v' of 233 | Lam {} -> dup_lam (Dup dup_lab r s v' k) v' 234 | Sup {} -> dup_sup (Dup dup_lab r s v' k) v' 235 | Era -> dup_era (Dup dup_lab r s v' k) v' 236 | Dup {} -> dup_dup (Dup dup_lab r s v' k) v' 237 | _ -> return (Dup dup_lab r s v' k) 238 | _ -> return term 239 | 240 | -- FIXME: this is ugly, improve 241 | step :: Term -> IO Term 242 | step term = do 243 | resetReduction 244 | term' <- whnf term 245 | didReduce <- hasReduced 246 | if didReduce then 247 | return term' 248 | else do 249 | resetReduction 250 | case term' of 251 | Lam lam_lab x b -> do 252 | b' <- step b 253 | didReduce <- hasReduced 254 | if didReduce then do 255 | markReduction 256 | return (Lam lam_lab x b') 257 | else 258 | return term' 259 | App app_lab f a -> do 260 | f' <- step f 261 | didReduce <- hasReduced 262 | if didReduce then do 263 | markReduction 264 | return (App app_lab f' a) 265 | else do 266 | resetReduction 267 | a' <- step a 268 | didReduce <- hasReduced 269 | if didReduce then do 270 | markReduction 271 | return (App app_lab f a') 272 | else 273 | return term' 274 | Sup sup_lab a b -> do 275 | a' <- step a 276 | didReduce <- hasReduced 277 | if didReduce then do 278 | markReduction 279 | return (Sup sup_lab a' b) 280 | else do 281 | resetReduction 282 | b' <- step b 283 | didReduce <- hasReduced 284 | if didReduce then do 285 | markReduction 286 | return (Sup sup_lab a b') 287 | else 288 | return term' 289 | Dup dup_lab r s v k -> do 290 | v' <- step v 291 | didReduce <- hasReduced 292 | if didReduce then do 293 | markReduction 294 | return (Dup dup_lab r s v' k) 295 | else do 296 | resetReduction 297 | k' <- step k 298 | didReduce <- hasReduced 299 | if didReduce then do 300 | markReduction 301 | return (Dup dup_lab r s v k') 302 | else 303 | return term' 304 | _ -> return term' 305 | 306 | normal :: Term -> IO Term 307 | normal term = do 308 | substStr <- showSubst 309 | putStrLn $ substStr ++ show term 310 | putStrLn $ replicate 40 '-' 311 | term' <- step term 312 | did_reduce <- hasReduced 313 | if did_reduce then 314 | normal term' 315 | else 316 | return term' 317 | 318 | -- Stringifier 319 | -- ----------- 320 | 321 | name :: Name -> String 322 | name k = all !! fromIntegral (k+1) where 323 | all :: [String] 324 | all = [""] ++ concatMap (\str -> map (: str) ['a'..'z']) all 325 | 326 | instance Show Term where 327 | show (Var n) = name n 328 | show (Let x t1 t2) = "! " ++ name x ++ " = " ++ show t1 ++ "; " ++ show t2 329 | show Era = "*" 330 | show (Sup l t1 t2) 331 | | l == 0 = "{" ++ show t1 ++ "," ++ show t2 ++ "}" 332 | | l == 1 = "<" ++ show t1 ++ "," ++ show t2 ++ ">" 333 | | otherwise = "&" ++ show (fromIntegral l :: Int) ++ "{" ++ show t1 ++ "," ++ show t2 ++ "}" 334 | show (Dup l x y t1 t2) 335 | | l == 0 = "! {" ++ name x ++ "," ++ name y ++ "} = " ++ show t1 ++ "; " ++ show t2 336 | | l == 1 = "! <" ++ name x ++ "," ++ name y ++ "> = " ++ show t1 ++ "; " ++ show t2 337 | | otherwise = "! &" ++ show (fromIntegral l :: Int) ++ "{" ++ name x ++ "," ++ name y ++ "} = " ++ show t1 ++ "; " ++ show t2 338 | show (Lam lab x t) 339 | | lab == 0 = "λ" ++ name x ++ "." ++ show t 340 | | lab == 1 = "Λ" ++ name x ++ "." ++ show t 341 | | otherwise = "&" ++ show (fromIntegral lab :: Int) ++ " λ" ++ name x ++ "." ++ show t 342 | show (App lab t1 t2) 343 | | lab == 0 = "(" ++ show t1 ++ " " ++ show t2 ++ ")" 344 | | lab == 1 = "[" ++ show t1 ++ " " ++ show t2 ++ "]" 345 | | otherwise = "&" ++ show (fromIntegral lab :: Int) ++ " (" ++ show t1 ++ " " ++ show t2 ++ ")" 346 | 347 | -- Parser 348 | -- ------ 349 | 350 | type ParserST = Map.Map String Name 351 | type LocalCtx = Map.Map String Name 352 | type Parser a = ParsecT String ParserST IO a 353 | 354 | whiteSpace :: Parser () 355 | whiteSpace = skipMany (space <|> comment) where 356 | comment = do 357 | try (string "//") 358 | skipMany (noneOf "\n\r") 359 | (newline <|> (eof >> return '\n')) 360 | 361 | lexeme :: Parser a -> Parser a 362 | lexeme p = p <* whiteSpace 363 | 364 | symbol :: String -> Parser String 365 | symbol s = lexeme (string s) 366 | 367 | parseNatural :: Parser Integer 368 | parseNatural = lexeme $ read <$> many1 digit 369 | 370 | isGlobal :: String -> Bool 371 | isGlobal name = take 1 name == "$" 372 | 373 | getGlobalName :: String -> Parser Name 374 | getGlobalName gname = do 375 | globalMap <- getState 376 | case Map.lookup gname globalMap of 377 | Just n -> return n 378 | Nothing -> do 379 | n <- liftIO fresh 380 | putState (Map.insert gname n globalMap) 381 | return n 382 | 383 | bindVar :: String -> LocalCtx -> Parser (Name, LocalCtx) 384 | bindVar name ctx 385 | | isGlobal name = do 386 | n <- getGlobalName name 387 | return (n, ctx) 388 | | otherwise = do 389 | n <- liftIO fresh 390 | let ctx' = Map.insert name n ctx 391 | return (n, ctx') 392 | 393 | getVar :: String -> LocalCtx -> Parser Name 394 | getVar name ctx 395 | | isGlobal name = getGlobalName name 396 | | otherwise = case Map.lookup name ctx of 397 | Just n -> return n 398 | Nothing -> fail $ "Unbound local variable: " ++ name 399 | 400 | parseVarName :: Parser String 401 | parseVarName = lexeme $ try (do 402 | char '$' 403 | name <- many1 (alphaNum <|> char '_') 404 | return ("$" ++ name) 405 | ) <|> many1 (alphaNum <|> char '_') 406 | 407 | -- Term parsers 408 | parseTerm :: LocalCtx -> Parser Term 409 | parseTerm ctx 410 | = try (parseApp ctx) 411 | <|> try (parseLet ctx) 412 | <|> try (parseLam ctx) 413 | <|> try (parseSup ctx) 414 | <|> try (parseDup ctx) 415 | <|> parseSimpleTerm ctx 416 | 417 | parseSimpleTerm :: LocalCtx -> Parser Term 418 | parseSimpleTerm ctx 419 | = parseVar ctx 420 | <|> parseEra 421 | <|> between (symbol "(") (symbol ")") (parseTerm ctx) 422 | 423 | parseVar :: LocalCtx -> Parser Term 424 | parseVar ctx = do 425 | name <- parseVarName 426 | n <- getVar name ctx 427 | return $ Var n 428 | 429 | parseLam :: LocalCtx -> Parser Term 430 | parseLam ctx = try (parseLamWithLabel ctx) <|> parseSimpleLam ctx <|> parseCapitalLam ctx 431 | 432 | parseSimpleLam :: LocalCtx -> Parser Term 433 | parseSimpleLam ctx = do 434 | symbol "λ" 435 | name <- parseVarName 436 | (n, ctx') <- bindVar name ctx 437 | symbol "." 438 | body <- parseTerm ctx' 439 | return $ Lam 0 n body 440 | 441 | parseCapitalLam :: LocalCtx -> Parser Term 442 | parseCapitalLam ctx = do 443 | symbol "Λ" 444 | name <- parseVarName 445 | (n, ctx') <- bindVar name ctx 446 | symbol "." 447 | body <- parseTerm ctx' 448 | return $ Lam 1 n body 449 | 450 | parseLamWithLabel :: LocalCtx -> Parser Term 451 | parseLamWithLabel ctx = do 452 | symbol "&" 453 | lab <- fromIntegral <$> parseNatural 454 | symbol "λ" 455 | name <- parseVarName 456 | (n, ctx') <- bindVar name ctx 457 | symbol "." 458 | body <- parseTerm ctx' 459 | return $ Lam lab n body 460 | 461 | parseApp :: LocalCtx -> Parser Term 462 | parseApp ctx = try (parseAppWithLabel ctx) <|> parseSimpleApp ctx <|> parseSquareApp ctx 463 | 464 | parseSimpleApp :: LocalCtx -> Parser Term 465 | parseSimpleApp ctx = between (symbol "(") (symbol ")") $ do 466 | f <- parseTerm ctx 467 | whiteSpace 468 | a <- parseTerm ctx 469 | return $ App 0 f a 470 | 471 | parseSquareApp :: LocalCtx -> Parser Term 472 | parseSquareApp ctx = between (symbol "[") (symbol "]") $ do 473 | f <- parseTerm ctx 474 | whiteSpace 475 | a <- parseTerm ctx 476 | return $ App 1 f a 477 | 478 | parseAppWithLabel :: LocalCtx -> Parser Term 479 | parseAppWithLabel ctx = do 480 | symbol "&" 481 | lab <- fromIntegral <$> parseNatural 482 | between (symbol "(") (symbol ")") $ do 483 | f <- parseTerm ctx 484 | whiteSpace 485 | a <- parseTerm ctx 486 | return $ App lab f a 487 | 488 | parseSup :: LocalCtx -> Parser Term 489 | parseSup ctx = try (parseSupWithLabel ctx) <|> parseSimpleSup ctx <|> parseAngleSup ctx 490 | 491 | parseSimpleSup :: LocalCtx -> Parser Term 492 | parseSimpleSup ctx = between (symbol "{") (symbol "}") $ do 493 | a <- parseTerm ctx 494 | symbol "," 495 | b <- parseTerm ctx 496 | return $ Sup 0 a b 497 | 498 | parseAngleSup :: LocalCtx -> Parser Term 499 | parseAngleSup ctx = between (symbol "<") (symbol ">") $ do 500 | a <- parseTerm ctx 501 | symbol "," 502 | b <- parseTerm ctx 503 | return $ Sup 1 a b 504 | 505 | parseSupWithLabel :: LocalCtx -> Parser Term 506 | parseSupWithLabel ctx = do 507 | symbol "&" 508 | l <- fromIntegral <$> parseNatural 509 | between (symbol "{") (symbol "}") $ do 510 | a <- parseTerm ctx 511 | symbol "," 512 | b <- parseTerm ctx 513 | return $ Sup l a b 514 | 515 | parseDup :: LocalCtx -> Parser Term 516 | parseDup ctx = try (parseDupWithLabel ctx) <|> parseSimpleDup ctx <|> parseAngleDup ctx 517 | 518 | parseSimpleDup :: LocalCtx -> Parser Term 519 | parseSimpleDup ctx = do 520 | symbol "!" 521 | (name1, name2) <- between (symbol "{") (symbol "}") $ do 522 | a <- parseVarName 523 | symbol "," 524 | b <- parseVarName 525 | return (a, b) 526 | symbol "=" 527 | val <- parseTerm ctx 528 | symbol ";" 529 | (n1, ctx') <- bindVar name1 ctx 530 | (n2, ctx'') <- bindVar name2 ctx' 531 | body <- parseTerm ctx'' 532 | return $ Dup 0 n1 n2 val body 533 | 534 | parseAngleDup :: LocalCtx -> Parser Term 535 | parseAngleDup ctx = do 536 | symbol "!" 537 | (name1, name2) <- between (symbol "<") (symbol ">") $ do 538 | a <- parseVarName 539 | symbol "," 540 | b <- parseVarName 541 | return (a, b) 542 | symbol "=" 543 | val <- parseTerm ctx 544 | symbol ";" 545 | (n1, ctx') <- bindVar name1 ctx 546 | (n2, ctx'') <- bindVar name2 ctx' 547 | body <- parseTerm ctx'' 548 | return $ Dup 1 n1 n2 val body 549 | 550 | parseDupWithLabel :: LocalCtx -> Parser Term 551 | parseDupWithLabel ctx = do 552 | symbol "!" 553 | symbol "&" 554 | l <- fromIntegral <$> parseNatural 555 | (name1, name2) <- between (symbol "{") (symbol "}") $ do 556 | a <- parseVarName 557 | symbol "," 558 | b <- parseVarName 559 | return (a, b) 560 | symbol "=" 561 | val <- parseTerm ctx 562 | symbol ";" 563 | (n1, ctx') <- bindVar name1 ctx 564 | (n2, ctx'') <- bindVar name2 ctx' 565 | body <- parseTerm ctx'' 566 | return $ Dup l n1 n2 val body 567 | 568 | parseLet :: LocalCtx -> Parser Term 569 | parseLet ctx = do 570 | symbol "!" 571 | name <- parseVarName 572 | symbol "=" 573 | t1 <- parseTerm ctx 574 | symbol ";" 575 | (n, ctx') <- bindVar name ctx 576 | t2 <- parseTerm ctx' 577 | return $ Let n t1 t2 578 | 579 | parseEra :: Parser Term 580 | parseEra = do 581 | symbol "*" 582 | return Era 583 | 584 | parseIC :: String -> IO (Either ParseError (Term, Map.Map String Name)) 585 | parseIC input = runParserT parser Map.empty "" input where 586 | parser = do 587 | whiteSpace 588 | term <- parseTerm Map.empty 589 | state <- getState 590 | return (term, state) 591 | 592 | doParseIC :: String -> IO Term 593 | doParseIC input = do 594 | result <- parseIC input 595 | case result of 596 | Left err -> error $ show err 597 | Right (term, _) -> return term 598 | 599 | -- Tests 600 | -- ----- 601 | 602 | test_term :: String -> IO () 603 | test_term input = do 604 | term <- doParseIC input 605 | _ <- normal term 606 | inters <- readIORef gINTERS 607 | putStrLn $ "- WORK: " ++ show inters 608 | 609 | test_ic :: IO () 610 | test_ic = do 611 | 612 | test_term $ """ 613 | !F = λf. 614 | !{f0,f1} = f; 615 | !{f0,f1} = λx.(f0 (f1 x)); 616 | λx.(f0 (f1 x)); 617 | ((F λnx.((nx λt0.λf0.f0) λt1.λf1.t1)) λT.λF.T) 618 | """ 619 | inters <- readIORef gINTERS 620 | putStrLn $ "- WORK: " ++ show inters 621 | 622 | main :: IO () 623 | main = test_ic 624 | -------------------------------------------------------------------------------- /src/collapse.c: -------------------------------------------------------------------------------- 1 | //./../IC.md// 2 | //./ic.h// 3 | //./collapse.h// 4 | 5 | // This is a WIP 6 | 7 | #include "ic.h" 8 | #include "collapse.h" 9 | #include "show.h" 10 | 11 | // ----------------------------------------------------------------------------- 12 | // Collapse Interactions 13 | // ----------------------------------------------------------------------------- 14 | 15 | // λx.* 16 | // ------ ERA-LAM 17 | // x <- * 18 | // * 19 | static inline Term ic_era_lam(IC* ic, Term lam, Term era) { 20 | ic->interactions++; 21 | 22 | Val lam_loc = TERM_VAL(lam); 23 | 24 | // Set substitution for x to an erasure 25 | ic->heap[lam_loc] = ic_make_sub(ic_make_era()); 26 | 27 | // Return an erasure 28 | return ic_make_era(); 29 | } 30 | 31 | // (f *) 32 | // ----- ERA-APP 33 | // * 34 | static inline Term ic_era_app(IC* ic, Term app, Term era) { 35 | ic->interactions++; 36 | 37 | // Return an erasure 38 | return ic_make_era(); 39 | } 40 | 41 | // λx.&L{f0,f1} 42 | // ----------------- SUP-LAM 43 | // x <- &L{x0,x1} 44 | // &L{λx0.f0,λx1.f1} 45 | static inline Term ic_sup_lam(IC* ic, Term lam, Term sup) { 46 | ic->interactions++; 47 | 48 | Val lam_loc = TERM_VAL(lam); 49 | Val sup_loc = TERM_VAL(sup); 50 | Lab sup_lab = TERM_LAB(sup); 51 | Term f0 = ic->heap[sup_loc + 0]; 52 | Term f1 = ic->heap[sup_loc + 1]; 53 | 54 | // Allocate two new LAM nodes 55 | Val lam0_loc = ic_alloc(ic, 1); 56 | Val lam1_loc = ic_alloc(ic, 1); 57 | ic->heap[lam0_loc + 0] = f0; 58 | ic->heap[lam1_loc + 0] = f1; 59 | 60 | // Create variables x0 and x1 pointing to lam0 and lam1 61 | Term x0 = ic_make_term(VAR, 0, lam0_loc); 62 | Term x1 = ic_make_term(VAR, 0, lam1_loc); 63 | 64 | // Create the new SUP &L{x0,x1} 65 | Val new_sup_loc = ic_alloc(ic, 2); 66 | ic->heap[new_sup_loc + 0] = x0; 67 | ic->heap[new_sup_loc + 1] = x1; 68 | Term new_sup = ic_make_sup(sup_lab, new_sup_loc); 69 | 70 | // Set substitution for x (original LAM variable) 71 | ic->heap[lam_loc] = ic_make_sub(new_sup); 72 | 73 | // Create the result SUP &L{lam0, lam1} 74 | Term lam0_term = ic_make_term(LAM, 0, lam0_loc); 75 | Term lam1_term = ic_make_term(LAM, 0, lam1_loc); 76 | Val result_sup_loc = ic_alloc(ic, 2); 77 | ic->heap[result_sup_loc + 0] = lam0_term; 78 | ic->heap[result_sup_loc + 1] = lam1_term; 79 | return ic_make_sup(sup_lab, result_sup_loc); 80 | } 81 | 82 | // (f &L{x0,x1}) 83 | // ------------------- SUP-APP 84 | // !&L{f0,f1} = f 85 | // &L{(f0 x0),(f1 x1)} 86 | static inline Term ic_sup_app(IC* ic, Term app, Term sup) { 87 | ic->interactions++; 88 | 89 | Val app_loc = TERM_VAL(app); 90 | Lab sup_lab = TERM_LAB(sup); 91 | Term fun = ic->heap[app_loc + 0]; 92 | Val sup_loc = TERM_VAL(sup); 93 | Term lft = ic->heap[sup_loc + 0]; 94 | Term rgt = ic->heap[sup_loc + 1]; 95 | 96 | // Allocate DUP node for fun 97 | Val dup_loc = ic_alloc(ic, 1); 98 | ic->heap[dup_loc] = fun; 99 | 100 | // Create f0 and f1 101 | Term f0 = ic_make_co0(sup_lab, dup_loc); 102 | Term f1 = ic_make_co1(sup_lab, dup_loc); 103 | 104 | // Create app0 = (f0 lft) 105 | Val app0_loc = ic_alloc(ic, 2); 106 | ic->heap[app0_loc + 0] = f0; 107 | ic->heap[app0_loc + 1] = lft; 108 | Term app0 = ic_make_term(APP, 0, app0_loc); 109 | 110 | // Create app1 = (f1 rgt) 111 | Val app1_loc = ic_alloc(ic, 2); 112 | ic->heap[app1_loc + 0] = f1; 113 | ic->heap[app1_loc + 1] = rgt; 114 | Term app1 = ic_make_term(APP, 0, app1_loc); 115 | 116 | // Create result SUP &L{app0, app1} 117 | Val result_sup_loc = ic_alloc(ic, 2); 118 | ic->heap[result_sup_loc + 0] = app0; 119 | ic->heap[result_sup_loc + 1] = app1; 120 | return ic_make_sup(sup_lab, result_sup_loc); 121 | } 122 | 123 | // &R{&L{x0,x1},y} 124 | // ----------------------- SUP-SUP-X (if R>L) 125 | // !&R{y0,y1} = y; 126 | // &L{&R{x0,x1},&R{y0,y1}} 127 | static inline Term ic_sup_sup_x(IC* ic, Term outer_sup, Term inner_sup) { 128 | ic->interactions++; 129 | 130 | Val outer_sup_loc = TERM_VAL(outer_sup); 131 | Lab outer_lab = TERM_LAB(outer_sup); 132 | Val inner_sup_loc = TERM_VAL(inner_sup); 133 | Lab inner_lab = TERM_LAB(inner_sup); 134 | Term x0 = ic->heap[inner_sup_loc + 0]; 135 | Term x1 = ic->heap[inner_sup_loc + 1]; 136 | Term y = ic->heap[outer_sup_loc + 1]; 137 | 138 | // Allocate DUP node for y with label outer_lab 139 | Val dup_loc = ic_alloc(ic, 1); 140 | ic->heap[dup_loc] = y; 141 | 142 | // Create y0 and y1 with label outer_lab 143 | Term y0 = ic_make_co0(outer_lab, dup_loc); 144 | Term y1 = ic_make_co1(outer_lab, dup_loc); 145 | 146 | // Create sup0 = &outer_lab{x0, y0} 147 | Val sup0_loc = ic_alloc(ic, 2); 148 | ic->heap[sup0_loc + 0] = x0; 149 | ic->heap[sup0_loc + 1] = y0; 150 | Term sup0 = ic_make_sup(outer_lab, sup0_loc); 151 | 152 | // Create sup1 = &outer_lab{x1, y1} 153 | Val sup1_loc = ic_alloc(ic, 2); 154 | ic->heap[sup1_loc + 0] = x1; 155 | ic->heap[sup1_loc + 1] = y1; 156 | Term sup1 = ic_make_sup(outer_lab, sup1_loc); 157 | 158 | // Create result SUP &inner_lab{sup0, sup1} 159 | Val result_sup_loc = ic_alloc(ic, 2); 160 | ic->heap[result_sup_loc + 0] = sup0; 161 | ic->heap[result_sup_loc + 1] = sup1; 162 | return ic_make_sup(inner_lab, result_sup_loc); 163 | } 164 | 165 | // &R{x,&L{y0,y1}} 166 | // ----------------------- SUP-SUP-Y (if R>L) 167 | // !&R{x0,x1} = x; 168 | // &L{&R{x0,x1},&R{y0,y1}} 169 | static inline Term ic_sup_sup_y(IC* ic, Term outer_sup, Term inner_sup) { 170 | ic->interactions++; 171 | 172 | Val outer_sup_loc = TERM_VAL(outer_sup); 173 | Lab outer_lab = TERM_LAB(outer_sup); 174 | Val inner_sup_loc = TERM_VAL(inner_sup); 175 | Lab inner_lab = TERM_LAB(inner_sup); 176 | Term x = ic->heap[outer_sup_loc + 0]; 177 | Term y0 = ic->heap[inner_sup_loc + 0]; 178 | Term y1 = ic->heap[inner_sup_loc + 1]; 179 | 180 | // Allocate DUP node for x with label outer_lab 181 | Val dup_loc = ic_alloc(ic, 1); 182 | ic->heap[dup_loc] = x; 183 | 184 | // Create x0 and x1 with label outer_lab 185 | Term x0 = ic_make_co0(outer_lab, dup_loc); 186 | Term x1 = ic_make_co1(outer_lab, dup_loc); 187 | 188 | // Create sup0 = &outer_lab{x0, y0} 189 | Val sup0_loc = ic_alloc(ic, 2); 190 | ic->heap[sup0_loc + 0] = x0; 191 | ic->heap[sup0_loc + 1] = y0; 192 | Term sup0 = ic_make_sup(outer_lab, sup0_loc); 193 | 194 | // Create sup1 = &outer_lab{x1, y1} 195 | Val sup1_loc = ic_alloc(ic, 2); 196 | ic->heap[sup1_loc + 0] = x1; 197 | ic->heap[sup1_loc + 1] = y1; 198 | Term sup1 = ic_make_sup(outer_lab, sup1_loc); 199 | 200 | // Create result SUP &inner_lab{sup0, sup1} 201 | Val result_sup_loc = ic_alloc(ic, 2); 202 | ic->heap[result_sup_loc + 0] = sup0; 203 | ic->heap[result_sup_loc + 1] = sup1; 204 | return ic_make_sup(inner_lab, result_sup_loc); 205 | } 206 | 207 | // !&L{x0,x1} = x; K 208 | // ----------------- DUP-VAR 209 | // x0 <- x 210 | // x1 <- x 211 | // K 212 | static inline Term ic_dup_var(IC* ic, Term dup, Term var) { 213 | ic->interactions++; 214 | Val dup_loc = TERM_VAL(dup); 215 | ic->heap[dup_loc] = ic_make_sub(var); 216 | return var; 217 | } 218 | 219 | // !&L{a0,a1} = (f x); K 220 | // --------------------- DUP-APP 221 | // a0 <- (f0 x0) 222 | // a1 <- (f1 x1) 223 | // !&L{f0,f1} = f; 224 | // !&L{x0,x1} = x; 225 | // K 226 | static inline Term ic_dup_app(IC* ic, Term dup, Term app) { 227 | ic->interactions++; 228 | 229 | Val dup_loc = TERM_VAL(dup); 230 | Lab lab = TERM_LAB(dup); 231 | TermTag tag = TERM_TAG(dup); 232 | bool is_co0 = IS_DP0(tag); 233 | 234 | Val app_loc = TERM_VAL(app); 235 | Term fun = ic->heap[app_loc + 0]; 236 | Term arg = ic->heap[app_loc + 1]; 237 | 238 | // Allocate DUP nodes for fun and arg 239 | Val dup_fun_loc = ic_alloc(ic, 1); 240 | ic->heap[dup_fun_loc] = fun; 241 | Val dup_arg_loc = ic_alloc(ic, 1); 242 | ic->heap[dup_arg_loc] = arg; 243 | 244 | // Create DP0 and DP1 for fun 245 | Term f0 = ic_make_co0(lab, dup_fun_loc); 246 | Term f1 = ic_make_co1(lab, dup_fun_loc); 247 | 248 | // Create DP0 and DP1 for arg 249 | Term x0 = ic_make_co0(lab, dup_arg_loc); 250 | Term x1 = ic_make_co1(lab, dup_arg_loc); 251 | 252 | // Create app0 = (f0 x0) 253 | Val app0_loc = ic_alloc(ic, 2); 254 | ic->heap[app0_loc + 0] = f0; 255 | ic->heap[app0_loc + 1] = x0; 256 | Term app0 = ic_make_term(APP, 0, app0_loc); 257 | 258 | // Create app1 = (f1 x1) 259 | Val app1_loc = ic_alloc(ic, 2); 260 | ic->heap[app1_loc + 0] = f1; 261 | ic->heap[app1_loc + 1] = x1; 262 | Term app1 = ic_make_term(APP, 0, app1_loc); 263 | 264 | // Set substitution and return 265 | if (is_co0) { 266 | ic->heap[dup_loc] = ic_make_sub(app1); 267 | return app0; 268 | } else { 269 | ic->heap[dup_loc] = ic_make_sub(app0); 270 | return app1; 271 | } 272 | } 273 | 274 | // ~N{0:&L{z0,z1};+:s;} 275 | // --------------------------------- SUP-SWI-Z 276 | // !&L{N0,N1} = N; 277 | // !&L{S0,S1} = S; 278 | // &L{~N0{0:z0;+:S0},~N1{0:z1;+:S1}} 279 | static inline Term ic_sup_swi_z(IC* ic, Term swi, Term sup) { 280 | ic->interactions++; 281 | 282 | Val swi_loc = TERM_VAL(swi); 283 | Val sup_loc = TERM_VAL(sup); 284 | Lab sup_lab = TERM_LAB(sup); 285 | 286 | Term num = ic->heap[swi_loc + 0]; 287 | Term z0 = ic->heap[sup_loc + 0]; 288 | Term z1 = ic->heap[sup_loc + 1]; 289 | Term s = ic->heap[swi_loc + 2]; 290 | 291 | // Create duplications for num and s 292 | Val dup_n_loc = ic_alloc(ic, 1); 293 | Val dup_s_loc = ic_alloc(ic, 1); 294 | 295 | ic->heap[dup_n_loc] = num; 296 | ic->heap[dup_s_loc] = s; 297 | 298 | Term n0 = ic_make_co0(sup_lab, dup_n_loc); 299 | Term n1 = ic_make_co1(sup_lab, dup_n_loc); 300 | Term s0 = ic_make_co0(sup_lab, dup_s_loc); 301 | Term s1 = ic_make_co1(sup_lab, dup_s_loc); 302 | 303 | // Create switch nodes for each branch 304 | Val swi0_loc = ic_alloc(ic, 3); 305 | ic->heap[swi0_loc + 0] = n0; 306 | ic->heap[swi0_loc + 1] = z0; 307 | ic->heap[swi0_loc + 2] = s0; 308 | 309 | Val swi1_loc = ic_alloc(ic, 3); 310 | ic->heap[swi1_loc + 0] = n1; 311 | ic->heap[swi1_loc + 1] = z1; 312 | ic->heap[swi1_loc + 2] = s1; 313 | 314 | // Create the resulting superposition 315 | Val res_loc = ic_alloc(ic, 2); 316 | ic->heap[res_loc + 0] = ic_make_term(SWI, 0, swi0_loc); 317 | ic->heap[res_loc + 1] = ic_make_term(SWI, 0, swi1_loc); 318 | 319 | return ic_make_sup(sup_lab, res_loc); 320 | } 321 | 322 | // ~N{0:z;+:&0{s0,s1};} 323 | // --------------------------------- SUP-SWI-S 324 | // !&L{N0,N1} = N; 325 | // !&L{Z0,Z1} = Z; 326 | // &L{~N0{0:z0;+:S0},~N1{0:z1;+:S1}} 327 | static inline Term ic_sup_swi_s(IC* ic, Term swi, Term sup) { 328 | ic->interactions++; 329 | 330 | Val swi_loc = TERM_VAL(swi); 331 | Val sup_loc = TERM_VAL(sup); 332 | Lab sup_lab = TERM_LAB(sup); 333 | 334 | Term num = ic->heap[swi_loc + 0]; 335 | Term z = ic->heap[swi_loc + 1]; 336 | Term s0 = ic->heap[sup_loc + 0]; 337 | Term s1 = ic->heap[sup_loc + 1]; 338 | 339 | // Create duplications for num and z 340 | Val dup_n_loc = ic_alloc(ic, 1); 341 | Val dup_z_loc = ic_alloc(ic, 1); 342 | 343 | ic->heap[dup_n_loc] = num; 344 | ic->heap[dup_z_loc] = z; 345 | 346 | Term n0 = ic_make_co0(sup_lab, dup_n_loc); 347 | Term n1 = ic_make_co1(sup_lab, dup_n_loc); 348 | Term z0 = ic_make_co0(sup_lab, dup_z_loc); 349 | Term z1 = ic_make_co1(sup_lab, dup_z_loc); 350 | 351 | // Create switch nodes for each branch 352 | Val swi0_loc = ic_alloc(ic, 3); 353 | ic->heap[swi0_loc + 0] = n0; 354 | ic->heap[swi0_loc + 1] = z0; 355 | ic->heap[swi0_loc + 2] = s0; 356 | 357 | Val swi1_loc = ic_alloc(ic, 3); 358 | ic->heap[swi1_loc + 0] = n1; 359 | ic->heap[swi1_loc + 1] = z1; 360 | ic->heap[swi1_loc + 2] = s1; 361 | 362 | // Create the resulting superposition 363 | Val res_loc = ic_alloc(ic, 2); 364 | ic->heap[res_loc + 0] = ic_make_term(SWI, 0, swi0_loc); 365 | ic->heap[res_loc + 1] = ic_make_term(SWI, 0, swi1_loc); 366 | 367 | return ic_make_sup(sup_lab, res_loc); 368 | } 369 | 370 | // ----------------------------------------------------------------------------- 371 | // Collapser 372 | // ----------------------------------------------------------------------------- 373 | 374 | Term ic_collapse_sups(IC* ic, Term term) { 375 | TermTag tag; 376 | Lab lab; 377 | Val loc; 378 | 379 | term = ic_whnf(ic, term); 380 | tag = TERM_TAG(term); 381 | lab = TERM_LAB(term); 382 | loc = TERM_VAL(term); 383 | 384 | if (tag == LAM) { 385 | ic->heap[loc+0] = ic_collapse_sups(ic, ic->heap[loc+0]); 386 | } else if (tag == APP) { 387 | ic->heap[loc+0] = ic_collapse_sups(ic, ic->heap[loc+0]); 388 | ic->heap[loc+1] = ic_collapse_sups(ic, ic->heap[loc+1]); 389 | } else if (IS_SUP(tag)) { 390 | ic->heap[loc+0] = ic_collapse_sups(ic, ic->heap[loc+0]); 391 | ic->heap[loc+1] = ic_collapse_sups(ic, ic->heap[loc+1]); 392 | } 393 | 394 | term = ic_whnf(ic, term); 395 | tag = TERM_TAG(term); 396 | lab = TERM_LAB(term); 397 | loc = TERM_VAL(term); 398 | 399 | if (tag == LAM) { 400 | Term bod_col = ic->heap[loc+0]; 401 | if (IS_SUP(TERM_TAG(bod_col))) { 402 | //printf(">> SUP-LAM\n"); 403 | return ic_collapse_sups(ic, ic_sup_lam(ic, term, bod_col)); 404 | } else if (ic_is_era(bod_col)) { 405 | //printf(">> ERA-LAM\n"); 406 | return ic_collapse_sups(ic, ic_era_lam(ic, term, bod_col)); 407 | } 408 | } else if (tag == APP) { 409 | Term fun_col = ic->heap[loc+0]; 410 | Term arg_col = ic->heap[loc+1]; 411 | if (IS_SUP(TERM_TAG(arg_col))) { 412 | //printf(">> SUP-APP\n"); 413 | return ic_collapse_sups(ic, ic_sup_app(ic, term, arg_col)); 414 | } else if (ic_is_era(arg_col)) { 415 | //printf(">> ERA-APP\n"); 416 | return ic_collapse_sups(ic, ic_era_app(ic, term, arg_col)); 417 | } 418 | } else if (IS_SUP(tag)) { 419 | Term lft_col = ic->heap[loc+0]; 420 | Term rgt_col = ic->heap[loc+1]; 421 | if (IS_SUP(TERM_TAG(lft_col)) && lab > TERM_LAB(lft_col)) { 422 | //printf(">> SUP-SUP-X\n"); 423 | return ic_collapse_sups(ic, ic_sup_sup_x(ic, term, lft_col)); 424 | } else if (IS_SUP(TERM_TAG(rgt_col)) && lab > TERM_LAB(rgt_col)) { 425 | //printf(">> SUP-SUP-Y\n"); 426 | return ic_collapse_sups(ic, ic_sup_sup_y(ic, term, rgt_col)); 427 | } 428 | } else if (tag == SWI) { 429 | Term num = ic->heap[loc+0]; 430 | Term ifz = ic->heap[loc+1]; 431 | Term ifs = ic->heap[loc+2]; 432 | 433 | if (IS_SUP(TERM_TAG(ifz))) { 434 | //printf(">> SUP-SWI-Z\n"); 435 | return ic_collapse_sups(ic, ic_sup_swi_z(ic, term, ifz)); 436 | } else if (IS_SUP(TERM_TAG(ifs))) { 437 | //printf(">> SUP-SWI-S\n"); 438 | return ic_collapse_sups(ic, ic_sup_swi_s(ic, term, ifs)); 439 | } 440 | } 441 | 442 | return term; 443 | } 444 | 445 | Term ic_collapse_dups(IC* ic, Term term) { 446 | term = ic_whnf(ic, term); 447 | TermTag tag = TERM_TAG(term); 448 | Val loc = TERM_VAL(term); 449 | if (IS_DUP(tag)) { 450 | // Get the value this collapser points to 451 | Term val = ic_collapse_dups(ic, ic->heap[loc]); 452 | TermTag val_tag = TERM_TAG(val); 453 | if (val_tag == VAR) { 454 | //printf(">> DUP-VAR\n"); 455 | return ic_collapse_dups(ic, ic_dup_var(ic, term, val)); 456 | } else if (val_tag == APP) { 457 | //printf(">> DUP-APP\n"); 458 | return ic_collapse_dups(ic, ic_dup_app(ic, term, val)); 459 | } else if (ic_is_era(val)) { 460 | //printf(">> DUP-ERA\n"); 461 | return ic_collapse_dups(ic, ic_dup_era(ic, term, val)); 462 | } else { 463 | return term; 464 | } 465 | } else if (tag == LAM) { 466 | ic->heap[loc+0] = ic_collapse_dups(ic, ic->heap[loc+0]); 467 | return term; 468 | } else if (tag == APP) { 469 | ic->heap[loc+0] = ic_collapse_dups(ic, ic->heap[loc+0]); 470 | ic->heap[loc+1] = ic_collapse_dups(ic, ic->heap[loc+1]); 471 | return term; 472 | } else if (IS_SUP(tag)) { 473 | ic->heap[loc+0] = ic_collapse_dups(ic, ic->heap[loc+0]); 474 | ic->heap[loc+1] = ic_collapse_dups(ic, ic->heap[loc+1]); 475 | return term; 476 | } else if (tag == SUC) { 477 | ic->heap[loc] = ic_collapse_dups(ic, ic->heap[loc]); 478 | return term; 479 | } else if (tag == SWI) { 480 | ic->heap[loc+0] = ic_collapse_dups(ic, ic->heap[loc+0]); 481 | ic->heap[loc+1] = ic_collapse_dups(ic, ic->heap[loc+1]); 482 | ic->heap[loc+2] = ic_collapse_dups(ic, ic->heap[loc+2]); 483 | return term; 484 | } else if (ic_is_era(term) || tag == NUM) { 485 | // ERA and NUM have no children, so just return them 486 | return term; 487 | } else { 488 | return term; 489 | } 490 | } 491 | -------------------------------------------------------------------------------- /src/collapse.h: -------------------------------------------------------------------------------- 1 | //./collapse.c// 2 | 3 | #ifndef IC_COLLAPSE_H 4 | #define IC_COLLAPSE_H 5 | 6 | #include "ic.h" 7 | 8 | static inline Term ic_era_lam(IC* ic, Term lam, Term era); 9 | static inline Term ic_era_app(IC* ic, Term app, Term era); 10 | static inline Term ic_sup_lam(IC* ic, Term lam, Term sup); 11 | static inline Term ic_sup_app(IC* ic, Term app, Term sup); 12 | static inline Term ic_sup_sup_x(IC* ic, Term outer_sup, Term inner_sup); 13 | static inline Term ic_sup_sup_y(IC* ic, Term outer_sup, Term inner_sup); 14 | static inline Term ic_dup_var(IC* ic, Term dup, Term var); 15 | static inline Term ic_dup_app(IC* ic, Term dup, Term app); 16 | 17 | // Numeric collapse operations 18 | static inline Term ic_sup_swi_z(IC* ic, Term swi, Term sup); 19 | static inline Term ic_sup_swi_s(IC* ic, Term swi, Term sup); 20 | 21 | Term ic_collapse_sups(IC* ic, Term term); 22 | Term ic_collapse_dups(IC* ic, Term term); 23 | 24 | #endif // IC_COLLAPSE_H 25 | -------------------------------------------------------------------------------- /src/ic.c: -------------------------------------------------------------------------------- 1 | #include "ic.h" 2 | 3 | // ----------------------------------------------------------------------------- 4 | // Memory Management Functions 5 | // ----------------------------------------------------------------------------- 6 | 7 | // Create a new IC context with the specified heap and stack sizes. 8 | // @param heap_size Number of terms in the heap 9 | // @param stack_size Number of terms in the stack 10 | // @return A new IC context or NULL if allocation failed 11 | inline IC* ic_new(Val heap_size, Val stack_size) { 12 | IC* ic = (IC*)malloc(sizeof(IC)); 13 | if (!ic) return NULL; 14 | 15 | // Initialize structure 16 | ic->heap_size = heap_size; 17 | ic->stack_size = stack_size; 18 | ic->heap_pos = 0; 19 | ic->interactions = 0; 20 | ic->stack_pos = 0; 21 | 22 | // Allocate heap and stack 23 | ic->heap = (Term*)calloc(heap_size, sizeof(Term)); 24 | ic->stack = (Term*)malloc(stack_size * sizeof(Term)); 25 | 26 | if (!ic->heap || !ic->stack) { 27 | ic_free(ic); 28 | return NULL; 29 | } 30 | 31 | return ic; 32 | } 33 | 34 | // Create a new IC context with default heap and stack sizes. 35 | // @return A new IC context or NULL if allocation failed 36 | inline IC* ic_default_new() { 37 | return ic_new(IC_DEFAULT_HEAP_SIZE, IC_DEFAULT_STACK_SIZE); 38 | } 39 | 40 | // Free all resources associated with an IC context. 41 | // @param ic The IC context to free 42 | inline void ic_free(IC* ic) { 43 | if (!ic) return; 44 | 45 | if (ic->heap) free(ic->heap); 46 | if (ic->stack) free(ic->stack); 47 | 48 | free(ic); 49 | } 50 | 51 | // Allocate n consecutive terms in memory. 52 | // @param ic The IC context 53 | // @param n Number of terms to allocate 54 | // @return Location in the heap 55 | // Does NOT bound check. We'll add a less frequent checker elsewhere. 56 | inline Val ic_alloc(IC* ic, Val n) { 57 | Val ptr = ic->heap_pos; 58 | ic->heap_pos += n; 59 | return ptr; 60 | } 61 | 62 | // ----------------------------------------------------------------------------- 63 | // Term Manipulation Functions 64 | // ----------------------------------------------------------------------------- 65 | 66 | // Create a term with the given tag and value. 67 | // @param tag Term type tag (includes label for SUP, CX, CY) 68 | // @param val Value/pointer into the heap 69 | // @return The constructed term 70 | inline Term ic_make_term(TermTag tag, Lab lab, Val val) { 71 | return MAKE_TERM(false, tag, lab, val); 72 | } 73 | 74 | // Create a substitution term. 75 | // @param term The term to convert to a substitution 76 | // @return The term with its substitution bit set 77 | inline Term ic_make_sub(Term term) { 78 | return term | TERM_SUB_MASK; 79 | } 80 | 81 | // Remove the substitution bit from a term. 82 | // @param term The term to clear the substitution bit from 83 | // @return The term with its substitution bit cleared 84 | inline Term ic_clear_sub(Term term) { 85 | return term & ~TERM_SUB_MASK; 86 | } 87 | 88 | // Helper to create a term with the appropriate superposition tag for a label 89 | // @param lab Label value (0-3) 90 | // @param val Value/pointer into the heap 91 | // @return The constructed superposition term 92 | inline Term ic_make_sup(Lab lab, Val val) { 93 | return ic_make_term(SUP_BASE_TAG, lab, val); 94 | } 95 | 96 | // Helper to create a DP0 term with the appropriate tag for a label 97 | // @param lab Label value (0-3) 98 | // @param val Value/pointer into the heap 99 | // @return The constructed DP0 term 100 | inline Term ic_make_co0(Lab lab, Val val) { 101 | return ic_make_term(DP0_BASE_TAG, lab, val); 102 | } 103 | 104 | // Helper to create a DP1 term with the appropriate tag for a label 105 | // @param lab Label value (0-3) 106 | // @param val Value/pointer into the heap 107 | // @return The constructed DP1 term 108 | inline Term ic_make_co1(Lab lab, Val val) { 109 | return ic_make_term(DP1_BASE_TAG, lab, val); 110 | } 111 | 112 | // Helper to create an erasure term 113 | // @return An erasure term (ERA tag with no value) 114 | inline Term ic_make_era() { 115 | return ic_make_term(ERA, 0, 0); 116 | } 117 | 118 | // Helper to create a number term 119 | // @param val The numeric value 120 | // @return A number term 121 | inline Term ic_make_num(Val val) { 122 | return ic_make_term(NUM, 0, val); 123 | } 124 | 125 | // Helper to create a successor term 126 | // @param val Pointer to the successor node 127 | // @return A successor term 128 | inline Term ic_make_suc(Val val) { 129 | return ic_make_term(SUC, 0, val); 130 | } 131 | 132 | // Helper to create a switch term 133 | // @param val Pointer to the switch node 134 | // @return A switch term 135 | inline Term ic_make_swi(Val val) { 136 | return ic_make_term(SWI, 0, val); 137 | } 138 | 139 | // Check if a term is an erasure 140 | // @param term The term to check 141 | // @return True if the term is an erasure, false otherwise 142 | inline bool ic_is_era(Term term) { 143 | return TERM_TAG(term) == ERA; 144 | } 145 | 146 | // Allocs a Lam node 147 | inline Val ic_lam(IC* ic, Term bod) { 148 | Val lam_loc = ic_alloc(ic, 1); 149 | ic->heap[lam_loc + 0] = bod; 150 | return lam_loc; 151 | } 152 | 153 | // Allocs an App node 154 | inline Val ic_app(IC* ic, Term fun, Term arg) { 155 | Val app_loc = ic_alloc(ic, 2); 156 | ic->heap[app_loc + 0] = fun; 157 | ic->heap[app_loc + 1] = arg; 158 | return app_loc; 159 | } 160 | 161 | // Allocs a Sup node 162 | inline Val ic_sup(IC* ic, Term lft, Term rgt) { 163 | Val sup_loc = ic_alloc(ic, 2); 164 | ic->heap[sup_loc + 0] = lft; 165 | ic->heap[sup_loc + 1] = rgt; 166 | return sup_loc; 167 | } 168 | 169 | // Allocs a Dup node 170 | inline Val ic_dup(IC* ic, Term val) { 171 | Val dup_loc = ic_alloc(ic, 1); 172 | ic->heap[dup_loc] = val; 173 | return dup_loc; 174 | } 175 | 176 | // Allocs a Suc node 177 | inline Val ic_suc(IC* ic, Term num) { 178 | Val suc_loc = ic_alloc(ic, 1); 179 | ic->heap[suc_loc] = num; 180 | return suc_loc; 181 | } 182 | 183 | // Allocs a Swi node 184 | inline Val ic_swi(IC* ic, Term num, Term ifz, Term ifs) { 185 | Val swi_loc = ic_alloc(ic, 3); 186 | ic->heap[swi_loc + 0] = num; 187 | ic->heap[swi_loc + 1] = ifz; 188 | ic->heap[swi_loc + 2] = ifs; 189 | return swi_loc; 190 | } 191 | 192 | // ----------------------------------------------------------------------------- 193 | // Core Interactions 194 | // ----------------------------------------------------------------------------- 195 | 196 | //(λx.f a) 197 | //-------- APP-LAM 198 | //x <- a 199 | //f 200 | inline Term ic_app_lam(IC* ic, Term app, Term lam) { 201 | ic->interactions++; 202 | 203 | Val app_loc = TERM_VAL(app); 204 | Val lam_loc = TERM_VAL(lam); 205 | 206 | Term arg = ic->heap[app_loc + 1]; 207 | Term bod = ic->heap[lam_loc + 0]; 208 | 209 | // Create substitution for the lambda variable 210 | ic->heap[lam_loc] = ic_make_sub(arg); 211 | 212 | return bod; 213 | } 214 | 215 | //(* a) 216 | //----- APP-ERA 217 | //* 218 | inline Term ic_app_era(IC* ic, Term app, Term era) { 219 | ic->interactions++; 220 | return era; // Return the erasure term 221 | } 222 | 223 | //(&L{a,b} c) 224 | //----------------- APP-SUP 225 | //! &L{c0,c1} = c; 226 | //&L{(a c0),(b c1)} 227 | inline Term ic_app_sup(IC* ic, Term app, Term sup) { 228 | ic->interactions++; 229 | 230 | Val app_loc = TERM_VAL(app); 231 | Val sup_loc = TERM_VAL(sup); 232 | Lab sup_lab = TERM_LAB(sup); 233 | 234 | Term arg = ic->heap[app_loc + 1]; 235 | Term lft = ic->heap[sup_loc + 0]; 236 | Term rgt = ic->heap[sup_loc + 1]; 237 | 238 | // Allocate only what's necessary 239 | Val dup_loc = ic_alloc(ic, 1); 240 | Val app1_loc = ic_alloc(ic, 2); 241 | 242 | // Store the arg in the duplication location 243 | ic->heap[dup_loc] = arg; 244 | 245 | // Create DP0 and DP1 terms 246 | Term x0 = ic_make_co0(sup_lab, dup_loc); 247 | Term x1 = ic_make_co1(sup_lab, dup_loc); 248 | 249 | // Reuse sup_loc for app0 250 | ic->heap[sup_loc + 1] = x0; // lft is already in heap[sup_loc + 0] 251 | 252 | // Set up app1 253 | ic->heap[app1_loc + 0] = rgt; 254 | ic->heap[app1_loc + 1] = x1; 255 | 256 | // Reuse app_loc for the result superposition 257 | ic->heap[app_loc + 0] = ic_make_term(APP, 0, sup_loc); 258 | ic->heap[app_loc + 1] = ic_make_term(APP, 0, app1_loc); 259 | 260 | // Use same superposition tag as input 261 | return ic_make_sup(sup_lab, app_loc); 262 | } 263 | 264 | //! &L{r,s} = *; 265 | //K 266 | //-------------- DUP-ERA 267 | //r <- * 268 | //s <- * 269 | //K 270 | inline Term ic_dup_era(IC* ic, Term dup, Term era) { 271 | ic->interactions++; 272 | 273 | Val dup_loc = TERM_VAL(dup); 274 | TermTag dup_tag = TERM_TAG(dup); 275 | bool is_co0 = IS_DP0(dup_tag); 276 | 277 | // Create erasure term for substitution 278 | Term era_term = ic_make_era(); 279 | 280 | // Set substitution 281 | ic->heap[dup_loc] = ic_make_sub(era_term); 282 | 283 | // Return an erasure 284 | return era_term; 285 | } 286 | 287 | //! &L{r,s} = λx.f; 288 | //K 289 | //----------------- DUP-LAM 290 | //r <- λx0.f0 291 | //s <- λx1.f1 292 | //x <- &L{x0,x1} 293 | //! &L{f0,f1} = f; 294 | //K 295 | inline Term ic_dup_lam(IC* ic, Term dup, Term lam) { 296 | ic->interactions++; 297 | 298 | Val dup_loc = TERM_VAL(dup); 299 | Val lam_loc = TERM_VAL(lam); 300 | Lab dup_lab = TERM_LAB(dup); 301 | TermTag dup_tag = TERM_TAG(dup); 302 | bool is_co0 = IS_DP0(dup_tag); 303 | 304 | Term bod = ic->heap[lam_loc + 0]; 305 | 306 | // Batch allocate memory for efficiency 307 | Val alloc_start = ic_alloc(ic, 5); 308 | Val lam0_loc = alloc_start; 309 | Val lam1_loc = alloc_start + 1; 310 | Val sup_loc = alloc_start + 2; // 2 locations 311 | Val dup_new_loc = alloc_start + 4; 312 | 313 | // Set up the superposition 314 | ic->heap[sup_loc + 0] = ic_make_term(VAR, 0, lam0_loc); 315 | ic->heap[sup_loc + 1] = ic_make_term(VAR, 0, lam1_loc); 316 | 317 | // Replace lambda's variable with the superposition 318 | ic->heap[lam_loc] = ic_make_sub(ic_make_sup(dup_lab, sup_loc)); 319 | 320 | // Set up the new duplication 321 | ic->heap[dup_new_loc] = bod; 322 | 323 | // Set up new lambda bodies 324 | ic->heap[lam0_loc] = ic_make_co0(dup_lab, dup_new_loc); 325 | ic->heap[lam1_loc] = ic_make_co1(dup_lab, dup_new_loc); 326 | 327 | // Create and return the appropriate lambda 328 | if (is_co0) { 329 | ic->heap[dup_loc] = ic_make_sub(ic_make_term(LAM, 0, lam1_loc)); 330 | return ic_make_term(LAM, 0, lam0_loc); 331 | } else { 332 | ic->heap[dup_loc] = ic_make_sub(ic_make_term(LAM, 0, lam0_loc)); 333 | return ic_make_term(LAM, 0, lam1_loc); 334 | } 335 | } 336 | 337 | //! &L{x,y} = &L{a,b}; 338 | //K 339 | //-------------------- DUP-SUP (if equal labels) 340 | //x <- a 341 | //y <- b 342 | //K 343 | 344 | //! &L{x,y} = &R{a,b}; 345 | //K 346 | //-------------------- DUP-SUP (if different labels) 347 | //x <- &R{a0,b0} 348 | //y <- &R{a1,b1} 349 | //! &L{a0,a1} = a 350 | //! &L{b0,b1} = b 351 | //K 352 | inline Term ic_dup_sup(IC* ic, Term dup, Term sup) { 353 | ic->interactions++; 354 | 355 | Val dup_loc = TERM_VAL(dup); 356 | Val sup_loc = TERM_VAL(sup); 357 | Lab dup_lab = TERM_LAB(dup); 358 | Lab sup_lab = TERM_LAB(sup); 359 | TermTag dup_tag = TERM_TAG(dup); 360 | bool is_co0 = IS_DP0(dup_tag); 361 | 362 | Term lft = ic->heap[sup_loc + 0]; 363 | Term rgt = ic->heap[sup_loc + 1]; 364 | 365 | // Fast path for matching labels (common case) 366 | if (dup_lab == sup_lab) { 367 | // Labels match: simple substitution 368 | if (is_co0) { 369 | ic->heap[dup_loc] = ic_make_sub(rgt); 370 | return lft; 371 | } else { 372 | ic->heap[dup_loc] = ic_make_sub(lft); 373 | return rgt; 374 | } 375 | } else { 376 | // Labels don't match: create nested duplications 377 | Val sup_start = ic_alloc(ic, 4); // 2 sups with 2 terms each 378 | Val sup0_loc = sup_start; 379 | Val sup1_loc = sup_start + 2; 380 | 381 | // Use existing locations as duplication locations 382 | Val dup_lft_loc = sup_loc + 0; 383 | Val dup_rgt_loc = sup_loc + 1; 384 | 385 | // Set up the first superposition (for DP0) 386 | ic->heap[sup0_loc + 0] = ic_make_co0(dup_lab, dup_lft_loc); 387 | ic->heap[sup0_loc + 1] = ic_make_co0(dup_lab, dup_rgt_loc); 388 | 389 | // Set up the second superposition (for DP1) 390 | ic->heap[sup1_loc + 0] = ic_make_co1(dup_lab, dup_lft_loc); 391 | ic->heap[sup1_loc + 1] = ic_make_co1(dup_lab, dup_rgt_loc); 392 | 393 | // Set up original duplications to point to lft and rgt 394 | ic->heap[dup_lft_loc] = lft; 395 | ic->heap[dup_rgt_loc] = rgt; 396 | 397 | if (is_co0) { 398 | ic->heap[dup_loc] = ic_make_sub(ic_make_sup(sup_lab, sup1_loc)); 399 | return ic_make_sup(sup_lab, sup0_loc); 400 | } else { 401 | ic->heap[dup_loc] = ic_make_sub(ic_make_sup(sup_lab, sup0_loc)); 402 | return ic_make_sup(sup_lab, sup1_loc); 403 | } 404 | } 405 | } 406 | 407 | // ----------------------------------------------------------------------------- 408 | // Numeric Interactions 409 | // ----------------------------------------------------------------------------- 410 | 411 | //+N 412 | //--- SUC-NUM 413 | //N+1 414 | inline Term ic_suc_num(IC* ic, Term suc, Term num) { 415 | ic->interactions++; 416 | uint32_t num_val = TERM_VAL(num); 417 | return ic_make_num(num_val + 1); 418 | } 419 | 420 | //+* 421 | //-- SUC-ERA 422 | //* 423 | inline Term ic_suc_era(IC* ic, Term suc, Term era) { 424 | ic->interactions++; 425 | return era; // Erasure propagates 426 | } 427 | 428 | //+&L{x,y} 429 | //--------- SUC-SUP 430 | //&L{+x,+y} 431 | inline Term ic_suc_sup(IC* ic, Term suc, Term sup) { 432 | ic->interactions++; 433 | 434 | Val sup_loc = TERM_VAL(sup); 435 | Lab sup_lab = TERM_LAB(sup); 436 | 437 | Term lft = ic->heap[sup_loc + 0]; 438 | Term rgt = ic->heap[sup_loc + 1]; 439 | 440 | // Create SUC nodes for each branch 441 | Val suc0_loc = ic_suc(ic, lft); 442 | Val suc1_loc = ic_suc(ic, rgt); 443 | 444 | // Create the resulting superposition of SUCs 445 | Val res_loc = ic_alloc(ic, 2); 446 | ic->heap[res_loc + 0] = ic_make_suc(suc0_loc); 447 | ic->heap[res_loc + 1] = ic_make_suc(suc1_loc); 448 | 449 | return ic_make_sup(sup_lab, res_loc); 450 | } 451 | 452 | //?N{0:z;+:s;} 453 | //------------ SWI-NUM (if N==0) 454 | //z 455 | inline Term ic_swi_num(IC* ic, Term swi, Term num) { 456 | ic->interactions++; 457 | 458 | Val swi_loc = TERM_VAL(swi); 459 | Val num_val = TERM_VAL(num); 460 | 461 | Term ifz = ic->heap[swi_loc + 1]; 462 | Term ifs = ic->heap[swi_loc + 2]; 463 | 464 | if (num_val == 0) { 465 | // If the number is 0, return the zero branch 466 | return ifz; 467 | } else { 468 | // Otherwise, apply the successor branch to N-1 469 | Val app_loc = ic_alloc(ic, 2); 470 | ic->heap[app_loc + 0] = ifs; 471 | ic->heap[app_loc + 1] = ic_make_num(num_val - 1); 472 | return ic_make_term(APP, 0, app_loc); 473 | } 474 | } 475 | 476 | //?*{0:z;+:s;} 477 | //------------ SWI-ERA 478 | //* 479 | inline Term ic_swi_era(IC* ic, Term swi, Term era) { 480 | ic->interactions++; 481 | return era; // Erasure propagates 482 | } 483 | 484 | //?&L{x,y}{0:z;+:s;} 485 | //--------------------------------- SWI-SUP 486 | //!&L{z0,z1} = z; 487 | //!&L{s0,s1} = s; 488 | //&L{?x{0:z0;+:s0;},?y{0:z1;+:s1;}} 489 | inline Term ic_swi_sup(IC* ic, Term swi, Term sup) { 490 | ic->interactions++; 491 | 492 | Val swi_loc = TERM_VAL(swi); 493 | Val sup_loc = TERM_VAL(sup); 494 | Lab sup_lab = TERM_LAB(sup); 495 | 496 | Term lft = ic->heap[sup_loc + 0]; 497 | Term rgt = ic->heap[sup_loc + 1]; 498 | Term ifz = ic->heap[swi_loc + 1]; 499 | Term ifs = ic->heap[swi_loc + 2]; 500 | 501 | // Create duplications for ifz and ifs branches 502 | Val dup_z_loc = ic_alloc(ic, 1); 503 | Val dup_s_loc = ic_alloc(ic, 1); 504 | 505 | ic->heap[dup_z_loc] = ifz; 506 | ic->heap[dup_s_loc] = ifs; 507 | 508 | Term z0 = ic_make_co0(sup_lab, dup_z_loc); 509 | Term z1 = ic_make_co1(sup_lab, dup_z_loc); 510 | Term s0 = ic_make_co0(sup_lab, dup_s_loc); 511 | Term s1 = ic_make_co1(sup_lab, dup_s_loc); 512 | 513 | // Create switch nodes for each branch 514 | Val swi0_loc = ic_swi(ic, lft, z0, s0); 515 | Val swi1_loc = ic_swi(ic, rgt, z1, s1); 516 | 517 | // Create the resulting superposition 518 | Val res_loc = ic_alloc(ic, 2); 519 | ic->heap[res_loc + 0] = ic_make_term(SWI, 0, swi0_loc); 520 | ic->heap[res_loc + 1] = ic_make_term(SWI, 0, swi1_loc); 521 | 522 | return ic_make_sup(sup_lab, res_loc); 523 | } 524 | 525 | //! &L{x,y} = N; 526 | //K 527 | //-------------- DUP-NUM 528 | //x <- N 529 | //y <- N 530 | //K 531 | inline Term ic_dup_num(IC* ic, Term dup, Term num) { 532 | ic->interactions++; 533 | 534 | Val dup_loc = TERM_VAL(dup); 535 | Val num_val = TERM_VAL(num); 536 | TermTag dup_tag = TERM_TAG(dup); 537 | bool is_co0 = IS_DP0(dup_tag); 538 | 539 | // Numbers are duplicated by simply substituting both variables with the same number 540 | ic->heap[dup_loc] = ic_make_sub(num); // Set substitution for the other variable 541 | 542 | return num; // Return the number 543 | } 544 | 545 | // ----------------------------------------------------------------------------- 546 | // Term Normalization 547 | // ----------------------------------------------------------------------------- 548 | 549 | // Reduce a term to weak head normal form (WHNF). 550 | // 551 | // @param ic The IC context 552 | // @param term The term to reduce 553 | // @return The term in WHNF 554 | inline Term ic_whnf(IC* ic, Term term) { 555 | Val stop = ic->stack_pos; 556 | Term next = term; 557 | Term* heap = ic->heap; 558 | Term* stack = ic->stack; 559 | Val stack_pos = stop; 560 | 561 | TermTag tag; 562 | Val val_loc; 563 | Term val; 564 | Term prev; 565 | TermTag ptag; 566 | 567 | while (1) { 568 | tag = TERM_TAG(next); 569 | 570 | // On variables: substitute 571 | // On eliminators: move to field 572 | if (tag == VAR) { 573 | val_loc = TERM_VAL(next); 574 | val = heap[val_loc]; 575 | if (TERM_SUB(val)) { 576 | next = ic_clear_sub(val); 577 | continue; 578 | } 579 | } else if (IS_DUP(tag)) { 580 | val_loc = TERM_VAL(next); 581 | val = heap[val_loc]; 582 | if (TERM_SUB(val)) { 583 | next = ic_clear_sub(val); 584 | continue; 585 | } else { 586 | stack[stack_pos++] = next; 587 | next = val; 588 | continue; 589 | } 590 | } else if (tag == APP) { 591 | val_loc = TERM_VAL(next); 592 | stack[stack_pos++] = next; 593 | next = heap[val_loc]; // Reduce the function part 594 | continue; 595 | } else if (tag == SUC) { 596 | val_loc = TERM_VAL(next); 597 | stack[stack_pos++] = next; 598 | next = heap[val_loc]; // Reduce the inner term 599 | continue; 600 | } else if (tag == SWI) { 601 | val_loc = TERM_VAL(next); 602 | stack[stack_pos++] = next; 603 | next = heap[val_loc]; // Reduce the number term 604 | continue; 605 | } 606 | 607 | // Empty stack: term is in WHNF 608 | if (stack_pos == stop) { 609 | ic->stack_pos = stack_pos; 610 | return next; 611 | } 612 | 613 | // Interaction Dispatcher 614 | prev = stack[--stack_pos]; 615 | ptag = TERM_TAG(prev); 616 | if (ptag == APP) { 617 | if (tag == LAM) { 618 | next = ic_app_lam(ic, prev, next); 619 | continue; 620 | } else if (IS_SUP(tag)) { 621 | next = ic_app_sup(ic, prev, next); 622 | continue; 623 | } else if (tag == ERA) { 624 | next = ic_app_era(ic, prev, next); 625 | continue; 626 | } 627 | } else if (IS_DUP(ptag)) { 628 | if (tag == LAM) { 629 | next = ic_dup_lam(ic, prev, next); 630 | continue; 631 | } else if (IS_SUP(tag)) { 632 | next = ic_dup_sup(ic, prev, next); 633 | continue; 634 | } else if (tag == ERA) { 635 | next = ic_dup_era(ic, prev, next); 636 | continue; 637 | } else if (tag == NUM) { 638 | next = ic_dup_num(ic, prev, next); 639 | continue; 640 | } 641 | } else if (ptag == SUC) { 642 | if (tag == NUM) { 643 | next = ic_suc_num(ic, prev, next); 644 | continue; 645 | } else if (IS_SUP(tag)) { 646 | next = ic_suc_sup(ic, prev, next); 647 | continue; 648 | } else if (tag == ERA) { 649 | next = ic_suc_era(ic, prev, next); 650 | continue; 651 | } 652 | } else if (ptag == SWI) { 653 | if (tag == NUM) { 654 | next = ic_swi_num(ic, prev, next); 655 | continue; 656 | } else if (IS_SUP(tag)) { 657 | next = ic_swi_sup(ic, prev, next); 658 | continue; 659 | } else if (tag == ERA) { 660 | next = ic_swi_era(ic, prev, next); 661 | continue; 662 | } 663 | } 664 | 665 | // No interaction: push term back to stack 666 | stack[stack_pos++] = prev; 667 | 668 | // Check if we're done 669 | if (stack_pos == stop) { 670 | ic->stack_pos = stack_pos; 671 | return next; 672 | } 673 | 674 | // Update parent chain 675 | while (stack_pos > stop) { 676 | prev = stack[--stack_pos]; 677 | ptag = TERM_TAG(prev); 678 | val_loc = TERM_VAL(prev); 679 | if (ptag == APP || ptag == SWI || IS_DUP(ptag)) { 680 | heap[val_loc] = next; 681 | } 682 | next = prev; 683 | } 684 | 685 | ic->stack_pos = stack_pos; 686 | return next; 687 | } 688 | } 689 | 690 | // Recursive implementation of normal form reduction 691 | inline Term ic_normal(IC* ic, Term term) { 692 | term = ic_whnf(ic, term); 693 | TermTag tag = TERM_TAG(term); 694 | Val loc = TERM_VAL(term); 695 | 696 | if (ic_is_era(term) || tag == NUM) { 697 | // ERA and NUM have no children, so just return them 698 | return term; 699 | } else if (tag == LAM) { 700 | ic->heap[loc] = ic_normal(ic, ic->heap[loc]); 701 | return term; 702 | } else if (tag == APP) { 703 | ic->heap[loc+0] = ic_normal(ic, ic->heap[loc]); 704 | ic->heap[loc+1] = ic_normal(ic, ic->heap[loc+1]); 705 | return term; 706 | } else if (IS_SUP(tag)) { 707 | ic->heap[loc+0] = ic_normal(ic, ic->heap[loc]); 708 | ic->heap[loc+1] = ic_normal(ic, ic->heap[loc+1]); 709 | return term; 710 | } else if (tag == SUC) { 711 | ic->heap[loc] = ic_normal(ic, ic->heap[loc]); 712 | return term; 713 | } else if (tag == SWI) { 714 | ic->heap[loc+0] = ic_normal(ic, ic->heap[loc]); 715 | ic->heap[loc+1] = ic_normal(ic, ic->heap[loc+1]); 716 | ic->heap[loc+2] = ic_normal(ic, ic->heap[loc+2]); 717 | return term; 718 | } else { 719 | return term; 720 | } 721 | } 722 | -------------------------------------------------------------------------------- /src/ic.h: -------------------------------------------------------------------------------- 1 | #ifndef IC_H 2 | #define IC_H 3 | 4 | // ----------------------------------------------------------------------------- 5 | // Interaction Calculus (IC) - Core header-only implementation 6 | // 7 | // This file contains the full implementation of the Interaction Calculus: 8 | // - Term representation and bit manipulation 9 | // - Memory management 10 | // - Core interactions (app_lam, app_sup, dup_lam, dup_sup) 11 | // - Weak Head Normal Form (WHNF) reduction 12 | // - Full Normal Form reduction 13 | // ----------------------------------------------------------------------------- 14 | 15 | #include 16 | #include 17 | #include 18 | #include 19 | #include 20 | 21 | // Default heap and stack sizes 22 | #ifdef IC_64BIT 23 | #define IC_DEFAULT_HEAP_SIZE (1ULL << 30) // 1G terms 24 | #define IC_DEFAULT_STACK_SIZE (1ULL << 28) // 256M terms 25 | #else 26 | #define IC_DEFAULT_HEAP_SIZE (1UL << 27) // 128M terms 27 | #define IC_DEFAULT_STACK_SIZE (1UL << 24) // 16M terms 28 | #endif 29 | 30 | // ----------------------------------------------------------------------------- 31 | // Core Types and Constants 32 | // ----------------------------------------------------------------------------- 33 | 34 | #ifdef IC_64BIT 35 | typedef enum { 36 | VAR = 0x00, // Variable 37 | LAM = 0x01, // Lambda 38 | APP = 0x02, // Application 39 | ERA = 0x03, // Erasure 40 | NUM = 0x04, // Number 41 | SUC = 0x05, // Successor 42 | SWI = 0x06, // Switch 43 | SUP = 0x07, // Superposition 44 | DPX = 0x08, // Duplication variable 0 45 | DPY = 0x09, // Duplication variable 1 46 | } TermTag; 47 | 48 | // Term 64-bit packed representation 49 | typedef uint64_t Term; 50 | typedef uint64_t Val; 51 | typedef uint16_t Lab; 52 | 53 | // Term components 54 | #define TERM_SUB_MASK 0x8000000000000000ULL // 1-bit: Is this a substitution? 55 | #define TERM_TAG_MASK 0x7F00000000000000ULL // 7-bits: Term tag 56 | #define TERM_LAB_MASK 0x00FFFF0000000000ULL // 16-bits: Label 57 | #define TERM_VAL_MASK 0x000000FFFFFFFFFFULL // 40-bits: Value/pointer 58 | 59 | #define NONE 0xFFFFFFFFFFFFFFFFULL 60 | #define LAB_MAX 0xFFFF 61 | 62 | // Term component extraction 63 | #define TERM_SUB(term) (((term) & TERM_SUB_MASK) != 0) 64 | #define TERM_TAG(term) ((TermTag)(((term) & TERM_TAG_MASK) >> 56)) 65 | #define TERM_VAL(term) ((term) & TERM_VAL_MASK) 66 | 67 | // Label helpers (for compatibility with existing code) 68 | #define TERM_LAB(term) ((Lab)(((term) & TERM_LAB_MASK) >> 40)) 69 | #define IS_SUP(tag) ((tag) == SUP) 70 | #define IS_DP0(tag) ((tag) == DPX) 71 | #define IS_DP1(tag) ((tag) == DPY) 72 | #define IS_DUP(tag) ((tag) == DPX || (tag) == DPY) 73 | #define IS_ERA(tag) ((tag) == ERA) 74 | #define IS_NUM(tag) ((tag) == NUM) 75 | #define IS_SUC(tag) ((tag) == SUC) 76 | #define IS_SWI(tag) ((tag) == SWI) 77 | #define SUP_BASE_TAG ((TermTag)(SUP)) 78 | #define DP0_BASE_TAG ((TermTag)(DPX)) 79 | #define DP1_BASE_TAG ((TermTag)(DPY)) 80 | 81 | #define MAKE_TERM(sub, tag, lab, val) \ 82 | (((sub) ? TERM_SUB_MASK : 0) | \ 83 | (((Term)(tag) << 56)) | \ 84 | (((Term)(lab) << 40)) | \ 85 | ((Term)(val) & TERM_VAL_MASK)) 86 | #else 87 | typedef enum { 88 | VAR = 0x00, // Variable 89 | LAM = 0x01, // Lambda 90 | APP = 0x02, // Application 91 | ERA = 0x03, // Erasure 92 | NUM = 0x04, // Number 93 | SUC = 0x05, // Successor 94 | SWI = 0x06, // Switch 95 | TMP = 0x07, // Temporary 96 | SP0 = 0x08, // Superposition with label 0 97 | SP1 = 0x09, // Superposition with label 1 98 | SP2 = 0x0A, // Superposition with label 2 99 | SP3 = 0x0B, // Superposition with label 3 100 | SP4 = 0x0C, // Superposition with label 4 101 | SP5 = 0x0D, // Superposition with label 5 102 | SP6 = 0x0E, // Superposition with label 6 103 | SP7 = 0x0F, // Superposition with label 7 104 | DX0 = 0x10, // Duplication variable 0 with label 0 105 | DX1 = 0x11, // Duplication variable 0 with label 1 106 | DX2 = 0x12, // Duplication variable 0 with label 2 107 | DX3 = 0x13, // Duplication variable 0 with label 3 108 | DX4 = 0x14, // Duplication variable 0 with label 4 109 | DX5 = 0x15, // Duplication variable 0 with label 5 110 | DX6 = 0x16, // Duplication variable 0 with label 6 111 | DX7 = 0x17, // Duplication variable 0 with label 7 112 | DY0 = 0x18, // Duplication variable 1 with label 0 113 | DY1 = 0x19, // Duplication variable 1 with label 1 114 | DY2 = 0x1A, // Duplication variable 1 with label 2 115 | DY3 = 0x1B, // Duplication variable 1 with label 3 116 | DY4 = 0x1C, // Duplication variable 1 with label 4 117 | DY5 = 0x1D, // Duplication variable 1 with label 5 118 | DY6 = 0x1E, // Duplication variable 1 with label 6 119 | DY7 = 0x1F, // Duplication variable 1 with label 7 120 | } TermTag; 121 | 122 | // Term 32-bit packed representation 123 | typedef uint32_t Term; 124 | typedef uint32_t Val; 125 | typedef uint8_t Lab; 126 | 127 | // Term components 128 | #define TERM_SUB_MASK 0x80000000UL // 1-bit: Is this a substitution? 129 | #define TERM_TAG_MASK 0x7C000000UL // 5-bits: Term tag 130 | #define TERM_VAL_MASK 0x03FFFFFFUL // 26-bits: Value/pointer 131 | 132 | #define NONE 0xFFFFFFFF 133 | #define LAB_MAX 0x7 134 | 135 | // Term component extraction 136 | #define TERM_SUB(term) (((term) & TERM_SUB_MASK) != 0) 137 | #define TERM_TAG(term) ((TermTag)(((term) & TERM_TAG_MASK) >> 26)) 138 | #define TERM_VAL(term) ((term) & TERM_VAL_MASK) 139 | 140 | // Label helpers (for compatibility with existing code) 141 | #define TERM_LAB(term) ((TERM_TAG(term) & LAB_MAX)) // Extract label from tag (last 3 bits) 142 | #define IS_SUP(tag) ((tag) >= SP0 && (tag) <= SP7) 143 | #define IS_DP0(tag) ((tag) >= DX0 && (tag) <= DX7) 144 | #define IS_DP1(tag) ((tag) >= DY0 && (tag) <= DY7) 145 | #define IS_DUP(tag) ((tag) >= DX0 && (tag) <= DY7) 146 | #define IS_ERA(tag) ((tag) == ERA) 147 | #define IS_NUM(tag) ((tag) == NUM) 148 | #define IS_SUC(tag) ((tag) == SUC) 149 | #define IS_SWI(tag) ((tag) == SWI) 150 | #define SUP_BASE_TAG ((TermTag)(SP0)) 151 | #define DP0_BASE_TAG ((TermTag)(DX0)) 152 | #define DP1_BASE_TAG ((TermTag)(DY0)) 153 | 154 | // Term creation 155 | #define MAKE_TERM(sub, tag, lab, val) \ 156 | (((sub) ? TERM_SUB_MASK : 0) | \ 157 | (((Term)(tag + lab) << 26)) | \ 158 | ((Term)(val) & TERM_VAL_MASK)) 159 | #endif 160 | 161 | // ----------------------------------------------------------------------------- 162 | // IC Structure 163 | // ----------------------------------------------------------------------------- 164 | 165 | // The main Interaction Calculus context structure. 166 | // Contains all state needed for term evaluation. 167 | typedef struct { 168 | // Memory management 169 | Term* heap; // Heap memory for terms 170 | Val heap_size; // Total size of the heap 171 | Val heap_pos; // Current allocation position 172 | 173 | // Evaluation stack 174 | Term* stack; // Stack for term evaluation 175 | Val stack_size; // Total size of the stack 176 | Val stack_pos; // Current stack position 177 | 178 | // Statistics 179 | uint64_t interactions; // Interaction counter 180 | } IC; 181 | 182 | // ----------------------------------------------------------------------------- 183 | // IC Functions 184 | // ----------------------------------------------------------------------------- 185 | 186 | #ifdef HAVE_METAL 187 | // Forward declarations for Metal functions 188 | bool metal_is_available(); 189 | void metal_execute_sup_reduction(uint32_t* heap, uint32_t sup_count, uint32_t* sup_indices); 190 | #endif 191 | 192 | // Create a new IC context with the specified heap and stack sizes. 193 | // @param heap_size Number of terms in the heap 194 | // @param stack_size Number of terms in the stack 195 | // @return A new IC context or NULL if allocation failed 196 | IC* ic_new(Val heap_size, Val stack_size); 197 | 198 | // Create a new IC context with default heap and stack sizes. 199 | // @return A new IC context or NULL if allocation failed 200 | IC* ic_default_new(); 201 | 202 | // Free all resources associated with an IC context. 203 | // @param ic The IC context to free 204 | void ic_free(IC* ic); 205 | 206 | // Allocate n consecutive terms in the heap. 207 | // @param ic The IC context 208 | // @param n Number of terms to allocate 209 | // @return The starting location of the allocated block 210 | Val ic_alloc(IC* ic, Val n); 211 | 212 | // Create a term with the given tag and value. 213 | // @param tag The term's tag 214 | // @param lab The term's label 215 | // @param val The term's value (typically a heap location) 216 | // @return The constructed term 217 | Term ic_make_term(TermTag tag, Lab lab, Val val); 218 | 219 | // Create a substitution term by setting the substitution bit. 220 | // @param term The term to convert to a substitution 221 | // @return The term with its substitution bit set 222 | Term ic_make_sub(Term term); 223 | 224 | // Clear the substitution bit from a term. 225 | // @param term The term to clear 226 | // @return The term with its substitution bit cleared 227 | Term ic_clear_sub(Term term); 228 | 229 | // Term constructors. 230 | Term ic_make_sup(Lab lab, Val val); 231 | Term ic_make_co0(Lab lab, Val val); 232 | Term ic_make_co1(Lab lab, Val val); 233 | Term ic_make_era(); 234 | Term ic_make_num(Val val); 235 | Term ic_make_suc(Val val); 236 | Term ic_make_swi(Val val); 237 | 238 | // Check if a term is an erasure term. 239 | // @param term The term to check 240 | // @return True if the term is an erasure, false otherwise 241 | bool ic_is_era(Term term); 242 | 243 | // Allocate a node in the heap. 244 | Val ic_lam(IC* ic, Term bod); 245 | Val ic_app(IC* ic, Term fun, Term arg); 246 | Val ic_sup(IC* ic, Term lft, Term rgt); 247 | Val ic_dup(IC* ic, Term val); 248 | Val ic_suc(IC* ic, Term num); 249 | Val ic_swi(IC* ic, Term num, Term ifz, Term ifs); 250 | 251 | // Interactions 252 | Term ic_app_lam(IC* ic, Term app, Term lam); 253 | Term ic_app_sup(IC* ic, Term app, Term sup); 254 | Term ic_app_era(IC* ic, Term app, Term era); 255 | Term ic_dup_lam(IC* ic, Term dup, Term lam); 256 | Term ic_dup_sup(IC* ic, Term dup, Term sup); 257 | Term ic_dup_era(IC* ic, Term dup, Term era); 258 | 259 | // Numeric interactions 260 | Term ic_suc_num(IC* ic, Term suc, Term num); 261 | Term ic_suc_era(IC* ic, Term suc, Term era); 262 | Term ic_suc_sup(IC* ic, Term suc, Term sup); 263 | Term ic_swi_num(IC* ic, Term swi, Term num); 264 | Term ic_swi_era(IC* ic, Term swi, Term era); 265 | Term ic_swi_sup(IC* ic, Term swi, Term sup); 266 | Term ic_dup_num(IC* ic, Term dup, Term num); 267 | 268 | // Reduce a term to weak head normal form (WHNF). 269 | // @param ic The IC context 270 | // @param term The term to reduce 271 | // @return The term in WHNF 272 | Term ic_whnf(IC* ic, Term term); 273 | 274 | // Reduce a term to full normal form by recursively normalizing subterms. 275 | // @param ic The IC context 276 | // @param term The term to normalize 277 | // @return The normalized term 278 | Term ic_normal(IC* ic, Term term); 279 | 280 | #endif // IC_H 281 | -------------------------------------------------------------------------------- /src/ic.metal: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | using namespace metal; 4 | 5 | /** 6 | * Interaction Calculus (IC) - Metal implementation 7 | * 8 | * This file contains the Metal GPU implementation of the Interaction Calculus: 9 | * - Term representation and bit manipulation 10 | * - Core interactions (app_lam, app_sup, col_lam, col_sup) 11 | * - Weak Head Normal Form (WHNF) reduction 12 | * - Full Normal Form reduction 13 | */ 14 | 15 | // Core Term representation and constants (aligned with ic.h) 16 | typedef uint32_t Term; 17 | 18 | // Term tags (matching the enum in ic.h) 19 | constant uint VAR = 0; 20 | constant uint SUP = 1; 21 | constant uint DP0 = 2; 22 | constant uint DP1 = 3; 23 | constant uint LAM = 4; 24 | constant uint APP = 5; 25 | 26 | // Term components 27 | constant uint32_t TERM_SUB_MASK = 0x80000000; 28 | constant uint32_t TERM_TAG_MASK = 0x70000000; 29 | constant uint32_t TERM_LAB_MASK = 0x0C000000; 30 | constant uint32_t TERM_VAL_MASK = 0x03FFFFFF; 31 | 32 | // ----------------------------------------------------------------------------- 33 | // Term Manipulation Macros 34 | // ----------------------------------------------------------------------------- 35 | 36 | #define M_IC_MAKE_SUB(term) ((term) | TERM_SUB_MASK) 37 | #define M_IC_CLEAR_SUB(term) ((term) & ~TERM_SUB_MASK) 38 | #define M_IC_GET_TAG(term) (((term) & TERM_TAG_MASK) >> 28) 39 | #define M_IC_GET_LAB(term) (((term) & TERM_LAB_MASK) >> 26) 40 | #define M_IC_GET_VAL(term) ((term) & TERM_VAL_MASK) 41 | #define M_IC_MAKE_TERM(tag, lab, val) \ 42 | (((uint32_t)(tag) << 28) | ((uint32_t)(lab) << 26) | ((uint32_t)(val) & TERM_VAL_MASK)) 43 | 44 | // Key constants for faster case switching 45 | #define INTERACTION_APP_LAM ((APP << 3) | LAM) 46 | #define INTERACTION_APP_SUP ((APP << 3) | SUP) 47 | 48 | // ----------------------------------------------------------------------------- 49 | // Memory Management Functions 50 | // ----------------------------------------------------------------------------- 51 | 52 | /** 53 | * Allocate n consecutive terms in memory. 54 | * @param heap_pos Current heap position reference 55 | * @param n Number of terms to allocate 56 | * @param heap_size Total size of the heap 57 | * @return Location in the heap 58 | */ 59 | inline uint32_t m_ic_alloc(device uint32_t& heap_pos, uint32_t n, 60 | constant uint32_t& heap_size) { 61 | uint32_t ptr = heap_pos; 62 | heap_pos += n; 63 | 64 | // Bounds check 65 | if (heap_pos >= heap_size) { 66 | // Cap at maximum size as a safeguard 67 | heap_pos = heap_size - 1; 68 | } 69 | 70 | return ptr; 71 | } 72 | 73 | // ----------------------------------------------------------------------------- 74 | // Interaction Functions 75 | // ----------------------------------------------------------------------------- 76 | 77 | /** 78 | * Apply a lambda to an argument. 79 | * @param heap Heap memory 80 | * @param interactions Interaction counter 81 | * @param app Application term 82 | * @param lam Lambda term 83 | * @return Result of the interaction 84 | */ 85 | inline Term m_ic_app_lam(device Term* heap, device atomic_uint& interactions, 86 | Term app, Term lam) { 87 | atomic_fetch_add_explicit(&interactions, 1, memory_order_relaxed); 88 | 89 | // Extract locations 90 | const uint32_t app_loc = M_IC_GET_VAL(app); 91 | const uint32_t lam_loc = M_IC_GET_VAL(lam); 92 | 93 | // Load arguments 94 | const Term arg = heap[app_loc + 1]; 95 | const Term bod = heap[lam_loc + 0]; 96 | 97 | // Create substitution for the lambda variable 98 | heap[lam_loc] = M_IC_MAKE_SUB(arg); 99 | 100 | return bod; 101 | } 102 | 103 | /** 104 | * Apply a function to a superposition. 105 | * @param heap Heap memory 106 | * @param interactions Interaction counter 107 | * @param heap_pos Current heap position 108 | * @param heap_size Total heap size 109 | * @param app Application term 110 | * @param sup Superposition term 111 | * @return Result of the interaction 112 | */ 113 | inline Term m_ic_app_sup(device Term* heap, device atomic_uint& interactions, 114 | device uint32_t& heap_pos, constant uint32_t& heap_size, 115 | Term app, Term sup) { 116 | atomic_fetch_add_explicit(&interactions, 1, memory_order_relaxed); 117 | 118 | // Cache frequent values 119 | const uint32_t app_loc = M_IC_GET_VAL(app); 120 | const uint32_t sup_loc = M_IC_GET_VAL(sup); 121 | const uint8_t sup_lab = M_IC_GET_LAB(sup); 122 | 123 | // Load arguments 124 | const Term arg = heap[app_loc + 1]; 125 | const Term rgt = heap[sup_loc + 1]; 126 | 127 | // Allocate memory 128 | const uint32_t col_loc = m_ic_alloc(heap_pos, 1, heap_size); 129 | const uint32_t app1_loc = m_ic_alloc(heap_pos, 2, heap_size); 130 | 131 | // Store arg in collapser location 132 | heap[col_loc] = arg; 133 | 134 | // Create DP0 and DP1 terms 135 | const Term x0 = M_IC_MAKE_TERM(DP0, sup_lab, col_loc); 136 | const Term x1 = M_IC_MAKE_TERM(DP1, sup_lab, col_loc); 137 | 138 | // Reuse sup_loc for app0 (lft is already in heap[sup_loc + 0]) 139 | heap[sup_loc + 1] = x0; 140 | 141 | // Set up app1 142 | heap[app1_loc + 0] = rgt; 143 | heap[app1_loc + 1] = x1; 144 | 145 | // Reuse app_loc for result superposition 146 | heap[app_loc + 0] = M_IC_MAKE_TERM(APP, 0, sup_loc); 147 | heap[app_loc + 1] = M_IC_MAKE_TERM(APP, 0, app1_loc); 148 | 149 | // Return the final result 150 | return M_IC_MAKE_TERM(SUP, sup_lab, app_loc); 151 | } 152 | 153 | /** 154 | * Collapse a lambda. 155 | * @param heap Heap memory 156 | * @param interactions Interaction counter 157 | * @param heap_pos Current heap position 158 | * @param heap_size Total heap size 159 | * @param col Duplication term 160 | * @param lam Lambda term 161 | * @return Result of the interaction 162 | */ 163 | inline Term m_ic_col_lam(device Term* heap, device atomic_uint& interactions, 164 | device uint32_t& heap_pos, constant uint32_t& heap_size, 165 | Term col, Term lam) { 166 | atomic_fetch_add_explicit(&interactions, 1, memory_order_relaxed); 167 | 168 | // Cache frequent values 169 | const uint32_t col_loc = M_IC_GET_VAL(col); 170 | const uint32_t lam_loc = M_IC_GET_VAL(lam); 171 | const uint8_t col_lab = M_IC_GET_LAB(col); 172 | const uint8_t is_co0 = (M_IC_GET_TAG(col) == DP0); 173 | 174 | // Load body 175 | const Term bod = heap[lam_loc + 0]; 176 | 177 | // Batch allocate memory for efficiency 178 | const uint32_t alloc_start = m_ic_alloc(heap_pos, 5, heap_size); 179 | const uint32_t lam0_loc = alloc_start; 180 | const uint32_t lam1_loc = alloc_start + 1; 181 | const uint32_t sup_loc = alloc_start + 2; // 2 locations 182 | const uint32_t col_new_loc = alloc_start + 4; 183 | 184 | // Set up superposition 185 | heap[sup_loc + 0] = M_IC_MAKE_TERM(VAR, 0, lam0_loc); 186 | heap[sup_loc + 1] = M_IC_MAKE_TERM(VAR, 0, lam1_loc); 187 | 188 | // Replace lambda's variable with the superposition 189 | heap[lam_loc] = M_IC_MAKE_SUB(M_IC_MAKE_TERM(SUP, col_lab, sup_loc)); 190 | 191 | // Set up the new collapser 192 | heap[col_new_loc] = bod; 193 | 194 | // Set up new lambda bodies 195 | heap[lam0_loc] = M_IC_MAKE_TERM(DP0, col_lab, col_new_loc); 196 | heap[lam1_loc] = M_IC_MAKE_TERM(DP1, col_lab, col_new_loc); 197 | 198 | // Create and return the appropriate lambda 199 | if (is_co0) { 200 | heap[col_loc] = M_IC_MAKE_SUB(M_IC_MAKE_TERM(LAM, 0, lam1_loc)); 201 | return M_IC_MAKE_TERM(LAM, 0, lam0_loc); 202 | } else { 203 | heap[col_loc] = M_IC_MAKE_SUB(M_IC_MAKE_TERM(LAM, 0, lam0_loc)); 204 | return M_IC_MAKE_TERM(LAM, 0, lam1_loc); 205 | } 206 | } 207 | 208 | /** 209 | * Collapse a superposition. 210 | * @param heap Heap memory 211 | * @param interactions Interaction counter 212 | * @param heap_pos Current heap position 213 | * @param heap_size Total heap size 214 | * @param col Duplication term 215 | * @param sup Superposition term 216 | * @return Result of the interaction 217 | */ 218 | inline Term m_ic_col_sup(device Term* heap, device atomic_uint& interactions, 219 | device uint32_t& heap_pos, constant uint32_t& heap_size, 220 | Term col, Term sup) { 221 | atomic_fetch_add_explicit(&interactions, 1, memory_order_relaxed); 222 | 223 | // Cache frequent values 224 | const uint32_t col_loc = M_IC_GET_VAL(col); 225 | const uint32_t sup_loc = M_IC_GET_VAL(sup); 226 | const uint8_t col_lab = M_IC_GET_LAB(col); 227 | const uint8_t sup_lab = M_IC_GET_LAB(sup); 228 | const uint8_t is_co0 = (M_IC_GET_TAG(col) == DP0); 229 | 230 | // Load values needed for both paths 231 | const Term lft = heap[sup_loc + 0]; 232 | const Term rgt = heap[sup_loc + 1]; 233 | 234 | // Fast path for matching labels (common case) 235 | if (col_lab == sup_lab) { 236 | // Labels match: simple substitution 237 | if (is_co0) { 238 | heap[col_loc] = M_IC_MAKE_SUB(rgt); 239 | return lft; 240 | } else { 241 | heap[col_loc] = M_IC_MAKE_SUB(lft); 242 | return rgt; 243 | } 244 | } else { 245 | // Labels don't match: create nested collapsers 246 | const uint32_t sup_start = m_ic_alloc(heap_pos, 4, heap_size); // 2 sups with 2 terms each 247 | const uint32_t sup0_loc = sup_start; 248 | const uint32_t sup1_loc = sup_start + 2; 249 | 250 | // Use existing locations as collapser locations 251 | const uint32_t col_lft_loc = sup_loc + 0; 252 | const uint32_t col_rgt_loc = sup_loc + 1; 253 | 254 | // Set up the first superposition (for DP0) 255 | heap[sup0_loc + 0] = M_IC_MAKE_TERM(DP0, col_lab, col_lft_loc); 256 | heap[sup0_loc + 1] = M_IC_MAKE_TERM(DP0, col_lab, col_rgt_loc); 257 | 258 | // Set up the second superposition (for DP1) 259 | heap[sup1_loc + 0] = M_IC_MAKE_TERM(DP1, col_lab, col_lft_loc); 260 | heap[sup1_loc + 1] = M_IC_MAKE_TERM(DP1, col_lab, col_rgt_loc); 261 | 262 | // Set up original collapsers to point to lft and rgt 263 | heap[col_lft_loc] = lft; 264 | heap[col_rgt_loc] = rgt; 265 | 266 | if (is_co0) { 267 | heap[col_loc] = M_IC_MAKE_SUB(M_IC_MAKE_TERM(SUP, sup_lab, sup1_loc)); 268 | return M_IC_MAKE_TERM(SUP, sup_lab, sup0_loc); 269 | } else { 270 | heap[col_loc] = M_IC_MAKE_SUB(M_IC_MAKE_TERM(SUP, sup_lab, sup0_loc)); 271 | return M_IC_MAKE_TERM(SUP, sup_lab, sup1_loc); 272 | } 273 | } 274 | } 275 | 276 | // ----------------------------------------------------------------------------- 277 | // Term Normalization 278 | // ----------------------------------------------------------------------------- 279 | 280 | /** 281 | * Reduce a term to weak head normal form (WHNF). 282 | * @param heap Heap memory 283 | * @param stack Evaluation stack 284 | * @param stack_pos Current stack position reference 285 | * @param stack_size Total stack size 286 | * @param heap_pos Current heap position reference 287 | * @param heap_size Total heap size 288 | * @param interactions Interaction counter 289 | * @param term The term to reduce 290 | * @return The term in WHNF 291 | */ 292 | inline Term m_ic_whnf(device Term* heap, device Term* stack, 293 | device uint32_t& stack_pos, constant uint32_t& stack_size, 294 | device uint32_t& heap_pos, constant uint32_t& heap_size, 295 | device atomic_uint& interactions, Term term) { 296 | // Cache frequently used variables in registers 297 | uint32_t stop = stack_pos; 298 | Term next = term; 299 | uint32_t sp = stop; 300 | 301 | // Main normalization loop 302 | while (true) { 303 | // Get tag with optimized macro 304 | const uint tag = M_IC_GET_TAG(next); 305 | 306 | switch (tag) { 307 | case VAR: { 308 | // Variable case 309 | const uint32_t var_loc = M_IC_GET_VAL(next); 310 | const Term subst = heap[var_loc]; 311 | if (subst & TERM_SUB_MASK) { // Direct bit test 312 | next = M_IC_CLEAR_SUB(subst); 313 | continue; 314 | } 315 | break; // No substitution, so it's in WHNF 316 | } 317 | 318 | case DP0: 319 | case DP1: { 320 | // Duplication case 321 | const uint32_t col_loc = M_IC_GET_VAL(next); 322 | const Term val = heap[col_loc]; 323 | if (val & TERM_SUB_MASK) { // Direct bit test 324 | next = M_IC_CLEAR_SUB(val); 325 | continue; 326 | } else { 327 | // Push to stack 328 | if (sp < stack_size) { 329 | stack[sp++] = next; 330 | next = val; 331 | continue; 332 | } else { 333 | // Stack overflow 334 | break; 335 | } 336 | } 337 | } 338 | 339 | case APP: { 340 | // Application case 341 | const uint32_t app_loc = M_IC_GET_VAL(next); 342 | 343 | // Push to stack 344 | if (sp < stack_size) { 345 | stack[sp++] = next; 346 | next = heap[app_loc]; // Reduce the function part 347 | continue; 348 | } else { 349 | // Stack overflow 350 | break; 351 | } 352 | } 353 | 354 | default: { // SUP, LAM 355 | // Handle default case (SUP, LAM) 356 | if (sp == stop) { 357 | stack_pos = sp; // Update stack position before return 358 | return next; // Stack empty, term is in WHNF 359 | } else { 360 | // Pop from stack 361 | Term prev = stack[--sp]; 362 | 363 | // Get tag 364 | const uint ptag = M_IC_GET_TAG(prev); 365 | 366 | // Handle interactions based on term types 367 | if (ptag == APP && tag == LAM) { 368 | next = m_ic_app_lam(heap, interactions, prev, next); 369 | continue; 370 | } 371 | else if (ptag == APP && tag == SUP) { 372 | next = m_ic_app_sup(heap, interactions, heap_pos, heap_size, prev, next); 373 | continue; 374 | } 375 | else if ((ptag == DP0 || ptag == DP1) && tag == LAM) { 376 | next = m_ic_col_lam(heap, interactions, heap_pos, heap_size, prev, next); 377 | continue; 378 | } 379 | else if ((ptag == DP0 || ptag == DP1) && tag == SUP) { 380 | next = m_ic_col_sup(heap, interactions, heap_pos, heap_size, prev, next); 381 | continue; 382 | } 383 | 384 | // No interaction found, return to stack 385 | stack[sp++] = prev; 386 | break; 387 | } 388 | } 389 | } 390 | 391 | // After processing, check stack and update heap if needed 392 | if (sp == stop) { 393 | stack_pos = sp; 394 | return next; // Stack empty, return WHNF 395 | } else { 396 | // Process remaining stack 397 | while (sp > stop) { 398 | // Direct stack access 399 | Term host = stack[--sp]; 400 | 401 | // Extract components 402 | const uint htag = M_IC_GET_TAG(host); 403 | const uint32_t hloc = M_IC_GET_VAL(host); 404 | 405 | // Update the heap with the reduced term - only for specific tags 406 | if (htag == APP || htag == DP0 || htag == DP1) { 407 | heap[hloc] = next; 408 | } 409 | next = host; 410 | } 411 | stack_pos = sp; 412 | return next; // Return updated original term 413 | } 414 | } 415 | } 416 | 417 | /** 418 | * Reduce a term to full normal form by recursively applying WHNF 419 | * to all subterms. 420 | * 421 | * @param heap Heap memory 422 | * @param stack Evaluation stack 423 | * @param stack_pos Current stack position reference 424 | * @param stack_size Total stack size 425 | * @param heap_pos Current heap position reference 426 | * @param heap_size Total heap size 427 | * @param interactions Interaction counter 428 | * @param term The term to normalize 429 | * @return The fully normalized term 430 | */ 431 | inline Term m_ic_normal(device Term* heap, device Term* stack, 432 | device uint32_t& stack_pos, constant uint32_t& stack_size, 433 | device uint32_t& heap_pos, constant uint32_t& heap_size, 434 | device atomic_uint& interactions, Term term) { 435 | // Reset stack 436 | stack_pos = 0; 437 | uint32_t sp = 0; 438 | 439 | // Allocate a new node for the initial term 440 | uint32_t root_loc = m_ic_alloc(heap_pos, 1, heap_size); 441 | heap[root_loc] = term; 442 | 443 | // Push initial location to stack 444 | stack[sp++] = (root_loc & TERM_VAL_MASK); 445 | 446 | // Main normalization loop 447 | while (sp > 0) { 448 | // Pop current location from stack 449 | const uint32_t loc = stack[--sp] & TERM_VAL_MASK; 450 | 451 | // Get term at this location 452 | Term current = heap[loc]; 453 | 454 | // Reduce to WHNF 455 | stack_pos = sp; 456 | current = m_ic_whnf(heap, stack, stack_pos, stack_size, 457 | heap_pos, heap_size, interactions, current); 458 | sp = stack_pos; 459 | 460 | // Store the WHNF term back to the heap 461 | heap[loc] = current; 462 | 463 | // Get term details 464 | const uint tag = M_IC_GET_TAG(current); 465 | const uint32_t val = M_IC_GET_VAL(current); 466 | 467 | // Push subterm locations based on term type 468 | if (tag == LAM) { 469 | if (sp < stack_size) { 470 | stack[sp++] = val & TERM_VAL_MASK; 471 | } 472 | } 473 | else if (tag == APP || tag == SUP) { 474 | // Both APP and SUP need to push two locations 475 | if (sp + 1 < stack_size) { 476 | stack[sp++] = val & TERM_VAL_MASK; 477 | stack[sp++] = (val + 1) & TERM_VAL_MASK; 478 | } 479 | } 480 | // Other tags have no subterms to process 481 | } 482 | 483 | // Update stack position and return the fully normalized term 484 | stack_pos = sp; 485 | return heap[root_loc]; 486 | } 487 | 488 | /** 489 | * Main Metal kernel function to normalize a term. 490 | */ 491 | kernel void normalizeKernel(device Term* heap [[buffer(0)]], 492 | device Term* stack [[buffer(1)]], 493 | device uint32_t& heap_pos [[buffer(2)]], 494 | device uint32_t& stack_pos [[buffer(3)]], 495 | device atomic_uint& interactions [[buffer(4)]], 496 | constant uint32_t& heap_size [[buffer(5)]], 497 | constant uint32_t& stack_size [[buffer(6)]], 498 | uint gid [[thread_position_in_grid]]) { 499 | // Only use thread 0 in the grid 500 | if (gid == 0) { 501 | // Get the term from the heap's entry point 502 | Term term = heap[0]; 503 | 504 | // Perform normalization 505 | term = m_ic_normal(heap, stack, stack_pos, stack_size, 506 | heap_pos, heap_size, interactions, term); 507 | 508 | // Store the result back to the heap's entry point 509 | heap[0] = term; 510 | } 511 | } 512 | -------------------------------------------------------------------------------- /src/ic_metal.mm: -------------------------------------------------------------------------------- 1 | #import 2 | #import 3 | #include "ic.h" 4 | 5 | /** 6 | * Interaction Calculus (IC) - Metal Objective-C++ bridge file 7 | * 8 | * This file provides the bridge between the main C implementation 9 | * and the Metal GPU implementation for accelerated normalization: 10 | * - Metal context creation and management 11 | * - Metal device, command queue, and pipeline setup 12 | * - Metal buffer management and synchronization 13 | */ 14 | 15 | // Structure to hold Metal-specific resources 16 | typedef struct { 17 | id device; 18 | id commandQueue; 19 | id library; 20 | id normalizeFunction; 21 | id normalizePipeline; 22 | id heapBuffer; 23 | id stackBuffer; 24 | id heapPosBuffer; 25 | id stackPosBuffer; 26 | id interactionsBuffer; 27 | id heapSizeBuffer; 28 | id stackSizeBuffer; 29 | bool initialized; 30 | } MetalContext; 31 | 32 | // Global Metal context 33 | static MetalContext metalContext = {0}; 34 | 35 | /** 36 | * Initialize the Metal environment. 37 | * @return true if initialization was successful, false otherwise 38 | */ 39 | static bool initMetal() { 40 | @autoreleasepool { 41 | // Get the default Metal device 42 | metalContext.device = MTLCreateSystemDefaultDevice(); 43 | if (!metalContext.device) { 44 | fprintf(stderr, "Metal: Error creating system default device\n"); 45 | return false; 46 | } 47 | 48 | // Create command queue 49 | metalContext.commandQueue = [metalContext.device newCommandQueue]; 50 | if (!metalContext.commandQueue) { 51 | fprintf(stderr, "Metal: Error creating command queue\n"); 52 | return false; 53 | } 54 | 55 | // Load Metal library from the default bundle 56 | NSError* error = nil; 57 | NSString* metalLibraryPath = [[NSBundle mainBundle] pathForResource:@"ic" ofType:@"metallib"]; 58 | 59 | if (metalLibraryPath) { 60 | // Load pre-compiled library if available 61 | NSURL* metalLibraryURL = [NSURL fileURLWithPath:metalLibraryPath]; 62 | metalContext.library = [metalContext.device newLibraryWithURL:metalLibraryURL error:&error]; 63 | } else { 64 | // If no pre-compiled library, load the source code and compile it 65 | NSString* shaderSource = [[NSBundle mainBundle] pathForResource:@"ic" ofType:@"metal"]; 66 | 67 | if (shaderSource) { 68 | metalContext.library = [metalContext.device newLibraryWithSource:shaderSource 69 | options:nil 70 | error:&error]; 71 | } else { 72 | // As a last resort, use the shader source from the implementation file 73 | NSString* shaderPath = [[NSBundle mainBundle] pathForResource:@"ic" ofType:@"metal"]; 74 | NSString* shaderSource = [NSString stringWithContentsOfFile:shaderPath 75 | encoding:NSUTF8StringEncoding 76 | error:&error]; 77 | 78 | if (shaderSource) { 79 | metalContext.library = [metalContext.device newLibraryWithSource:shaderSource 80 | options:nil 81 | error:&error]; 82 | } 83 | } 84 | } 85 | 86 | if (!metalContext.library) { 87 | fprintf(stderr, "Metal: Error creating library: %s\n", 88 | error ? [[error localizedDescription] UTF8String] : "unknown error"); 89 | return false; 90 | } 91 | 92 | // Get the normalize function from the library 93 | metalContext.normalizeFunction = [metalContext.library newFunctionWithName:@"normalizeKernel"]; 94 | if (!metalContext.normalizeFunction) { 95 | fprintf(stderr, "Metal: Failed to find the normalizeKernel function\n"); 96 | return false; 97 | } 98 | 99 | // Create compute pipeline 100 | metalContext.normalizePipeline = [metalContext.device newComputePipelineStateWithFunction:metalContext.normalizeFunction 101 | error:&error]; 102 | if (!metalContext.normalizePipeline) { 103 | fprintf(stderr, "Metal: Error creating compute pipeline: %s\n", 104 | [[error localizedDescription] UTF8String]); 105 | return false; 106 | } 107 | 108 | metalContext.initialized = true; 109 | return true; 110 | } 111 | } 112 | 113 | /** 114 | * Check if Metal is available on this system. 115 | * @return 1 if Metal is available, 0 otherwise 116 | */ 117 | extern "C" int ic_metal_available() { 118 | @autoreleasepool { 119 | id device = MTLCreateSystemDefaultDevice(); 120 | return device != nil; 121 | } 122 | } 123 | 124 | /** 125 | * Normalize a term using Metal. 126 | * @param ic The IC context 127 | * @param term The term to normalize 128 | * @return The normalized term 129 | */ 130 | extern "C" Term ic_normal_metal(IC* ic, Term term) { 131 | @autoreleasepool { 132 | // Initialize Metal if not already done 133 | if (!metalContext.initialized) { 134 | if (!initMetal()) { 135 | fprintf(stderr, "Metal: Failed to initialize Metal. Falling back to CPU.\n"); 136 | return term; 137 | } 138 | } 139 | 140 | // Get heap and stack parameters 141 | uint32_t heap_size = ic->heap_size; 142 | uint32_t stack_size = ic->stack_size; 143 | uint32_t heap_pos = ic->heap_pos; 144 | uint32_t stack_pos = 0; 145 | uint32_t interactions = 0; // Use uint32_t for Metal compatibility 146 | 147 | // Create Metal buffers 148 | metalContext.heapBuffer = [metalContext.device newBufferWithLength:heap_size * sizeof(Term) 149 | options:MTLResourceStorageModeShared]; 150 | 151 | metalContext.stackBuffer = [metalContext.device newBufferWithLength:stack_size * sizeof(Term) 152 | options:MTLResourceStorageModeShared]; 153 | 154 | metalContext.heapPosBuffer = [metalContext.device newBufferWithBytes:&heap_pos 155 | length:sizeof(uint32_t) 156 | options:MTLResourceStorageModeShared]; 157 | 158 | metalContext.stackPosBuffer = [metalContext.device newBufferWithBytes:&stack_pos 159 | length:sizeof(uint32_t) 160 | options:MTLResourceStorageModeShared]; 161 | 162 | metalContext.interactionsBuffer = [metalContext.device newBufferWithBytes:&interactions 163 | length:sizeof(uint32_t) 164 | options:MTLResourceStorageModeShared]; 165 | 166 | metalContext.heapSizeBuffer = [metalContext.device newBufferWithBytes:&heap_size 167 | length:sizeof(uint32_t) 168 | options:MTLResourceStorageModeShared]; 169 | 170 | metalContext.stackSizeBuffer = [metalContext.device newBufferWithBytes:&stack_size 171 | length:sizeof(uint32_t) 172 | options:MTLResourceStorageModeShared]; 173 | 174 | // Verify buffer allocation 175 | if (!metalContext.heapBuffer || !metalContext.stackBuffer || 176 | !metalContext.heapPosBuffer || !metalContext.stackPosBuffer || 177 | !metalContext.interactionsBuffer || !metalContext.heapSizeBuffer || 178 | !metalContext.stackSizeBuffer) { 179 | fprintf(stderr, "Metal: Failed to create buffers\n"); 180 | return term; 181 | } 182 | 183 | // Copy heap data to the Metal buffer 184 | Term* heapData = (Term*)metalContext.heapBuffer.contents; 185 | memcpy(heapData, ic->heap, ic->heap_pos * sizeof(Term)); 186 | 187 | // Set up Metal command execution 188 | id commandBuffer = [metalContext.commandQueue commandBuffer]; 189 | id computeEncoder = [commandBuffer computeCommandEncoder]; 190 | 191 | // Configure the compute command encoder 192 | [computeEncoder setComputePipelineState:metalContext.normalizePipeline]; 193 | 194 | // Set buffer arguments for the kernel 195 | [computeEncoder setBuffer:metalContext.heapBuffer offset:0 atIndex:0]; 196 | [computeEncoder setBuffer:metalContext.stackBuffer offset:0 atIndex:1]; 197 | [computeEncoder setBuffer:metalContext.heapPosBuffer offset:0 atIndex:2]; 198 | [computeEncoder setBuffer:metalContext.stackPosBuffer offset:0 atIndex:3]; 199 | [computeEncoder setBuffer:metalContext.interactionsBuffer offset:0 atIndex:4]; 200 | [computeEncoder setBuffer:metalContext.heapSizeBuffer offset:0 atIndex:5]; 201 | [computeEncoder setBuffer:metalContext.stackSizeBuffer offset:0 atIndex:6]; 202 | 203 | // Configure grid and threadgroup sizes 204 | MTLSize gridSize = MTLSizeMake(1, 1, 1); 205 | MTLSize threadGroupSize = MTLSizeMake(1, 1, 1); 206 | 207 | // Dispatch the kernel 208 | [computeEncoder dispatchThreadgroups:gridSize threadsPerThreadgroup:threadGroupSize]; 209 | [computeEncoder endEncoding]; 210 | 211 | // Add completion handler 212 | [commandBuffer addCompletedHandler:^(id buffer) { 213 | if (buffer.error) { 214 | NSLog(@"Metal: Command buffer execution failed: %@", buffer.error); 215 | } 216 | }]; 217 | 218 | // Execute the command buffer 219 | [commandBuffer commit]; 220 | [commandBuffer waitUntilCompleted]; 221 | 222 | // Read back results 223 | heap_pos = *(uint32_t*)metalContext.heapPosBuffer.contents; 224 | stack_pos = *(uint32_t*)metalContext.stackPosBuffer.contents; 225 | interactions = *(uint32_t*)metalContext.interactionsBuffer.contents; 226 | 227 | // Copy data back from Metal buffer to IC heap 228 | memcpy(ic->heap, heapData, heap_pos * sizeof(Term)); 229 | 230 | // Update IC state 231 | ic->heap_pos = heap_pos; 232 | ic->interactions += interactions; 233 | 234 | // Return the normalized term 235 | return ic->heap[0]; 236 | } 237 | } 238 | 239 | /** 240 | * Compile the Metal shader file. 241 | * @param metal_file_path Path to the Metal shader file 242 | * @return true if compilation was successful, false otherwise 243 | */ 244 | extern "C" bool ic_metal_compile_shader(const char* metal_file_path) { 245 | @autoreleasepool { 246 | // Initialize Metal if not already done 247 | if (!metalContext.initialized) { 248 | if (!initMetal()) { 249 | return false; 250 | } 251 | } 252 | 253 | NSError* error = nil; 254 | NSString* sourcePath = [NSString stringWithUTF8String:metal_file_path]; 255 | NSString* shaderSource = [NSString stringWithContentsOfFile:sourcePath 256 | encoding:NSUTF8StringEncoding 257 | error:&error]; 258 | 259 | if (!shaderSource) { 260 | fprintf(stderr, "Metal: Error reading shader source: %s\n", 261 | error ? [[error localizedDescription] UTF8String] : "unknown error"); 262 | return false; 263 | } 264 | 265 | // Compile the shader 266 | id library = [metalContext.device newLibraryWithSource:shaderSource 267 | options:nil 268 | error:&error]; 269 | 270 | if (!library) { 271 | fprintf(stderr, "Metal: Error compiling shader: %s\n", 272 | error ? [[error localizedDescription] UTF8String] : "unknown error"); 273 | return false; 274 | } 275 | 276 | // Check that our function exists 277 | id normalizeFunction = [library newFunctionWithName:@"normalizeKernel"]; 278 | if (!normalizeFunction) { 279 | fprintf(stderr, "Metal: Failed to find the normalizeKernel function\n"); 280 | return false; 281 | } 282 | 283 | printf("Metal: Shader compiled successfully\n"); 284 | return true; 285 | } 286 | } -------------------------------------------------------------------------------- /src/main.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include "ic.h" 7 | #include "collapse.h" 8 | #include "parse.h" 9 | #include "show.h" 10 | 11 | // Forward declarations for Metal GPU functions 12 | #ifdef HAVE_METAL 13 | extern Term ic_normal_metal(IC* ic, Term term); 14 | extern int ic_metal_available(); 15 | #endif 16 | 17 | // Stub functions when Metal is not available 18 | #ifndef HAVE_METAL 19 | static inline int ic_metal_available() { 20 | return 0; // Metal not available 21 | } 22 | 23 | static inline Term ic_normal_metal(IC* ic, Term term) { 24 | fprintf(stderr, "Warning: Metal GPU support not compiled. Running on CPU instead.\n"); 25 | return ic_normal(ic, term); 26 | } 27 | #endif 28 | 29 | // Default test term string 30 | const char* DEFAULT_TEST_TERM = "(λf.λx.(f (f (f x))) λb.(b λt.λf.f λt.λf.t) λt.λf.t)"; 31 | 32 | // Function declarations 33 | static Term normalize_term(IC* ic, Term term, int use_gpu, int use_collapse, int thread_count); 34 | static void process_term(IC* ic, Term term, int use_gpu, int use_collapse, int thread_count); 35 | static void benchmark_term(IC* ic, Term term, int use_gpu, int use_collapse, int thread_count); 36 | static void test(IC* ic, int use_gpu, int use_collapse, int thread_count); 37 | static void print_usage(void); 38 | 39 | // Normalize a term based on mode flags 40 | static Term normalize_term(IC* ic, Term term, int use_gpu, int use_collapse, int thread_count) { 41 | if (use_collapse) { 42 | if (use_gpu) { 43 | fprintf(stderr, "Warning: Collapse mode is not available for GPU. Using normal GPU normalization.\n"); 44 | if (ic_metal_available()) { 45 | return ic_normal_metal(ic, term); 46 | } else { 47 | fprintf(stderr, "Warning: No GPU acceleration available. Falling back to CPU normalization.\n"); 48 | return ic_normal(ic, term); 49 | } 50 | } else { 51 | term = ic_collapse_sups(ic, term); 52 | term = ic_collapse_dups(ic, term); 53 | return term; 54 | } 55 | } else { 56 | if (use_gpu) { 57 | if (ic_metal_available()) { 58 | return ic_normal_metal(ic, term); 59 | } else { 60 | fprintf(stderr, "Warning: No GPU acceleration available. Falling back to CPU normalization.\n"); 61 | return ic_normal(ic, term); 62 | } 63 | } else { 64 | return ic_normal(ic, term); 65 | } 66 | } 67 | } 68 | 69 | // Process and print results of term normalization 70 | static void process_term(IC* ic, Term term, int use_gpu, int use_collapse, int thread_count) { 71 | ic->interactions = 0; // Reset interaction counter 72 | 73 | struct timeval start_time, current_time; 74 | gettimeofday(&start_time, NULL); 75 | 76 | term = normalize_term(ic, term, use_gpu, use_collapse, thread_count); 77 | 78 | gettimeofday(¤t_time, NULL); 79 | double elapsed_seconds = (current_time.tv_sec - start_time.tv_sec) + 80 | (current_time.tv_usec - start_time.tv_usec) / 1000000.0; 81 | 82 | size_t size = ic->heap_pos; // Heap size in nodes 83 | double perf = elapsed_seconds > 0 ? (ic->interactions / elapsed_seconds) / 1000000.0 : 0.0; 84 | 85 | // Use namespaced version with '$' prefix when collapse mode is off 86 | if (use_collapse) { 87 | show_term(stdout, ic, term); 88 | } else { 89 | show_term_namespaced(stdout, ic, term, "$"); 90 | } 91 | printf("\n\n"); 92 | printf("WORK: %llu interactions\n", ic->interactions); 93 | printf("TIME: %.7f seconds\n", elapsed_seconds); 94 | printf("SIZE: %zu nodes\n", size); 95 | printf("PERF: %.3f MIPS\n", perf); 96 | 97 | const char* mode_str; 98 | if (use_collapse && !use_gpu) { 99 | mode_str = "CPU (collapse)"; 100 | } else if (use_gpu) { 101 | if (ic_metal_available()) { 102 | mode_str = "Metal GPU"; 103 | } else { 104 | mode_str = "CPU"; 105 | } 106 | } else { 107 | mode_str = "CPU"; 108 | } 109 | printf("MODE: %s\n", mode_str); 110 | if (use_gpu && use_collapse) { 111 | printf("Note: Collapse mode is not available for GPU. Used normal GPU normalization.\n"); 112 | } 113 | printf("\n"); 114 | } 115 | 116 | // Benchmark normalization performance over 1 second 117 | static void benchmark_term(IC* ic, Term term, int use_gpu, int use_collapse, int thread_count) { 118 | // Snapshot initial heap state 119 | Val original_heap_pos = ic->heap_pos; 120 | Term* original_heap_state = (Term*)malloc(original_heap_pos * sizeof(Term)); 121 | if (!original_heap_state) { 122 | fprintf(stderr, "Error: Memory allocation failed for heap snapshot\n"); 123 | return; 124 | } 125 | memcpy(original_heap_state, ic->heap, original_heap_pos * sizeof(Term)); 126 | Term original_term = term; 127 | 128 | // Normalize once to show result 129 | Term result = normalize_term(ic, term, use_gpu, use_collapse, thread_count); 130 | // Use namespaced version with '$' prefix when collapse mode is off 131 | if (use_collapse) { 132 | show_term(stdout, ic, result); 133 | } else { 134 | show_term_namespaced(stdout, ic, result, "$"); 135 | } 136 | printf("\n\n"); 137 | 138 | // Benchmark loop 139 | uint64_t total_interactions = 0; 140 | uint64_t iterations = 0; 141 | struct timeval start_time, current_time; 142 | gettimeofday(&start_time, NULL); 143 | double elapsed_seconds = 0; 144 | 145 | while (elapsed_seconds < 1.0) { 146 | ic->heap_pos = original_heap_pos; 147 | memcpy(ic->heap, original_heap_state, original_heap_pos * sizeof(Term)); 148 | ic->interactions = 0; 149 | 150 | normalize_term(ic, original_term, use_gpu, use_collapse, thread_count); 151 | 152 | total_interactions += ic->interactions; 153 | iterations++; 154 | 155 | gettimeofday(¤t_time, NULL); 156 | elapsed_seconds = (current_time.tv_sec - start_time.tv_sec) + 157 | (current_time.tv_usec - start_time.tv_usec) / 1000000.0; 158 | } 159 | 160 | double mips = (total_interactions / elapsed_seconds) / 1000000.0; 161 | 162 | printf("BENCHMARK:\n"); 163 | printf("- LOOP: %u\n", iterations); 164 | printf("- WORK: %llu\n", total_interactions); 165 | printf("- TIME: %.3f seconds\n", elapsed_seconds); 166 | printf("- PERF: %.3f MIPS\n", mips); 167 | 168 | const char* mode_str; 169 | if (use_collapse && !use_gpu) { 170 | mode_str = "CPU (collapse)"; 171 | } else if (use_gpu) { 172 | if (ic_metal_available()) { 173 | mode_str = "Metal GPU"; 174 | } else { 175 | mode_str = "CPU"; 176 | } 177 | } else { 178 | mode_str = "CPU"; 179 | } 180 | printf("- MODE: %s\n", mode_str); 181 | if (use_gpu && use_collapse) { 182 | printf("- Note: Collapse mode is not available for GPU. Used normal GPU normalization.\n"); 183 | } 184 | 185 | free(original_heap_state); 186 | } 187 | 188 | // Run default test term 189 | static void test(IC* ic, int use_gpu, int use_collapse, int thread_count) { 190 | printf("Running with default test term: %s\n", DEFAULT_TEST_TERM); 191 | Term term = parse_string(ic, DEFAULT_TEST_TERM); 192 | process_term(ic, term, use_gpu, use_collapse, thread_count); 193 | } 194 | 195 | // Print command-line usage 196 | static void print_usage(void) { 197 | printf("Usage: ic [arguments] [options]\n\n"); 198 | printf("Commands:\n"); 199 | printf(" run - Parse and normalize a IC file on CPU\n"); 200 | printf(" run-gpu - Parse and normalize a IC file on GPU (Metal)\n"); 201 | printf(" eval - Parse and normalize a IC expression on CPU\n"); 202 | printf(" eval-gpu - Parse and normalize a IC expression on GPU (Metal)\n"); 203 | printf(" bench - Benchmark normalization of a IC file on CPU\n"); 204 | printf(" bench-gpu - Benchmark normalization of a IC file on GPU (Metal)\n"); 205 | printf("\n"); 206 | printf("Options:\n"); 207 | printf(" -C - Use collapse mode (CPU only)\n"); 208 | printf("\n"); 209 | } 210 | 211 | int main(int argc, char* argv[]) { 212 | IC* ic = ic_default_new(); 213 | if (!ic) { 214 | fprintf(stderr, "Error: Failed to initialize IC context\n"); 215 | return 1; 216 | } 217 | 218 | int result = 0; 219 | int use_gpu = 0; 220 | int use_collapse = 0; 221 | int thread_count = 1; 222 | 223 | if (argc < 2) { 224 | test(ic, 0, 0, thread_count); 225 | goto cleanup; 226 | } 227 | 228 | const char* command = argv[1]; 229 | if (strcmp(command, "run-gpu") == 0 || strcmp(command, "eval-gpu") == 0 || strcmp(command, "bench-gpu") == 0) { 230 | use_gpu = 1; 231 | } else if (strcmp(command, "run") != 0 && strcmp(command, "eval") != 0 && strcmp(command, "bench") != 0) { 232 | fprintf(stderr, "Error: Unknown command '%s'\n", command); 233 | print_usage(); 234 | result = 1; 235 | goto cleanup; 236 | } 237 | 238 | if (argc < 3) { 239 | fprintf(stderr, "Error: No term source specified\n"); 240 | print_usage(); 241 | result = 1; 242 | goto cleanup; 243 | } 244 | 245 | // Parse flags 246 | for (int i = 3; i < argc; i++) { 247 | if (strcmp(argv[i], "-C") == 0) { 248 | use_collapse = 1; 249 | } else { 250 | fprintf(stderr, "Error: Unknown flag '%s'\n", argv[i]); 251 | print_usage(); 252 | result = 1; 253 | goto cleanup; 254 | } 255 | } 256 | 257 | // Parse term based on command 258 | Term term; 259 | if (strcmp(command, "eval") == 0 || strcmp(command, "eval-gpu") == 0) { 260 | term = parse_string(ic, argv[2]); 261 | } else { // run, run-gpu, bench, bench-gpu 262 | term = parse_file(ic, argv[2]); 263 | } 264 | 265 | // Execute command 266 | if (strcmp(command, "bench") == 0 || strcmp(command, "bench-gpu") == 0) { 267 | benchmark_term(ic, term, use_gpu, use_collapse, thread_count); 268 | } else { // run, run-gpu, eval, eval-gpu 269 | process_term(ic, term, use_gpu, use_collapse, thread_count); 270 | } 271 | 272 | cleanup: 273 | ic_free(ic); 274 | return result; 275 | } 276 | -------------------------------------------------------------------------------- /src/parse.c: -------------------------------------------------------------------------------- 1 | // parse.c 2 | #include "parse.h" 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | // Forward declarations 9 | Val parse_term_alloc(Parser* parser); 10 | void parse_term(Parser* parser, Val loc); 11 | void skip(Parser* parser); 12 | char peek_char(Parser* parser); 13 | char next_char(Parser* parser); 14 | bool peek_is(Parser* parser, char c); 15 | void parse_error(Parser* parser, const char* message); 16 | 17 | // Helper functions 18 | static bool starts_with_dollar(const char* name) { 19 | return name[0] == '$'; 20 | } 21 | 22 | static size_t find_or_add_global_var(Parser* parser, const char* name) { 23 | for (size_t i = 0; i < parser->global_vars_count; i++) { 24 | if (strcmp(parser->global_vars[i].name, name) == 0) { 25 | return i; 26 | } 27 | } 28 | if (parser->global_vars_count >= MAX_GLOBAL_VARS) { 29 | parse_error(parser, "Too many global variables"); 30 | } 31 | size_t idx = parser->global_vars_count++; 32 | Binder* binder = &parser->global_vars[idx]; 33 | strncpy(binder->name, name, MAX_NAME_LEN - 1); 34 | binder->name[MAX_NAME_LEN - 1] = '\0'; 35 | binder->var = NONE; 36 | binder->loc = NONE; 37 | return idx; 38 | } 39 | 40 | static void push_lexical_binder(Parser* parser, const char* name, Term term) { 41 | if (parser->lexical_vars_count >= MAX_LEXICAL_VARS) { 42 | parse_error(parser, "Too many lexical binders"); 43 | } 44 | Binder* binder = &parser->lexical_vars[parser->lexical_vars_count]; 45 | strncpy(binder->name, name, MAX_NAME_LEN - 1); 46 | binder->name[MAX_NAME_LEN - 1] = '\0'; 47 | binder->var = term; 48 | binder->loc = NONE; 49 | parser->lexical_vars_count++; 50 | } 51 | 52 | static void pop_lexical_binder(Parser* parser) { 53 | if (parser->lexical_vars_count > 0) { 54 | parser->lexical_vars_count--; 55 | } 56 | } 57 | 58 | static Binder* find_lexical_binder(Parser* parser, const char* name) { 59 | for (int i = parser->lexical_vars_count - 1; i >= 0; i--) { 60 | if (strcmp(parser->lexical_vars[i].name, name) == 0) { 61 | return &parser->lexical_vars[i]; 62 | } 63 | } 64 | return NULL; 65 | } 66 | 67 | static void resolve_global_vars(Parser* parser) { 68 | for (size_t i = 0; i < parser->global_vars_count; i++) { 69 | Binder* binder = &parser->global_vars[i]; 70 | if (binder->var == NONE) { 71 | char error[256]; 72 | snprintf(error, sizeof(error), "Undefined global variable: %s", binder->name); 73 | parse_error(parser, error); 74 | } 75 | if (binder->loc != NONE) { 76 | parser->ic->heap[binder->loc] = binder->var; 77 | } 78 | } 79 | } 80 | 81 | static void move_term(Parser* parser, Val from_loc, Val to_loc) { 82 | for (size_t i = 0; i < parser->global_vars_count; i++) { 83 | if (parser->global_vars[i].loc == from_loc) { 84 | parser->global_vars[i].loc = to_loc; 85 | } 86 | } 87 | for (size_t i = 0; i < parser->lexical_vars_count; i++) { 88 | if (parser->lexical_vars[i].loc == from_loc) { 89 | parser->lexical_vars[i].loc = to_loc; 90 | } 91 | } 92 | parser->ic->heap[to_loc] = parser->ic->heap[from_loc]; 93 | } 94 | 95 | // Parse helper functions 96 | bool consume(Parser* parser, const char* str) { 97 | size_t len = strlen(str); 98 | skip(parser); 99 | if (strncmp(parser->input + parser->pos, str, len) == 0) { 100 | for (size_t i = 0; i < len; i++) { 101 | next_char(parser); 102 | } 103 | return true; 104 | } 105 | return false; 106 | } 107 | 108 | void parse_error(Parser* parser, const char* message) { 109 | fprintf(stderr, "Parse error at line %zu, column %zu: %s\n", 110 | parser->line, parser->col, message); 111 | fprintf(stderr, "Input:\n%s\n", parser->input); 112 | fprintf(stderr, " "); 113 | for (size_t i = 0; i < parser->pos && i < 40; i++) { 114 | fprintf(stderr, " "); 115 | } 116 | fprintf(stderr, "^\n"); 117 | exit(1); 118 | } 119 | 120 | bool expect(Parser* parser, const char* token, const char* error_context) { 121 | if (!consume(parser, token)) { 122 | char error[256]; 123 | snprintf(error, sizeof(error), "Expected '%s' %s", token, error_context); 124 | parse_error(parser, error); 125 | return false; 126 | } 127 | return true; 128 | } 129 | 130 | void init_parser(Parser* parser, IC* ic, const char* input) { 131 | parser->ic = ic; 132 | parser->input = input; 133 | parser->pos = 0; 134 | parser->line = 1; 135 | parser->col = 1; 136 | parser->global_vars_count = 0; 137 | parser->lexical_vars_count = 0; 138 | } 139 | 140 | static void parse_name(Parser* parser, char* name) { 141 | size_t i = 0; 142 | char c = peek_char(parser); 143 | if (!isalpha(c) && c != '_' && c != '$') { 144 | parse_error(parser, "Expected name starting with letter, underscore, or '$'"); 145 | } 146 | while (isalnum(peek_char(parser)) || peek_char(parser) == '_' || peek_char(parser) == '$') { 147 | if (i < MAX_NAME_LEN - 1) { 148 | name[i++] = next_char(parser); 149 | } else { 150 | parse_error(parser, "Name too long"); 151 | } 152 | } 153 | name[i] = '\0'; 154 | } 155 | 156 | char next_char(Parser* parser) { 157 | char c = parser->input[parser->pos++]; 158 | if (c == '\n') { 159 | parser->line++; 160 | parser->col = 1; 161 | } else { 162 | parser->col++; 163 | } 164 | return c; 165 | } 166 | 167 | char peek_char(Parser* parser) { 168 | return parser->input[parser->pos]; 169 | } 170 | 171 | bool peek_is(Parser* parser, char c) { 172 | return peek_char(parser) == c; 173 | } 174 | 175 | void store_term(Parser* parser, Val loc, TermTag tag, Lab lab, Val value) { 176 | parser->ic->heap[loc] = ic_make_term(tag, lab, value); 177 | } 178 | 179 | Val parse_uint(Parser* parser) { 180 | Val value = 0; 181 | bool has_digit = false; 182 | while (isdigit(peek_char(parser))) { 183 | value = value * 10 + (next_char(parser) - '0'); 184 | has_digit = true; 185 | } 186 | if (!has_digit) { 187 | parse_error(parser, "Expected digit"); 188 | } 189 | return value; 190 | } 191 | 192 | void skip(Parser* parser) { 193 | while (1) { 194 | char c = peek_char(parser); 195 | if (isspace(c)) { 196 | next_char(parser); 197 | } else if (c == '/' && parser->input[parser->pos + 1] == '/') { 198 | next_char(parser); 199 | next_char(parser); 200 | while (peek_char(parser) != '\0' && peek_char(parser) != '\n') { 201 | next_char(parser); 202 | } 203 | if (peek_char(parser) == '\n') { 204 | next_char(parser); 205 | } 206 | } else { 207 | break; 208 | } 209 | } 210 | } 211 | 212 | bool check_utf8(Parser* parser, uint8_t b1, uint8_t b2) { 213 | return (unsigned char)parser->input[parser->pos] == b1 && 214 | (unsigned char)parser->input[parser->pos + 1] == b2; 215 | } 216 | 217 | void consume_utf8(Parser* parser, int bytes) { 218 | for (int i = 0; i < bytes; i++) { 219 | next_char(parser); 220 | } 221 | } 222 | 223 | // Term parsing functions 224 | static void parse_term_var(Parser* parser, Val loc) { 225 | char name[MAX_NAME_LEN]; 226 | parse_name(parser, name); 227 | if (starts_with_dollar(name)) { 228 | size_t idx = find_or_add_global_var(parser, name); 229 | if (parser->global_vars[idx].var == NONE) { 230 | parser->global_vars[idx].loc = loc; 231 | } else { 232 | parser->ic->heap[loc] = parser->global_vars[idx].var; 233 | } 234 | } else { 235 | Binder* binder = find_lexical_binder(parser, name); 236 | if (binder == NULL) { 237 | char error[256]; 238 | snprintf(error, sizeof(error), "Undefined lexical variable: %s", name); 239 | parse_error(parser, error); 240 | } 241 | if (binder->loc == NONE) { 242 | parser->ic->heap[loc] = binder->var; 243 | binder->loc = loc; 244 | } else { 245 | Val dup_loc = ic_alloc(parser->ic, 1); 246 | parser->ic->heap[dup_loc] = parser->ic->heap[binder->loc]; 247 | Term dp0 = ic_make_co0(0, dup_loc); 248 | Term dp1 = ic_make_co1(0, dup_loc); 249 | parser->ic->heap[binder->loc] = dp0; 250 | parser->ic->heap[loc] = dp1; 251 | binder->loc = loc; 252 | } 253 | } 254 | } 255 | 256 | static void parse_term_lam(Parser* parser, Val loc) { 257 | if (check_utf8(parser, 0xCE, 0xBB)) { 258 | consume_utf8(parser, 2); 259 | } else if (!consume(parser, "λ")) { 260 | parse_error(parser, "Expected 'λ' for lambda"); 261 | } 262 | char name[MAX_NAME_LEN]; 263 | parse_name(parser, name); 264 | expect(parser, ".", "after name in lambda"); 265 | Val lam_node = ic_alloc(parser->ic, 1); 266 | Term var_term = ic_make_term(VAR, 0, lam_node); 267 | if (starts_with_dollar(name)) { 268 | size_t idx = find_or_add_global_var(parser, name); 269 | if (parser->global_vars[idx].var != NONE) { 270 | char error[256]; 271 | snprintf(error, sizeof(error), "Duplicate global variable binder: %s", name); 272 | parse_error(parser, error); 273 | } 274 | parser->global_vars[idx].var = var_term; 275 | } else { 276 | push_lexical_binder(parser, name, var_term); 277 | } 278 | parse_term(parser, lam_node); 279 | if (!starts_with_dollar(name)) { 280 | pop_lexical_binder(parser); 281 | } 282 | store_term(parser, loc, LAM, 0, lam_node); 283 | } 284 | 285 | static void parse_term_app(Parser* parser, Val loc) { 286 | expect(parser, "(", "for application"); 287 | parse_term(parser, loc); 288 | skip(parser); 289 | while (peek_char(parser) != ')') { 290 | Val app_node = ic_alloc(parser->ic, 2); 291 | move_term(parser, loc, app_node + 0); 292 | parse_term(parser, app_node + 1); 293 | store_term(parser, loc, APP, 0, app_node); 294 | skip(parser); 295 | } 296 | expect(parser, ")", "after terms in application"); 297 | } 298 | 299 | static void parse_term_sup(Parser* parser, Val loc) { 300 | expect(parser, "&", "for superposition"); 301 | Lab label = parse_uint(parser) & LAB_MAX; 302 | expect(parser, "{", "after label in superposition"); 303 | Val sup_node = ic_alloc(parser->ic, 2); 304 | parse_term(parser, sup_node + 0); 305 | expect(parser, ",", "between terms in superposition"); 306 | parse_term(parser, sup_node + 1); 307 | expect(parser, "}", "after terms in superposition"); 308 | parser->ic->heap[loc] = ic_make_sup(label, sup_node); 309 | } 310 | 311 | static void parse_term_dup(Parser* parser, Val loc) { 312 | expect(parser, "!&", "for duplication"); 313 | Lab label = parse_uint(parser) & LAB_MAX; 314 | expect(parser, "{", "after label in duplication"); 315 | char x0[MAX_NAME_LEN]; 316 | char x1[MAX_NAME_LEN]; 317 | parse_name(parser, x0); 318 | expect(parser, ",", "between names in duplication"); 319 | parse_name(parser, x1); 320 | expect(parser, "}", "after names in duplication"); 321 | expect(parser, "=", "after names in duplication"); 322 | Val dup_node = ic_alloc(parser->ic, 1); 323 | parse_term(parser, dup_node); 324 | expect(parser, ";", "after value in duplication"); 325 | Term co0_term = ic_make_co0(label, dup_node); 326 | Term co1_term = ic_make_co1(label, dup_node); 327 | if (starts_with_dollar(x0)) { 328 | size_t idx = find_or_add_global_var(parser, x0); 329 | if (parser->global_vars[idx].var != NONE) { 330 | char error[256]; 331 | snprintf(error, sizeof(error), "Duplicate global variable binder: %s", x0); 332 | parse_error(parser, error); 333 | } 334 | parser->global_vars[idx].var = co0_term; 335 | } else { 336 | push_lexical_binder(parser, x0, co0_term); 337 | } 338 | if (starts_with_dollar(x1)) { 339 | size_t idx = find_or_add_global_var(parser, x1); 340 | if (parser->global_vars[idx].var != NONE) { 341 | char error[256]; 342 | snprintf(error, sizeof(error), "Duplicate global variable binder: %s", x1); 343 | parse_error(parser, error); 344 | } 345 | parser->global_vars[idx].var = co1_term; 346 | } else { 347 | push_lexical_binder(parser, x1, co1_term); 348 | } 349 | parse_term(parser, loc); 350 | if (!starts_with_dollar(x1)) { 351 | pop_lexical_binder(parser); 352 | } 353 | if (!starts_with_dollar(x0)) { 354 | pop_lexical_binder(parser); 355 | } 356 | } 357 | 358 | static void parse_term_era(Parser* parser, Val loc) { 359 | expect(parser, "*", "for erasure"); 360 | store_term(parser, loc, ERA, 0, 0); 361 | } 362 | 363 | static void parse_term_num(Parser* parser, Val loc) { 364 | Val value = parse_uint(parser); 365 | store_term(parser, loc, NUM, 0, value); 366 | } 367 | 368 | static void parse_term_suc(Parser* parser, Val loc) { 369 | expect(parser, "+", "for successor"); 370 | Val suc_node = ic_alloc(parser->ic, 1); 371 | parse_term(parser, suc_node); 372 | store_term(parser, loc, SUC, 0, suc_node); 373 | } 374 | 375 | static void parse_term_swi(Parser* parser, Val loc) { 376 | expect(parser, "?", "for switch"); 377 | Val swi_node = ic_alloc(parser->ic, 3); 378 | parse_term(parser, swi_node); 379 | expect(parser, "{", "after condition in switch"); 380 | expect(parser, "0", "for zero case"); 381 | expect(parser, ":", "after '0'"); 382 | parse_term(parser, swi_node + 1); 383 | expect(parser, ";", "after zero case"); 384 | expect(parser, "+", "for successor case"); 385 | expect(parser, ":", "after '+'"); 386 | parse_term(parser, swi_node + 2); 387 | expect(parser, ";", "after successor case"); 388 | expect(parser, "}", "to close switch"); 389 | store_term(parser, loc, SWI, 0, swi_node); 390 | } 391 | 392 | static void parse_term_let(Parser* parser, Val loc) { 393 | expect(parser, "!", "for let expression"); 394 | char name[MAX_NAME_LEN]; 395 | parse_name(parser, name); 396 | expect(parser, "=", "after name in let expression"); 397 | Val app_node = ic_alloc(parser->ic, 2); 398 | Val lam_node = ic_alloc(parser->ic, 1); 399 | parse_term(parser, app_node + 1); 400 | expect(parser, ";", "after value in let expression"); 401 | Term var_term = ic_make_term(VAR, 0, lam_node); 402 | if (starts_with_dollar(name)) { 403 | size_t idx = find_or_add_global_var(parser, name); 404 | if (parser->global_vars[idx].var != NONE) { 405 | char error[256]; 406 | snprintf(error, sizeof(error), "Duplicate global variable binder: %s", name); 407 | parse_error(parser, error); 408 | } 409 | parser->global_vars[idx].var = var_term; 410 | } else { 411 | push_lexical_binder(parser, name, var_term); 412 | } 413 | parse_term(parser, lam_node); 414 | if (!starts_with_dollar(name)) { 415 | pop_lexical_binder(parser); 416 | } 417 | store_term(parser, app_node + 0, LAM, 0, lam_node); 418 | store_term(parser, loc, APP, 0, app_node); 419 | } 420 | 421 | void parse_term(Parser* parser, Val loc) { 422 | skip(parser); 423 | if (parser->input[parser->pos] == '\0') { 424 | parse_error(parser, "Unexpected end of input"); 425 | } 426 | unsigned char c = (unsigned char)parser->input[parser->pos]; 427 | if (isalpha(c) || c == '_' || c == '$') { 428 | parse_term_var(parser, loc); 429 | } else if (isdigit(c)) { 430 | parse_term_num(parser, loc); 431 | } else if (c == '!') { 432 | parser->pos++; 433 | char next = peek_char(parser); 434 | parser->pos--; 435 | if (next == '&') { 436 | parse_term_dup(parser, loc); 437 | } else if (isalpha(next) || next == '_' || next == '$') { 438 | parse_term_let(parser, loc); 439 | } else { 440 | parse_error(parser, "Expected '&' or name after '!' for duplication or let"); 441 | } 442 | } else if (c == '&') { 443 | parse_term_sup(parser, loc); 444 | } else if (c == 0xCE && (unsigned char)parser->input[parser->pos + 1] == 0xBB) { 445 | parse_term_lam(parser, loc); 446 | } else if (c == '(') { 447 | parse_term_app(parser, loc); 448 | } else if (c == '*') { 449 | parse_term_era(parser, loc); 450 | } else if (c == '+') { 451 | parse_term_suc(parser, loc); 452 | } else if (c == '?') { 453 | parse_term_swi(parser, loc); 454 | } else { 455 | char error_msg[100]; 456 | snprintf(error_msg, sizeof(error_msg), "Unexpected character: %c (code: %d)", c, (int)c); 457 | parse_error(parser, error_msg); 458 | } 459 | } 460 | 461 | Val parse_term_alloc(Parser* parser) { 462 | Val loc = ic_alloc(parser->ic, 1); 463 | parse_term(parser, loc); 464 | return loc; 465 | } 466 | 467 | Term parse_string(IC* ic, const char* input) { 468 | Parser parser; 469 | init_parser(&parser, ic, input); 470 | skip(&parser); 471 | Val term_loc = parse_term_alloc(&parser); 472 | resolve_global_vars(&parser); 473 | return parser.ic->heap[term_loc]; 474 | } 475 | 476 | Term parse_file(IC* ic, const char* filename) { 477 | FILE* file = fopen(filename, "r"); 478 | if (!file) { 479 | fprintf(stderr, "Error: Could not open file '%s'\n", filename); 480 | exit(1); 481 | } 482 | fseek(file, 0, SEEK_END); 483 | long size = ftell(file); 484 | fseek(file, 0, SEEK_SET); 485 | char* buffer = (char*)malloc(size + 1); 486 | if (!buffer) { 487 | fprintf(stderr, "Error: Memory allocation failed\n"); 488 | fclose(file); 489 | exit(1); 490 | } 491 | size_t read_size = fread(buffer, 1, size, file); 492 | fclose(file); 493 | buffer[read_size] = '\0'; 494 | Term term = parse_string(ic, buffer); 495 | free(buffer); 496 | return term; 497 | } 498 | -------------------------------------------------------------------------------- /src/parse.h: -------------------------------------------------------------------------------- 1 | #ifndef PARSE_H 2 | #define PARSE_H 3 | 4 | #include "ic.h" 5 | #include 6 | #include 7 | 8 | #define MAX_NAME_LEN 64 9 | #define MAX_GLOBAL_VARS 1024 10 | #define MAX_LEXICAL_VARS 1024 11 | 12 | typedef struct { 13 | char name[MAX_NAME_LEN]; 14 | Term var; 15 | Val loc; 16 | } Binder; 17 | 18 | typedef struct { 19 | IC* ic; 20 | const char* input; 21 | size_t pos; 22 | size_t line; 23 | size_t col; 24 | 25 | Binder global_vars[MAX_GLOBAL_VARS]; 26 | size_t global_vars_count; 27 | 28 | Binder lexical_vars[MAX_LEXICAL_VARS]; 29 | size_t lexical_vars_count; 30 | } Parser; 31 | 32 | void init_parser(Parser* parser, IC* ic, const char* input); 33 | Term parse_string(IC* ic, const char* input); 34 | Term parse_file(IC* ic, const char* filename); 35 | 36 | #endif // PARSE_H 37 | -------------------------------------------------------------------------------- /src/show.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include "ic.h" 6 | #include "show.h" 7 | 8 | // For backward compatibility with the showing code 9 | #define DP0 100 // Just a value not used for any other tag 10 | #define DP1 101 // Just a value not used for any other tag 11 | 12 | // Helper functions for numeric operations 13 | static Val get_num_val(Term term) { 14 | if (TERM_TAG(term) == NUM) { 15 | return TERM_VAL(term) & TERM_VAL_MASK; 16 | } else { 17 | return 0; // Default to 0 if not a number 18 | } 19 | } 20 | 21 | // Maximum string length for term representation 22 | #define MAX_STR_LEN 65536 23 | 24 | // Structure to track variable names 25 | typedef struct { 26 | uint32_t count; // Number of variables encountered 27 | Val* locations; // Array of variable locations 28 | TermTag* types; // Array of variable types (VAR, DP0, DP1) 29 | char** names; // Array of variable names 30 | uint32_t capacity; // Capacity of the arrays 31 | } VarNameTable; 32 | 33 | // Structure to track duplication nodes 34 | typedef struct { 35 | Val* locations; // Array of duplication locations 36 | Lab* labels; // Array of duplication labels 37 | uint32_t count; // Number of duplications 38 | uint32_t capacity; // Capacity of the array 39 | } DupTable; 40 | 41 | // Initialize variable name table 42 | void init_var_table(VarNameTable* table) { 43 | table->count = 0; 44 | table->capacity = 64; 45 | table->locations = (Val*)malloc(table->capacity * sizeof(Val)); 46 | table->types = (TermTag*)malloc(table->capacity * sizeof(TermTag)); 47 | table->names = (char**)malloc(table->capacity * sizeof(char*)); 48 | } 49 | 50 | // Free variable name table 51 | void free_var_table(VarNameTable* table) { 52 | for (uint32_t i = 0; i < table->count; i++) { 53 | free(table->names[i]); 54 | } 55 | free(table->locations); 56 | free(table->types); 57 | free(table->names); 58 | } 59 | 60 | // Initialize duplication table 61 | void init_dup_table(DupTable* table) { 62 | table->count = 0; 63 | table->capacity = 64; 64 | table->locations = (Val*)malloc(table->capacity * sizeof(Val)); 65 | table->labels = (Lab*)malloc(table->capacity * sizeof(Lab)); 66 | } 67 | 68 | // Free duplication table 69 | void free_dup_table(DupTable* table) { 70 | free(table->locations); 71 | free(table->labels); 72 | } 73 | 74 | // Convert an index to an alphabetic variable name (a, b, c, ..., z, aa, ab, ...) 75 | char* index_to_var_name(uint32_t index) { 76 | char* name = (char*)malloc(16); 77 | if (index < 26) { 78 | // a-z 79 | sprintf(name, "%c", 'a' + index); 80 | } else { 81 | // aa, ab, ac, ... 82 | uint32_t first = (index - 26) / 26; 83 | uint32_t second = (index - 26) % 26; 84 | sprintf(name, "%c%c", 'a' + first, 'a' + second); 85 | } 86 | return name; 87 | } 88 | 89 | // Add a variable to the table and return its name 90 | char* add_variable(VarNameTable* table, Val location, TermTag type) { 91 | // Check if we need to expand the table 92 | if (table->count >= table->capacity) { 93 | table->capacity *= 2; 94 | table->locations = (Val*)realloc(table->locations, table->capacity * sizeof(Val)); 95 | table->types = (TermTag*)realloc(table->types, table->capacity * sizeof(TermTag)); 96 | table->names = (char**)realloc(table->names, table->capacity * sizeof(char*)); 97 | } 98 | 99 | // For compatibility, we only store the basic types (VAR, DP0, DP1) in the table 100 | TermTag basicType = type; 101 | if (IS_DP0(type)) { 102 | basicType = DP0; 103 | } else if (IS_DP1(type)) { 104 | basicType = DP1; 105 | } 106 | 107 | // Check if the variable is already in the table 108 | for (uint32_t i = 0; i < table->count; i++) { 109 | if (table->locations[i] == location && table->types[i] == basicType) { 110 | return table->names[i]; 111 | } 112 | } 113 | 114 | // Add the new variable 115 | table->locations[table->count] = location; 116 | table->types[table->count] = basicType; 117 | 118 | // Generate a name for the variable based on its type 119 | char* name; 120 | if (basicType == VAR) { 121 | name = index_to_var_name(table->count); 122 | } else if (basicType == DP0) { 123 | name = (char*)malloc(16); 124 | sprintf(name, "a%u", table->count); 125 | } else if (basicType == DP1) { 126 | name = (char*)malloc(16); 127 | sprintf(name, "b%u", table->count); 128 | } 129 | 130 | table->names[table->count] = name; 131 | table->count++; 132 | return name; 133 | } 134 | 135 | // Get a variable name from the table 136 | char* get_var_name(VarNameTable* table, Val location, TermTag type) { 137 | // Convert to basic type for lookup 138 | TermTag basicType = type; 139 | if (IS_DP0(type)) { 140 | basicType = DP0; 141 | } else if (IS_DP1(type)) { 142 | basicType = DP1; 143 | } 144 | 145 | for (uint32_t i = 0; i < table->count; i++) { 146 | if (table->locations[i] == location && table->types[i] == basicType) { 147 | return table->names[i]; 148 | } 149 | } 150 | return "?"; // Unknown variable 151 | } 152 | 153 | // Forward declarations 154 | void assign_var_ids(IC* ic, Term term, VarNameTable* var_table, DupTable* dup_table); 155 | void stringify_term(IC* ic, Term term, VarNameTable* var_table, char* buffer, int* pos, int max_len, const char* prefix); 156 | void stringify_duplications(IC* ic, DupTable* dup_table, VarNameTable* var_table, char* buffer, int* pos, int max_len, const char* prefix); 157 | 158 | // Register a duplication in the table 159 | bool register_duplication(DupTable* table, Val location, Lab label) { 160 | for (uint32_t i = 0; i < table->count; i++) { 161 | if (table->locations[i] == location) { 162 | if (table->labels[i] != label) { 163 | fprintf(stderr, "Label mismatch for duplication\n"); 164 | exit(1); 165 | } 166 | return false; 167 | } 168 | } 169 | if (table->count >= table->capacity) { 170 | table->capacity *= 2; 171 | table->locations = (Val*)realloc(table->locations, table->capacity * sizeof(Val)); 172 | table->labels = (Lab*)realloc(table->labels, table->capacity * sizeof(Lab)); 173 | } 174 | table->locations[table->count] = location; 175 | table->labels[table->count] = label; 176 | table->count++; 177 | return true; 178 | } 179 | 180 | // Assign IDs to variables and register duplications 181 | void assign_var_ids(IC* ic, Term term, VarNameTable* var_table, DupTable* dup_table) { 182 | TermTag tag = TERM_TAG(term); 183 | Val val = TERM_VAL(term); 184 | Lab lab = TERM_LAB(term); 185 | 186 | if (tag == VAR) { 187 | Val loc = val; 188 | Term subst = ic->heap[loc]; 189 | if (TERM_SUB(subst)) { 190 | assign_var_ids(ic, ic_clear_sub(subst), var_table, dup_table); 191 | } 192 | // For VAR, nothing else to do 193 | 194 | } else if (IS_DUP(tag)) { 195 | Val loc = val; 196 | Term subst = ic->heap[loc]; 197 | if (TERM_SUB(subst)) { 198 | assign_var_ids(ic, ic_clear_sub(subst), var_table, dup_table); 199 | } else { 200 | if (register_duplication(dup_table, loc, lab)) { 201 | assign_var_ids(ic, subst, var_table, dup_table); 202 | } 203 | } 204 | 205 | } else if (tag == LAM) { 206 | Val lam_loc = val; 207 | add_variable(var_table, lam_loc, VAR); 208 | assign_var_ids(ic, ic->heap[lam_loc], var_table, dup_table); 209 | 210 | } else if (tag == APP) { 211 | Val app_loc = val; 212 | assign_var_ids(ic, ic->heap[app_loc], var_table, dup_table); 213 | assign_var_ids(ic, ic->heap[app_loc + 1], var_table, dup_table); 214 | 215 | } else if (tag == ERA) { 216 | // ERA terms don't have children, so nothing to do 217 | 218 | } else if (IS_SUP(tag)) { 219 | Val sup_loc = val; 220 | assign_var_ids(ic, ic->heap[sup_loc], var_table, dup_table); 221 | assign_var_ids(ic, ic->heap[sup_loc + 1], var_table, dup_table); 222 | 223 | } else if (tag == NUM) { 224 | // NUM has no variables to assign 225 | 226 | } else if (tag == SUC) { 227 | Val suc_loc = val; 228 | assign_var_ids(ic, ic->heap[suc_loc], var_table, dup_table); 229 | 230 | } else if (tag == SWI) { 231 | Val swi_loc = val; 232 | assign_var_ids(ic, ic->heap[swi_loc], var_table, dup_table); // Number 233 | assign_var_ids(ic, ic->heap[swi_loc + 1], var_table, dup_table); // Zero branch 234 | assign_var_ids(ic, ic->heap[swi_loc + 2], var_table, dup_table); // Successor branch 235 | 236 | } else { 237 | // Unknown tag, so nothing to do 238 | } 239 | } 240 | 241 | // Stringify duplications 242 | void stringify_duplications(IC* ic, DupTable* dup_table, VarNameTable* var_table, char* buffer, int* pos, int max_len, const char* prefix) { 243 | // First, add all duplication variables 244 | for (uint32_t i = 0; i < dup_table->count; i++) { 245 | Val dup_loc = dup_table->locations[i]; 246 | add_variable(var_table, dup_loc, DP0); 247 | add_variable(var_table, dup_loc, DP1); 248 | } 249 | 250 | // Then, stringify each duplication 251 | for (uint32_t i = 0; i < dup_table->count; i++) { 252 | Val dup_loc = dup_table->locations[i]; 253 | Lab lab = dup_table->labels[i]; 254 | Term val_term = ic->heap[dup_loc]; 255 | 256 | // Get variable names 257 | char* var0 = get_var_name(var_table, dup_loc, DP0); 258 | char* var1 = get_var_name(var_table, dup_loc, DP1); 259 | 260 | // Add duplication header with optional prefix 261 | if (prefix) { 262 | *pos += snprintf(buffer + *pos, max_len - *pos, "! &%u{%s%s,%s%s} = ", lab, prefix, var0, prefix, var1); 263 | } else { 264 | *pos += snprintf(buffer + *pos, max_len - *pos, "! &%u{%s,%s} = ", lab, var0, var1); 265 | } 266 | 267 | // Add the value 268 | stringify_term(ic, val_term, var_table, buffer, pos, max_len, prefix); 269 | 270 | // Add separator 271 | *pos += snprintf(buffer + *pos, max_len - *pos, ";\n"); 272 | } 273 | } 274 | 275 | // Stringify a term 276 | void stringify_term(IC* ic, Term term, VarNameTable* var_table, char* buffer, int* pos, int max_len, const char* prefix) { 277 | TermTag tag = TERM_TAG(term); 278 | Val val = TERM_VAL(term); 279 | Lab lab = TERM_LAB(term); 280 | 281 | if (tag == VAR) { 282 | Val loc = val; 283 | Term subst = ic->heap[loc]; 284 | if (TERM_SUB(subst)) { 285 | stringify_term(ic, ic_clear_sub(subst), var_table, buffer, pos, max_len, prefix); 286 | } else { 287 | char* name = get_var_name(var_table, loc, VAR); 288 | if (prefix) { 289 | *pos += snprintf(buffer + *pos, max_len - *pos, "%s%s", prefix, name); 290 | } else { 291 | *pos += snprintf(buffer + *pos, max_len - *pos, "%s", name); 292 | } 293 | } 294 | 295 | } else if (IS_DUP(tag)) { 296 | TermTag co_type = IS_DP0(tag) ? DP0 : DP1; 297 | Val loc = val; 298 | Term subst = ic->heap[loc]; 299 | if (TERM_SUB(subst)) { 300 | stringify_term(ic, ic_clear_sub(subst), var_table, buffer, pos, max_len, prefix); 301 | } else { 302 | char* name = get_var_name(var_table, loc, co_type); 303 | if (prefix) { 304 | *pos += snprintf(buffer + *pos, max_len - *pos, "%s%s", prefix, name); 305 | } else { 306 | *pos += snprintf(buffer + *pos, max_len - *pos, "%s", name); 307 | } 308 | } 309 | 310 | } else if (tag == LAM) { 311 | Val lam_loc = val; 312 | char* var_name = get_var_name(var_table, lam_loc, VAR); 313 | if (prefix) { 314 | *pos += snprintf(buffer + *pos, max_len - *pos, "λ%s%s.", prefix, var_name); 315 | } else { 316 | *pos += snprintf(buffer + *pos, max_len - *pos, "λ%s.", var_name); 317 | } 318 | stringify_term(ic, ic->heap[lam_loc], var_table, buffer, pos, max_len, prefix); 319 | 320 | } else if (tag == APP) { 321 | *pos += snprintf(buffer + *pos, max_len - *pos, "("); 322 | stringify_term(ic, ic->heap[val], var_table, buffer, pos, max_len, prefix); 323 | *pos += snprintf(buffer + *pos, max_len - *pos, " "); 324 | stringify_term(ic, ic->heap[val + 1], var_table, buffer, pos, max_len, prefix); 325 | *pos += snprintf(buffer + *pos, max_len - *pos, ")"); 326 | 327 | } else if (tag == ERA) { 328 | *pos += snprintf(buffer + *pos, max_len - *pos, "*"); 329 | 330 | } else if (IS_SUP(tag)) { 331 | *pos += snprintf(buffer + *pos, max_len - *pos, "&%u{", lab); 332 | stringify_term(ic, ic->heap[val], var_table, buffer, pos, max_len, prefix); 333 | *pos += snprintf(buffer + *pos, max_len - *pos, ","); 334 | stringify_term(ic, ic->heap[val + 1], var_table, buffer, pos, max_len, prefix); 335 | *pos += snprintf(buffer + *pos, max_len - *pos, "}"); 336 | 337 | } else if (tag == NUM) { 338 | *pos += snprintf(buffer + *pos, max_len - *pos, "%u", val & TERM_VAL_MASK); 339 | 340 | } else if (tag == SUC) { 341 | *pos += snprintf(buffer + *pos, max_len - *pos, "+"); 342 | stringify_term(ic, ic->heap[val], var_table, buffer, pos, max_len, prefix); 343 | 344 | } else if (tag == SWI) { 345 | *pos += snprintf(buffer + *pos, max_len - *pos, "?"); 346 | stringify_term(ic, ic->heap[val], var_table, buffer, pos, max_len, prefix); 347 | *pos += snprintf(buffer + *pos, max_len - *pos, "{0:"); 348 | stringify_term(ic, ic->heap[val + 1], var_table, buffer, pos, max_len, prefix); 349 | *pos += snprintf(buffer + *pos, max_len - *pos, ";+:"); 350 | stringify_term(ic, ic->heap[val + 2], var_table, buffer, pos, max_len, prefix); 351 | *pos += snprintf(buffer + *pos, max_len - *pos, ";}"); 352 | 353 | } else { 354 | *pos += snprintf(buffer + *pos, max_len - *pos, ""); 355 | } 356 | } 357 | 358 | // Convert a term to its string representation with optional namespace prefix 359 | static char* term_to_string_internal(IC* ic, Term term, const char* prefix) { 360 | // Initialize tables 361 | VarNameTable var_table; 362 | DupTable dup_table; 363 | init_var_table(&var_table); 364 | init_dup_table(&dup_table); 365 | 366 | // Assign IDs to variables and register duplications 367 | assign_var_ids(ic, term, &var_table, &dup_table); 368 | 369 | // Allocate buffer for the string representation 370 | char* buffer = (char*)malloc(MAX_STR_LEN); 371 | int pos = 0; 372 | 373 | // First stringify all duplications 374 | stringify_duplications(ic, &dup_table, &var_table, buffer, &pos, MAX_STR_LEN, prefix); 375 | 376 | // Then stringify the main term 377 | stringify_term(ic, term, &var_table, buffer, &pos, MAX_STR_LEN, prefix); 378 | 379 | // Free tables 380 | free_var_table(&var_table); 381 | free_dup_table(&dup_table); 382 | 383 | return buffer; 384 | } 385 | 386 | // Convert a term to its string representation 387 | char* term_to_string(IC* ic, Term term) { 388 | return term_to_string_internal(ic, term, NULL); 389 | } 390 | 391 | // Convert a term to its string representation with a prefix for variable names 392 | char* term_to_string_namespaced(IC* ic, Term term, const char* prefix) { 393 | return term_to_string_internal(ic, term, prefix); 394 | } 395 | 396 | // Display a term to the specified output stream 397 | void show_term(FILE* stream, IC* ic, Term term) { 398 | char* str = term_to_string(ic, term); 399 | fprintf(stream, "%s", str); 400 | free(str); 401 | } 402 | 403 | // Display a term to the specified output stream with a prefix for variable names 404 | void show_term_namespaced(FILE* stream, IC* ic, Term term, const char* prefix) { 405 | char* str = term_to_string_namespaced(ic, term, prefix); 406 | fprintf(stream, "%s", str); 407 | free(str); 408 | } 409 | -------------------------------------------------------------------------------- /src/show.h: -------------------------------------------------------------------------------- 1 | //./../InteractionCalculus.md// 2 | //./show.c// 3 | 4 | #ifndef SHOW_H 5 | #define SHOW_H 6 | 7 | #include 8 | #include "ic.h" 9 | 10 | // Convert a term to its string representation 11 | // The returned string is dynamically allocated and must be freed by the caller 12 | char* term_to_string(IC* ic, Term term); 13 | 14 | // Convert a term to its string representation with a prefix for variable names 15 | // The returned string is dynamically allocated and must be freed by the caller 16 | char* term_to_string_namespaced(IC* ic, Term term, const char* prefix); 17 | 18 | // Display a term to the specified output stream 19 | void show_term(FILE* stream, IC* ic, Term term); 20 | 21 | // Display a term to the specified output stream with a prefix for variable names 22 | void show_term_namespaced(FILE* stream, IC* ic, Term term, const char* prefix); 23 | 24 | #endif // SHOW_H 25 | --------------------------------------------------------------------------------