diff --git a/Makefile b/Makefile index f93e605..0af3144 100644 --- a/Makefile +++ b/Makefile @@ -1,9 +1,13 @@ -.PHONY: test test-long +.PHONY: test test-long test-examples # Fast unit tests: Nock primitives + noun literal syntax (~5 min total) test: bash tests/test-nock.sh +# North Forth example program tests: fibonacci, ackermann, sieve, charclass, wordcount +test-examples: + bash tests/test-examples.sh + # Long-running benchmark tests (urbit/benchmark reference cases). # Each test spawns a full urbit eval + nock.fs load; expect O(minutes) per test. test-long: diff --git a/examples/ackermann.fs b/examples/ackermann.fs new file mode 100644 index 0000000..8a70c64 --- /dev/null +++ b/examples/ackermann.fs @@ -0,0 +1,20 @@ +\ Ackermann-Péter function in North Forth +\ ( m n -- ack(m,n) ) +\ Definition: +\ ack(0, n) = n + 1 +\ ack(m, 0) = ack(m-1, 1) +\ ack(m, n) = ack(m-1, ack(m, n-1)) +\ Grows extremely fast; keep m <= 3, n <= 4 for reasonable runtimes. +\ ack(0,0)=1 ack(1,1)=3 ack(2,2)=7 ack(3,2)=29 ack(3,3)=61 + +: ack ( m n -- result ) + OVER 0 = IF + NIP 1+ \ ack(0,n) = n+1 + ELSE + DUP 0 = IF + DROP 1- 1 RECURSE \ ack(m,0) = ack(m-1,1) + ELSE + OVER SWAP 1- RECURSE \ compute ack(m, n-1) ... + SWAP 1- SWAP RECURSE \ ... then ack(m-1, that) + THEN + THEN ; diff --git a/examples/charclass.fs b/examples/charclass.fs new file mode 100644 index 0000000..00f0c4c --- /dev/null +++ b/examples/charclass.fs @@ -0,0 +1,20 @@ +\ Character classification words for North Forth +\ All predicates: ( c -- flag ) flag is forth-true or 0 +\ All converters: ( c -- c' ) +\ ASCII ranges: digits 48..57 upper 65..90 lower 97..122 + +: isdigit ( c -- flag ) DUP 48 < 0= SWAP 57 > 0= AND ; +: isupper ( c -- flag ) DUP 65 < 0= SWAP 90 > 0= AND ; +: islower ( c -- flag ) DUP 97 < 0= SWAP 122 > 0= AND ; + +: isalpha ( c -- flag ) DUP isupper SWAP islower OR ; +: isalnum ( c -- flag ) DUP isalpha SWAP isdigit OR ; + +: isspace ( c -- flag ) + DUP 32 = SWAP + DUP 9 = SWAP + DUP 10 = SWAP + 13 = OR OR OR ; + +: toupper ( c -- c' ) DUP islower IF 32 - THEN ; +: tolower ( c -- c' ) DUP isupper IF 32 + THEN ; diff --git a/examples/fibonacci.fs b/examples/fibonacci.fs new file mode 100644 index 0000000..3482312 --- /dev/null +++ b/examples/fibonacci.fs @@ -0,0 +1,22 @@ +\ Fibonacci sequence in North Forth +\ fib(n) -- nth Fibonacci number, 0-indexed +\ fib(0)=0, fib(1)=1, fib(2)=1, fib(3)=2, fib(5)=5, fib(10)=55 +\ Uses two variables and BEGIN/WHILE/REPEAT to avoid DO LOOP's +\ "always-at-least-once" behaviour when the trip count is zero (n=2). + +VARIABLE fib-a +VARIABLE fib-b + +: fib ( n -- fib(n) ) + DUP 2 < IF EXIT THEN \ fib(0)=0, fib(1)=1 returned directly + 1 fib-a ! \ fib(1) = 1 + 1 fib-b ! \ fib(2) = 1 + 2 - \ remaining iterations (0 for n=2) + BEGIN DUP 0 > WHILE \ while counter > 0 + fib-a @ fib-b @ + \ next = a + b + fib-b @ fib-a ! \ a = old b + fib-b ! \ b = next + 1- \ decrement counter + REPEAT + DROP + fib-b @ ; diff --git a/examples/sieve.fs b/examples/sieve.fs new file mode 100644 index 0000000..83da54f --- /dev/null +++ b/examples/sieve.fs @@ -0,0 +1,38 @@ +\ Sieve of Eratosthenes in North Forth +\ After sieve-run: sieve-arr+n holds 1 if n is prime, 0 otherwise. +\ Usage: +\ sieve-run ( -- ) run the sieve +\ n is-prime? ( n -- flag ) test primality (after sieve-run) + +100 CONSTANT SIEVE-LIMIT + +HERE SIEVE-LIMIT ALLOT CONSTANT sieve-arr + +\ Set all slots to 1; mark 0 and 1 as non-prime. +: sieve-init ( -- ) + SIEVE-LIMIT 0 DO 1 sieve-arr I + ! LOOP + 0 sieve-arr ! + 0 sieve-arr 1 + ! ; + +\ Mark every multiple of p starting at p^2 as composite. +: sieve-mark ( p -- ) + DUP >R \ save p on r-stack + DUP * \ start at p^2 + BEGIN DUP SIEVE-LIMIT < WHILE + 0 OVER sieve-arr + ! \ mark slot as composite + R@ + \ advance by p + REPEAT + DROP R> DROP ; + +\ Run the full sieve up to SIEVE-LIMIT. +: sieve-run ( -- ) + sieve-init + 2 BEGIN DUP DUP * SIEVE-LIMIT < WHILE + DUP sieve-arr + @ IF \ if p is still marked prime + DUP sieve-mark \ mark its multiples + THEN + 1+ + REPEAT DROP ; + +\ Primality test (requires sieve-run to have been called). +: is-prime? ( n -- flag ) sieve-arr + @ ; diff --git a/examples/wordcount.fs b/examples/wordcount.fs new file mode 100644 index 0000000..47fce1e --- /dev/null +++ b/examples/wordcount.fs @@ -0,0 +1,45 @@ +\ Word count in North Forth +\ count-words ( addr len -- n ) +\ Counts space-separated words in a memory buffer. +\ A "word" is a maximal run of characters with ASCII code >= 33. +\ Demo strings are pre-stored using [CHAR]/comma to avoid S" quoting issues. + +VARIABLE wc-base +VARIABLE wc-len +VARIABLE wc-words +VARIABLE wc-in + +: count-words ( addr len -- n ) + wc-len ! wc-base ! + 0 wc-words ! + 0 wc-in ! + wc-len @ 0 DO + wc-base @ I + @ \ fetch char at offset I + 33 < IF + 0 wc-in ! \ space/ctrl: leave word + ELSE + wc-in @ 0= IF + wc-words @ 1+ wc-words ! \ entering new word + THEN + 1 wc-in ! \ mark in-word + THEN + LOOP + wc-words @ ; + +\ Pre-stored demo string: "hello world" (11 chars, 2 words) +HERE CONSTANT wc-demo-addr +[CHAR] h , [CHAR] e , [CHAR] l , [CHAR] l , [CHAR] o , +32 , +[CHAR] w , [CHAR] o , [CHAR] r , [CHAR] l , [CHAR] d , +11 CONSTANT wc-demo-len + +\ Pre-stored demo string: " foo bar baz " (18 chars, 3 words) +HERE CONSTANT wc-demo2-addr +32 , 32 , +[CHAR] f , [CHAR] o , [CHAR] o , +32 , 32 , 32 , +[CHAR] b , [CHAR] a , [CHAR] r , +32 , 32 , +[CHAR] b , [CHAR] a , [CHAR] z , +32 , 32 , +18 CONSTANT wc-demo2-len diff --git a/tests/test-examples.sh b/tests/test-examples.sh new file mode 100755 index 0000000..8736453 --- /dev/null +++ b/tests/test-examples.sh @@ -0,0 +1,117 @@ +#!/usr/bin/env bash +# North Forth example program tests +# Tests fibonacci, ackermann, sieve, charclass, and wordcount. +# Run from repo root: bash tests/test-examples.sh +# +# Each test loads the relevant .fs source into a fresh north state, +# evaluates a test expression, and checks the resulting d-stack. +# +# Boolean results are normalised with "1 AND" so tests expect ~[1] or ~[0] +# rather than the internal forth-true value (0x7fff_ffff_ffff_ffff). + +LIB="desk/lib/north.hoon" +PASS=0 +FAIL=0 + +# Strip Forth \ comments and collapse whitespace to a single line. +# Handles both "\ comment" and bare "\" (blank comment lines). +load-fs() { + sed 's/[[:space:]]*\\[[:space:]].*$//; s/^[[:space:]]*\\[[:space:]].*$//; s/^[[:space:]]*\\$//' "$1" \ + | tr '\n' ' ' | sed 's/ */ /g' | sed 's/^ *//; s/ *$//' +} + +north-eval() { + local src="$1" expr="$2" + local raw + raw=$( (printf '=>\n'; cat "$LIB"; \ + printf 'd-stack:(eval (parse "%s %s") *north)\n' "$src" "$expr") \ + | ~/bin/urbit eval 2>&1 ) + echo "$raw" \ + | grep -v '^lite:\|^loom:\|^eval (run):\|^eval:' \ + | sed 's/\x1b\[[0-9;]*m//g' | tr -d '\r' \ + | tr '\n' ' ' | sed 's/ */ /g' | sed 's/^ *//; s/ *$//' +} + +check() { + local desc="$1" src="$2" expr="$3" expected="$4" + local result + result=$(north-eval "$src" "$expr") + if [ "$result" = "$expected" ]; then + echo "PASS $desc" + PASS=$((PASS + 1)) + else + echo "FAIL $desc" + echo " expected: $expected" + echo " got: $result" + FAIL=$((FAIL + 1)) + fi +} + +FIB=$(load-fs "examples/fibonacci.fs") +ACK=$(load-fs "examples/ackermann.fs") +SIV=$(load-fs "examples/sieve.fs") +CLS=$(load-fs "examples/charclass.fs") +WC=$(load-fs "examples/wordcount.fs") + +# ── Fibonacci ────────────────────────────────────────────────────────────── +echo "=== Fibonacci ===" +check "fib(0)" "$FIB" "0 fib" "~[0]" +check "fib(1)" "$FIB" "1 fib" "~[1]" +check "fib(2)" "$FIB" "2 fib" "~[1]" +check "fib(5)" "$FIB" "5 fib" "~[5]" +check "fib(10)" "$FIB" "10 fib" "~[55]" + +# ── Ackermann ────────────────────────────────────────────────────────────── +echo "" +echo "=== Ackermann ===" +check "ack(0,0)" "$ACK" "0 0 ack" "~[1]" +check "ack(0,5)" "$ACK" "0 5 ack" "~[6]" +check "ack(1,0)" "$ACK" "1 0 ack" "~[2]" +check "ack(1,1)" "$ACK" "1 1 ack" "~[3]" +check "ack(2,0)" "$ACK" "2 0 ack" "~[3]" +check "ack(2,2)" "$ACK" "2 2 ack" "~[7]" +check "ack(3,2)" "$ACK" "3 2 ack" "~[29]" + +# ── Sieve of Eratosthenes ────────────────────────────────────────────────── +echo "" +echo "=== Sieve of Eratosthenes ===" +check "sieve: 0 not prime" "$SIV" "sieve-run 0 is-prime? 1 AND" "~[0]" +check "sieve: 1 not prime" "$SIV" "sieve-run 1 is-prime? 1 AND" "~[0]" +check "sieve: 2 is prime" "$SIV" "sieve-run 2 is-prime? 1 AND" "~[1]" +check "sieve: 3 is prime" "$SIV" "sieve-run 3 is-prime? 1 AND" "~[1]" +check "sieve: 4 composite" "$SIV" "sieve-run 4 is-prime? 1 AND" "~[0]" +check "sieve: 97 is prime" "$SIV" "sieve-run 97 is-prime? 1 AND" "~[1]" +check "sieve: 99 composite" "$SIV" "sieve-run 99 is-prime? 1 AND" "~[0]" + +# ── Character Classification ─────────────────────────────────────────────── +echo "" +echo "=== Character Classification ===" +check "isdigit '5' (53)" "$CLS" "53 isdigit 1 AND" "~[1]" +check "isdigit 'a' (97)" "$CLS" "97 isdigit 1 AND" "~[0]" +check "isdigit ' ' (32)" "$CLS" "32 isdigit 1 AND" "~[0]" +check "isupper 'A' (65)" "$CLS" "65 isupper 1 AND" "~[1]" +check "isupper 'a' (97)" "$CLS" "97 isupper 1 AND" "~[0]" +check "islower 'a' (97)" "$CLS" "97 islower 1 AND" "~[1]" +check "islower 'Z' (90)" "$CLS" "90 islower 1 AND" "~[0]" +check "isalpha 'a' (97)" "$CLS" "97 isalpha 1 AND" "~[1]" +check "isalpha 'Z' (90)" "$CLS" "90 isalpha 1 AND" "~[1]" +check "isalpha '5' (53)" "$CLS" "53 isalpha 1 AND" "~[0]" +check "isalnum '5' (53)" "$CLS" "53 isalnum 1 AND" "~[1]" +check "isalnum 'a' (97)" "$CLS" "97 isalnum 1 AND" "~[1]" +check "isalnum ' ' (32)" "$CLS" "32 isalnum 1 AND" "~[0]" +check "toupper 'a'->65" "$CLS" "97 toupper" "~[65]" +check "toupper 'A'->65" "$CLS" "65 toupper" "~[65]" +check "tolower 'A'->97" "$CLS" "65 tolower" "~[97]" +check "tolower 'a'->97" "$CLS" "97 tolower" "~[97]" + +# ── Word Count ───────────────────────────────────────────────────────────── +echo "" +echo "=== Word Count ===" +check "wc: empty string" "$WC" "0 0 count-words" "~[0]" +check "wc: 'hello world'" "$WC" "wc-demo-addr wc-demo-len count-words" "~[2]" +check "wc: ' foo bar baz '" "$WC" "wc-demo2-addr wc-demo2-len count-words" "~[3]" + +echo "" +echo "=== Results ===" +echo "Passed: $PASS Failed: $FAIL" +[ $FAIL -eq 0 ] && exit 0 || exit 1