Switch : and ::, so that : is pattern-bind and :: is set-key

This commit is contained in:
Tony Garnock-Jones 2024-05-13 09:55:12 +02:00
parent b34ce1ba0c
commit 8fcc00b8c5
5 changed files with 71 additions and 71 deletions

View file

@ -9,7 +9,7 @@ incorporating ideas loosely inspired by ICON4 and Haskell's non-determinism (lis
> ./bin/catish.js -- '1 2 3 + + wr nl'
6
> ./bin/catish.js -- '[1 2 3] ::vs [vs / 1 +] wr nl'
> ./bin/catish.js -- '[1 2 3] :vs [vs / 1 +] wr nl'
[2 3 4]
## Overview
@ -82,29 +82,29 @@ if no comma is present.
Records are unusual in that the record label is taken literally, and may not be computed.
2024 ::year 5 ::month 3 ::day
"Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec" " " split month 1 - ? ::monthName
2024 :year 5 :month 3 :day
"Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec" " " split month 1 - ? :monthName
<date year monthName day>
# has effect () --> (<date 2024 "May" 3>), and introduces four new bindings
Blocks are unusual in that they construct Preserves dictionaries, and so require both keys and
values. The colon (`:`) operator pops the top of the stack into a temporary "key" register. If
the "key" register was empty, it does nothing further; otherwise, it pops a single value, and
stores it along with the previous contents of the "key" register as a key-value pair in the
dictionary under construction. At the end of a block, the same thing happens if the "key"
register is nonempty. The comma operator may also be used, and has the same effect as for other
compound terms, accumulating any pending key-value pair and resetting the stack. In addition,
the comma operator clears the "key" register.
values. The double-colon (`::`) operator pops the top of the stack into a temporary "key"
register. If the "key" register was empty, it does nothing further; otherwise, it pops a single
value, and stores it along with the previous contents of the "key" register as a key-value pair
in the dictionary under construction. At the end of a block, the same thing happens if the
"key" register is nonempty. The comma operator may also be used, and has the same effect as for
other compound terms, accumulating any pending key-value pair and resetting the stack. In
addition, the comma operator clears the "key" register.
{
=a: 1 2 +
=b: 3 4 +
"c": 5 6 +
9 2 *: 3 3 3 * *
=a :: 1 2 +
=b :: 3 4 +
"c" :: 5 6 +
9 2 * :: 3 3 3 * *
}
# has effect () --> ({a: 3, b: 7, "c": 11, 18: 27})
10 { =a: dup 1 +, =b: dup 2 +, =c: dup 3 + }
10 { =a :: dup 1 +, =b :: dup 2 +, =c :: dup 3 + }
# has effect () --> (10 {a: 11, b: 12, c: 13})
## Standard words
@ -197,7 +197,7 @@ That is, a `branch` splits execution, keeping pushed values from all non-failing
## Pattern matching
The `::` operator precedes a *pattern*, to be matched against the top of the stack. If no value
The `:` operator precedes a *pattern*, to be matched against the top of the stack. If no value
is on the stack, an error is signalled. If the pattern fails to match the top of stack,
execution fails as if the `fail` word were executed. Otherwise, new bindings are introduced to
the environment and execution continues.
@ -222,38 +222,38 @@ Patterns follow a grammar:
Examples:
3 ::3 # --> ()
3 ::x # --> (), and places x ⟼ 3 in the environment
3 ::4 # --> fails
[1 2] ::[x y] # --> (), and places x ⟼ 1 and y ⟼ 2 in the environment
3 :3 # --> ()
3 :x # --> (), and places x ⟼ 3 in the environment
3 :4 # --> fails
[1 2] :[x y] # --> (), and places x ⟼ 1 and y ⟼ 2 in the environment
Patterns interact with branching, alternatives and failure:
(::3 =is-3, =not-3) # a closure that yields is-3 or not-3, depending on the top of stack
(::=inc 1 +, ::=dec 1 -) # a kind of object that understands inc and dec "messages"
(:3 =is-3, =not-3) # a closure that yields is-3 or not-3, depending on the top of stack
(:=inc 1 +, :=dec 1 -) # a kind of object that understands inc and dec "messages"
## Iteration and filtering
Imagining a `gt` that succeeds, popping one value and leaving one, if second-on-the-stack is
greater than top-of-the-stack, and fails otherwise:
(0 gt ::n ::c c (c) n 1 - times, ::n ::c) ::times
(0 gt :n :c c (c) n 1 - times, :n :c) :times
A continuation-passing variation:
(0 gt ::n ::c ((c) n 1 - timesK) c, ::n ::c) ::timesK
(0 gt :n :c ((c) n 1 - timesK) c, :n :c) :timesK
We can try to use `branch` and `timesK` to construct `/`, which visits every element of a
sequence in its own branch:
(::vs 0 (::k ::n branch (vs n .) (n 1 + k) if) vs size timesK) ::/
(:vs 0 (:k :n branch (vs n .) (n 1 + k) if) vs size timesK) :/
where `vs n .` retrieves the `n`th element of `vs`.
Then,
(dup 2 remainder 0 = () (fail) if) ::even?
[1 2 3 4 5 6] ::vs
(dup 2 remainder 0 = () (fail) if) :even?
[1 2 3 4 5 6] :vs
[vs / even?] # --> ([2 4 6])

