diff --git a/desk/app/north.hoon b/desk/app/north.hoon index 9f9e3d1..cc51dbf 100644 --- a/desk/app/north.hoon +++ b/desk/app/north.hoon @@ -80,7 +80,9 @@ :_ this(show-stack %.n) ~[[%shoe ~[sole-id] %sole [%txt "stack display off"]]] :: run Forth input through the interpreter - =/ result (mule |.((eval:vm (parse:vm cmd) forth))) + :: inject now and our from the bowl so NOW and OUR words are current + =/ forth1 forth(settings settings.forth(now now.bowl, our our.bowl)) + =/ result (mule |.((eval:vm (parse:vm cmd) forth1))) ?: ?=([%| *] result) =/ tanks p.result =/ err=tape diff --git a/desk/lib/north.hoon b/desk/lib/north.hoon index 445fa3a..b7e65e1 100644 --- a/desk/lib/north.hoon +++ b/desk/lib/north.hoon @@ -14,7 +14,9 @@ == +$ settings-map $: state=? :: %.y = interpret mode (bunt), %.n = compile mode - base=@ud + base=@tas :: print aura: '' or 'ud'=decimal, 'ux'=hex, 'ub'=binary, 'da'=date, 'p'=ship, 't'=cord + now=@da :: current time; set by agent before each eval; 0 in lib context + our=@p :: our ship; set by agent before each eval; 0 (~zod) in lib context tin=@ud ntib=@ud here=@ud @@ -220,6 +222,38 @@ ?: =(0 n) ~ =/ qr (divmod:ua n 10) (weld $(n p.qr) ~[^-(@t (add:ua q.qr 48))]) +:: NUM-TO-HEX-TAPE - format atom as uppercase hex digits (no prefix) +++ num-to-hex-tape + |= n=@ + ^- tape + ?: =(0 n) "0" + |- ^- tape + ?: =(0 n) ~ + =/ d (mod:ua n 16) + =/ c=@t ?: (lth:ua d 10) + ^-(@t (add:ua d 48)) :: '0'-'9' + ^-(@t (add:ua d 55)) :: 'A'-'F' (55 = 'A' - 10) + (weld $(n (div:ua n 16)) ~[c]) +:: NUM-TO-BIN-TAPE - format atom as binary digits (no prefix) +++ num-to-bin-tape + |= n=@ + ^- tape + ?: =(0 n) "0" + |- ^- tape + ?: =(0 n) ~ + =/ d (mod:ua n 2) + =/ c=@t ^-(@t (add:ua d 48)) :: '0' or '1' + (weld $(n (div:ua n 2)) ~[c]) +:: NUM-TO-BASE-TAPE - format atom per current print aura +++ num-to-base-tape + |= [n=@ b=@tas] + ^- tape + ?: =(b 'ux') (num-to-hex-tape n) + ?: =(b 'ub') (num-to-bin-tape n) + ?: =(b 'da') (scow 'da' n) + ?: =(b 'p') (scow 'p' n) + ?: =(b 't') (trip ^-(@t n)) + (num-to-tape n) :: READ-CHARS - read cnt chars from stak at addr, produce tape ++ read-chars :: Extract cnt chars from stak starting at addr, produce tape @@ -484,10 +518,53 @@ st(d-stack ds, buffers buffers.st(output (weld output.buffers.st (tape-reap n ' ')))) :: Tier 13: Number and string output ?: =(w '.') - :: ( n -- ) print TOS as unsigned decimal followed by a space + :: ( n -- ) print TOS in current base followed by a space + =^ n=@ ds (pop ds) + =/ str (weld (num-to-base-tape n base.settings.st) ~[' ']) + st(d-stack ds, buffers buffers.st(output (weld output.buffers.st str))) + ?: =(w 'U.') + :: ( u -- ) print TOS as unsigned in current base followed by a space (alias for .) =^ n=@ ds (pop ds) - =/ str (weld (num-to-tape n) ~[' ']) + =/ str (weld (num-to-base-tape n base.settings.st) ~[' ']) st(d-stack ds, buffers buffers.st(output (weld output.buffers.st str))) + :: BASE/HEX/DECIMAL — numeric base control + ?: =(w 'HEX') + st(settings settings.st(base 'ux')) + ?: =(w 'DECIMAL') + st(settings settings.st(base 'ud')) + ?: =(w 'BINARY') + st(settings settings.st(base 'ub')) + ?: =(w 'BASE') + :: ( -- n ) push current numeric base as an integer; 0 for non-numeric auras + =/ n ?: =(base.settings.st 'ux') 16 + ?: =(base.settings.st 'ub') 2 + ?: =(base.settings.st 'da') 0 + ?: =(base.settings.st 'p') 0 + 10 + st(d-stack (push ds n)) + :: Type aura print modes + ?: =(w 'AS-DATE') st(settings settings.st(base 'da')) + ?: =(w 'AS-SHIP') st(settings settings.st(base 'p')) + ?: =(w 'AS-CORD') st(settings settings.st(base 't')) + :: Dedicated type output words (ignore current base) + ?: =(w 'DATE.') + =^ n=@ ds (pop ds) + st(d-stack ds, buffers buffers.st(output (weld output.buffers.st (weld (scow 'da' n) ~[' '])))) + ?: =(w 'SHIP.') + =^ n=@ ds (pop ds) + st(d-stack ds, buffers buffers.st(output (weld output.buffers.st (weld (scow 'p' n) ~[' '])))) + ?: =(w 'CORD.') + =^ n=@ ds (pop ds) + st(d-stack ds, buffers buffers.st(output (weld output.buffers.st (weld (trip ^-(@t n)) ~[' '])))) + ?: =(w 'INT.') + =^ n=@ ds (pop ds) + st(d-stack ds, buffers buffers.st(output (weld output.buffers.st (weld (num-to-tape n) ~[' '])))) + :: NOW: push current time as @da (set by agent; 0 in lib context) + ?: =(w 'NOW') + st(d-stack (push ds now.settings.st)) + :: OUR: push our ship as @p (set by agent; 0=~zod in lib context) + ?: =(w 'OUR') + st(d-stack (push ds our.settings.st)) ?: =(w 'TYPE') :: ( addr cnt -- ) print cnt chars from mem starting at addr =^ cnt=@ ds (pop ds) diff --git a/docs/architecture.md b/docs/architecture.md index 1c8dc42..5034971 100644 --- a/docs/architecture.md +++ b/docs/architecture.md @@ -176,5 +176,6 @@ North was built tier-by-tier, each tier adding a set of words or features: | 19 | 20 | `IMMEDIATE` — compile-time word flag | | 21 | 21 | `DEFER`/`IS`, `EXIT`, `-ROT`, `CELL`, `CHARS`, `[CHAR]`, `NOOP` | | — | 22 | Noun literals `[42]`, `[42 99]`, `[[1 2] 3]` via `is-pure-noun` lookahead | +| — | 23 | `HEX`/`DECIMAL`/`BINARY`/`BASE`/`U.`; `.` respects base; base stored as aura tag (`%ux`, `%ud`, `%ub`) | **Next:** Nock code generation — emit Nock nouns from Forth definitions. diff --git a/docs/words.md b/docs/words.md index 208d3fe..97e8f68 100644 --- a/docs/words.md +++ b/docs/words.md @@ -95,11 +95,42 @@ All words implemented as of Tier 21. Stack notation: `( before -- after )`. | `CELL+` | `( addr -- addr+1 )` | advance address by one cell | | `,` | `( n -- )` | store n at HERE and advance HERE | +## Numeric Base + +North stores the current print base as an aura tag rather than an integer. +`HEX`, `DECIMAL`, and `BINARY` switch the tag; `.` and `U.` respect it. +The `BASE` word pushes the equivalent integer (10, 16, or 2) for compatibility. +Output uses no prefix: `HEX 255 .` prints `FF `. + +| Word | Stack | Description | +|---|---|---| +| `HEX` | `( -- )` | set print base to hexadecimal (`%ux`) | +| `DECIMAL` | `( -- )` | set print base to decimal (`%ud`) — default | +| `BINARY` | `( -- )` | set print base to binary (`%ub`) | +| `BASE` | `( -- n )` | push current numeric base (10, 16, or 2) | +| `AS-DATE` | `( -- )` | set print aura to date (`%da`); `.` prints as `~YYYY.M.D` | +| `AS-SHIP` | `( -- )` | set print aura to ship (`%p`); `.` prints as `~shipname` | +| `AS-CORD` | `( -- )` | set print aura to cord (`%t`); `.` prints raw UTF-8 text | + +## Type Aura Output + +Words for printing typed values in their natural format, regardless of current base. + +| Word | Stack | Description | +|---|---|---| +| `INT.` | `( n -- )` | print TOS as decimal integer + space (ignores current base) | +| `DATE.` | `( n -- )` | print TOS as `@da` date (`~YYYY.M.D...`) + space | +| `SHIP.` | `( n -- )` | print TOS as `@p` ship name (`~shipname`) + space | +| `CORD.` | `( n -- )` | print TOS as `@t` cord (raw UTF-8 text) + space | +| `NOW` | `( -- n )` | push current time as `@da` atom (injected from Arvo) | +| `OUR` | `( -- n )` | push our ship address as `@p` atom (injected from Arvo) | + ## Output | Word | Stack | Description | |---|---|---| -| `.` | `( n -- )` | print TOS as unsigned decimal + space | +| `.` | `( n -- )` | print TOS unsigned in current base + space | +| `U.` | `( u -- )` | print TOS unsigned in current base + space (alias for `.`) | | `TYPE` | `( addr cnt -- )` | print cnt chars from memory at addr | | `EMIT` | `( char -- )` | emit one character | | `CR` | `( -- )` | emit newline | @@ -192,8 +223,6 @@ Handled by the Gall agent before reaching the interpreter: |---|---| | `ACCEPT` | read a line of input into a buffer | | `KEY` | read a single character from input | -| `HEX` / `DECIMAL` / `BASE` | change numeric base | -| `U.` | print TOS as unsigned, respecting BASE | | `MOVE` / `CMOVE` / `FILL` | bulk memory operations | | `EVALUATE` | evaluate a string as Forth source | | `POSTPONE` | compile-time: compile the compilation semantics of the next word | diff --git a/tests/test-north.sh b/tests/test-north.sh index 3034c29..82c7221 100644 --- a/tests/test-north.sh +++ b/tests/test-north.sh @@ -427,7 +427,7 @@ check "bracket top level" "d-stack:(eval (parse \"3 [ 4 + ] 5\") *north)" echo "" echo "=== Tier 13: . (dot) output ===" -# . prints TOS as unsigned decimal followed by a space, consuming TOS +# . prints TOS unsigned in current base followed by a space, consuming TOS check "dot 0" "output.buffers:(eval (parse \"0 .\") *north)" "\"0 \"" check "dot 42" "output.buffers:(eval (parse \"42 .\") *north)" "\"42 \"" check "dot 999" "output.buffers:(eval (parse \"999 .\") *north)" "\"999 \"" @@ -439,6 +439,51 @@ check "dot multiple" "output.buffers:(eval (parse \"1 . 2 . 3 .\") *north)" # . in a word definition check "dot in word" "output.buffers:(eval (parse \": show . ; 42 show\") *north)" "\"42 \"" +echo "" +echo "=== Numeric base: HEX / DECIMAL / BINARY / BASE ===" + +# HEX sets base to %ux; . prints uppercase hex without prefix +check "HEX 255 ." "output.buffers:(eval (parse \"HEX 255 .\") *north)" "\"FF \"" +check "HEX 0 ." "output.buffers:(eval (parse \"HEX 0 .\") *north)" "\"0 \"" +check "HEX 16 ." "output.buffers:(eval (parse \"HEX 16 .\") *north)" "\"10 \"" +check "HEX 256 ." "output.buffers:(eval (parse \"HEX 256 .\") *north)" "\"100 \"" +# DECIMAL restores base +check "HEX then DEC" "output.buffers:(eval (parse \"HEX 255 . DECIMAL 255 .\") *north)" "\"FF 255 \"" +# BINARY +check "BINARY 10 ." "output.buffers:(eval (parse \"BINARY 10 .\") *north)" "\"1010 \"" +check "BINARY 0 ." "output.buffers:(eval (parse \"BINARY 0 .\") *north)" "\"0 \"" +# BASE pushes numeric base as integer +check "BASE decimal" "d-stack:(eval (parse \"BASE\") *north)" "~[10]" +check "HEX BASE" "d-stack:(eval (parse \"HEX BASE\") *north)" "~[16]" +check "BINARY BASE" "d-stack:(eval (parse \"BINARY BASE\") *north)" "~[2]" +# U. is an alias for . +check "U. decimal" "output.buffers:(eval (parse \"42 U.\") *north)" "\"42 \"" +check "HEX U." "output.buffers:(eval (parse \"HEX 255 U.\") *north)" "\"FF \"" +# base persists across word definitions +check "HEX in word" "output.buffers:(eval (parse \"HEX : show-hex . ; 255 show-hex\") *north)" "\"FF \"" + +echo "" +echo "=== Type aura output words ===" + +# OUR: push our ship (@p); in lib context our=0 = ~zod +check "OUR is ~zod" "d-stack:(eval (parse \"OUR\") *north)" "~[0]" +# SHIP.: print TOS as @p +check "SHIP. ~zod" "output.buffers:(eval (parse \"OUR SHIP.\") *north)" "\"~zod \"" +check "SHIP. 256" "output.buffers:(eval (parse \"256 SHIP.\") *north)" "\"~marzod \"" +# NOW: push current time (@da); in lib context now=*@da = ~2000.1.1 +check "NOW is epoch" "d-stack:(eval (parse \"NOW\") *north)" "~[170.141.184.492.615.420.181.573.981.275.213.004.800]" +check "DATE. epoch" "output.buffers:(eval (parse \"NOW DATE.\") *north)" "\"~2000.1.1 \"" +# CORD.: print TOS as @t cord +check "CORD. A" "output.buffers:(eval (parse \"65 CORD.\") *north)" "\"A \"" +check "CORD. hi" "output.buffers:(eval (parse \"0x6968 CORD.\") *north)" "\"hi \"" +# INT.: print TOS as decimal regardless of current base +check "INT. decimal" "output.buffers:(eval (parse \"255 INT.\") *north)" "\"255 \"" +check "INT. in HEX" "output.buffers:(eval (parse \"HEX 255 INT.\") *north)" "\"255 \"" +# AS-SHIP / AS-DATE / AS-CORD set base; . respects it +check "AS-SHIP ." "output.buffers:(eval (parse \"AS-SHIP OUR .\") *north)" "\"~zod \"" +check "AS-DATE ." "output.buffers:(eval (parse \"AS-DATE NOW .\") *north)" "\"~2000.1.1 \"" +check "AS-CORD ." "output.buffers:(eval (parse \"AS-CORD 65 .\") *north)" "\"A \"" + echo "" echo "=== Tier 13: TYPE output ==="