Hi, Racket Discourse.
I was feeling a bit antsy last night and thought it would be good idea to take a look at forsp, which I'd glanced at before, but forgotten about again in the meantime.
Anthony presents a very interesting semantics with his fusion of forth and lisp characteristics.
The evaluation is call-by-push-value (CBPV), which I find quite pleasing to use.
I translated some of his code into a Racket macro, substituting his use of $ and ^ with quasiquote and unquote. I also took the liberty of referring to pop as pull, although this is immaterial.
'foo
; pushes the value 'foo onto the stack
`foo
; pulls a value off the stack and binds it to 'foo in the environment
,foo
; refs the value of 'foo in the environment and pushes it onto the stack
foo
; calls the value of 'foo if it is a procedure, or pushes it onto the stack otherwise
(foo ...)
; a closure which captures the environment, and pushes the thunk of `foo ...` onto the stack
foo bar
; call foo, then call bar
I won't claim to be 100% faithful to the author's explanation, since it was merely an exploratory dive into the system, and forths in general. Very charming, nonetheless.
Just look at this Y-combinator:
(`f (`x (,x x) f) dup force) `Y
And the obligatory list?:
(`g (,g Y)) `rec ; a helper for working with Y
(`self
`_
(#false (,_ cdr self) (,_ pair?) if) #true (,_ nil?) if)
rec
`list?
The implementation is reasonably short, and could probably be streamlined some more:
#lang racket/base
(require
(only-in
racket/function disjoin)
(only-in
racket/dict dict-ref dict-set dict?)
(only-in
racket/bool nor)
(for-syntax
racket/base
syntax/parse))
(define stack-item?
(disjoin
symbol? string? char? exact-integer? rational? boolean?
null? pair?
procedure?))
(define stack (make-parameter #false))
(define table (make-parameter #false))
(define (pull)
(unless (pair? {stack})
(error 'forsp "cannot pull from an empty stack"))
(let ([ex (car {stack})])
{stack (cdr {stack})}
ex))
(define (push ex)
(unless (stack-item? ex)
(error 'forsp "expected a stack-item? found: ~a" ex))
{stack (cons ex {stack})})
(define (pull/set ex)
{table (dict-set {table} ex (pull))})
(define (unknown-handler ex)
(ฮป _ (error 'forsp "unknown reference: ~a" ex)))
(define (ref/push ex)
(push (dict-ref {table} ex (unknown-handler ex))))
(define (ref/call ex)
(define ref (dict-ref {table} ex (unknown-handler ex)))
(if (procedure? ref) (ref) (push ref)))
(define (nop/push) (push void))
(define (clo/push proc)
(define tbl {table})
(push (ฮป _ (parameterize ([table tbl]) (proc)))))
(define-syntax (forsp stx)
(syntax-parse stx
#:datum-literals (nil quote quasiquote unquote unquote-splicing)
[(_ (~or* 'ex:id ex:string ex:char ex:exact-integer ex:boolean nil) exs ...)
#;quote-push
#'(begin (push (~? 'ex null)) (forsp exs ...))]
[(_ `ex:id exs ...)
#;quote-pull-set
#'(begin (pull/set 'ex) (forsp exs ...))]
[(_ ,ex:id exs ...)
#;quote-ref-push
#'(begin (ref/push 'ex) (forsp exs ...))]
#;[(_ ,@ex:expr exs ...)
#;quote-ref-push-xeno
#'(begin (push ex) (forsp exs ...))]
[(_ ex:id exs ...)
#;quote-ref-call
#'(begin (ref/call 'ex) (forsp exs ...))]
[(_ () exs ...)
#;void-push
#'(begin (nop/push) (forsp exs ...))]
[(_ (ex:expr ...) exs ...)
#;closure-push
#'(begin (clo/push (ฮป _ (forsp ex ...))) (forsp exs ...))]
[(_) #''ok]))
And here we have some examples of its usage:
(define โ compose1)
; some built-in functions available to the user
(define builtins
`([symbol? . ,(โ push symbol? pull)]
[string? . ,(โ push string? pull)]
[char? . ,(โ push char? pull)]
[integer? . ,(โ push exact-integer? pull)]
[rational? . ,(โ push rational? pull)]
[boolean? . ,(โ push boolean? pull)]
[nil? . ,(โ push null? pull)]
[pair? . ,(โ push pair? pull)]
[dict? . ,(โ push dict? pull)]
[closure? . ,(โ push procedure? pull)]
[not . ,(โ push not pull)]
[nor . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (nor a b))))]
[eq? . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (equal? a b))))]
[cons . ,(โ push (ฮป _ (cons (pull) (pull))))]
[car . ,(โ push car pull)]
[cdr . ,(โ push cdr pull)]
[stack . ,(โ push stack)]
[table . ,(โ push table)]
[cswap . ,(ฮป _ (when (pull) (let ([a (pull)] [b (pull)]) (push a) (push b))))]
[< . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (< a b))))]
[โค . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (<= a b))))]
[> . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (> a b))))]
[โฅ . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (>= a b))))]
[= . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (= a b))))]
[+ . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (+ a b))))]
[- . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (- a b))))]
[* . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (* a b))))]
[/ . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (/ a b))))]
[ยซ . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (arithmetic-shift a b))))]
[ยป . ,(โ push (ฮป _ (let ([b (pull)] [a (pull)]) (arithmetic-shift a (- b)))))]
[chars . ,(โ push string->list pull)]
[print . ,(โ println pull)]))
(define-syntax-rule
(fresh-forsp ex ...)
(parameterize ([stack null]
[table builtins])
(forsp ex ...)))
(fresh-forsp
;------------------------------------------------------------
; utility procedures
;------------------------------------------------------------
(`_ ,_ ,_) `dup
(#true cswap) `swap
(`_ _) `force
(`a `b `c ,c ,b ,a ,c) `over2
(`a `b `c ,b ,a ,c) `rot
(force cswap `_ force) `if
(`f `t `c `fn ,f ,t ,c fn) `endif
(`f (`x (,x x) f) dup force) `Y
(`g (,g Y)) `rec
(`self
`_
(#false (,_ cdr self) (,_ pair?) if) #true (,_ nil?) if)
rec
`list?
;------------------------------------------------------------
'-----------------------------
`dashed-line
'say-hello print
"Hello, world!" print
dashed-line print
'make-a-list print
nil 3 cons 2 cons 1 cons print
dashed-line print
'is-this-a-list? print
2 2 cons dup print
list? print
dashed-line print
'get-the-car print
3 2 cons dup print
car print
dashed-line print
'get-the-cdr print
3 2 cons dup print
cdr print
dashed-line print
'is-3=4? print
(#false print) (#true print) 3 4 eq? if
dashed-line print
'is-1=1? print
,if (1 1 eq?)
(#true print)
(#false print)
endif
dashed-line print
'1+2= print
1 2 + print
dashed-line print
'2-1= print
2 1 - print
dashed-line print
'2*2= print
2 2 * print
dashed-line print
'2/2= print
2 2 / print
dashed-line print
(nor not) `or
(`x `y ,y not ,x not nor) `and
(and not) `nand
'false-or-false print
#f #f or print
dashed-line print
'true-and-true print
#t #t and print
dashed-line print
'false-nand-false print
#f #f nand print
dashed-line print
(`self
`n
(,n 1 - self ,n *) 1 (0 ,n eq?) if)
rec
`factorial
'factorial-5 print
5 factorial print
dashed-line print
'factorial-7 print
7 factorial print
dashed-line print
(`self
`n `fn
(fn ,fn ,n 1 - self) () (0 ,n eq?) if)
rec
`repeat
1 (dup) 2 repeat
'print-1-times-3 print
(print) 3 repeat
dashed-line print
(stack nil?) `stack-nil?
'is-the-stack-empty? print
stack-nil? print
dashed-line print
'1-jumps-over-the-others print
1 2 3 stack print
over2
stack print
dashed-line print
'rotate-3 print
(rot stack print)
3 repeat
dashed-line print)
'say-hello
"Hello, world!"
'-----------------------------
'make-a-list
'(1 2 3)
'-----------------------------
'is-this-a-list?
'(2 . 2)
#f
'-----------------------------
'get-the-car
'(2 . 3)
2
'-----------------------------
'get-the-cdr
'(2 . 3)
3
'-----------------------------
'is-3=4?
#f
'-----------------------------
'is-1=1?
#t
'-----------------------------
'1+2=
3
'-----------------------------
'2-1=
1
'-----------------------------
'2*2=
4
'-----------------------------
'2/2=
1
'-----------------------------
'false-or-false
#f
'-----------------------------
'true-and-true
#t
'-----------------------------
'false-nand-false
#t
'-----------------------------
'factorial-5
120
'-----------------------------
'factorial-7
5040
'-----------------------------
'print-1-times-3
1
1
1
'-----------------------------
'is-the-stack-empty?
#t
'-----------------------------
'1-jumps-over-the-others
'(3 2 1)
'(1 3 2 1)
'-----------------------------
'rotate-3
'(2 1 3 1)
'(3 2 1 1)
'(1 3 2 1)
'-----------------------------
'ok
>
Have a good weekend everyone!
Edit: I thought of a cute way to incorporate keywords:
20 'john #: man
21 'mary #: woman
#:woman `name `age
,name 'woman cons print
,age 'woman cons print
#:man `name `age
,name 'man cons print
,age 'man cons print
'flounder #: fish
#:bird `type
;=> '(woman . mary)
;=> '(woman . 21)
;=> '(man . john)
;=> '(man . 20)
;=> forsp: expected the keyword #:bird, found: #:fish
When the macro encounters the empty keyword, #:, it "quotes" the next identifier as a keyword, and pushes it onto the stack.
Then, when the macro encounters any other keyword, it pulls the next item from the stack, which must be a keyword equal to it. If it is not, an error is raised.