View file

@ -14,7 +14,7 @@ the nearest backtracking point.
`/`, from preserves-path, acts like I imagined `...` might:
[1 2 3] ::vs
[1 2 3] :vs
[vs / 1 +] # --> [2 3 4]
[vs / dup even? !!] # --> [2]; note that `!!` means "fail-if-false", "(fail) unless"
[vs / even?] # --> [#f #t #f]
@ -54,7 +54,7 @@ Maybe with `??` yields bool, with `?` yields a filter.
Then you'd have `v (even? drop T, drop F)!`.
(! drop #t; drop #f) ::boolean
(! drop #t; drop #f) :boolean
[vs / even?] # --> [2]
#{vs / even?} # --> #{2}
@ -114,11 +114,11 @@ You could recast preserves-path in this system:
Existing preserves-path has `<count selector>`, "Counts number of results of selector":
(::filter [filter] length) ::count
(:filter [filter] length) :count
or
([over over !] length nip nip) ::count
([over over !] length nip nip) :count
which you might use as in `[1 2 3 4 5 6] (/ even?) count`. (This suggests reframing
accumulation to be more general, to admit aggregate operators like count and group-by as well
@ -129,7 +129,7 @@ as push-onto-sequence etc.)
The examples become:
- `.annotations =Documentation ^ 0 . /`
- `// dup .^ (::=Test, ::=NondeterministicTest)! dup 1 . rec?`
- `// dup .^ (:=Test, :=NondeterministicTest)! dup 1 . rec?`
## Figuring out what `/` means
@ -138,9 +138,9 @@ Clearly `/` is just one operator for introducing branches; `//` is another examp
So let's imagine a word `branch` that splits execution into two, with `#f` and `#t` pushed in
each of the new branches.
(::n ::c n 0 gt (c (c) n 1 - times) when) ::times
(::n ::c n 0 gt (((c) n 1 - timesK) c) when) ::timesK
(::vs 0 (::k ::n branch (vs n .) (n 1 + k) if) vs length timesK) ::/
(:n :c n 0 gt (c (c) n 1 - times) when) :times
(:n :c n 0 gt (((c) n 1 - timesK) c) when) :timesK
(:vs 0 (:k :n branch (vs n .) (n 1 + k) if) vs length timesK) :/
~~A `branch` succeeds if either or both its branches succeed, failing only if both branches fail.~~
@ -182,7 +182,7 @@ So we can't build a continuationish `branch`, but if the goal is to build a clos
`branch`, then we kind of can, so long as we have a "flatten this sequence onto the stack"
operator:
(::k [(#t k) catch] sequence-to-stack [(#f k) catch] sequence-to-stack) ::branch
(:k [(#t k) catch] sequence-to-stack [(#f k) catch] sequence-to-stack) :branch
Sadly a continuationish `catch` doesn't make sense absent continuation-capture operators, since
there's no reified object which can be invoked multiple times.

30
lib.px
View file

@ -1,42 +1,42 @@
"Loading standard library..." pr nl
(0 gt ::n ::c c (c) n 1 - times, ::n ::c) ::times
(0 gt ::n ::c ((c) n 1 - timesK) c, ::n ::c) ::timesK
(0 gt :n :c c (c) n 1 - times, :n :c) :times
(0 gt :n :c ((c) n 1 - timesK) c, :n :c) :timesK
# aka `reset` perhaps?
([dup !] drop drop) ::do
([dup !] drop drop) :do
# `do` has a similar feel to `forEach`:
(::f ::vs (vs / f) do) ::forEach
(:f :vs (vs / f) do) :forEach
(::f ::vs [vs / f]) ::map
(:f :vs [vs / f]) :map
# `flatMap` is just a usage pattern of map:
# [5 iota] (dup dup) map wr nl
# [5 iota] (drop) map wr nl
(::fc ::tc (::#f fc, drop tc) !) ::if
(::tc (::#f, drop tc) !) ::when
(::fc (::#f fc, drop) !) ::unless
(:fc :tc (:#f fc, drop tc) !) :if
(:tc (:#f, drop tc) !) :when
(:fc (:#f fc, drop) !) :unless
# Awkward in languages like this with failing guards rather than
# explicit boolean predicates
(::f ::vs [vs / dup f (drop) unless]) ::filter
(::g (g drop #t, drop #f)) ::guard-to-predicate
(:f :vs [vs / dup f (drop) unless]) :filter
(:g (g drop #t, drop #f)) :guard-to-predicate
(::top drop top) ::nip
(:top drop top) :nip
([dup !] nip) ::list
([dup !] nip) :list
# Doesn't work, because it leaves the last `n` (= 5) on the stack
# at the end.
#
# (::limit 0 (::k ::n [(n) (n 1 + k)] / !) limit timesK) ::iota
# (:limit 0 (:k :n [(n) (n 1 + k)] / !) limit timesK) :iota
#
(::limit (::n n limit lt drop [(n) (n 1 + loop)] / !) ::loop 0 loop) ::iota
(:limit (:n n limit lt drop [(n) (n 1 + loop)] / !) :loop 0 loop) :iota
# ---------------------------------------------------------------------------
(5 iota wr nl) do
[5 iota 1 +] wr nl
[3 iota ::x 3 iota ::y [x y]] wr nl
[3 iota :x 3 iota :y [x y]] wr nl

View file

@ -12,8 +12,8 @@
((BLOCK ps ...) `(block ,@(map pexpr->term ps)))
((SET ps ...) (error 'pexpr->term "Sets not supported in the model"))
((COMMA) '%comma)
((COLONS 1) '%colon)
((COLONS 2) '%pat)
((COLONS 1) '%:)
((COLONS 2) '%::)
(v v)))
(define (code->term s)
@ -29,8 +29,8 @@
(record (variable-except) word ...)
(block word ...)
%comma
%colon
%pat
%:
%::
shift
catch
fail)
@ -139,7 +139,7 @@
comma
(where (stack_post cont_post) (accumulate stack cont)))
(--> { (%colon word ...) (value value_s ...) env store cont }
(--> { (%:: word ...) (value value_s ...) env store cont }
{ (word ...)
(value_s ...)
env
@ -160,7 +160,7 @@
[suspension_1 ...])
(find-block cont)))
(--> { (%colon word ...) (value value_nv value_s ...) env store cont }
(--> { (%:: word ...) (value value_nv value_s ...) env store cont }
{ (word ...)
(value_s ...)
env
@ -181,7 +181,7 @@
[suspension_1 ...])
(find-block cont)))
(--> { (%pat x word ...) (value value_s ...) ( binding ...) ( cell ...) cont }
(--> { (%: x word ...) (value value_s ...) ( binding ...) ( cell ...) cont }
{ ( word ...) ( value_s ...) ((x loc) binding ...) ((loc value) cell ...) cont }
bind
(fresh loc))
@ -285,7 +285,7 @@
(define *branch*
(term (@closure
(
shift %pat k
shift %: k
(group k #t) (group) catch %comma
(group k #f) (group) catch %comma
) ())))
@ -364,14 +364,14 @@
(term (answer (3))))
(test-->> B-red
(boot "{ =a: 1 2 + =b: 3 4 + \"c\": 5 6 + 9 2 *: 3 3 3 * * }")
(boot "{ =a :: 1 2 + =b :: 3 4 + \"c\" :: 5 6 + 9 2 * :: 3 3 3 * * }")
(term (answer ((dictionary (=a 3) (=b 7) ("c" 11) (18 27))))))
;; (A "(1 2 +) ::f f")
;; (A "(1 2 +) :f f")
;; (A "1 ::a 2 ::b a b +")
;; (A "1 :a 2 :b a b +")
;; (A "1 ::a 2 ::b [a b]")
;; (A "1 :a 2 :b [a b]")
(test-->> B-red
(boot "10 [1 +, 2 +, 3 +]")
@ -390,15 +390,15 @@
(term (answer ((sequence 11 12 13) 10))))
;; (A #<<ENDDOC
;; 2024 ::year 5 ::month 3 ::day
;; "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec" " " split month 1 - ? ::monthName
;; 2024 :year 5 :month 3 :day
;; "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec" " " split month 1 - ? :monthName
;; <date year monthName day>
;; # has effect () --> (<date 2024 "May" 3>), and introduces four new bindings
;; ENDDOC
;; )
;; (A #<<ENDDOC
;; (::month "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec" " " split month 1 - ?) ::monthName
;; (:month "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec" " " split month 1 - ?) :monthName
;; <date 2024 5 monthName 3>
;; ENDDOC
;; )
@ -455,7 +455,7 @@
(traces B-red
(boot #<<ENDDOC
(::month "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec" " " split month 1 - ?) ::monthName
(:month "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec" " " split month 1 - ?) :monthName
<date 2024 5 monthName 3>
ENDDOC
))

View file

@ -216,9 +216,9 @@ export class VM<T extends Embeddable> {
case ',':
return this.comma();
case ':':
return this.key();
case '::':
return this.pattern();
case '::':
return this.key();
default:
return this.error('unexpected-punctuation', w.position);
}
@ -256,7 +256,7 @@ export class VM<T extends Embeddable> {
extractNames(words: Words, scope: Scope<T>): boolean {
for (let i = 0; i < words.exprs.length; i++) {
const w = words.exprs[i];
if (Pexpr.Punct.isColon(w, 2)) {
if (Pexpr.Punct.isColon(w, 1)) {
const pat = words.get(i + 1);
if (pat === void 0) {
this.error('missing-pattern', words.positions[i]);
@ -623,4 +623,4 @@ export function main(args: string[]) {
do {
if (verbose) console.log(vm.dumpState());
} while (vm.step());
}
}