Add example programs and test suite for North Forth

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:

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 ;

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 ;

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 @ ;

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 + @ ;

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

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