RHS A beatnik interpreter written in tcl. Can take beatnik source from a filename or stdin:
#!/bin/sh
# This line continues for Tcl, but is a single line for 'sh' \
exec tclsh8.5 "$0" ${1+"$@"}
proc log {args} {}
interp alias {} = {} expr
array set values {
A 1 B 3 C 3 D 2 E 1 F 4 G 2 H 4 I 1 J 8 K 5 L 1 M 3
N 1 O 1 P 3 Q 10 R 1 S 1 T 1 U 1 V 4 W 4 X 8 Y 4 Z 10
}
proc peek {&stack} {
upvar ${&stack} stack
lindex $stack end
}
proc push {&stack value} {
upvar ${&stack} stack
lappend stack $value
}
proc pop {&stack} {
upvar ${&stack} stack
set value [lindex $stack end]
set stack [lrange $stack 0 end-1]
return $value
}
proc score {word} {
set score 0
foreach letter [split [string toupper $word] {}] {
incr score $::values($letter)
}
return $score
}
proc doScore {&stack scores index} {
upvar ${&stack} stack
set score [lindex $scores $index]
log "Handling index $index : $score ($stack)"
if { (![string is integer -strict $score]) || $score <0 } {
error "invalid score $score"
}
set step 1
switch -exact -- $score {
0 - 1 - 2 - 3 - 4 {
# Does nothing. The Beatnik Interpreter may mock you
# for your poor scoring, at its discretion.
}
5 {
# Finds the score of the next word and pushes it onto the stack.
# Skips the aforementioned next word.
push stack [lindex $scores [= $index + 1]]
set step 2
}
6 {
# Pops the top number off the stack and discards it.
pop stack
}
7 {
# Adds the top two values on the stack together
# (as described above)
push stack [= [pop stack] + [pop stack]]
}
8 {
# Input a character from the user and push its value on
# the stack. Waits for a keypress.
push stack [scan [gets stdin] %c]
}
9 {
# Pop a number off the stack and output the corresponding
# ASCII character to the screen.
puts -nonewline [format %c [pop stack]]
}
10 {
# Subtract the top value on the stack from the next value
# on the stack, pushing the result.
set x [pop stack]
set y [pop stack]
push stack [= $y - $x]
}
11 {
# Swap the top two values on the stack.
set x [pop stack]
set y [pop stack]
push stack $x
push stack $y
}
12 {
# Duplicate the top value.
push stack [peek stack]
}
13 {
# Pop a number from the stack, and figure out the score of
# the next word. If the number from the stack is zero,
# skip ahead by n words, where n is the score of the next word.
# (The skipping is actually n+1 words, because the word scored
# to give us n is also skipped.
set value [pop stack]
set nextScore [lindex $scores [= $index + 1]]
if { ! $value } {
set step [= 2 + $nextScore]
}
}
14 {
# Same as above, except skip if the value on the stack isn't zero.
set value [pop stack]
set nextScore [lindex $scores [= $index + 1]]
if { $value } {
set step [= 2 + $nextScore]
}
}
15 {
# Skip back n words, if the value on the stack is zero.
set value [pop stack]
set nextScore [lindex $scores [= $index + 1]]
if { ! $value } {
set step [= 0 - $nextScore]
}
}
16 {
# Skip back if it's not zero.
set value [pop stack]
set nextScore [lindex $scores [= $index + 1]]
if { $value } {
set step [= 0 - $nextScore]
}
}
17 {
# Stop the program.
return -code return
}
18 - 19 - 20 - 21 - 22 - 23 {
# Does nothing. However, the score is high enough that
# the Beatnik Interpreter will not mock you, unless it's
# had a really bad day.
}
default {
# Garners "Beatnik applause" for the programmer. This
# generally consists of reserved finger-snapping.
}
}
return $step
}
proc main {script} {
set stack {}
set scores {}
set words [regexp -all -inline {\m\w+\M} $script]
foreach word $words {
set score [score $word]
#log "$word = $score"
lappend scores [score $word]
}
log $scores
for {set i 0} {$i < [llength $scores]} {} {
incr i [doScore stack $scores $i]
}
}
proc readfile {argv} {
switch -exact -- [llength $argv] {
0 {
set fd stdin
}
1 {
set fd [open [lindex $argv 0] r]
}
default {
puts -stdout "Usage: [file tail [info script]] ?filename?"
exit
}
}
set text [read $fd]
if { ![string equal $fd stdin] } {
close $fd
}
return $text
}
if { [string equal [file normalize $argv0] [file normalize [info script]]] } {
fconfigure stdout -buffering none
fconfigure stdin -buffering none
set commands [readfile $argv]
main $commands
puts ""
}And, the standard Hello World program (stolen from the emacs Beatnik mode):
bet you comments secret
this file prints "Hello World!".
It really does! (said me)
Comments allowed
See http://zaaf.nl/emacs/beatnik.html for the interpreter used.
Edit here
we have reasons,
but whether mouse droppin' are holding up schools, feel if I want
letters.
Regardless of truth, agents are abandonin' units again.
Print between lines are separate works.
load sequentially, include users explicitly. Later and evil can me over! (antinormal)
Does I says?
Dust duchess schools foolings. My, my, is iceleaf over genius imposed. Can Neo have decided systems?
But free flips become lines between continued stops. Start gets made standard.
Help! Old world skool really stink (really!) Prerent third closest
from weird deletion.
Interestingly!